Autoformat everything with brittany.

[?]

May 29, 2020, 2:18 PM

EFSXYZPOGA5M4DN65IEIDO7JK6U34DMQELAPHOIL2UAT6HRC66BAC

Dependencies

[2] 4R7XIYK3 Switch from ClassyPrelude to Relude
[3] 64C6AWH6 Rename Ananke -> Quixotic, project reboot.
[4] VJPT6HDR Fix remaining type errors after addition of login handler.
[5] WZUHEZSB Start of migration back toward snap.
[6] GCVQD44V Create amends endpoint, switch to UUID primary keys
[7] RN7EI6IN Update database layer to use CreditTo
[8] Z3MK2PJ5 Add GET handler for retrieving auction data.
[9] MJ6R42RC Utility methods for reading key & cert data.
[10] BXGLKYRX Added primitive user registration handler.
[11] Z3M53KTL Adrift.
[12] NAS4BFL4 Trivial stylish-haskell reformat.
[13] POX3UAMT Enabling logging of time to contributor/project accounts
[14] 4IQVQL4T Added client for payouts endpoint.
[15] QADKFHAR Adds CreatePayment handler implementation.
[16] FXJQACES Ensure that auction is not ended at the time of bid
[17] 7XN3I3QJ Add 'loggedIntervals' endpoint.
[18] ADMKQQGC Initial empty Snap project.
[19] SCXG6TJW Make log reduction safer in presence of overlapping events.
[20] SPJCFHXW Update shell scripts to point to https://aftok.com and prompt for input.
[21] BROSTG5K Beginning of modularization of server.
[22] 5DRIWGLU Improving TimeLog specs
[23] HALRDT2F Added initial auction create route.
[24] B6HWAPDP Modularize & update to recent haskoin.
[25] BSIUHCGF Add payment response handler.
[26] Q5X5RYQL stylish-haskell reformatting
[27] HO2PFRAB Client login now handles response correctly.
[28] EMVTF2IW WIP moving back to snap.
[29] 64VI73NP Server now compiles using abstracted SQLite
[30] RPAJLHMT Change to use UUIDs instead of ints for primary keys.
[31] TCOAKCGG Completed conversion to snap.
[32] 75N3UJ4J More progression toward lenses.
[33] TJEUE7TY Added OverloadedStrings to eliminate Text fiddling.
[34] EKY7U7SK Finish conversion to stack.
[35] JV3UEPNC Fix Aeson constructors.
[36] Y35QCWYW Minor improvement in WorkIndex type to eliminate duplicated information.
[37] 6L5BK5EH Use generic SMTP rather than Sendmail-specific mail client.
[38] M4KM76DG Merge branch 'stackify'
[39] 4B66XH43 Add sample billing config
[40] NLZ3JXLO Fix formatting with stylish-haskell.
[41] FD7SV5I6 Fix handling of event_t columns.
[42] 7HPY3QPF Fix linting errors. (yay hlint!)
[43] MB5SHULB Add route for accepting an invitation with an existing account
[44] 2KZPOGRB Once you get Haskell to compile, the tests pass!
[45] HMDM3B55 Implement core of payments/billing infrastructure.
[46] EW2XN7KU Update docker build, clean up migration for payments tables.
[47] 2XQD6KKK Add invitation logic and clean up DBProg error handling.
[48] PBD7LZYQ Postgres & auth are beginning to function.
[49] WJO37T74 Restored the single test to functionality.
[50] 2G3GNDDU Event logging is now functioning in postgres.
[51] LCBJULKE Fix swapped default and key in QConfig.
[52] MGOF7IUF Update TASKS list to reflect completed projects.
[53] OV5AKJHA Remove unused LogInterval type.
[54] GLFF5ZDK Factor winningBids for easier testing.
[55] JFOEOFGA stylish-haskell formatting.
[56] 7KZP4RHZ Switch from Data.Time to Data.Thyme
[57] TLQ72DSJ Lenses, sqlite-simple
[58] O5FVTOM6 Undo JSON silliness, enable a couple more routes.
[59] 3GBSDS5P Fix out-of-date test code, add skeleton for payments spec.
[60] DFOBMSAO Initial work on payments API
[61] LD4GLVSF More database stuff.
[62] LAROLAYU WIP
[63] LHJ2HFXV Add property test for auction algorithm.
[64] WZFQDWW4 Add retrieval/storage of current exchange rate data to payment recording.
[65] 2MNO5FUY Upgrade LTS version
[66] SEWTRB6S Implement payment request creation functions.
[67] 5OI44E4E Add authentication to auction search.
[68] Z7KS5XHH Very WIP. Wow.
[69] RSEB2NFG Replacing Snap with Scotty.
[70] KNSI575V Cleanup of EventLog types.
[71] W35DDBFY Factor common JSON conversions up into client lib module.
[72] EKI57EJR Add alternative implementation of auction winner determination.
[73] O722AOKE Add route to allow crediting of events to users/projects.
[74] 4U7F3CPI THE GREAT RENAMING OF THINGS!
[75] NMWWP4ZN Trying out Hspec
[76] F2XLL7XW Remove Ord Bid & sort in favor of sortBy
[77] 5ZSKPQ3K Add created_at and auction_start timestamps to auction
[78] EZQG2APB Update task list.
[79] 3QVT6MA6 Add database support for event amend operations.
[80] BWN72T44 Don't accept work timestamp from an external source.
[81] IZEVQF62 Work in progress replacing sqlite with postgres.
[82] GMYPBCWE Make docker-compose work.
[83] TNR3TEHK Switch to Postgres + snaplet arch compiles.
[84] NEDDHXUK Reformat via stylish-haskell
[85] A6HKMINB Attempting to improve JSON handling.
[86] V2VDN77H Enable postgres configuration via environment variable for Heroku.
[87] WAIX6AGN Add event serialization for PaymentRequest & Payment
[88] I2KHGVD4 Require project permissions for access to most data.
[89] 4FDQGIXN Make payment request retrieval key an opaque 32-bit hash.
[90] UILI6PIL The route-based logStart/logStop is nicer.
[91] P6NR2CGX Beginning of implementation of depreciation.
[92] 7VGYLTMU Clean up schema version handling.
[93] 73NDXDEZ Begin implementation of billing event persistence.
[94] N4NDAZYT Initial implementation of payouts.
[95] HBULCDN6 Add tests for auction winner determination algorithm.
[96] UOG5H2TW Default work logging credit to logged-in user.
[97] ASF3UPJL Add auction creation and bid handlers
[98] NVOCQVAS Initial failing tests.
[99] GKGVYBZG Added JSON serialization to TimeLog
[100] ZP62WC47 Begin conversion to build with stack.
[101] KEP5WUFJ Convert project to stack-based build.
[102] XTBSG4C7 Adding serveJSON combinator to eliminate some boilerplate from handlers.
[103] UUR6SMCA Add start of specs for auctions.
[104] AL37SVTC Implement payments service endpoints.
[105] PGZJ736C Update aftok.cfg.example and revise INSTALL instructions
[106] 4ZLEDBK7 Initial attempts at dockerizing, cabal isn't cooperating.
[107] WO2MINIF Auctions now compile!
[108] DXIGERDT Change order of Docker build to avoid rebuilding the universe.
[109] Y3LIJ5US Add handler for CreatePaymentRequest
[110] O227CEAV Adds storage of original event JSON for some DBOp constructors.
[111] EQXRXRZD Changed to use tasty instead of test-framework
[112] 4SCFOJGN Specs for recovering intervals from the log now pass.
[113] MMRVIM3F Removes copy/paste error from email invitation subject.
[114] IPG33FAW Add billing daemon
[115] QMRKFEPG Refactor QDB to use a free monad algebra instead.

Change contents

replacement in daemon/AftokD/AftokM.hs at line 9

[2.443]→[3.1666:2042](∅→∅),[3.1666]→[3.1666:2042](∅→∅)

import Control.Error.Util (maybeT)
import Control.Lens ((^.), makeLenses, makeClassyPrisms, traverseOf, to)
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Except (MonadError, throwError)
import Control.Monad.Reader (MonadReader)
import Control.Monad.Trans.Except (ExceptT, withExceptT, runExceptT)
import Control.Monad.Trans.Reader (mapReaderT, withReaderT)

[2.443]

[3.2042]

import Control.Error.Util ( maybeT )
import Control.Lens ( (^.)
, makeLenses
, makeClassyPrisms
, traverseOf
, to
)
import Control.Monad.IO.Class ( MonadIO(..) )
import Control.Monad.Except ( MonadError
, throwError
)
import Control.Monad.Reader ( MonadReader )
import Control.Monad.Trans.Except ( ExceptT
, withExceptT
, runExceptT
)
import Control.Monad.Trans.Reader ( mapReaderT
, withReaderT
)
replacement in daemon/AftokD/AftokM.hs at line 29

[3.2043]→[3.2043:2102](∅→∅)

import Crypto.Random.Types (MonadRandom(..))

[3.2043]

[3.2102]

import Crypto.Random.Types ( MonadRandom(..) )
replacement in daemon/AftokD/AftokM.hs at line 31

[3.2103]→[3.2103:2209](∅→∅),[3.2209]→[2.444:505](∅→∅),[2.505]→[3.427:531](∅→∅),[3.2238]→[3.427:531](∅→∅),[3.531]→[3.2325:2360](∅→∅),[3.2325]→[3.2325:2360](∅→∅),[3.2360]→[3.532:668](∅→∅),[3.668]→[3.2397:2445](∅→∅),[3.2397]→[3.2397:2445](∅→∅)

import Database.PostgreSQL.Simple (Connection, connect)
import Data.Thyme.Clock as C
import Data.Thyme.Time as C
import qualified Data.Text as T
import qualified Network.Mail.Mime as Mime
import qualified Network.Mail.SMTP as SMTP
import Network.URI (URI, parseURI)
import Network.Haskoin.Address (Address)
import Text.StringTemplate (directoryGroup, newSTMP, getStringTemplate, setManyAttrib, render)
import Filesystem.Path.CurrentOS (encodeString)

[3.2103]

[3.2445]

import Database.PostgreSQL.Simple ( Connection
, connect
)
import Data.Thyme.Clock as C
import Data.Thyme.Time as C
import qualified Data.Text as T
import qualified Network.Mail.Mime as Mime
import qualified Network.Mail.SMTP as SMTP
import Network.URI ( URI
, parseURI
)
import Network.Haskoin.Address ( Address )
import Text.StringTemplate ( directoryGroup
, newSTMP
, getStringTemplate
, setManyAttrib
, render
)
import Filesystem.Path.CurrentOS ( encodeString )
replacement in daemon/AftokD/AftokM.hs at line 51

[3.2446]→[3.2446:2483](∅→∅)

import Network.Bippy.Types (Satoshi)

[3.2446]

[3.2483]

import Network.Bippy.Types ( Satoshi )
replacement in daemon/AftokD/AftokM.hs at line 53

[3.2484]→[3.669:799](∅→∅),[3.799]→[3.2571:2991](∅→∅),[3.2571]→[3.2571:2991](∅→∅),[3.2991]→[3.800:854](∅→∅),[3.854]→[3.3060:3089](∅→∅),[3.3060]→[3.3060:3089](∅→∅)

import Aftok.Types (User, UserId, ProjectId(..), userEmail, _Email)
import Aftok.Currency.Bitcoin (NetworkId, satoshi)
import qualified Aftok.Config as AC
import Aftok.Billables (Billable, Billable', Subscription', customer, name, billable, project, paymentRequestEmailTemplate, paymentRequestMemoTemplate)
import qualified Aftok.Database as DB
import Aftok.Database.PostgreSQL (QDBM(..))
import qualified Aftok.Payments as P
import Aftok.Payments.Types (PaymentKey(..), subscription, paymentRequestTotal, paymentKey)
import Aftok.Project (Project, projectName)
import qualified AftokD as D

[3.2484]

[3.3089]

import Aftok.Types ( User
, UserId
, ProjectId(..)
, userEmail
, _Email
)
import Aftok.Currency.Bitcoin ( NetworkId
, satoshi
)
import qualified Aftok.Config as AC
import Aftok.Billables ( Billable
, Billable'
, Subscription'
, customer
, name
, billable
, project
, paymentRequestEmailTemplate
, paymentRequestMemoTemplate
)
import qualified Aftok.Database as DB
import Aftok.Database.PostgreSQL ( QDBM(..) )
import qualified Aftok.Payments as P
import Aftok.Payments.Types ( PaymentKey(..)
, subscription
, paymentRequestTotal
, paymentKey
)
import Aftok.Project ( Project
, projectName
)
import qualified AftokD as D
replacement in daemon/AftokD/AftokM.hs at line 94

[3.3297]→[3.3297:3335](∅→∅)

_Overdue = _PaymentErr . P._Overdue

[3.3297]

[3.3335]

_Overdue = _PaymentErr . P._Overdue
replacement in daemon/AftokD/AftokM.hs at line 105

[3.3564]→[3.883:920](∅→∅),[3.920]→[3.3593:3657](∅→∅),[3.3593]→[3.3593:3657](∅→∅)

networkMode = pcfg . P.networkMode
signingKey = pcfg . P.signingKey
pkiData = pcfg . P.pkiData

[3.3564]

[3.3657]

networkMode = pcfg . P.networkMode
signingKey = pcfg . P.signingKey
pkiData = pcfg . P.pkiData
replacement in daemon/AftokD/AftokM.hs at line 129

[3.4340]→[3.4340:4423](∅→∅)

void . runExceptT $ (runReaderT . runAftokM) createProjectsPaymentRequests $ env

[3.4340]

[3.4423]

void
. runExceptT
$ (runReaderT . runAftokM) createProjectsPaymentRequests
$ env
replacement in daemon/AftokD/AftokM.hs at line 141

[3.4687]→[3.4687:4989](∅→∅)

now <- liftIO C.getCurrentTime
let ops = P.BillingOps memoGen (fmap Just . paymentURL) payloadGen
subscribers <- liftQDBM $ DB.findSubscribers pid
requests <- traverse (\uid -> P.createPaymentRequests ops now uid pid) $ subscribers
traverse_ sendPaymentRequestEmail (join requests)

[3.4687]

[3.4989]

now <- liftIO C.getCurrentTime
let ops = P.BillingOps memoGen (fmap Just . paymentURL) payloadGen
subscribers <- liftQDBM $ DB.findSubscribers pid
requests <-
traverse (\uid -> P.createPaymentRequests ops now uid pid) $ subscribers
traverse_ sendPaymentRequestEmail (join requests)
replacement in daemon/AftokD/AftokM.hs at line 151

[3.5097]→[3.5097:5347](∅→∅)

let AC.SmtpConfig{..} = cfg ^. (dcfg . D.smtpConfig)
preqCfg = cfg ^. (dcfg . D.paymentRequestConfig)
reqMay = do
preq <- DB.findPaymentRequestId reqId
preq' <- traverseOf P.subscription DB.findSubscriptionBillable preq

[3.5097]

[3.5347]

let AC.SmtpConfig {..} = cfg ^. (dcfg . D.smtpConfig)
preqCfg = cfg ^. (dcfg . D.paymentRequestConfig)
reqMay = do
preq <- DB.findPaymentRequestId reqId
preq' <- traverseOf P.subscription DB.findSubscriptionBillable preq
replacement in daemon/AftokD/AftokM.hs at line 158

[3.5501]→[3.5501:5569](∅→∅)

req <- maybeT (throwError $ DBErr DB.SubjectNotFound) pure reqMay

[3.5501]

[3.5569]

req <- maybeT (throwError $ DBErr DB.SubjectNotFound) pure reqMay
replacement in daemon/AftokD/AftokM.hs at line 160

[3.5614]→[3.5614:5670](∅→∅),[3.5670]→[3.1077:1179](∅→∅)

mail <- buildPaymentRequestEmail preqCfg req bip70URL
let mailer = maybe (SMTP.sendMailWithLogin _smtpHost) (SMTP.sendMailWithLogin' _smtpHost) _smtpPort

[3.5614]

[3.5762]

mail <- buildPaymentRequestEmail preqCfg req bip70URL
let mailer = maybe (SMTP.sendMailWithLogin _smtpHost)
(SMTP.sendMailWithLogin' _smtpHost)
_smtpPort
replacement in daemon/AftokD/AftokM.hs at line 166

[3.1181]→[3.5808:5923](∅→∅),[3.5808]→[3.5808:5923](∅→∅),[3.5923]→[3.1182:1307](∅→∅),[3.1307]→[3.6025:6057](∅→∅),[3.6025]→[3.6025:6057](∅→∅),[3.6057]→[3.1308:1348](∅→∅)

buildPaymentRequestEmail :: (MonadIO m, MonadError AftokDErr m)
=> D.PaymentRequestConfig
-> P.PaymentRequest' (Subscription' (User (NetworkId, Address)) (Billable' Project UserId Satoshi))
-> URI
-> m Mime.Mail

[3.1181]

[3.6092]

buildPaymentRequestEmail
:: (MonadIO m, MonadError AftokDErr m)
=> D.PaymentRequestConfig
-> P.PaymentRequest'
( Subscription'
(User (NetworkId, Address))
(Billable' Project UserId Satoshi)
)
-> URI
-> m Mime.Mail
replacement in daemon/AftokD/AftokM.hs at line 178

[3.6219]→[2.506:615](∅→∅)

let billTemplate = (newSTMP . T.unpack) <$> req ^. (subscription . billable . paymentRequestEmailTemplate)

[3.6219]

[3.6326]

let billTemplate =
(newSTMP . T.unpack)
<$> req
^. (subscription . billable . paymentRequestEmailTemplate)
replacement in daemon/AftokD/AftokM.hs at line 184

[3.6439]→[3.6439:6526](∅→∅)

Nothing -> throwError $ ConfigError "Could not find template for invitation email"

[3.6439]

[3.1349]

Nothing ->
throwError $ ConfigError "Could not find template for invitation email"
replacement in daemon/AftokD/AftokM.hs at line 188

[3.6596]→[3.6596:6805](∅→∅),[3.6805]→[3.1371:1406](∅→∅),[3.1406]→[3.6841:6891](∅→∅),[3.6841]→[3.6841:6891](∅→∅)

toEmail = req ^. (subscription . customer . userEmail)
pname = req ^. (subscription . billable . project . projectName)
total = req ^. (P.paymentRequest . to paymentRequestTotal)
setAttrs = setManyAttrib
[ ("from_email", fromEmail ^. _Email)

[3.6596]

[3.6891]

toEmail = req ^. (subscription . customer . userEmail)
pname = req ^. (subscription . billable . project . projectName)
total = req ^. (P.paymentRequest . to paymentRequestTotal)
setAttrs = setManyAttrib
[ ("from_email" , fromEmail ^. _Email)
replacement in daemon/AftokD/AftokM.hs at line 194

[3.6929]→[3.6929:6975](∅→∅),[3.6975]→[2.616:717](∅→∅)

, ("to_email", toEmail ^. _Email)
, ("amount_due", show $ total ^. satoshi)
, ("payment_url", show paymentUrl)

[3.6929]

[3.7078]

, ("to_email" , toEmail ^. _Email)
, ("amount_due" , show $ total ^. satoshi)
, ("payment_url" , show paymentUrl)
replacement in daemon/AftokD/AftokM.hs at line 200

[3.1533]→[3.7208:7281](∅→∅),[3.7208]→[3.7208:7281](∅→∅)

subject = "Payment is due for your "<>pname<>" subscription!"

[3.1533]

[3.1534]

subject = "Payment is due for your " <> pname <> " subscription!"
replacement in daemon/AftokD/AftokM.hs at line 204

[3.7418]→[3.1604:1645](∅→∅),[3.1645]→[2.718:735](∅→∅),[2.735]→[3.1662:1683](∅→∅),[3.1662]→[3.1662:1683](∅→∅),[3.1683]→[3.7500:7531](∅→∅),[3.7500]→[3.7500:7531](∅→∅)

memoGen :: Subscription' UserId Billable
-> C.Day
-> C.UTCTime
-> AftokM (Maybe Text)

[3.7418]

[3.7531]

memoGen
:: Subscription' UserId Billable -> C.Day -> C.UTCTime -> AftokM (Maybe Text)
replacement in daemon/AftokD/AftokM.hs at line 208

[3.7639]→[2.736:827](∅→∅)

let template = (newSTMP . T.unpack) <$> (sub ^. (billable . paymentRequestMemoTemplate))

[3.7639]

[3.1684]

let template =
(newSTMP . T.unpack)
<$> (sub ^. (billable . paymentRequestMemoTemplate))
replacement in daemon/AftokD/AftokM.hs at line 215

[2.873]→[2.873:916](∅→∅)

, ("issue_time", show requestTime)

[2.873]

[3.7973]

, ("issue_time" , show requestTime)
replacement in daemon/AftokD/AftokM.hs at line 224

[3.8210]→[3.8210:8280](∅→∅)

let hostname = env ^. (dcfg . D.paymentRequestConfig . D.aftokHost)

[3.8210]

[3.8280]

let hostname = env ^. (dcfg . D.paymentRequestConfig . D.aftokHost)
replacement in daemon/AftokD/AftokM.hs at line 227

[3.8354]→[3.8354:8454](∅→∅)

(throwError . ConfigError $ "Could not parse path " <> paymentRequestPath <> " to a valid URI")

[3.8354]

[3.8454]

( throwError
. ConfigError
$ "Could not parse path "
<> paymentRequestPath
<> " to a valid URI"
)
replacement in daemon/AftokD/AftokM.hs at line 236

[3.8505]→[2.917:1018](∅→∅)

payloadGen :: Monad m => Subscription' UserId Billable -> C.Day -> C.UTCTime -> m (Maybe ByteString)

[3.8505]

[3.8606]

payloadGen
:: Monad m
=> Subscription' UserId Billable
-> C.Day
-> C.UTCTime
-> m (Maybe ByteString)
replacement in daemon/AftokD.hs at line 5

[3.8770]→[3.8770:8790](∅→∅)

import Control.Lens

[3.8770]

[3.8790]

import Control.Lens
replacement in daemon/AftokD.hs at line 9

[3.8896]→[3.8896:8947](∅→∅),[3.8947]→[2.1020:1126](∅→∅)

import Database.PostgreSQL.Simple (ConnectInfo)
import Filesystem.Path.CurrentOS (fromText, encodeString)
import qualified Filesystem.Path.CurrentOS as P

[3.8896]

[3.9015]

import Database.PostgreSQL.Simple ( ConnectInfo )
import Filesystem.Path.CurrentOS ( fromText
, encodeString
)
import qualified Filesystem.Path.CurrentOS as P
replacement in daemon/AftokD.hs at line 15

[3.9016]→[3.1717:1748](∅→∅),[3.1748]→[3.9041:9077](∅→∅),[3.9041]→[3.9041:9077](∅→∅)

import Aftok.Types (Email(..))
import qualified Aftok.Config as AC

[3.9016]

[3.9077]

import Aftok.Types ( Email(..) )
import qualified Aftok.Config as AC
replacement in daemon/AftokD.hs at line 34

[2.1198]→[3.1749:1770](∅→∅),[3.9494]→[3.1749:1770](∅→∅),[3.1770]→[3.9516:9576](∅→∅),[3.9516]→[3.9516:9576](∅→∅)

loadConfig cfgFile =
readConfig =<< C.load [C.Required $ encodeString cfgFile]

[2.1198]

[3.9576]

loadConfig cfgFile = readConfig =<< C.load [C.Required $ encodeString cfgFile]
replacement in daemon/AftokD.hs at line 37

[3.9614]→[3.1771:1795](∅→∅),[3.1795]→[3.9639:9690](∅→∅),[3.9639]→[3.9639:9690](∅→∅),[3.9690]→[3.1796:1853](∅→∅),[3.1853]→[3.9748:9868](∅→∅),[3.9748]→[3.9748:9868](∅→∅)

readConfig cfg = Config
<$> (AC.readSmtpConfig $ C.subconfig "smtp" cfg)
<*> (AC.readBillingConfig $ C.subconfig "billing" cfg)
<*> (AC.readConnectInfo $ C.subconfig "db" cfg)
<*> (readPaymentRequestConfig $ C.subconfig "payment_requests" cfg)

[3.9614]

[3.9868]

readConfig cfg =
Config
<$> (AC.readSmtpConfig $ C.subconfig "smtp" cfg)
<*> (AC.readBillingConfig $ C.subconfig "billing" cfg)
<*> (AC.readConnectInfo $ C.subconfig "db" cfg)
<*> (readPaymentRequestConfig $ C.subconfig "payment_requests" cfg)
replacement in daemon/AftokD.hs at line 45

[3.9934]→[3.9934:10123](∅→∅)

readPaymentRequestConfig cfg = PaymentRequestConfig
<$> C.require cfg "aftok_host"
<*> (fromText <$> C.require cfg "template_path")
<*> (Email <$> C.require cfg "payment_from_email")

[3.9934]

readPaymentRequestConfig cfg =
PaymentRequestConfig
<$> C.require cfg "aftok_host"
<*> (fromText <$> C.require cfg "template_path")
<*> (Email <$> C.require cfg "payment_from_email")
replacement in daemon/Main.hs at line 3

[2.1239]→[3.10199:10224](∅→∅),[3.10199]→[3.10199:10224](∅→∅)

module Main (main) where

[2.1239]

[3.10224]

module Main
( main
)
where
replacement in daemon/Main.hs at line 10

[3.10247]→[2.1242:1273](∅→∅),[2.1273]→[3.10247:10293](∅→∅),[3.10247]→[3.10247:10293](∅→∅),[3.10293]→[2.1274:1318](∅→∅),[2.1318]→[3.10293:10341](∅→∅),[3.10293]→[3.10293:10341](∅→∅)

import Control.Exception (try)
import System.Environment (getEnv)
import System.IO.Error (IOError)
import Filesystem.Path.CurrentOS (decodeString)

[3.10247]

[3.10341]

import Control.Exception ( try )
import System.Environment ( getEnv )
import System.IO.Error ( IOError )
import Filesystem.Path.CurrentOS ( decodeString )
replacement in daemon/Main.hs at line 15

[3.10342]→[3.10342:10419](∅→∅)

import qualified AftokD as D
import AftokD.AftokM (createAllPaymentRequests)

[3.10342]

[3.10419]

import qualified AftokD as D
import AftokD.AftokM ( createAllPaymentRequests )
replacement in daemon/Main.hs at line 21

[2.1381]→[3.10513:10595](∅→∅),[3.10513]→[3.10513:10595](∅→∅)

cfg <- D.loadConfig . decodeString $ either (const "conf/aftok.cfg") id cfgPath

[2.1381]

[3.10595]

cfg <- D.loadConfig . decodeString $ either (const "conf/aftok.cfg")
id
cfgPath
replacement in lib/Aftok/Auction.hs at line 6

[3.52]→[3.1902:2022](∅→∅),[3.2022]→[3.3:85](∅→∅),[3.96]→[3.3:85](∅→∅)

import Data.Hourglass (Seconds(..))
import Data.Ratio ((%))
import Data.Traversable (for)
import Data.Thyme.Clock as C
import Data.Thyme.Format ()

[3.64]

[3.135]

import Data.Hourglass ( Seconds(..) )
import Data.Ratio ( (%) )
import Data.Traversable ( for )
import Data.Thyme.Clock as C
import Data.Thyme.Format ( )
replacement in lib/Aftok/Auction.hs at line 13

[3.27]→[3.2023:2193](∅→∅)

import Aftok.Types (UserId, ProjectId)
import Aftok.Currency.Bitcoin (satoshi, ssub)
import Network.Bippy.Types (Satoshi(..))

[3.27]

[3.5213]

import Aftok.Types ( UserId
, ProjectId
)
import Aftok.Currency.Bitcoin ( satoshi
, ssub
)
import Network.Bippy.Types ( Satoshi(..) )
replacement in lib/Aftok/Auction.hs at line 57

[3.181]→[3.181:198](∅→∅),[3.198]→[3.2230:2286](∅→∅)

bidsTotal bids =
foldl' (\s b -> s <> (b^.bidAmount)) (Satoshi 0) bids

[3.181]

[3.253]

bidsTotal bids = foldl' (\s b -> s <> (b ^. bidAmount)) (Satoshi 0) bids
replacement in lib/Aftok/Auction.hs at line 60

[3.38]→[3.38:49](∅→∅),[3.49]→[3.67:122](∅→∅),[3.122]→[3.71:125](∅→∅),[3.71]→[3.71:125](∅→∅),[3.125]→[3.2287:2342](∅→∅),[3.2342]→[3.170:209](∅→∅),[3.170]→[3.170:209](∅→∅)

bidOrder =
comparing costRatio `mappend` comparing (^. bidTime)
where
secs bid = toRational $ bid ^. bidSeconds
btc bid = toRational $ bid ^. bidAmount . satoshi
costRatio bid = secs bid / btc bid

[3.38]

[3.293]

bidOrder = comparing costRatio `mappend` comparing (^. bidTime)
where
secs bid = toRational $ bid ^. bidSeconds
btc bid = toRational $ bid ^. bidAmount . satoshi
costRatio bid = secs bid / btc bid
replacement in lib/Aftok/Auction.hs at line 72

[3.141]→[3.323:374](∅→∅),[3.325]→[3.323:374](∅→∅),[3.443]→[3.323:374](∅→∅),[3.397]→[3.323:374](∅→∅),[3.374]→[3.123:162](∅→∅),[3.162]→[3.481:538](∅→∅),[3.481]→[3.481:538](∅→∅),[3.538]→[3.2343:2463](∅→∅)

let takeWinningBids :: Satoshi -> [Bid] -> [Bid]
takeWinningBids total (bid : xs)
-- if the total is fully within the raise amount
| total <> (bid ^. bidAmount) < raiseAmount' =
bid : takeWinningBids (total <> (bid ^. bidAmount)) xs

[3.443]

[3.652]

let
takeWinningBids :: Satoshi -> [Bid] -> [Bid]
takeWinningBids total (bid : xs)
|
-- if the total is fully within the raise amount
total <> (bid ^. bidAmount) < raiseAmount'
= bid : takeWinningBids (total <> (bid ^. bidAmount)) xs
|
replacement in lib/Aftok/Auction.hs at line 81

[3.653]→[3.653:727](∅→∅),[3.727]→[3.195:228](∅→∅),[3.228]→[2.1385:1644](∅→∅),[2.1644]→[3.2737:2800](∅→∅),[3.2737]→[3.2737:2800](∅→∅),[3.2800]→[3.1081:1106](∅→∅),[3.1081]→[3.1081:1106](∅→∅)

-- if the last bid will exceed the raise amount, reduce it to fit
| total < raiseAmount' =
let winFraction r = r % (bid ^. bidAmount . satoshi)
remainderSeconds (Satoshi r) = Seconds . round $ winFraction r * fromIntegral (bid ^. bidSeconds)
adjustBid r = bid & bidSeconds .~ remainderSeconds r & bidAmount .~ r
in toList $ adjustBid <$> raiseAmount' `ssub` total
| otherwise = []

[3.653]

[3.437]

-- if the last bid will exceed the raise amount, reduce it to fit
total < raiseAmount'
= let
winFraction r = r % (bid ^. bidAmount . satoshi)
remainderSeconds (Satoshi r) =
Seconds . round $ winFraction r * fromIntegral (bid ^. bidSeconds)
adjustBid r = bid & bidSeconds .~ remainderSeconds r & bidAmount .~ r
in
toList $ adjustBid <$> raiseAmount' `ssub` total
| otherwise
= []
replacement in lib/Aftok/Auction.hs at line 93

[3.438]→[3.1115:1147](∅→∅),[3.1115]→[3.1115:1147](∅→∅)

takeWinningBids _ [] = []

[3.438]

[3.444]

takeWinningBids _ [] = []
replacement in lib/Aftok/Auction.hs at line 95

[3.445]→[3.445:483](∅→∅),[3.483]→[3.2801:2958](∅→∅)

submittedTotal = bidsTotal bids
in maybe
(WinningBids $ takeWinningBids (Satoshi 0) $ sortBy bidOrder bids)
InsufficientBids
(raiseAmount' `ssub` submittedTotal)

[3.445]

[3.653]

submittedTotal = bidsTotal bids
in
maybe (WinningBids $ takeWinningBids (Satoshi 0) $ sortBy bidOrder bids)
InsufficientBids
(raiseAmount' `ssub` submittedTotal)
replacement in lib/Aftok/Auction.hs at line 107

[3.3009]→[3.3009:3046](∅→∅),[3.454]→[3.588:664](∅→∅),[3.3046]→[3.588:664](∅→∅),[3.588]→[3.588:664](∅→∅)

put (x <> bid ^. bidAmount) >>
(pure . Just $ Commitment bid (bid ^. bidSeconds) (bid ^. bidAmount))

[3.3009]

[3.664]

put (x <> bid ^. bidAmount)
>> (pure . Just $ Commitment bid (bid ^. bidSeconds) (bid ^. bidAmount))
replacement in lib/Aftok/Auction.hs at line 113

[2.1704]→[2.1704:1812](∅→∅)

remainderSeconds (Satoshi r) = Seconds . round $ winFraction r * fromIntegral (bid ^. bidSeconds)

[2.1704]

[3.3222]

remainderSeconds (Satoshi r) =
Seconds . round $ winFraction r * fromIntegral (bid ^. bidSeconds)
replacement in lib/Aftok/Auction.hs at line 116

[3.3276]→[3.3276:3387](∅→∅)

put (x <> remainder) *>
(pure $ Commitment bid (remainderSeconds remainder) remainder)

[3.3276]

[3.1074]

put (x <> remainder)
*> (pure $ Commitment bid (remainderSeconds remainder) remainder)
replacement in lib/Aftok/Config.hs at line 5

[3.10875]→[3.10875:10914](∅→∅)

import Control.Lens (makeClassy, (^.))

[3.10875]

[3.10914]

import Control.Lens ( makeClassy
, (^.)
)
replacement in lib/Aftok/Config.hs at line 11

[3.11046]→[3.11046:11125](∅→∅),[3.11125]→[3.3550:3625](∅→∅),[3.3625]→[2.1817:1965](∅→∅)

import Data.X509.File (readKeyFile, readSignedObject)
import Database.PostgreSQL.Simple (ConnectInfo(..))
import Filesystem.Path.CurrentOS (fromText, encodeString)
import qualified Filesystem.Path.CurrentOS as P
import Safe (headMay)

[3.11046]

[3.11258]

import Data.X509.File ( readKeyFile
, readSignedObject
)
import Database.PostgreSQL.Simple ( ConnectInfo(..) )
import Filesystem.Path.CurrentOS ( fromText
, encodeString
)
import qualified Filesystem.Path.CurrentOS as P
import Safe ( headMay )
replacement in lib/Aftok/Config.hs at line 25

[3.11421]→[3.3704:3748](∅→∅),[3.3748]→[3.11421:11464](∅→∅),[3.11421]→[3.11421:11464](∅→∅)

import Aftok.Currency.Bitcoin (NetworkMode)
import Aftok.Payments (PaymentsConfig(..))

[3.11421]

[3.11464]

import Aftok.Currency.Bitcoin ( NetworkMode )
import Aftok.Payments ( PaymentsConfig(..) )
replacement in lib/Aftok/Config.hs at line 46

[3.11945]→[3.11945:12141](∅→∅)

SmtpConfig <$> C.require cfg "smtpHost"
<*> ((fmap . fmap) fromInteger $ C.lookup cfg "smtpPort")
<*> C.require cfg "smtpUser"
<*> C.require cfg "smtpKey"

[3.11945]

[3.12141]

SmtpConfig
<$> C.require cfg "smtpHost"
<*> ((fmap . fmap) fromInteger $ C.lookup cfg "smtpPort")
<*> C.require cfg "smtpUser"
<*> C.require cfg "smtpKey"
replacement in lib/Aftok/Config.hs at line 54

[3.12217]→[3.3894:3942](∅→∅),[3.3942]→[3.12280:12466](∅→∅),[3.12280]→[3.12280:12466](∅→∅)

BillingConfig <$> C.require cfg "networkMode"
<*> (fromText <$> C.require cfg "signingKeyFile")
<*> (fromText <$> C.require cfg "certsFile")
<*> C.require cfg "exchangeRateServiceURI"

[3.12217]

[3.12593]

BillingConfig
<$> C.require cfg "networkMode"
<*> (fromText <$> C.require cfg "signingKeyFile")
<*> (fromText <$> C.require cfg "certsFile")
<*> C.require cfg "exchangeRateServiceURI"
replacement in lib/Aftok/Config.hs at line 62

[3.12663]→[3.12663:12866](∅→∅)

ConnectInfo <$> C.require cfg "host"
<*> C.require cfg "port"
<*> C.require cfg "user"
<*> C.require cfg "password"
<*> C.require cfg "database"

[3.12663]

[3.12866]

ConnectInfo
<$> C.require cfg "host"
<*> C.require cfg "port"
<*> C.require cfg "user"
<*> C.require cfg "password"
<*> C.require cfg "database"
replacement in lib/Aftok/Config.hs at line 73

[3.13076]→[3.13076:13114](∅→∅)

privKey <- case headMay privKeys of

[3.13076]

[3.13114]

privKey <- case headMay privKeys of
replacement in lib/Aftok/Config.hs at line 75

[3.13148]→[3.3990:4188](∅→∅)

Just _ -> fail $ "Only RSA keys are currently supported for payment request signing."
Nothing -> fail $ "No keys found in private key file " <> encodeString (c ^. signingKeyFile)

[3.13148]

[3.13343]

Just _ ->
fail
$ "Only RSA keys are currently supported for payment request signing."
Nothing -> fail $ "No keys found in private key file " <> encodeString
(c ^. signingKeyFile)
replacement in lib/Aftok/Currency/Bitcoin.hs at line 8

[2.2054]→[3.4474:4520](∅→∅),[3.4474]→[3.4474:4520](∅→∅)

import qualified Data.Configurator.Types as C

[2.2054]

[3.4520]

import qualified Data.Configurator.Types as C
replacement in lib/Aftok/Currency/Bitcoin.hs at line 10

[3.4550]→[3.4550:4602](∅→∅)

import Network.Bippy.Types (Satoshi (..))

[3.4550]

[3.4602]

import Network.Bippy.Types ( Satoshi(..) )
replacement in lib/Aftok/Currency/Bitcoin.hs at line 18

[3.4839]→[3.4839:4858](∅→∅)

ssub _ _ = Nothing

[3.4839]

[3.4858]

ssub _ _ = Nothing
replacement in lib/Aftok/Currency/Bitcoin.hs at line 34

[3.5115]→[3.5115:5130](∅→∅)

_ -> Nothing

[3.5115]

[3.5130]

_ -> Nothing
replacement in lib/Aftok/Currency/Bitcoin.hs at line 44

[3.5298]→[3.5298:5313](∅→∅)

_ -> Nothing

[3.5298]

[3.5313]

_ -> Nothing
replacement in lib/Aftok/Currency/Bitcoin.hs at line 48

[3.5398]→[3.5398:5420](∅→∅)

convert _ = Nothing

[3.5398]

[3.5420]

convert _ = Nothing
replacement in lib/Aftok/Currency/Bitcoin.hs at line 60

[3.5668]→[3.5668:5688](∅→∅)

"btc" -> Just BTC

[3.5668]

[3.5688]

"btc" -> Just BTC
replacement in lib/Aftok/Currency/Bitcoin.hs at line 62

[3.5712]→[3.5712:5732](∅→∅)

"bch" -> Just BCH

[3.5712]

[3.5732]

"bch" -> Just BCH
replacement in lib/Aftok/Currency/Bitcoin.hs at line 64

[3.5756]→[3.5756:5771](∅→∅)

_ -> Nothing

[3.5756]

_ -> Nothing
replacement in lib/Aftok/Currency.hs at line 3

[3.5838]→[3.5838:5917](∅→∅)

import Data.Aeson (Value)
import Data.Aeson.Types (Parser)

[3.5838]

[3.5917]

import Data.Aeson ( Value )
import Data.Aeson.Types ( Parser )
replacement in lib/Aftok/Database/PostgreSQL/Types.hs at line 3

[3.6188]→[3.6188:6367](∅→∅)

import Data.Aeson (FromJSON(..), ToJSON(..))
import Aftok.TimeLog.Serialization (depfFromJSON, depfToJSON)
import Aftok.Types (DepreciationFunction)

[3.6120]

[3.6367]

import Data.Aeson ( FromJSON(..)
, ToJSON(..)
)
import Aftok.TimeLog.Serialization ( depfFromJSON
, depfToJSON
)
import Aftok.Types ( DepreciationFunction )
replacement in lib/Aftok/Database/PostgreSQL.hs at line 6

[3.566]→[3.13542:13601](∅→∅)

module Aftok.Database.PostgreSQL (QDBM(..), runQDBM) where

[3.566]

[3.622]

module Aftok.Database.PostgreSQL
( QDBM(..)
, runQDBM
)
where
replacement in lib/Aftok/Database/PostgreSQL.hs at line 12

[3.623]→[2.2104:2172](∅→∅)

import Prelude hiding (null)

[3.623]

[3.969]

import Prelude hiding ( null )
replacement in lib/Aftok/Database/PostgreSQL.hs at line 14

[3.999]→[3.13602:13690](∅→∅),[3.13690]→[3.4:143](∅→∅),[3.1043]→[3.4:143](∅→∅),[3.143]→[3.511:581](∅→∅),[3.163]→[3.511:581](∅→∅),[3.1043]→[3.511:581](∅→∅)

import Control.Monad.Trans.Except (ExceptT(..), throwE, runExceptT)
import Crypto.Random.Types (MonadRandom,
getRandomBytes)
import Data.Aeson (Value, toJSON)

[3.999]

[3.1165]

import Control.Monad.Trans.Except ( ExceptT(..)
, throwE
, runExceptT
)
import Crypto.Random.Types ( MonadRandom
, getRandomBytes
)
import Data.Aeson ( Value
, toJSON
)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 25

[3.1197]→[3.1205:1264](∅→∅),[3.1264]→[3.789:929](∅→∅),[3.929]→[3.1349:1412](∅→∅),[3.1349]→[3.1349:1412](∅→∅),[3.652]→[3.109:172](∅→∅),[3.1412]→[3.109:172](∅→∅),[3.109]→[3.109:172](∅→∅),[3.172]→[3.1256:1315](∅→∅),[3.1256]→[3.1256:1315](∅→∅)

import qualified Data.List as L
import Data.ProtocolBuffers (decodeMessage,
encodeMessage)
import Data.Serialize.Get (runGet)
import Data.Serialize.Put (runPut)
import Data.Thyme.Clock as C

[3.1197]

[3.1315]

import qualified Data.List as L
import Data.ProtocolBuffers ( decodeMessage
, encodeMessage
)
import Data.Serialize.Get ( runGet )
import Data.Serialize.Put ( runPut )
import Data.Thyme.Clock as C
replacement in lib/Aftok/Database/PostgreSQL.hs at line 33

[3.1348]→[3.1348:1409](∅→∅)

import Data.UUID (UUID)

[3.1348]

[3.1409]

import Data.UUID ( UUID )
replacement in lib/Aftok/Database/PostgreSQL.hs at line 37

[3.1559]→[3.13691:13751](∅→∅),[3.13751]→[3.4:65](∅→∅),[3.1559]→[3.4:65](∅→∅),[3.65]→[2.2173:2237](∅→∅)

import Database.PostgreSQL.Simple.SqlQQ (sql)
import Database.PostgreSQL.Simple.Types (Null)
import Safe (headMay)

[3.1559]

[3.1011]

import Database.PostgreSQL.Simple.SqlQQ
( sql )
import Database.PostgreSQL.Simple.Types
( Null )
import Safe ( headMay )
replacement in lib/Aftok/Database/PostgreSQL.hs at line 43

[3.1583]→[3.1088:1147](∅→∅),[3.1147]→[3.1663:1722](∅→∅)

import qualified Aftok.Auction as A
import qualified Aftok.Billables as B

[3.1012]

[3.6735]

import qualified Aftok.Auction as A
import qualified Aftok.Billables as B
replacement in lib/Aftok/Database/PostgreSQL.hs at line 47

[3.1646]→[3.6776:6851](∅→∅)

import Aftok.Database.PostgreSQL.Types (SerDepFunction(..))

[3.1646]

[3.1646]

import Aftok.Database.PostgreSQL.Types
( SerDepFunction(..) )
replacement in lib/Aftok/Database/PostgreSQL.hs at line 50

[3.1678]→[3.723:792](∅→∅),[3.792]→[3.930:1009](∅→∅),[3.1009]→[3.792:860](∅→∅),[3.792]→[3.792:860](∅→∅),[3.860]→[3.1010:1085](∅→∅)

import Aftok.Json (billableJSON,
createSubscriptionJSON,
paymentJSON,
paymentRequestJSON)

[3.1678]

[3.1085]

import Aftok.Json ( billableJSON
, createSubscriptionJSON
, paymentJSON
, paymentRequestJSON
)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 56

[3.205]→[3.1208:1267](∅→∅),[3.1123]→[3.1208:1267](∅→∅),[3.1471]→[3.1208:1267](∅→∅),[3.1678]→[3.1208:1267](∅→∅)

import qualified Aftok.Project as P

[3.1123]

[3.1678]

import qualified Aftok.Project as P
replacement in lib/Aftok/Database/PostgreSQL.hs at line 59

[3.1738]→[3.6852:7076](∅→∅)

import Network.Bippy.Types (Satoshi(..))
import Network.Haskoin.Address (Address, stringToAddr, addrToString)
import Network.Haskoin.Constants (Network)

[3.1738]

[3.1123]

import Network.Bippy.Types ( Satoshi(..) )
import Network.Haskoin.Address ( Address
, stringToAddr
, addrToString
)
import Network.Haskoin.Constants ( Network )
replacement in lib/Aftok/Database/PostgreSQL.hs at line 82

[3.7309]→[3.7309:7323](∅→∅)

null = field

[3.7309]

[3.1215]

null = field
replacement in lib/Aftok/Database/PostgreSQL.hs at line 93

[3.7497]→[3.7497:7630](∅→∅)

Just other -> returnError ConversionFailed f ("Network identifier " <> other <> " is not supported.")
Nothing -> pure BTC

[3.7497]

[3.7630]

Just other -> returnError
ConversionFailed
f
("Network identifier " <> other <> " is not supported.")
Nothing -> pure BTC
replacement in lib/Aftok/Database/PostgreSQL.hs at line 102

[3.7761]→[3.7761:7829](∅→∅)

address <- fieldWith $ addrFieldParser (toNetwork mode networkId)

[3.7761]

[3.7829]

address <- fieldWith $ addrFieldParser (toNetwork mode networkId)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 108

[3.7981]→[3.2035:2131](∅→∅),[3.1952]→[3.2035:2131](∅→∅)

let err = returnError ConversionFailed f "could not deserialize value to a valid BTC address"

[3.7981]

[3.2131]

let err = returnError ConversionFailed
f
"could not deserialize value to a valid BTC address"
replacement in lib/Aftok/Database/PostgreSQL.hs at line 127

[3.1923]→[3.7982:8188](∅→∅)

else maybe (returnError UnexpectedNull f "event type may not be null")
(maybe (returnError Incompatible f "unrecognized event type value") pure . nameEvent . decodeUtf8)
v

[3.1923]

[3.2299]

else maybe
(returnError UnexpectedNull f "event type may not be null")
( maybe (returnError Incompatible f "unrecognized event type value") pure
. nameEvent
. decodeUtf8
)
v
replacement in lib/Aftok/Database/PostgreSQL.hs at line 136

[3.2353]→[3.1124:1152](∅→∅),[3.1152]→[3.2382:2417](∅→∅),[3.2382]→[3.2382:2417](∅→∅)

nominalDiffTimeParser f v =
C.fromSeconds' <$> fromField f v

[3.2353]

[3.271]

nominalDiffTimeParser f v = C.fromSeconds' <$> fromField f v
replacement in lib/Aftok/Database/PostgreSQL.hs at line 141

[3.294]→[3.8327:8417](∅→∅)

creditToParser' :: NetworkMode -> FieldParser (RowParser (CreditTo (NetworkId, Address)))

[3.294]

[3.8417]

creditToParser'
:: NetworkMode -> FieldParser (RowParser (CreditTo (NetworkId, Address)))
replacement in lib/Aftok/Database/PostgreSQL.hs at line 144

[3.8444]→[3.8444:8867](∅→∅),[3.1742]→[3.2409:2461](∅→∅),[3.2606]→[3.2409:2461](∅→∅),[3.8867]→[3.2409:2461](∅→∅),[3.2409]→[3.2409:2461](∅→∅),[3.2461]→[3.1349:1376](∅→∅),[3.1376]→[3.2489:2618](∅→∅),[3.2489]→[3.2489:2618](∅→∅)

let parser :: Text -> RowParser (CreditTo (NetworkId, Address))
parser "credit_to_address" =
CreditToCurrency <$> (addressParser mode <* nullField <* nullField)
parser "credit_to_user" =
CreditToUser <$> (nullField *> nullField *> idParser UserId <* nullField)
parser "credit_to_project" =
CreditToProject <$> (nullField *> nullField *> nullField *> idParser ProjectId)
parser _ = empty
in do
tn <- typename f
if tn /= "credit_to_t"
then returnError Incompatible f "column was not of type credit_to_t"
else maybe empty (pure . parser . decodeUtf8) v

[3.8444]

[3.1409]

let
parser :: Text -> RowParser (CreditTo (NetworkId, Address))
parser "credit_to_address" =
CreditToCurrency <$> (addressParser mode <* nullField <* nullField)
parser "credit_to_user" =
CreditToUser <$> (nullField *> nullField *> idParser UserId <* nullField)
parser "credit_to_project" =
CreditToProject
<$> (nullField *> nullField *> nullField *> idParser ProjectId)
parser _ = empty
in
do
tn <- typename f
if tn /= "credit_to_t"
then returnError Incompatible f "column was not of type credit_to_t"
else maybe empty (pure . parser . decodeUtf8) v
replacement in lib/Aftok/Database/PostgreSQL.hs at line 163

[3.8965]→[3.8965:9000](∅→∅),[3.9000]→[3.2607:2664](∅→∅),[3.402]→[3.2607:2664](∅→∅),[3.2664]→[3.403:424](∅→∅),[3.403]→[3.403:424](∅→∅)

LogEntry <$> creditToParser mode
<*> (fieldWith eventTypeParser <*> utcParser)
<*> field

[3.8965]

[3.2597]

LogEntry
<$> creditToParser mode
<*> (fieldWith eventTypeParser <*> utcParser)
<*> field
replacement in lib/Aftok/Database/PostgreSQL.hs at line 168

[3.2598]→[3.9001:9084](∅→∅)

qdbLogEntryParser :: NetworkMode -> RowParser (KeyedLogEntry (NetworkId, Address))

[3.2598]

[3.9084]

qdbLogEntryParser
:: NetworkMode -> RowParser (KeyedLogEntry (NetworkId, Address))
replacement in lib/Aftok/Database/PostgreSQL.hs at line 171

[3.9109]→[3.9109:9139](∅→∅),[3.9139]→[3.1775:1802](∅→∅),[3.1775]→[3.1775:1802](∅→∅),[3.1802]→[3.9140:9171](∅→∅)

(,,) <$> idParser ProjectId
<*> idParser UserId
<*> logEntryParser mode

[3.9109]

[3.2021]

(,,) <$> idParser ProjectId <*> idParser UserId <*> logEntryParser mode
replacement in lib/Aftok/Database/PostgreSQL.hs at line 175

[3.2039]→[3.9172:9207](∅→∅),[3.9207]→[3.1840:1872](∅→∅),[3.1840]→[3.1840:1872](∅→∅),[3.1872]→[3.2760:2864](∅→∅),[3.2760]→[3.2760:2864](∅→∅)

A.Auction <$> idParser ProjectId
<*> idParser UserId
<*> utcParser
<*> btcParser
<*> utcParser
<*> utcParser

[3.2039]

[3.2729]

A.Auction
<$> idParser ProjectId
<*> idParser UserId
<*> utcParser
<*> btcParser
<*> utcParser
<*> utcParser
replacement in lib/Aftok/Database/PostgreSQL.hs at line 185

[3.2052]→[3.1873:1901](∅→∅),[3.1901]→[3.2887:2963](∅→∅),[3.2887]→[3.2887:2963](∅→∅)

A.Bid <$> idParser UserId
<*> (Seconds <$> field)
<*> btcParser
<*> utcParser

[3.2052]

[3.2828]

A.Bid <$> idParser UserId <*> (Seconds <$> field) <*> btcParser <*> utcParser
replacement in lib/Aftok/Database/PostgreSQL.hs at line 189

[3.9273]→[3.2964:2996](∅→∅),[3.2160]→[3.2964:2996](∅→∅),[3.2996]→[3.9274:9353](∅→∅),[3.3183]→[3.2210:2239](∅→∅),[3.9353]→[3.2210:2239](∅→∅),[3.993]→[3.2210:2239](∅→∅)

User <$> (UserName <$> field)
<*> ((null *> null *> pure Nothing) <|> fmap Just (addressParser mode))
<*> (Email <$> field)

[3.9273]

[3.3061]

User
<$> (UserName <$> field)
<*> ((null *> null *> pure Nothing) <|> fmap Just (addressParser mode))
<*> (Email <$> field)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 196

[3.2224]→[3.3075:3097](∅→∅),[3.3097]→[3.3018:3044](∅→∅),[3.3044]→[3.1902:1934](∅→∅),[3.1934]→[3.9354:9417](∅→∅)

P.Project <$> field
<*> utcParser
<*> idParser UserId
<*> (unSerDepFunction <$> fieldWith fromJSONField)

[3.2224]

[3.313]

P.Project
<$> field
<*> utcParser
<*> idParser UserId
<*> (unSerDepFunction <$> fieldWith fromJSONField)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 204

[3.2298]→[3.9418:9456](∅→∅),[3.9456]→[3.1975:2010](∅→∅),[3.1975]→[3.1975:2010](∅→∅),[3.2010]→[3.3129:3194](∅→∅),[3.3129]→[3.3129:3194](∅→∅),[3.3194]→[3.3412:3457](∅→∅),[3.3412]→[3.3412:3457](∅→∅)

P.Invitation <$> idParser ProjectId
<*> idParser UserId
<*> fmap Email field
<*> utcParser
<*> fmap (fmap toThyme) field

[3.2298]

[3.3458]

P.Invitation
<$> idParser ProjectId
<*> idParser UserId
<*> fmap Email field
<*> utcParser
<*> fmap (fmap toThyme) field
replacement in lib/Aftok/Database/PostgreSQL.hs at line 213

[3.3516]→[3.9457:9493](∅→∅),[3.9493]→[3.2049:2082](∅→∅),[3.2049]→[3.2049:2082](∅→∅),[3.2082]→[3.3310:3417](∅→∅),[3.3310]→[3.3310:3417](∅→∅),[3.3417]→[3.2083:2106](∅→∅),[3.2106]→[3.3451:3516](∅→∅),[3.3451]→[3.3451:3516](∅→∅),[3.3516]→[3.14032:14078](∅→∅)

B.Billable <$> idParser ProjectId
<*> idParser UserId
<*> field
<*> field
<*> recurrenceParser
<*> btcParser
<*> field
<*> fieldWith (optionalField nominalDiffTimeParser)
<*> field
<*> field

[3.3516]

[3.3516]

B.Billable
<$> idParser ProjectId
<*> idParser UserId
<*> field
<*> field
<*> recurrenceParser
<*> btcParser
<*> field
<*> fieldWith (optionalField nominalDiffTimeParser)
<*> field
<*> field
replacement in lib/Aftok/Database/PostgreSQL.hs at line 239

[3.1442]→[3.311:391](∅→∅),[3.391]→[3.4057:4146](∅→∅),[3.4057]→[3.4057:4146](∅→∅)

B.Subscription <$> idParser UserId
<*> idParser B.BillableId
<*> (toThyme <$> field)
<*> ((fmap toThyme) <$> field)

[3.1442]

[3.2247]

B.Subscription
<$> idParser UserId
<*> idParser B.BillableId
<*> (toThyme <$> field)
<*> ((fmap toThyme) <$> field)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 247

[3.1466]→[3.214:263](∅→∅),[3.263]→[2.2528:2612](∅→∅),[2.2612]→[3.338:461](∅→∅),[3.338]→[3.338:461](∅→∅)

PaymentRequest <$> fmap B.SubscriptionId field
<*> ((either (const empty) pure . runGet decodeMessage) =<< field)
<*> fmap PaymentKey field
<*> fmap toThyme field
<*> fmap toThyme field

[3.1466]

[3.2528]

PaymentRequest
<$> fmap B.SubscriptionId field
<*> ((either (const empty) pure . runGet decodeMessage) =<< field)
<*> fmap PaymentKey field
<*> fmap toThyme field
<*> fmap toThyme field
replacement in lib/Aftok/Database/PostgreSQL.hs at line 256

[3.1483]→[3.2581:2624](∅→∅),[3.2581]→[3.2581:2624](∅→∅),[3.2624]→[2.2613:2690](∅→∅),[2.2690]→[3.2692:2726](∅→∅),[3.2692]→[3.2692:2726](∅→∅),[3.2726]→[3.265:285](∅→∅)

Payment <$> (PaymentRequestId <$> field)
<*> (field >>= (either (const empty) pure . runGet decodeMessage))
<*> (toThyme <$> field)
<*> field

[3.1483]

[3.293]

Payment
<$> (PaymentRequestId <$> field)
<*> (field >>= (either (const empty) pure . runGet decodeMessage))
<*> (toThyme <$> field)
<*> field
replacement in lib/Aftok/Database/PostgreSQL.hs at line 287

[3.264]→[3.953:1089](∅→∅)

storeEvent (CreateSubscription uid bid t) =
Just $ storeEventJSON (Just uid) "create_subscription" (createSubscriptionJSON uid bid t)

[3.264]

[3.384]

storeEvent (CreateSubscription uid bid t) = Just $ storeEventJSON
(Just uid)
"create_subscription"
(createSubscriptionJSON uid bid t)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 292

[3.385]→[3.624:746](∅→∅)

storeEvent (CreatePaymentRequest req) =
Just $ storeEventJSON Nothing "create_payment_request" (paymentRequestJSON req)

[3.385]

[3.248]

storeEvent (CreatePaymentRequest req) = Just
$ storeEventJSON Nothing "create_payment_request" (paymentRequestJSON req)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 305

[3.661]→[3.9646:9664](∅→∅)

pinsert EventId

[3.661]

[3.9664]

pinsert
EventId
replacement in lib/Aftok/Database/PostgreSQL.hs at line 316

[3.4296]→[3.9829:9898](∅→∅),[3.4367]→[3.4161:4173](∅→∅),[3.9898]→[3.4161:4173](∅→∅),[3.4161]→[3.4161:4173](∅→∅),[3.4173]→[3.9899:10066](∅→∅)

pgEval (CreateEvent (ProjectId pid) (UserId uid) (LogEntry c e m)) =
case c of
CreditToCurrency (nid, addr) -> do
mode <- askNetworkMode
let network = toNetwork mode nid
pinsert EventId
[sql| INSERT INTO work_events

[3.4296]

[3.14378]

pgEval (CreateEvent (ProjectId pid) (UserId uid) (LogEntry c e m)) = case c of
CreditToCurrency (nid, addr) -> do
mode <- askNetworkMode
let network = toNetwork mode nid
pinsert
EventId
[sql| INSERT INTO work_events
replacement in lib/Aftok/Database/PostgreSQL.hs at line 327

[3.14581]→[3.10168:10338](∅→∅)

( pid
, uid
, creditToName c
, addrToString network addr
, eventName e
, fromThyme $ e ^. eventTime
, m
)

[3.14581]

[3.762]

( pid
, uid
, creditToName c
, addrToString network addr
, eventName e
, fromThyme $ e ^. eventTime
, m
)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 336

[3.763]→[3.4547:4575](∅→∅),[3.4575]→[3.10339:10399](∅→∅)

CreditToProject pid' ->
pinsert EventId
[sql| INSERT INTO work_events

[3.763]

[3.14644]

CreditToProject pid' -> pinsert
EventId
[sql| INSERT INTO work_events
replacement in lib/Aftok/Database/PostgreSQL.hs at line 343

[3.14850]→[3.10501:10601](∅→∅)

( pid, uid, creditToName c, pid' ^. _ProjectId, eventName e, fromThyme $ e ^. eventTime, m)

[3.14850]

[3.1807]

( pid
, uid
, creditToName c
, pid' ^. _ProjectId
, eventName e
, fromThyme $ e ^. eventTime
, m
)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 352

[3.1808]→[3.4909:4934](∅→∅),[3.4934]→[3.10602:10662](∅→∅)

CreditToUser uid' ->
pinsert EventId
[sql| INSERT INTO work_events

[3.1808]

[3.10662]

CreditToUser uid' -> pinsert
EventId
[sql| INSERT INTO work_events
replacement in lib/Aftok/Database/PostgreSQL.hs at line 358

[3.15099]→[3.5162:5259](∅→∅),[3.5162]→[3.5162:5259](∅→∅)

( pid, uid, creditToName c, uid' ^. _UserId, eventName e, fromThyme $ e ^. eventTime, m)

[3.15099]

[3.3405]

( pid
, uid
, creditToName c
, uid' ^. _UserId
, eventName e
, fromThyme $ e ^. eventTime
, m
)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 369

[3.10880]→[3.10880:10926](∅→∅)

headMay <$> pquery (qdbLogEntryParser mode)

[3.10880]

[3.10926]

headMay <$> pquery
(qdbLogEntryParser mode)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 379

[3.11215]→[3.11215:11362](∅→∅)

let q (Before e) = pquery (logEntryParser mode)
[sql| SELECT credit_to_type, credit_to_address, credit_to_user_id, credit_to_project_id,

[3.11215]

[3.11362]

let
q (Before e) = pquery
(logEntryParser mode)
[sql| SELECT credit_to_type, credit_to_address, credit_to_user_id, credit_to_project_id,
replacement in lib/Aftok/Database/PostgreSQL.hs at line 387

[3.15705]→[3.5813:5845](∅→∅),[3.5813]→[3.5813:5845](∅→∅),[3.5845]→[3.11475:11624](∅→∅)

(pid, uid, fromThyme e)
q (During s e) = pquery (logEntryParser mode)
[sql| SELECT credit_to_type, credit_to_address, credit_to_user_id, credit_to_project_id,

[3.15705]

[3.11624]

(pid, uid, fromThyme e)
q (During s e) = pquery
(logEntryParser mode)
[sql| SELECT credit_to_type, credit_to_address, credit_to_user_id, credit_to_project_id,
replacement in lib/Aftok/Database/PostgreSQL.hs at line 395

[3.16052]→[3.6072:6117](∅→∅),[3.6072]→[3.6072:6117](∅→∅),[3.6117]→[3.11767:11913](∅→∅)

(pid, uid, fromThyme s, fromThyme e)
q (After s) = pquery (logEntryParser mode)
[sql| SELECT credit_to_type, credit_to_address, credit_to_user_id, credit_to_project_id,

[3.16052]

[3.11913]

(pid, uid, fromThyme s, fromThyme e)
q (After s) = pquery
(logEntryParser mode)
[sql| SELECT credit_to_type, credit_to_address, credit_to_user_id, credit_to_project_id,
replacement in lib/Aftok/Database/PostgreSQL.hs at line 402

[3.16361]→[3.6310:6342](∅→∅),[3.6310]→[3.6310:6342](∅→∅)

(pid, uid, fromThyme s)

[3.16361]

[3.12005]

(pid, uid, fromThyme s)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 405

[3.1952]→[3.4463:4517](∅→∅),[3.4517]→[3.12015:12081](∅→∅)

pgEval (AmendEvent (EventId eid) (TimeChange mt t)) =
pinsert AmendmentId
[sql| INSERT INTO event_time_amendments

[3.1952]

[3.12081]

pgEval (AmendEvent (EventId eid) (TimeChange mt t)) = pinsert
AmendmentId
[sql| INSERT INTO event_time_amendments
replacement in lib/Aftok/Database/PostgreSQL.hs at line 410

[3.16519]→[3.6556:6609](∅→∅),[3.6556]→[3.6556:6609](∅→∅)

( eid, fromThyme $ mt ^. _ModTime, fromThyme t )

[3.16519]

[3.2903]

(eid, fromThyme $ mt ^. _ModTime, fromThyme t)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 417

[3.12292]→[3.12292:12318](∅→∅)

pinsert AmendmentId

[3.12292]

[3.12318]

pinsert
AmendmentId
replacement in lib/Aftok/Database/PostgreSQL.hs at line 422

[3.16725]→[3.12445:12532](∅→∅)

( eid, fromThyme $ mt ^. _ModTime, creditToName c, addrToString network addr )

[3.16725]

[3.1932]

( eid
, fromThyme $ mt ^. _ModTime
, creditToName c
, addrToString network addr
)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 428

[3.1933]→[3.6999:7026](∅→∅),[3.7026]→[3.12533:12612](∅→∅)

CreditToProject pid ->
pinsert AmendmentId
[sql| INSERT INTO event_credit_to_amendments

[3.1933]

[3.12612]

CreditToProject pid -> pinsert
AmendmentId
[sql| INSERT INTO event_credit_to_amendments
replacement in lib/Aftok/Database/PostgreSQL.hs at line 433

[3.16933]→[3.12688:12767](∅→∅)

( eid, fromThyme $ mt ^. _ModTime, creditToName c, pid ^. _ProjectId )

[3.16933]

[3.2208]

(eid, fromThyme $ mt ^. _ModTime, creditToName c, pid ^. _ProjectId)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 435

[3.2209]→[3.7299:7323](∅→∅),[3.7323]→[3.12768:12847](∅→∅)

CreditToUser uid ->
pinsert AmendmentId
[sql| INSERT INTO event_credit_to_amendments

[3.2209]

[3.12847]

CreditToUser uid -> pinsert
AmendmentId
[sql| INSERT INTO event_credit_to_amendments
replacement in lib/Aftok/Database/PostgreSQL.hs at line 440

[3.17138]→[3.7511:7587](∅→∅),[3.7511]→[3.7511:7587](∅→∅)

( eid, fromThyme $ mt ^. _ModTime, creditToName c, uid ^. _UserId )

[3.17138]

[3.4597]

(eid, fromThyme $ mt ^. _ModTime, creditToName c, uid ^. _UserId)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 442

[3.4598]→[3.4577:4635](∅→∅),[3.4635]→[3.12920:12990](∅→∅)

pgEval (AmendEvent (EventId eid) (MetadataChange mt v)) =
pinsert AmendmentId
[sql| INSERT INTO event_metadata_amendments

[3.4598]

[3.12990]

pgEval (AmendEvent (EventId eid) (MetadataChange mt v)) = pinsert
AmendmentId
[sql| INSERT INTO event_metadata_amendments
replacement in lib/Aftok/Database/PostgreSQL.hs at line 447

[3.17304]→[3.7800:7842](∅→∅),[3.7800]→[3.7800:7842](∅→∅)

( eid, fromThyme $ mt ^. _ModTime, v)

[3.17304]

[3.4861]

(eid, fromThyme $ mt ^. _ModTime, v)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 450

[3.13084]→[3.13084:13154](∅→∅)

mode <- askNetworkMode
logEntries <- pquery (logEntryParser mode)

[3.13084]

[3.13154]

mode <- askNetworkMode
logEntries <- pquery
(logEntryParser mode)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 460

[3.5183]→[3.4683:4712](∅→∅),[3.4712]→[3.13331:13435](∅→∅)

pgEval (CreateAuction auc) =
pinsert A.AuctionId
[sql| INSERT INTO auctions (project_id, initiator_id, raise_amount, end_time)

[3.5183]

[3.17664]

pgEval (CreateAuction auc) = pinsert
A.AuctionId
[sql| INSERT INTO auctions (project_id, initiator_id, raise_amount, end_time)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 464

[3.17710]→[3.13436:13476](∅→∅),[3.13476]→[3.8289:8414](∅→∅),[3.8289]→[3.8289:8414](∅→∅)

( auc ^. (A.projectId . _ProjectId)
, auc ^. (A.initiator . _UserId)
, auc ^. (A.raiseAmount . satoshi)
, auc ^. (A.auctionEnd . to fromThyme)
)

[3.17710]

[3.5424]

( auc ^. (A.projectId . _ProjectId)
, auc ^. (A.initiator . _UserId)
, auc ^. (A.raiseAmount . satoshi)
, auc ^. (A.auctionEnd . to fromThyme)
)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 470

[3.5425]→[3.4713:4742](∅→∅),[3.4742]→[3.13477:13602](∅→∅)

pgEval (FindAuction aucId) =
headMay <$> pquery auctionParser
[sql| SELECT project_id, initiator_id, created_at, raise_amount, start_time, end_time

[3.5425]

[3.13602]

pgEval (FindAuction aucId) = headMay <$> pquery
auctionParser
[sql| SELECT project_id, initiator_id, created_at, raise_amount, start_time, end_time
replacement in lib/Aftok/Database/PostgreSQL.hs at line 475

[3.17889]→[3.8597:8632](∅→∅),[3.8597]→[3.8597:8632](∅→∅)

(Only (aucId ^. A._AuctionId))

[3.17889]

[3.5524]

(Only (aucId ^. A._AuctionId))
replacement in lib/Aftok/Database/PostgreSQL.hs at line 477

[3.5525]→[3.4743:4788](∅→∅),[3.4788]→[3.13627:13731](∅→∅)

pgEval (CreateBid (A.AuctionId aucId) bid) =
pinsert A.BidId
[sql| INSERT INTO bids (auction_id, bidder_id, bid_seconds, bid_amount, bid_time)

[3.5525]

[3.17996]

pgEval (CreateBid (A.AuctionId aucId) bid) = pinsert
A.BidId
[sql| INSERT INTO bids (auction_id, bidder_id, bid_seconds, bid_amount, bid_time)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 481

[3.18045]→[3.8826:9007](∅→∅),[3.8826]→[3.8826:9007](∅→∅)

( aucId
, bid ^. (A.bidUser . _UserId)
, case bid ^. A.bidSeconds of (Seconds i) -> i
, bid ^. (A.bidAmount . satoshi)
, bid ^. (A.bidTime . to fromThyme)
)

[3.18045]

[3.667]

( aucId
, bid ^. (A.bidUser . _UserId)
, case bid ^. A.bidSeconds of
(Seconds i) -> i
, bid ^. (A.bidAmount . satoshi)
, bid ^. (A.bidTime . to fromThyme)
)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 489

[3.668]→[3.2727:2753](∅→∅),[3.2753]→[3.13732:13782](∅→∅),[3.13782]→[3.18097:18197](∅→∅),[3.18097]→[3.18097:18197](∅→∅),[3.2894]→[3.9145:9180](∅→∅),[3.18197]→[3.9145:9180](∅→∅),[3.9145]→[3.9145:9180](∅→∅)

pgEval (FindBids aucId) =
pquery ((,) <$> idParser A.BidId <*> bidParser)
[sql| SELECT id, bidder_id, bid_seconds, bid_amount, bid_time FROM bids WHERE auction_id = ? |]
(Only (aucId ^. A._AuctionId))

[3.668]

[3.704]

pgEval (FindBids aucId) = pquery
((,) <$> idParser A.BidId <*> bidParser)
[sql| SELECT id, bidder_id, bid_seconds, bid_amount, bid_time FROM bids WHERE auction_id = ? |]
(Only (aucId ^. A._AuctionId))
replacement in lib/Aftok/Database/PostgreSQL.hs at line 502

[3.14063]→[3.14063:14080](∅→∅)

pinsert UserId

[3.14063]

[3.14080]

pinsert
UserId
replacement in lib/Aftok/Database/PostgreSQL.hs at line 506

[3.14185]→[3.9428:9464](∅→∅),[3.18307]→[3.9428:9464](∅→∅),[3.9428]→[3.9428:9464](∅→∅)

( user' ^. (username._UserName)

[3.14185]

[3.14186]

( user' ^. (username . _UserName)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 509

[3.9478]→[3.9478:9510](∅→∅)

, user' ^. userEmail._Email

[3.9478]

[3.9510]

, user' ^. userEmail . _Email
replacement in lib/Aftok/Database/PostgreSQL.hs at line 514

[3.14281]→[3.14281:14320](∅→∅)

headMay <$> pquery (userParser mode)

[3.14281]

[3.18341]

headMay <$> pquery
(userParser mode)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 521

[3.14388]→[3.14388:14455](∅→∅)

headMay <$> pquery ((,) <$> idParser UserId <*> userParser mode)

[3.14388]

[3.18473]

headMay <$> pquery
((,) <$> idParser UserId <*> userParser mode)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 534

[3.10161]→[3.4994:5023](∅→∅),[3.5023]→[3.14652:14779](∅→∅)

pgEval (FindInvitation ic) =
headMay <$> pquery invitationParser
[sql| SELECT project_id, invitor_id, invitee_email, invitation_time, acceptance_time

[3.10161]

[3.18840]

pgEval (FindInvitation ic) = headMay <$> pquery
invitationParser
[sql| SELECT project_id, invitor_id, invitee_email, invitation_time, acceptance_time
replacement in lib/Aftok/Database/PostgreSQL.hs at line 538

[3.18895]→[3.10367:10399](∅→∅),[3.10367]→[3.10367:10399](∅→∅)

(Only $ P.renderInvCode ic)

[3.18895]

[3.3741]

(Only $ P.renderInvCode ic)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 552

[3.3836]→[3.5089:5116](∅→∅),[3.5116]→[3.14977:15090](∅→∅)

pgEval (CreateProject p) =
pinsert ProjectId
[sql| INSERT INTO projects (project_name, inception_date, initiator_id, depreciation_fn)

[3.3836]

[3.19337]

pgEval (CreateProject p) = pinsert
ProjectId
[sql| INSERT INTO projects (project_name, inception_date, initiator_id, depreciation_fn)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 556

[3.19383]→[3.15091:15248](∅→∅)

( p ^. P.projectName
, p ^. (P.inceptionDate . to fromThyme)
, p ^. (P.initiator . _UserId)
, toJSON $ p ^. P.depf . to SerDepFunction
)

[3.19383]

[3.19384]

( p ^. P.projectName
, p ^. (P.inceptionDate . to fromThyme)
, p ^. (P.initiator . _UserId)
, toJSON $ p ^. P.depf . to SerDepFunction
)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 563

[3.19407]→[3.15249:15279](∅→∅),[3.15279]→[3.19439:19483](∅→∅),[3.19439]→[3.19439:19483](∅→∅)

pquery (idParser ProjectId)
[sql| SELECT id FROM projects |]
()

[3.19407]

[3.19483]

pquery (idParser ProjectId) [sql| SELECT id FROM projects |] ()
replacement in lib/Aftok/Database/PostgreSQL.hs at line 565

[3.19484]→[3.19484:19542](∅→∅),[3.19542]→[3.15280:15307](∅→∅)

pgEval (FindSubscribers pid) =
pquery (idParser UserId)
[sql| SELECT s.user_id

[3.19484]

[3.15307]

pgEval (FindSubscribers pid) = pquery
(idParser UserId)
[sql| SELECT s.user_id
replacement in lib/Aftok/Database/PostgreSQL.hs at line 571

[3.19689]→[3.15389:15420](∅→∅)

(Only (pid ^. _ProjectId))

[3.19689]

[3.4290]

(Only (pid ^. _ProjectId))
replacement in lib/Aftok/Database/PostgreSQL.hs at line 573

[3.4291]→[3.15421:15495](∅→∅),[3.15495]→[3.19759:19866](∅→∅),[3.19759]→[3.19759:19866](∅→∅),[3.19866]→[3.11325:11340](∅→∅),[3.11325]→[3.11325:11340](∅→∅)

pgEval (FindProject (ProjectId pid)) =
headMay <$> pquery projectParser
[sql| SELECT project_name, inception_date, initiator_id, depreciation_fn FROM projects WHERE id = ? |]
(Only pid)

[3.4291]

[3.946]

pgEval (FindProject (ProjectId pid)) = headMay <$> pquery
projectParser
[sql| SELECT project_name, inception_date, initiator_id, depreciation_fn FROM projects WHERE id = ? |]
(Only pid)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 578

[3.947]→[3.5159:5200](∅→∅),[3.5200]→[3.15496:15643](∅→∅)

pgEval (FindUserProjects (UserId uid)) =
pquery ((,) <$> idParser ProjectId <*> projectParser)
[sql| SELECT p.id, p.project_name, p.inception_date, p.initiator_id, p.depreciation_fn

[3.947]

[3.15643]

pgEval (FindUserProjects (UserId uid)) = pquery
((,) <$> idParser ProjectId <*> projectParser)
[sql| SELECT p.id, p.project_name, p.inception_date, p.initiator_id, p.depreciation_fn
replacement in lib/Aftok/Database/PostgreSQL.hs at line 584

[3.20174]→[3.11642:11657](∅→∅),[3.11642]→[3.11642:11657](∅→∅)

(uid, uid)

[3.20174]

[3.1013]

(uid, uid)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 586

[3.1014]→[3.5201:5252](∅→∅),[3.5252]→[3.15763:15771](∅→∅),[3.15771]→[3.20184:20279](∅→∅),[3.20184]→[3.20184:20279](∅→∅),[3.20279]→[3.15772:15832](∅→∅)

pgEval (AddUserToProject pid current new) = void $
pexec
[sql| INSERT INTO project_companions (project_id, user_id, invited_by) VALUES (?, ?, ?) |]
(pid ^. _ProjectId, new ^. _UserId, current ^. _UserId)

[3.1014]

[3.1042]

pgEval (AddUserToProject pid current new) = void $ pexec
[sql| INSERT INTO project_companions (project_id, user_id, invited_by) VALUES (?, ?, ?) |]
(pid ^. _ProjectId, new ^. _UserId, current ^. _UserId)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 592

[3.11949]→[3.15872:15895](∅→∅)

pinsert B.BillableId

[3.11949]

[3.15895]

pinsert
B.BillableId
replacement in lib/Aftok/Database/PostgreSQL.hs at line 613

[3.3719]→[3.3045:3073](∅→∅),[3.3073]→[3.16107:16211](∅→∅)

pgEval (FindBillable bid) =
headMay <$> pquery billableParser
[sql| SELECT b.project_id, e.created_by, b.name, b.description,

[3.3719]

[3.16211]

pgEval (FindBillable bid) = headMay <$> pquery
billableParser
[sql| SELECT b.project_id, e.created_by, b.name, b.description,
replacement in lib/Aftok/Database/PostgreSQL.hs at line 621

[3.21120]→[3.5594:5628](∅→∅),[3.12769]→[3.5594:5628](∅→∅)

(Only (bid ^. B._BillableId))

[3.21120]

[3.21121]

(Only (bid ^. B._BillableId))
replacement in lib/Aftok/Database/PostgreSQL.hs at line 623

[3.21122]→[3.16337:16500](∅→∅)

pgEval (FindBillables pid) =
pquery ((,) <$> idParser B.BillableId <*> billableParser)
[sql| SELECT b.id, b.project_id, e.created_by, b.name, b.description,

[3.21122]

[3.16500]

pgEval (FindBillables pid) = pquery
((,) <$> idParser B.BillableId <*> billableParser)
[sql| SELECT b.id, b.project_id, e.created_by, b.name, b.description,
replacement in lib/Aftok/Database/PostgreSQL.hs at line 631

[3.21589]→[3.16681:16712](∅→∅)

(Only (pid ^. _ProjectId))

[3.21589]

[3.3942]

(Only (pid ^. _ProjectId))
replacement in lib/Aftok/Database/PostgreSQL.hs at line 635

[3.609]→[3.16771:16798](∅→∅)

pinsert B.SubscriptionId

[3.609]

[3.16798]

pinsert
B.SubscriptionId
replacement in lib/Aftok/Database/PostgreSQL.hs at line 640

[3.1326]→[3.567:590](∅→∅),[3.21790]→[3.567:590](∅→∅),[3.746]→[3.567:590](∅→∅)

( view _UserId uid

[3.21790]

[3.590]

( view _UserId uid
replacement in lib/Aftok/Database/PostgreSQL.hs at line 642

[3.619]→[3.619:647](∅→∅)

, view _EventId eventId

[3.619]

[3.1327]

, view _EventId eventId
replacement in lib/Aftok/Database/PostgreSQL.hs at line 646

[3.3075]→[3.1484:1516](∅→∅),[3.1516]→[3.16890:16985](∅→∅)

pgEval (FindSubscription sid) =
headMay <$> pquery subscriptionParser
[sql| SELECT id, billable_id, start_date, end_date

[3.3075]

[3.16985]

pgEval (FindSubscription sid) = headMay <$> pquery
subscriptionParser
[sql| SELECT id, billable_id, start_date, end_date
replacement in lib/Aftok/Database/PostgreSQL.hs at line 651

[3.21948]→[3.3249:3287](∅→∅),[3.3249]→[3.3249:3287](∅→∅)

(Only (sid ^. B._SubscriptionId))

[3.21948]

[3.5781]

(Only (sid ^. B._SubscriptionId))
replacement in lib/Aftok/Database/PostgreSQL.hs at line 653

[3.5782]→[3.1517:1554](∅→∅),[3.1554]→[3.17017:17151](∅→∅)

pgEval (FindSubscriptions uid pid) =
pquery ((,) <$> idParser B.SubscriptionId <*> subscriptionParser)
[sql| SELECT s.id, user_id, billable_id, start_date, end_date

[3.5782]

[3.17151]

pgEval (FindSubscriptions uid pid) = pquery
((,) <$> idParser B.SubscriptionId <*> subscriptionParser)
[sql| SELECT s.id, user_id, billable_id, start_date, end_date
replacement in lib/Aftok/Database/PostgreSQL.hs at line 660

[3.22234]→[3.17264:17304](∅→∅)

(uid ^. _UserId, pid ^. _ProjectId)

[3.22234]

[3.811]

(uid ^. _UserId, pid ^. _ProjectId)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 665

[3.896]→[3.17350:17377](∅→∅)

pinsert PaymentRequestId

[3.896]

[3.17377]

pinsert
PaymentRequestId
replacement in lib/Aftok/Database/PostgreSQL.hs at line 678

[3.1568]→[3.685:730](∅→∅),[3.730]→[3.17506:17588](∅→∅)

pgEval (FindPaymentRequest (PaymentKey k)) =
headMay <$> pquery ((,) <$> idParser PaymentRequestId <*> paymentRequestParser)

[3.1568]

[3.17588]

pgEval (FindPaymentRequest (PaymentKey k)) = headMay <$> pquery
((,) <$> idParser PaymentRequestId <*> paymentRequestParser)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 686

[3.22743]→[3.22743:22841](∅→∅)

pgEval (FindPaymentRequestId (PaymentRequestId prid)) =
headMay <$> pquery paymentRequestParser

[3.22743]

[3.17731]

pgEval (FindPaymentRequestId (PaymentRequestId prid)) = headMay <$> pquery
paymentRequestParser
replacement in lib/Aftok/Database/PostgreSQL.hs at line 693

[3.1591]→[3.1591:1626](∅→∅),[3.1626]→[3.17844:17914](∅→∅)

pgEval (FindPaymentRequests sid) =
pquery ((,) <$> idParser PaymentRequestId <*> paymentRequestParser)

[3.1591]

[3.17914]

pgEval (FindPaymentRequests sid) = pquery
((,) <$> idParser PaymentRequestId <*> paymentRequestParser)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 702

[3.846]→[3.846:892](∅→∅),[3.892]→[3.886:1010](∅→∅),[3.886]→[3.886:1010](∅→∅),[3.1010]→[3.18031:18079](∅→∅)

rowp = (,,,) <$> (PaymentKey <$> field)
<*> paymentRequestParser
<*> subscriptionParser
<*> billableParser
in pquery rowp
[sql| SELECT r.url_key,

[3.846]

[3.18079]

rowp =
(,,,)
<$> (PaymentKey <$> field)
<*> paymentRequestParser
<*> subscriptionParser
<*> billableParser
in pquery
rowp
[sql| SELECT r.url_key,
replacement in lib/Aftok/Database/PostgreSQL.hs at line 722

[3.24012]→[3.1601:1641](∅→∅),[3.1601]→[3.1601:1641](∅→∅)

(Only (sid ^. B._SubscriptionId))

[3.24012]

[3.1641]

(Only (sid ^. B._SubscriptionId))
replacement in lib/Aftok/Database/PostgreSQL.hs at line 726

[3.81]→[3.18563:18583](∅→∅)

pinsert PaymentId

[3.81]

[3.18583]

pinsert
PaymentId
replacement in lib/Aftok/Database/PostgreSQL.hs at line 738

[3.4353]→[3.1627:1655](∅→∅),[3.1655]→[3.18700:18756](∅→∅)

pgEval (FindPayments rid) =
pquery ((,) <$> idParser PaymentId <*> paymentParser)

[3.4353]

[3.18756]

pgEval (FindPayments rid) = pquery
((,) <$> idParser PaymentId <*> paymentParser)
replacement in lib/Aftok/Database.hs at line 11

[2.2693]→[3.24463:24549](∅→∅),[3.143]→[3.24463:24549](∅→∅),[3.24549]→[3.1787:1844](∅→∅),[3.1787]→[3.1787:1844](∅→∅)

import Control.Lens (view, (^.), makeClassyPrisms, traverseOf)
import Control.Monad.Trans.Maybe (MaybeT (..))

[2.2693]

[3.173]

import Control.Lens ( view
, (^.)
, makeClassyPrisms
, traverseOf
)
import Control.Monad.Trans.Maybe ( MaybeT(..) )
replacement in lib/Aftok/Database.hs at line 18

[3.207]→[3.1845:1893](∅→∅),[3.1893]→[3.1356:1410](∅→∅),[3.1410]→[2.2694:2726](∅→∅)

import Data.Thyme.Clock as C
import Data.Thyme.Time as T (Day)
import Safe (headMay)

[3.207]

[3.6576]

import Data.Thyme.Clock as C
import Data.Thyme.Time as T
( Day )
import Safe ( headMay )
replacement in lib/Aftok/Database.hs at line 24

[3.18875]→[3.1894:1990](∅→∅),[3.270]→[3.1894:1990](∅→∅),[3.1990]→[3.18876:18931](∅→∅)

import Aftok.Auction as A
import Aftok.Billables as B
import Aftok.Currency.Bitcoin (NetworkId)

[3.18875]

[3.301]

import Aftok.Auction as A
import Aftok.Billables as B
import Aftok.Currency.Bitcoin ( NetworkId )
replacement in lib/Aftok/Database.hs at line 29

[3.6499]→[3.1991:2039](∅→∅)

import Aftok.Project as P

[3.6499]

[3.333]

import Aftok.Project as P
replacement in lib/Aftok/Database.hs at line 33

[3.5920]→[3.18932:18985](∅→∅)

import Network.Haskoin.Address (Address)

[3.5920]

[3.18985]

import Network.Haskoin.Address ( Address )
replacement in lib/Aftok/Database.hs at line 36

[3.19041]→[3.19041:19101](∅→∅)

type InvitingUID = UserId
type InvitedUID = UserId

[3.19041]

[3.19101]

type InvitingUID = UserId
type InvitedUID = UserId
replacement in lib/Aftok/Database.hs at line 43

[3.6156]→[3.19165:19328](∅→∅)

CreateUser :: BTCUser -> DBOp UserId
FindUser :: UserId -> DBOp (Maybe BTCUser)
FindUserByName :: UserName -> DBOp (Maybe (UserId, BTCUser))

[3.6156]

[3.6305]

CreateUser ::BTCUser -> DBOp UserId
FindUser ::UserId -> DBOp (Maybe BTCUser)
FindUserByName ::UserName -> DBOp (Maybe (UserId, BTCUser))
replacement in lib/Aftok/Database.hs at line 47

[3.6306]→[3.6306:6410](∅→∅),[3.6410]→[3.24550:24638](∅→∅),[3.24638]→[3.4711:4771](∅→∅),[3.6410]→[3.4711:4771](∅→∅),[3.4771]→[3.6462:6534](∅→∅),[3.6462]→[3.6462:6534](∅→∅),[3.6534]→[3.4554:4781](∅→∅)

CreateProject :: Project -> DBOp ProjectId
FindProject :: ProjectId -> DBOp (Maybe Project)
ListProjects :: DBOp [ProjectId]
FindSubscribers :: ProjectId -> DBOp [UserId]
FindUserProjects :: UserId -> DBOp [(ProjectId, Project)]
AddUserToProject :: ProjectId -> InvitingUID -> InvitedUID -> DBOp ()
CreateInvitation :: ProjectId -> InvitingUID -> Email -> C.UTCTime -> DBOp InvitationCode
FindInvitation :: InvitationCode -> DBOp (Maybe Invitation)
AcceptInvitation :: UserId -> InvitationCode -> C.UTCTime -> DBOp ()

[3.6306]

[3.6534]

CreateProject ::Project -> DBOp ProjectId
FindProject ::ProjectId -> DBOp (Maybe Project)
ListProjects ::DBOp [ProjectId]
FindSubscribers ::ProjectId -> DBOp [UserId]
FindUserProjects ::UserId -> DBOp [(ProjectId, Project)]
AddUserToProject ::ProjectId -> InvitingUID -> InvitedUID -> DBOp ()
CreateInvitation ::ProjectId -> InvitingUID -> Email -> C.UTCTime -> DBOp InvitationCode
FindInvitation ::InvitationCode -> DBOp (Maybe Invitation)
AcceptInvitation ::UserId -> InvitationCode -> C.UTCTime -> DBOp ()
replacement in lib/Aftok/Database.hs at line 57

[3.6535]→[3.19329:19690](∅→∅)

CreateEvent :: ProjectId -> UserId -> LogEntry BTCNet -> DBOp EventId
AmendEvent :: EventId -> EventAmendment BTCNet -> DBOp AmendmentId
FindEvent :: EventId -> DBOp (Maybe (KeyedLogEntry BTCNet))
FindEvents :: ProjectId -> UserId -> Interval' -> DBOp [LogEntry BTCNet]
ReadWorkIndex :: ProjectId -> DBOp (WorkIndex BTCNet)

[3.6535]

[3.6857]

CreateEvent ::ProjectId -> UserId -> LogEntry BTCNet -> DBOp EventId
AmendEvent ::EventId -> EventAmendment BTCNet -> DBOp AmendmentId
FindEvent ::EventId -> DBOp (Maybe (KeyedLogEntry BTCNet))
FindEvents ::ProjectId -> UserId -> Interval' -> DBOp [LogEntry BTCNet]
ReadWorkIndex ::ProjectId -> DBOp (WorkIndex BTCNet)
replacement in lib/Aftok/Database.hs at line 63

[3.6858]→[3.254:302](∅→∅),[3.302]→[3.6919:7028](∅→∅),[3.6919]→[3.6919:7028](∅→∅),[3.7028]→[3.4772:4827](∅→∅)

CreateAuction :: Auction -> DBOp AuctionId
FindAuction :: AuctionId -> DBOp (Maybe Auction)
CreateBid :: AuctionId -> Bid -> DBOp BidId
FindBids :: AuctionId -> DBOp [(BidId, Bid)]

[3.6858]

[3.4052]

CreateAuction ::Auction -> DBOp AuctionId
FindAuction ::AuctionId -> DBOp (Maybe Auction)
CreateBid ::AuctionId -> Bid -> DBOp BidId
FindBids ::AuctionId -> DBOp [(BidId, Bid)]
replacement in lib/Aftok/Database.hs at line 68

[3.4053]→[3.1003:1063](∅→∅),[3.1063]→[3.4828:4886](∅→∅),[3.4886]→[3.24639:24705](∅→∅)

CreateBillable :: UserId -> Billable -> DBOp BillableId
FindBillable :: BillableId -> DBOp (Maybe Billable)
FindBillables :: ProjectId -> DBOp [(BillableId, Billable)]

[3.4053]

[3.13382]

CreateBillable ::UserId -> Billable -> DBOp BillableId
FindBillable ::BillableId -> DBOp (Maybe Billable)
FindBillables ::ProjectId -> DBOp [(BillableId, Billable)]
replacement in lib/Aftok/Database.hs at line 72

[3.13383]→[3.1411:1488](∅→∅),[3.1488]→[3.1712:1865](∅→∅),[3.1712]→[3.1712:1865](∅→∅)

CreateSubscription :: UserId -> BillableId -> T.Day -> DBOp SubscriptionId
FindSubscription :: SubscriptionId -> DBOp (Maybe Subscription)
FindSubscriptions :: UserId -> ProjectId -> DBOp [(SubscriptionId, Subscription)]

[3.13383]

[3.4199]

CreateSubscription ::UserId -> BillableId -> T.Day -> DBOp SubscriptionId
FindSubscription ::SubscriptionId -> DBOp (Maybe Subscription)
FindSubscriptions ::UserId -> ProjectId -> DBOp [(SubscriptionId, Subscription)]
replacement in lib/Aftok/Database.hs at line 76

[3.4200]→[3.1598:1665](∅→∅),[3.1665]→[3.5107:5194](∅→∅),[3.5107]→[3.5107:5194](∅→∅),[3.5194]→[3.1866:1929](∅→∅),[3.1929]→[3.1666:1755](∅→∅),[3.1755]→[3.24706:24781](∅→∅)

CreatePaymentRequest :: PaymentRequest -> DBOp PaymentRequestId
FindPaymentRequests :: SubscriptionId -> DBOp [(PaymentRequestId, PaymentRequest)]
FindUnpaidRequests :: SubscriptionId -> DBOp [BillDetail]
FindPaymentRequest :: PaymentKey -> DBOp (Maybe (PaymentRequestId, PaymentRequest))
FindPaymentRequestId :: PaymentRequestId -> DBOp (Maybe PaymentRequest)

[3.4200]

[3.5194]

CreatePaymentRequest ::PaymentRequest -> DBOp PaymentRequestId
FindPaymentRequests ::SubscriptionId -> DBOp [(PaymentRequestId, PaymentRequest)]
FindUnpaidRequests ::SubscriptionId -> DBOp [BillDetail]
FindPaymentRequest ::PaymentKey -> DBOp (Maybe (PaymentRequestId, PaymentRequest))
FindPaymentRequestId ::PaymentRequestId -> DBOp (Maybe PaymentRequest)
replacement in lib/Aftok/Database.hs at line 82

[3.5195]→[3.1756:1802](∅→∅),[3.1802]→[3.5251:5319](∅→∅),[3.5251]→[3.5251:5319](∅→∅)

CreatePayment :: Payment -> DBOp PaymentId
FindPayments :: PaymentRequestId -> DBOp [(PaymentId, Payment)]

[3.5195]

[3.7074]

CreatePayment ::Payment -> DBOp PaymentId
FindPayments ::PaymentRequestId -> DBOp [(PaymentId, Payment)]
replacement in lib/Aftok/Database.hs at line 144

[3.25369]→[3.25369:25468](∅→∅)

findProjectOrError pid = fromMaybeT
(raiseSubjectNotFound $ FindProject pid)
(findProject pid)

[3.25369]

[3.25468]

findProjectOrError pid =
fromMaybeT (raiseSubjectNotFound $ FindProject pid) (findProject pid)
replacement in lib/Aftok/Database.hs at line 169

[3.557]→[3.7867:7949](∅→∅)

addUserToProject :: (MonadDB m) => ProjectId -> InvitingUID -> InvitedUID -> m ()

[3.557]

[3.625]

addUserToProject
:: (MonadDB m) => ProjectId -> InvitingUID -> InvitedUID -> m ()
replacement in lib/Aftok/Database.hs at line 174

[3.5600]→[3.7950:8052](∅→∅)

createInvitation :: (MonadDB m) => ProjectId -> InvitingUID -> Email -> C.UTCTime -> m InvitationCode

[3.5600]

[3.5692]

createInvitation
:: (MonadDB m)
=> ProjectId
-> InvitingUID
-> Email
-> C.UTCTime
-> m InvitationCode
replacement in lib/Aftok/Database.hs at line 187

[3.5907]→[3.8173:8253](∅→∅)

acceptInvitation :: (MonadDB m) => UserId -> C.UTCTime -> InvitationCode-> m ()

[3.5907]

[3.413]

acceptInvitation :: (MonadDB m) => UserId -> C.UTCTime -> InvitationCode -> m ()
replacement in lib/Aftok/Database.hs at line 192

[3.6088]→[3.661:676](∅→∅),[3.676]→[3.8254:8285](∅→∅)

Nothing ->
raiseSubjectNotFound act

[3.6088]

[3.677]

Nothing -> raiseSubjectNotFound act
replacement in lib/Aftok/Database.hs at line 197

[3.8393]→[3.804:818](∅→∅),[3.6383]→[3.804:818](∅→∅),[3.818]→[3.558:625](∅→∅)

Just i ->
withProjectAuth (i ^. P.projectId) (i ^. P.invitingUser) act

[3.8393]

[3.1389]

Just i -> withProjectAuth (i ^. P.projectId) (i ^. P.invitingUser) act
replacement in lib/Aftok/Database.hs at line 202

[3.8566]→[3.19869:19951](∅→∅)

createEvent :: (MonadDB m) => ProjectId -> UserId -> LogEntry BTCNet -> m EventId

[3.8566]

[3.819]

createEvent
:: (MonadDB m) => ProjectId -> UserId -> LogEntry BTCNet -> m EventId
replacement in lib/Aftok/Database.hs at line 206

[3.8692]→[3.19952:20041](∅→∅)

amendEvent :: (MonadDB m) => UserId -> EventId -> EventAmendment BTCNet -> m AmendmentId

[3.8692]

[3.8764]

amendEvent
:: (MonadDB m) => UserId -> EventId -> EventAmendment BTCNet -> m AmendmentId
replacement in lib/Aftok/Database.hs at line 210

[3.8812]→[3.8812:8841](∅→∅)

let act = AmendEvent eid a

[3.8812]

[3.6524]

let act = AmendEvent eid a
replacement in lib/Aftok/Database.hs at line 213

[3.8596]→[3.8596:8680](∅→∅)

maybe missing (\(_, uid', _) -> if uid' == uid then liftdb act else forbidden) ev

[3.8596]

[3.1146]

maybe missing
(\(_, uid', _) -> if uid' == uid then liftdb act else forbidden)
ev
replacement in lib/Aftok/Database.hs at line 220

[3.4025]→[3.20115:20200](∅→∅)

findEvents :: (MonadDB m) => ProjectId -> UserId -> Interval' -> m [LogEntry BTCNet]

[3.4025]

[3.8854]

findEvents
:: (MonadDB m) => ProjectId -> UserId -> Interval' -> m [LogEntry BTCNet]
replacement in lib/Aftok/Database.hs at line 236

[3.5572]→[3.5572:5666](∅→∅)

findSubscriptions :: (MonadDB m) => UserId -> ProjectId -> m [(SubscriptionId, Subscription)]

[3.5572]

[3.5666]

findSubscriptions
:: (MonadDB m) => UserId -> ProjectId -> m [(SubscriptionId, Subscription)]
replacement in lib/Aftok/Database.hs at line 240

[3.5730]→[3.1989:2091](∅→∅)

findSubscriptionBillable :: (MonadDB m) => SubscriptionId -> MaybeT m (Subscription' UserId Billable)

[3.5730]

[3.5825]

findSubscriptionBillable
:: (MonadDB m) => SubscriptionId -> MaybeT m (Subscription' UserId Billable)
replacement in lib/Aftok/Database.hs at line 246

[3.4655]→[3.5937:6032](∅→∅)

findPaymentRequests :: (MonadDB m) => SubscriptionId -> m [(PaymentRequestId, PaymentRequest)]

[3.4655]

[3.6032]

findPaymentRequests
:: (MonadDB m) => SubscriptionId -> m [(PaymentRequestId, PaymentRequest)]
replacement in lib/Aftok/Database.hs at line 250

[3.1595]→[3.25718:25813](∅→∅)

findPaymentRequest :: (MonadDB m) => PaymentKey -> MaybeT m (PaymentRequestId, PaymentRequest)

[3.1595]

[3.25813]

findPaymentRequest
:: (MonadDB m) => PaymentKey -> MaybeT m (PaymentRequestId, PaymentRequest)
replacement in lib/Aftok/Database.hs at line 254

[3.25872]→[3.25872:25955](∅→∅)

findPaymentRequestId :: (MonadDB m) => PaymentRequestId -> MaybeT m PaymentRequest

[3.25872]

[3.25955]

findPaymentRequestId
:: (MonadDB m) => PaymentRequestId -> MaybeT m PaymentRequest
replacement in lib/Aftok/Database.hs at line 276

[3.892]→[3.26237:26271](∅→∅),[3.26271]→[3.20278:20343](∅→∅),[3.20343]→[3.26337:26350](∅→∅),[3.26337]→[3.26337:26350](∅→∅)

auc <- MaybeT $ liftdb findOp
_ <- lift $ checkProjectAuth (auc ^. A.projectId) uid findOp
pure auc

[3.892]

[3.292]

auc <- MaybeT $ liftdb findOp
_ <- lift $ checkProjectAuth (auc ^. A.projectId) uid findOp
pure auc
replacement in lib/Aftok/Database.hs at line 284

[3.411]→[3.9820:9850](∅→∅),[3.9850]→[3.437:523](∅→∅),[3.437]→[3.437:523](∅→∅),[3.523]→[3.9851:9905](∅→∅)

maybeAuc <- liftdb findOp
_ <- traverse (\auc -> checkProjectAuth (auc ^. A.projectId) uid findOp) maybeAuc
maybe (raiseSubjectNotFound findOp) pure maybeAuc

[3.411]

[3.21]

maybeAuc <- liftdb findOp
_ <- traverse
(\auc -> checkProjectAuth (auc ^. A.projectId) uid findOp)
maybeAuc
maybe (raiseSubjectNotFound findOp) pure maybeAuc
replacement in lib/Aftok/Database.hs at line 294

[3.618]→[3.618:650](∅→∅),[3.650]→[3.9973:10019](∅→∅),[3.964]→[3.702:756](∅→∅),[3.10019]→[3.702:756](∅→∅),[3.702]→[3.702:756](∅→∅),[3.756]→[3.10020:10047](∅→∅)

auc <- findAuction' aid uid
if view bidTime bid > view auctionEnd auc
then raiseOpForbidden uid AuctionEnded createOp
else liftdb createOp

[3.618]

auc <- findAuction' aid uid
if view bidTime bid > view auctionEnd auc
then raiseOpForbidden uid AuctionEnded createOp
else liftdb createOp
replacement in lib/Aftok/Interval.hs at line 4

[3.1609]→[3.3:48](∅→∅),[3.3657]→[3.3:48](∅→∅),[3.5263]→[3.3:48](∅→∅),[3.48]→[3.1316:1359](∅→∅),[3.48]→[3.3192:3228](∅→∅),[3.54]→[3.3192:3228](∅→∅),[3.1359]→[3.3192:3228](∅→∅),[3.44]→[3.3192:3228](∅→∅)

( Interval(..), interval, start, end, ilen
, Interval'(..), interval', start', end'
, intervalJSON, parseIntervalJSON

[3.3657]

[3.55]

( Interval(..)
, interval
, start
, end
, ilen
, Interval'(..)
, interval'
, start'
, end'
, intervalJSON
, parseIntervalJSON
replacement in lib/Aftok/Interval.hs at line 16

[3.44]→[3.1483:1493](∅→∅),[3.77]→[3.1483:1493](∅→∅),[3.3228]→[3.1483:1493](∅→∅),[3.1483]→[3.1483:1493](∅→∅)

) where

[3.77]

[3.1493]

)
where
replacement in lib/Aftok/Interval.hs at line 21

[2.2729]→[3.3690:3750](∅→∅),[3.1727]→[3.3690:3750](∅→∅)

import Control.Lens (makeLenses, (^.))

[2.2729]

[3.3750]

import Control.Lens ( makeLenses
, (^.)
)
replacement in lib/Aftok/Interval.hs at line 27

[3.3846]→[3.3846:3980](∅→∅)

import Data.Thyme.Clock as C
import Data.Thyme.Format.Aeson ()
import Data.Thyme.LocalTime ()

[3.3846]

[3.1544]

import Data.Thyme.Clock as C
import Data.Thyme.Format.Aeson ( )
import Data.Thyme.LocalTime ( )
replacement in lib/Aftok/Json.hs at line 12

[3.1966]→[3.20511:20587](∅→∅),[3.20587]→[3.950:1014](∅→∅),[3.1966]→[3.950:1014](∅→∅),[3.1014]→[3.20588:20654](∅→∅)

import Control.FromSum (fromMaybeM, fromEitherM)
import Control.Lens hiding ((.=))
import Control.Monad.Fail (MonadFail(..))

[3.1966]

[3.1014]

import Control.FromSum ( fromMaybeM
, fromEitherM
)
import Control.Lens hiding ( (.=) )
import Control.Monad.Fail ( MonadFail(..) )
replacement in lib/Aftok/Json.hs at line 19

[3.1076]→[3.3:59](∅→∅),[3.1132]→[3.353:410](∅→∅),[3.410]→[3.1636:1691](∅→∅)

import qualified Data.Attoparsec.ByteString.Char8 as PC
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Char8 as C

[3.1076]

[3.1132]

import qualified Data.Attoparsec.ByteString.Char8
as PC
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Char8 as C
replacement in lib/Aftok/Json.hs at line 24

[3.1159]→[3.1003:1058](∅→∅),[3.1058]→[3.1159:1270](∅→∅),[3.1159]→[3.1159:1270](∅→∅),[3.1270]→[3.1692:1817](∅→∅),[3.518]→[3.4970:5025](∅→∅),[3.1817]→[3.4970:5025](∅→∅),[3.1270]→[3.4970:5025](∅→∅),[3.5025]→[2.2731:2786](∅→∅),[2.2786]→[3.2070:2136](∅→∅),[3.5025]→[3.2070:2136](∅→∅),[3.2136]→[3.20655:20714](∅→∅),[3.20714]→[3.1554:1610](∅→∅),[3.58]→[3.1554:1610](∅→∅),[3.58]→[3.3094:3149](∅→∅),[3.1610]→[3.3094:3149](∅→∅),[3.6278]→[3.3094:3149](∅→∅),[3.790]→[3.3094:3149](∅→∅)

import Data.HashMap.Strict as O
import Data.List.NonEmpty as L
import Data.Map.Strict as MS
import Data.ProtocolBuffers (encodeMessage)
import Data.Serialize.Put (runPut)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Thyme.Calendar (showGregorian)
import Data.Thyme.Clock as Clock
import Data.Thyme.Time (Day)
import Data.UUID as U

[3.1159]

[3.231]

import Data.HashMap.Strict as O
import Data.List.NonEmpty as L
import Data.Map.Strict as MS
import Data.ProtocolBuffers ( encodeMessage )
import Data.Serialize.Put ( runPut )
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Thyme.Calendar ( showGregorian )
import Data.Thyme.Clock as Clock
import Data.Thyme.Time ( Day )
import Data.UUID as U
replacement in lib/Aftok/Json.hs at line 36

[3.232]→[3.20715:20815](∅→∅)

import Network.Haskoin.Address (Address, addrToJSON, addrFromJSON, stringToAddr)

[3.232]

[3.20815]

import Network.Haskoin.Address ( Address
, addrToJSON
, addrFromJSON
, stringToAddr
)
replacement in lib/Aftok/Json.hs at line 43

[3.20856]→[3.60:115](∅→∅),[3.1294]→[3.60:115](∅→∅),[3.115]→[3.1349:1404](∅→∅)

import Aftok.Auction as A
import qualified Aftok.Billables as B

[3.20856]

[3.1326]

import Aftok.Auction as A
import qualified Aftok.Billables as B
replacement in lib/Aftok/Json.hs at line 47

[3.551]→[3.2372:2435](∅→∅),[3.551]→[3.116:171](∅→∅),[3.2435]→[3.116:171](∅→∅),[3.1358]→[3.116:171](∅→∅)

import Aftok.Payments.Types (BillDetail)
import Aftok.Project as P

[3.551]

[3.1358]

import Aftok.Payments.Types ( BillDetail )
import Aftok.Project as P
replacement in lib/Aftok/Json.hs at line 51

[3.201]→[3.1818:1883](∅→∅)

import Aftok.Util (traverseKeys)

[3.201]

[3.272]

import Aftok.Util ( traverseKeys )
replacement in lib/Aftok/Json.hs at line 53

[3.273]→[3.1390:1446](∅→∅)

import qualified Language.Haskell.TH as TH

[3.273]

[3.1446]

import qualified Language.Haskell.TH as TH
replacement in lib/Aftok/Json.hs at line 64

[3.20940]→[2.2787:2884](∅→∅)

printVersion Version{..} = T.intercalate "." $ fmap (T.pack . show) [majorVersion, minorVersion]

[3.20940]

[3.2225]

printVersion Version {..} =
T.intercalate "." $ fmap (T.pack . show) [majorVersion, minorVersion]
replacement in lib/Aftok/Json.hs at line 74

[3.21160]→[3.21160:21478](∅→∅)

v = QuasiQuoter { quoteExp = quoteVersionExp
, quotePat = error "Pattern quasiquotation of versions not supported."
, quoteType = error "Type quasiquotation of versions not supported."
, quoteDec = error "Dec quasiquotation of versions not supported."
}

[3.21160]

[3.2414]

v = QuasiQuoter
{ quoteExp = quoteVersionExp
, quotePat = error "Pattern quasiquotation of versions not supported."
, quoteType = error "Type quasiquotation of versions not supported."
, quoteDec = error "Dec quasiquotation of versions not supported."
}
replacement in lib/Aftok/Json.hs at line 88

[3.574]→[3.21541:21625](∅→∅)

versioned ver o = Object $ uncurry O.insert ("schemaVersion" .= printVersion ver) o

[3.574]

[3.186]

versioned ver o =
Object $ uncurry O.insert ("schemaVersion" .= printVersion ver) o
replacement in lib/Aftok/Json.hs at line 116

[3.940]→[3.1032:1093](∅→∅)

badVersion :: forall v a. String -> Version -> v -> Parser a

[3.940]

[3.21705]

badVersion :: forall v a . String -> Version -> v -> Parser a
replacement in lib/Aftok/Json.hs at line 118

[3.21727]→[2.2966:3061](∅→∅)

const . fail $ "Unrecognized " <> name <> " schema version: " <> T.unpack (printVersion ver)

[3.21727]

[3.5114]

const . fail $ "Unrecognized " <> name <> " schema version: " <> T.unpack
(printVersion ver)
replacement in lib/Aftok/Json.hs at line 129

[3.2437]→[3.1611:1659](∅→∅)

idValue :: forall a. Lens' a UUID -> a -> Value

[3.2437]

[3.21821]

idValue :: forall a . Lens' a UUID -> a -> Value
replacement in lib/Aftok/Json.hs at line 132

[3.1700]→[3.1700:1802](∅→∅)

idJSON :: forall a. Text -> Lens' a UUID -> a -> Value
idJSON t l a = v1 $ obj [ t .= idValue l a ]

[3.1700]

[3.485]

idJSON :: forall a . Text -> Lens' a UUID -> a -> Value
idJSON t l a = v1 $ obj [t .= idValue l a]
replacement in lib/Aftok/Json.hs at line 136

[3.26421]→[3.26421:26514](∅→∅),[3.26514]→[3.1288:1296](∅→∅),[3.1288]→[3.1288:1296](∅→∅)

qdbJSON name l f (xid, x) = v1 $
obj [ (name <> "Id") .= idValue l xid
, name .= f x
]

[3.26421]

[3.249]

qdbJSON name l f (xid, x) =
v1 $ obj [(name <> "Id") .= idValue l xid, name .= f x]
replacement in lib/Aftok/Json.hs at line 143

[3.5298]→[3.5319:5340](∅→∅),[3.5340]→[3.1349:1445](∅→∅),[3.1445]→[2.3062:3119](∅→∅),[2.3119]→[3.1508:1516](∅→∅),[3.1508]→[3.1508:1516](∅→∅)

projectJSON p = v1 $
obj [ "projectName" .= (p ^. projectName)
, "inceptionDate" .= (p ^. inceptionDate)
, "initiator" .= (p ^. P.initiator . _UserId)
]

[3.5298]

[3.26515]

projectJSON p = v1 $ obj
[ "projectName" .= (p ^. projectName)
, "inceptionDate" .= (p ^. inceptionDate)
, "initiator" .= (p ^. P.initiator . _UserId)
]
replacement in lib/Aftok/Json.hs at line 156

[3.571]→[3.571:592](∅→∅),[3.592]→[3.1945:2064](∅→∅),[3.2064]→[3.5070:5127](∅→∅),[3.1694]→[3.5070:5127](∅→∅),[3.5127]→[3.1750:1758](∅→∅),[3.1750]→[3.1750:1758](∅→∅)

auctionJSON x = v1 $
obj [ "projectId" .= idValue (A.projectId._ProjectId) x
, "initiator" .= idValue (A.initiator._UserId) x
, "raiseAmount" .= (x ^. (raiseAmount . satoshi))
]

[3.571]

[3.483]

auctionJSON x = v1 $ obj
[ "projectId" .= idValue (A.projectId . _ProjectId) x
, "initiator" .= idValue (A.initiator . _UserId) x
, "raiseAmount" .= (x ^. (raiseAmount . satoshi))
]
replacement in lib/Aftok/Json.hs at line 163

[3.512]→[3.512:533](∅→∅),[3.533]→[2.3120:3157](∅→∅)

bidIdJSON pid = v1 $
obj [ "bidId" .= (pid ^. _BidId) ]

[3.512]

[3.21865]

bidIdJSON pid = v1 $ obj ["bidId" .= (pid ^. _BidId)]
replacement in lib/Aftok/Json.hs at line 170

[3.21955]→[3.21955:22152](∅→∅)

creditToJSON nmode (CreditToCurrency (netId, addr)) =
v2 $ obj [ "creditToAddress" .= addrToJSON (toNetwork nmode netId) addr
, "creditToNetwork" .= renderNetworkId netId
]

[3.21955]

[3.22152]

creditToJSON nmode (CreditToCurrency (netId, addr)) = v2 $ obj
[ "creditToAddress" .= addrToJSON (toNetwork nmode netId) addr
, "creditToNetwork" .= renderNetworkId netId
]
replacement in lib/Aftok/Json.hs at line 175

[3.22188]→[3.22188:22244](∅→∅)

v2 $ obj [ "creditToUser" .= idValue _UserId uid ]

[3.22188]

[3.22244]

v2 $ obj ["creditToUser" .= idValue _UserId uid]
replacement in lib/Aftok/Json.hs at line 177

[3.22283]→[3.22283:22337](∅→∅)

v2 $ obj [ "creditToProject" .= projectIdJSON pid ]

[3.22283]

[3.22337]

v2 $ obj ["creditToProject" .= projectIdJSON pid]
replacement in lib/Aftok/Json.hs at line 186

[3.22616]→[3.22616:22744](∅→∅),[3.22744]→[2.3158:3254](∅→∅),[2.3254]→[3.22838:22927](∅→∅),[3.22838]→[3.22838:22927](∅→∅)

:: NetworkMode
-> NetworkId
-> Text
-> Parser (CreditTo (NetworkId, Address))
parseBtcAddr nmode net addrText =
maybe
(fail . T.unpack $ "Address " <> addrText <> " cannot be parsed as a BTC network address.")
(pure . CreditToCurrency . (net,))
(stringToAddr (toNetwork nmode net) addrText)

[3.22616]

[3.22927]

:: NetworkMode -> NetworkId -> Text -> Parser (CreditTo (NetworkId, Address))
parseBtcAddr nmode net addrText = maybe
( fail
. T.unpack
$ "Address "
<> addrText
<> " cannot be parsed as a BTC network address."
)
(pure . CreditToCurrency . (net, ))
(stringToAddr (toNetwork nmode net) addrText)
replacement in lib/Aftok/Json.hs at line 198

[3.22944]→[3.22944:23017](∅→∅)

:: NetworkMode
-> Object
-> Parser (CreditTo (NetworkId, Address))

[3.22944]

[3.23017]

:: NetworkMode -> Object -> Parser (CreditTo (NetworkId, Address))
replacement in lib/Aftok/Json.hs at line 202

[3.23091]→[3.23091:23174](∅→∅)

parseCreditToV2 :: NetworkMode -> Object -> Parser (CreditTo (NetworkId, Address))

[3.23091]

[3.23174]

parseCreditToV2
:: NetworkMode -> Object -> Parser (CreditTo (NetworkId, Address))
replacement in lib/Aftok/Json.hs at line 205

[3.23200]→[3.23200:23542](∅→∅)

let parseCreditToAddr = do
netName <- o .: "creditToNetwork"
net <- fromMaybeM
(fail . T.unpack $ "Currency network " <> netName <> " not recognized.")
(parseNetworkId netName)
addrValue <- o .: "creditToAddress"
CreditToCurrency . (net,) <$> addrFromJSON (toNetwork nmode net) addrValue

[3.23200]

[3.23542]

let
parseCreditToAddr = do
netName <- o .: "creditToNetwork"
net <- fromMaybeM
(fail . T.unpack $ "Currency network " <> netName <> " not recognized.")
(parseNetworkId netName)
addrValue <- o .: "creditToAddress"
CreditToCurrency
. (net, )
<$> addrFromJSON (toNetwork nmode net) addrValue
replacement in lib/Aftok/Json.hs at line 216

[3.23543]→[3.23543:23637](∅→∅)

parseCreditToUser =
fmap CreditToUser . parseId _UserId =<< o .: "creditToUser"

[3.23543]

[3.23637]

parseCreditToUser =
fmap CreditToUser . parseId _UserId =<< o .: "creditToUser"
replacement in lib/Aftok/Json.hs at line 219

[3.23638]→[3.23638:23744](∅→∅)

parseCreditToProject =
fmap CreditToProject . parseId _ProjectId =<< o .: "creditToProject"

[3.23638]

[3.23744]

parseCreditToProject =
fmap CreditToProject . parseId _ProjectId =<< o .: "creditToProject"
replacement in lib/Aftok/Json.hs at line 222

[3.23745]→[3.23745:23831](∅→∅)

notFound = fail $ "Value " <> show o <> " does not represent a CreditTo value."

[3.23745]

[3.23831]

notFound =
fail $ "Value " <> show o <> " does not represent a CreditTo value."
in
parseCreditToAddr
<|> parseCreditToUser
<|> parseCreditToProject
<|> notFound
edit in lib/Aftok/Json.hs at line 230

[3.23832]→[3.23832:23917](∅→∅)

in parseCreditToAddr <|> parseCreditToUser <|> parseCreditToProject <|> notFound
replacement in lib/Aftok/Json.hs at line 234

[3.581]→[3.23935:24180](∅→∅),[3.24180]→[3.3488:3577](∅→∅),[3.3488]→[3.3488:3577](∅→∅),[3.3577]→[3.2080:2139](∅→∅)

payoutsJSON :: NetworkMode -> Payouts (NetworkId, Address)-> Value
payoutsJSON nmode (Payouts m) = v2 $
let payoutsRec :: (CreditTo (NetworkId, Address), Rational) -> Value
payoutsRec (c, r) = object [ "creditTo" .= creditToJSON nmode c
, "payoutRatio" .= r
]
in obj $ [ "payouts" .= fmap payoutsRec (MS.assocs m) ]

[3.581]

[3.24181]

payoutsJSON :: NetworkMode -> Payouts (NetworkId, Address) -> Value
payoutsJSON nmode (Payouts m) =
v2
$ let payoutsRec :: (CreditTo (NetworkId, Address), Rational) -> Value
payoutsRec (c, r) =
object ["creditTo" .= creditToJSON nmode c, "payoutRatio" .= r]
in obj $ ["payouts" .= fmap payoutsRec (MS.assocs m)]
replacement in lib/Aftok/Json.hs at line 242

[3.24182]→[3.24182:24264](∅→∅)

parsePayoutsJSON :: NetworkMode -> Value -> Parser (Payouts (NetworkId, Address))

[3.24182]

[3.24264]

parsePayoutsJSON
:: NetworkMode -> Value -> Parser (Payouts (NetworkId, Address))
replacement in lib/Aftok/Json.hs at line 246

[3.24385]→[3.24385:24497](∅→∅)

p (Version 1 _) val =
Payouts <$> join (traverseKeys (parseBtcAddr nmode BTC) <$> parseJSON (Object val))

[3.24385]

[3.24497]

p (Version 1 _) val = Payouts <$> join
(traverseKeys (parseBtcAddr nmode BTC) <$> parseJSON (Object val))
replacement in lib/Aftok/Json.hs at line 250

[3.24522]→[3.24522:24755](∅→∅)

let parsePayoutRecord x = (,) <$> (parseCreditToV2 nmode =<< (x .: "creditTo"))
<*> (x .: "payoutRatio")
in Payouts . MS.fromList <$> (traverse parsePayoutRecord =<< parseJSON (Object val))

[3.24522]

[3.24755]

let parsePayoutRecord x =
(,)
<$> (parseCreditToV2 nmode =<< (x .: "creditTo"))
<*> (x .: "payoutRatio")
in Payouts
. MS.fromList
<$> (traverse parsePayoutRecord =<< parseJSON (Object val))
replacement in lib/Aftok/Json.hs at line 258

[3.24756]→[3.24756:24799](∅→∅)

p ver x =
badVersion "Payouts" ver x

[3.24756]

[3.1904]

p ver x = badVersion "Payouts" ver x
replacement in lib/Aftok/Json.hs at line 265

[3.24892]→[3.24892:25081](∅→∅),[3.25081]→[3.3815:3924](∅→∅),[3.3815]→[3.3815:3924](∅→∅),[3.3924]→[3.2140:2201](∅→∅)

workIndexJSON nmode (WorkIndex widx) = v2 $
let widxRec :: (CreditTo (NetworkId, Address), NonEmpty Interval) -> Value
widxRec (c, l) = object [ "creditTo" .= creditToJSON nmode c
, "intervals" .= (intervalJSON <$> L.toList l)
]
in obj $ [ "workIndex" .= fmap widxRec (MS.assocs widx) ]

[3.24892]

[3.2061]

workIndexJSON nmode (WorkIndex widx) =
v2
$ let widxRec :: (CreditTo (NetworkId, Address), NonEmpty Interval) -> Value
widxRec (c, l) = object
[ "creditTo" .= creditToJSON nmode c
, "intervals" .= (intervalJSON <$> L.toList l)
]
in obj $ ["workIndex" .= fmap widxRec (MS.assocs widx)]
replacement in lib/Aftok/Json.hs at line 278

[3.1440]→[3.1440:1530](∅→∅)

logEventJSON' ev = object [ eventName ev .= object [ "eventTime" .= (ev ^. eventTime) ] ]

[3.1440]

[3.254]

logEventJSON' ev =
object [eventName ev .= object ["eventTime" .= (ev ^. eventTime)]]
replacement in lib/Aftok/Json.hs at line 282

[3.25152]→[3.25152:25240](∅→∅),[3.25240]→[3.1531:1567](∅→∅),[3.2274]→[3.1531:1567](∅→∅),[3.1567]→[3.2309:2342](∅→∅),[3.2309]→[3.2309:2342](∅→∅)

logEntryJSON nmode (LogEntry c ev m) = v2 $
obj [ "creditTo" .= creditToJSON nmode c
, "event" .= logEventJSON' ev
, "eventMeta" .= m
]

[3.25152]

[3.5559]

logEntryJSON nmode (LogEntry c ev m) = v2 $ obj
[ "creditTo" .= creditToJSON nmode c
, "event" .= logEventJSON' ev
, "eventMeta" .= m
]
replacement in lib/Aftok/Json.hs at line 299

[3.2627]→[3.2252:2308](∅→∅),[3.2308]→[3.2691:2726](∅→∅),[3.2691]→[3.2691:2726](∅→∅)

[ "projectId" .= idValue (B.project . _ProjectId) b
, "name" .= (b ^. B.name)

[3.2627]

[3.2726]

[ "projectId" .= idValue (B.project . _ProjectId) b
, "name" .= (b ^. B.name)
replacement in lib/Aftok/Json.hs at line 302

[3.2768]→[3.2768:2874](∅→∅)

, "recurrence" .= recurrenceJSON' (b ^. B.recurrence)
, "amount" .= (b ^. (B.amount . satoshi))

[3.2768]

[3.2874]

, "recurrence" .= recurrenceJSON' (b ^. B.recurrence)
, "amount" .= (b ^. (B.amount . satoshi))
replacement in lib/Aftok/Json.hs at line 312

[3.1886]→[3.1886:2030](∅→∅)

recurrenceJSON' B.Annually = object [ "annually" .= Null ]
recurrenceJSON' (B.Monthly i) = object [ "monthly " .= object [ "months" .= i ] ]

[3.1886]

[3.6375]

recurrenceJSON' B.Annually = object ["annually" .= Null]
recurrenceJSON' (B.Monthly i) = object ["monthly " .= object ["months" .= i]]
replacement in lib/Aftok/Json.hs at line 315

[3.6442]→[3.2095:2236](∅→∅),[3.2095]→[3.2095:2236](∅→∅)

recurrenceJSON' (B.Weekly i) = object [ "weekly " .= object [ "weeks" .= i ] ]
recurrenceJSON' B.OneTime = object [ "onetime" .= Null ]

[3.6442]

[3.5681]

recurrenceJSON' (B.Weekly i) = object ["weekly " .= object ["weeks" .= i]]
recurrenceJSON' B.OneTime = object ["onetime" .= Null]
replacement in lib/Aftok/Json.hs at line 319

[3.2374]→[3.2374:2551](∅→∅),[3.2551]→[3.621:629](∅→∅),[3.3188]→[3.621:629](∅→∅),[3.10521]→[3.621:629](∅→∅),[3.2422]→[3.621:629](∅→∅)

createSubscriptionJSON uid bid d = v1 $
obj [ "user_id" .= idValue _UserId uid
, "billable_id" .= idValue B._BillableId bid
, "start_date" .= showGregorian d
]

[3.2374]

[3.3189]

createSubscriptionJSON uid bid d = v1 $ obj
[ "user_id" .= idValue _UserId uid
, "billable_id" .= idValue B._BillableId bid
, "start_date" .= showGregorian d
]
replacement in lib/Aftok/Json.hs at line 330

[3.3359]→[3.2552:2608](∅→∅)

[ "user_id" .= idValue (B.customer . _UserId) sub

[3.3359]

[3.2608]

[ "user_id" .= idValue (B.customer . _UserId) sub
replacement in lib/Aftok/Json.hs at line 332

[3.2670]→[3.3475:3557](∅→∅),[3.3475]→[3.3475:3557](∅→∅)

, "start_time" .= view B.startTime sub
, "end_time" .= view B.endTime sub

[3.2670]

[3.3557]

, "start_time" .= view B.startTime sub
, "end_time" .= view B.endTime sub
replacement in lib/Aftok/Json.hs at line 350

[3.4011]→[3.25323:25331](∅→∅),[3.25331]→[2.3255:3342](∅→∅)

where
prBytes = paymentRequest . to (T.decodeUtf8 . B64.encode . runPut . encodeMessage)

[3.4011]

[3.4011]

where
prBytes =
paymentRequest . to (T.decodeUtf8 . B64.encode . runPut . encodeMessage)
replacement in lib/Aftok/Json.hs at line 355

[3.4053]→[3.4053:4131](∅→∅)

billDetailsJSON r = v1 $
obj ["payment_requests" .= fmap billDetailJSON r ]

[3.4053]

[3.975]

billDetailsJSON r = v1 $ obj ["payment_requests" .= fmap billDetailJSON r]
replacement in lib/Aftok/Json.hs at line 358

[3.4171]→[3.4171:4205](∅→∅),[3.4205]→[3.1120:1178](∅→∅),[3.1178]→[3.4274:4377](∅→∅),[3.4274]→[3.4274:4377](∅→∅)

billDetailJSON r =
obj $ concat
[ ["payment_request_id" .= view (_1 . _PaymentKey) r]
, paymentRequestKV $ view _2 r
, subscriptionKV $ view _3 r
, billableKV $ view _4 r
]

[3.4171]

[3.26950]

billDetailJSON r = obj $ concat
[ ["payment_request_id" .= view (_1 . _PaymentKey) r]
, paymentRequestKV $ view _2 r
, subscriptionKV $ view _3 r
, billableKV $ view _4 r
]
replacement in lib/Aftok/Json.hs at line 369

[3.1008]→[3.1008:1029](∅→∅),[3.1029]→[3.2891:3017](∅→∅),[3.3017]→[3.1216:1261](∅→∅),[3.1216]→[3.1216:1261](∅→∅),[3.1261]→[3.2422:2430](∅→∅),[3.2422]→[3.2422:2430](∅→∅),[3.2430]→[3.25332:25340](∅→∅),[3.25340]→[2.3343:3428](∅→∅)

paymentJSON r = v1 $
obj [ "payment_request_id" .= idValue (request . _PaymentRequestId) r
, "payment_protobuf_64" .= view paymentBytes r
, "payment_date" .= (r ^. paymentDate)
]
where
paymentBytes = payment . to (T.decodeUtf8 . B64.encode . runPut . encodeMessage)

[3.1008]

[3.2430]

paymentJSON r = v1 $ obj
[ "payment_request_id" .= idValue (request . _PaymentRequestId) r
, "payment_protobuf_64" .= view paymentBytes r
, "payment_date" .= (r ^. paymentDate)
]
where
paymentBytes =
payment . to (T.decodeUtf8 . B64.encode . runPut . encodeMessage)
replacement in lib/Aftok/Json.hs at line 384

[3.25383]→[3.27108:27207](∅→∅),[3.27108]→[3.27108:27207](∅→∅)

maybe (fail $ "Value " <> str <> "Could not be parsed as a valid UUID.") pure $ U.fromString str

[3.25383]

[3.27207]

maybe (fail $ "Value " <> str <> "Could not be parsed as a valid UUID.") pure
$ U.fromString str
replacement in lib/Aftok/Json.hs at line 387

[3.27208]→[3.27208:27264](∅→∅)

parseId :: forall a. Prism' a UUID -> Value -> Parser a

[3.27208]

[3.25384]

parseId :: forall a . Prism' a UUID -> Value -> Parser a
replacement in lib/Aftok/Json.hs at line 406

[3.25852]→[3.25852:25921](∅→∅),[3.25921]→[3.4081:4151](∅→∅),[3.2109]→[3.4081:4151](∅→∅),[3.4151]→[3.25922:25999](∅→∅),[3.25999]→[3.4222:4292](∅→∅),[3.4222]→[3.4222:4292](∅→∅),[3.4292]→[2.3429:3513](∅→∅),[2.3513]→[3.1328:1362](∅→∅),[3.26082]→[3.1328:1362](∅→∅),[3.4481]→[3.1328:1362](∅→∅)

let parseA :: Text -> Parser (EventAmendment (NetworkId, Address))
parseA "timeChange" = TimeChange t <$> o .: "eventTime"
parseA "addrChange" = CreditToChange t <$> parseCreditToV1 nmode o
parseA "metadataChange" = MetadataChange t <$> o .: "eventMeta"
parseA tid = fail . T.unpack $ "Amendment type " <> tid <> " not recognized."
in o .: "amendment" >>= parseA

[3.25852]

[3.2512]

let
parseA :: Text -> Parser (EventAmendment (NetworkId, Address))
parseA "timeChange" = TimeChange t <$> o .: "eventTime"
parseA "addrChange" = CreditToChange t <$> parseCreditToV1 nmode o
parseA "metadataChange" = MetadataChange t <$> o .: "eventMeta"
parseA tid =
fail . T.unpack $ "Amendment type " <> tid <> " not recognized."
in
o .: "amendment" >>= parseA
replacement in lib/Aftok/Json.hs at line 422

[3.26231]→[3.26231:26300](∅→∅),[3.26300]→[3.4426:4496](∅→∅),[3.2665]→[3.4426:4496](∅→∅),[3.4496]→[3.26301:26378](∅→∅),[3.26378]→[3.4567:4637](∅→∅),[3.4567]→[3.4567:4637](∅→∅),[3.4637]→[2.3514:3599](∅→∅),[2.3599]→[3.1363:1397](∅→∅),[3.26462]→[3.1363:1397](∅→∅),[3.4591]→[3.1363:1397](∅→∅)

let parseA :: Text -> Parser (EventAmendment (NetworkId, Address))
parseA "timeChange" = TimeChange t <$> o .: "eventTime"
parseA "creditToChange" = CreditToChange t <$> parseCreditToV2 nmode o
parseA "metadataChange" = MetadataChange t <$> o .: "eventMeta"
parseA tid = fail . T.unpack $ "Amendment type " <> tid <> " not recognized."
in o .: "amendment" >>= parseA

[3.26231]

[3.3862]

let
parseA :: Text -> Parser (EventAmendment (NetworkId, Address))
parseA "timeChange" = TimeChange t <$> o .: "eventTime"
parseA "creditToChange" = CreditToChange t <$> parseCreditToV2 nmode o
parseA "metadataChange" = MetadataChange t <$> o .: "eventMeta"
parseA tid =
fail . T.unpack $ "Amendment type " <> tid <> " not recognized."
in
o .: "amendment" >>= parseA
replacement in lib/Aftok/Json.hs at line 440

[3.4747]→[3.26659:26754](∅→∅)

creditTo' <- o .:? "creditTo" >>= maybe (pure $ CreditToUser uid) (parseCreditToV2 nmode)

[3.4747]

[3.4801]

creditTo' <- o .:? "creditTo" >>= maybe (pure $ CreditToUser uid)
(parseCreditToV2 nmode)
replacement in lib/Aftok/Json.hs at line 449

[3.26816]→[3.27537:27850](∅→∅),[3.27537]→[3.27537:27850](∅→∅)

let parseAnnually o' = const (pure B.Annually) <$> O.lookup "annually" o'
parseMonthly o' = fmap B.Monthly . parseJSON <$> O.lookup "monthly" o'
parseWeekly o' = fmap B.Weekly . parseJSON <$> O.lookup "weekly" o'
parseOneTime o' = const (pure B.OneTime) <$> O.lookup "one-time" o'

[3.26816]

[3.987]

let
parseAnnually o' = const (pure B.Annually) <$> O.lookup "annually" o'
parseMonthly o' = fmap B.Monthly . parseJSON <$> O.lookup "monthly" o'
parseWeekly o' = fmap B.Weekly . parseJSON <$> O.lookup "weekly" o'
parseOneTime o' = const (pure B.OneTime) <$> O.lookup "one-time" o'
replacement in lib/Aftok/Json.hs at line 455

[3.988]→[3.27851:27939](∅→∅),[3.27939]→[3.26817:26961](∅→∅),[3.26961]→[3.28028:28064](∅→∅),[3.28028]→[3.28028:28064](∅→∅)

notFound = fail $ "Value " <> show o <> " does not represent a Recurrence value."
parseV val = parseAnnually val
<|> parseMonthly val
<|> parseWeekly val
<|> parseOneTime val
in fromMaybe notFound $ parseV o

[3.988]

[3.3264]

notFound =
fail $ "Value " <> show o <> " does not represent a Recurrence value."
parseV val =
parseAnnually val
<|> parseMonthly val
<|> parseWeekly val
<|> parseOneTime val
in
fromMaybe notFound $ parseV o
replacement in lib/Aftok/Payments/Types.hs at line 11

[2.3603]→[3.1902:1973](∅→∅),[3.10647]→[3.1902:1973](∅→∅)

import Control.Lens (makeLenses, makePrisms, view)

[2.3603]

[3.10703]

import Control.Lens ( makeLenses
, makePrisms
, view
)
replacement in lib/Aftok/Payments/Types.hs at line 16

[3.10704]→[3.773:821](∅→∅),[3.821]→[3.1974:2019](∅→∅),[3.10704]→[3.1974:2019](∅→∅),[3.2019]→[2.3604:3694](∅→∅)

import Data.Aeson (Value)
import Data.Thyme.Clock as C
import Data.Thyme.Time as C
import qualified Data.Text as T

[3.10704]

[3.10746]

import Data.Aeson ( Value )
import Data.Thyme.Clock as C
import Data.Thyme.Time as C
import qualified Data.Text as T
replacement in lib/Aftok/Payments/Types.hs at line 22

[3.10774]→[3.2065:2175](∅→∅),[3.2175]→[3.28240:28313](∅→∅),[3.28313]→[3.27044:27112](∅→∅)

import qualified Network.Bippy.Proto as P
import Network.Bippy.Types (expiryTime, getExpires,
getPaymentDetails, Satoshi(..))
import Network.Haskoin.Address.Base58 (decodeBase58Check)

[3.10774]

[3.10816]

import qualified Network.Bippy.Proto as P
import Network.Bippy.Types ( expiryTime
, getExpires
, getPaymentDetails
, Satoshi(..)
)
import Network.Haskoin.Address.Base58 ( decodeBase58Check )
replacement in lib/Aftok/Payments/Types.hs at line 30

[3.10817]→[3.2236:2317](∅→∅)

import Aftok.Billables (Billable, Subscription, SubscriptionId)

[3.10817]

[3.10857]

import Aftok.Billables ( Billable
, Subscription
, SubscriptionId
)
replacement in lib/Aftok/Payments/Types.hs at line 72

[3.7098]→[3.4644:4706](∅→∅)

isExpired :: forall s. C.UTCTime -> PaymentRequest' s -> Bool

[3.7098]

[3.2489]

isExpired :: forall s . C.UTCTime -> PaymentRequest' s -> Bool
replacement in lib/Aftok/Payments/Types.hs at line 75

[2.3782]→[3.2510:2570](∅→∅),[3.7223]→[3.2510:2570](∅→∅),[3.2570]→[3.7284:7313](∅→∅),[3.7284]→[3.7284:7313](∅→∅),[3.7313]→[2.3783:3880](∅→∅)

-- using error here is reasonable since it would indicate
-- a serialization problem
in either (error . T.pack) (check . getExpires) $ getPaymentDetails (view paymentRequest req)

[2.3782]

[3.2571]

-- using error here is reasonable since it would indicate
-- a serialization problem
in either (error . T.pack) (check . getExpires)
$ getPaymentDetails (view paymentRequest req)
replacement in lib/Aftok/Payments/Types.hs at line 81

[3.1441]→[3.27113:27198](∅→∅)

parsePaymentKey bs = (PaymentKey . decodeUtf8) <$> decodeBase58Check (decodeUtf8 bs)

[3.1441]

[3.28394]

parsePaymentKey bs =
(PaymentKey . decodeUtf8) <$> decodeBase58Check (decodeUtf8 bs)
replacement in lib/Aftok/Project.hs at line 7

[2.3886]→[3.1129:1198](∅→∅),[3.1129]→[3.1129:1198](∅→∅),[3.1198]→[3.15984:16058](∅→∅)

import Control.Lens (makeLenses, makePrisms)
import Crypto.Random.Types (MonadRandom, getRandomBytes)

[2.3886]

[3.6468]

import Control.Lens ( makeLenses
, makePrisms
)
import Crypto.Random.Types ( MonadRandom
, getRandomBytes
)
replacement in lib/Aftok/Project.hs at line 14

[3.6469]→[2.3887:3937](∅→∅),[2.3937]→[3.1198:1298](∅→∅),[3.6469]→[3.1198:1298](∅→∅),[3.1198]→[3.1198:1298](∅→∅)

import qualified Data.ByteString as BS
import Data.ByteString.Base64.URL as B64
import Data.Thyme.Clock as C

[3.6469]

[3.1381]

import qualified Data.ByteString as BS
import Data.ByteString.Base64.URL as B64
import Data.Thyme.Clock as C
replacement in lib/Aftok/TimeLog/Serialization.hs at line 6

[3.29478]→[3.29478:29488](∅→∅)

) where

[3.29478]

[3.29488]

)
where
replacement in lib/Aftok/TimeLog/Serialization.hs at line 10

[2.3968]→[3.29510:29545](∅→∅),[3.29510]→[3.29510:29545](∅→∅)

import Control.Applicative ((<*>))

[2.3968]

[3.29545]

import Control.Applicative ( (<*>) )
replacement in lib/Aftok/TimeLog/Serialization.hs at line 12

[3.29546]→[3.29546:29676](∅→∅),[3.29676]→[2.3969:4005](∅→∅)

import Data.Aeson (Value(..), (.=), (.:), object)
import Data.Aeson.Types (Parser)
import Data.Functor ((<$>))
import Data.Text (unpack)

[3.29546]

[3.29676]

import Data.Aeson ( Value(..)
, (.=)
, (.:)
, object
)
import Data.Aeson.Types ( Parser )
import Data.Functor ( (<$>) )
import Data.Text ( unpack )
replacement in lib/Aftok/TimeLog/Serialization.hs at line 21

[3.29677]→[3.29677:29696](∅→∅)

import Aftok.Types

[3.29677]

[3.29696]

import Aftok.Types
replacement in lib/Aftok/TimeLog/Serialization.hs at line 25

[3.29760]→[3.29760:30012](∅→∅)

LinearDepreciation (Months up) (Months dp) ->
object [ "type" .= ("LinearDepreciation" :: Text)
, "arguments" .= object [ "undep" .= up
, "dep" .= dp
]
]

[3.29760]

[3.30012]

LinearDepreciation (Months up) (Months dp) -> object
[ "type" .= ("LinearDepreciation" :: Text)
, "arguments" .= object ["undep" .= up, "dep" .= dp]
]
replacement in lib/Aftok/TimeLog/Serialization.hs at line 33

[3.30104]→[3.30104:30140](∅→∅)

t <- v .: "type" :: Parser Text

[3.30104]

[3.30140]

t <- v .: "type" :: Parser Text
replacement in lib/Aftok/TimeLog/Serialization.hs at line 42

[3.30437]→[3.30437:30519](∅→∅)

_ ->
fail $ "Cannot interpret non-object value as a depreciation function."

[3.30437]

[3.30519]

_ -> fail $ "Cannot interpret non-object value as a depreciation function."
replacement in lib/Aftok/Types.hs at line 6

[3.877]→[3.32494:32939](∅→∅)

import Control.Lens (makeLenses, makePrisms)
import Data.Maybe (Maybe)
import Data.Eq (Eq)
import Data.Functor (Functor)
import Data.Ord (Ord)
import Data.Text (Text)
import Data.UUID (UUID)
import Prelude (Integer)
import Text.Show (Show)

[3.877]

[3.32939]

import Control.Lens ( makeLenses
, makePrisms
)
import Data.Maybe ( Maybe )
import Data.Eq ( Eq )
import Data.Functor ( Functor )
import Data.Ord ( Ord )
import Data.Text ( Text )
import Data.UUID ( UUID )
import Prelude ( Integer )
import Text.Show ( Show )
replacement in lib/Aftok/Types.hs at line 50

[3.33807]→[3.33807:33914](∅→∅)

creditToName (CreditToUser _) = "credit_to_user"
creditToName (CreditToProject _) = "credit_to_project"

[3.33807]

[3.33914]

creditToName (CreditToUser _) = "credit_to_user"
creditToName (CreditToProject _) = "credit_to_project"
replacement in lib/Aftok/Util/Http.hs at line 6

[3.5401]→[3.5401:5504](∅→∅)

import Data.ByteString (split)
import qualified Data.ByteString.Base64 as B64

[3.5401]

[3.430]

import Data.ByteString ( split )
import qualified Data.ByteString.Base64 as B64
replacement in lib/Aftok/Util/Http.hs at line 13

[3.529]→[3.529:718](∅→∅)

let isBase64Char w = (w >= 47 && w <= 57 ) ||
(w >= 64 && w <= 90 ) ||
(w >= 97 && w <= 122) ||
(w == 43 || w == 61 )

[3.529]

[3.5505]

let isBase64Char w =
(w >= 47 && w <= 57)
|| (w >= 64 && w <= 90)
|| (w >= 97 && w <= 122)
|| (w == 43 || w == 61)
replacement in lib/Aftok/Util/Http.hs at line 22

[3.1636]→[3.906:989](∅→∅),[3.906]→[3.906:989](∅→∅)

_ -> fail "Could not unpack auth header into username and password components"

[3.1636]

[3.989]

_ ->
fail "Could not unpack auth header into username and password components"
replacement in lib/Aftok/Util.hs at line 8

[2.4014]→[3.30980:31025](∅→∅),[3.30980]→[3.30980:31025](∅→∅)

import Control.Error.Util (maybeT)

[2.4014]

[3.5594]

import Control.Error.Util ( maybeT )
replacement in lib/Aftok/Util.hs at line 10

[3.5637]→[3.31026:31078](∅→∅)

import Control.Monad.Trans.Maybe (MaybeT)

[3.5637]

[3.31078]

import Control.Monad.Trans.Maybe ( MaybeT )
replacement in lib/Aftok/Util.hs at line 13

[3.5676]→[3.2710:2758](∅→∅)

import Data.Map.Strict as M

[3.5676]

[3.10199]

import Data.Map.Strict as M
replacement in lib/Aftok/Util.hs at line 20

[3.10293]→[3.10293:10362](∅→∅)

interpret :: Monad m => (forall x. f x -> m x) -> Program f a -> m a

[3.10293]

[3.5677]

interpret :: Monad m => (forall x . f x -> m x) -> Program f a -> m a
replacement in lib/Aftok/Util.hs at line 22

[3.5694]→[3.10380:10423](∅→∅),[3.10380]→[3.10380:10423](∅→∅),[3.10423]→[3.16488:16520](∅→∅)

let eval (Coyoneda cf cm) = nt cm >>= cf
in iterM eval (runProgram p)

[3.5694]

[3.10442]

let eval (Coyoneda cf cm) = nt cm >>= cf in iterM eval (runProgram p)
replacement in server/Aftok/QConfig.hs at line 7

[3.4552]→[2.4018:4067](∅→∅)

import Control.Lens (makeLenses, (^.))

[3.4552]

[3.32426]

import Control.Lens ( makeLenses
, (^.)
)
replacement in server/Aftok/QConfig.hs at line 14

[2.4120]→[3.32480:32544](∅→∅),[3.25085]→[3.32480:32544](∅→∅),[3.6698]→[3.32480:32544](∅→∅),[3.32544]→[2.4121:4237](∅→∅)

import System.Environment (getEnvironment)
import Filesystem.Path.CurrentOS (fromText, encodeString)
import qualified Filesystem.Path.CurrentOS as P

[2.4120]

[3.4736]

import System.Environment ( getEnvironment )
import Filesystem.Path.CurrentOS ( fromText
, encodeString
)
import qualified Filesystem.Path.CurrentOS as P
replacement in server/Aftok/QConfig.hs at line 48

[3.7411]→[3.5402:5459](∅→∅),[3.5402]→[3.5402:5459](∅→∅),[3.5459]→[3.7412:7458](∅→∅),[3.7458]→[3.32904:32957](∅→∅),[3.32957]→[3.7459:7502](∅→∅),[3.5544]→[3.7459:7502](∅→∅),[3.7502]→[3.5588:5653](∅→∅),[3.5588]→[3.5588:5653](∅→∅),[3.5653]→[3.539:572](∅→∅),[3.572]→[3.204:266](∅→∅),[3.266]→[3.32958:33148](∅→∅)

QConfig <$> C.lookupDefault "localhost" cfg "hostname"
<*> C.lookupDefault 8000 cfg "port"
<*> (fromText <$> C.require cfg "siteKey")
<*> C.lookup cfg "cookieTimeout"
<*> maybe (mkPGSConfig $ C.subconfig "db" cfg) pure pc
<*> readSmtpConfig cfg
<*> (readBillingConfig $ C.subconfig "billing" cfg)
<*> (fromText <$> C.lookupDefault "/opt/aftok/server/templates/" cfg "templatePath")
<*> (fromText <$> C.lookupDefault "/opt/aftok/server/static/" cfg "staticAssetPath")

[3.7411]

[3.7968]

QConfig
<$> C.lookupDefault "localhost" cfg "hostname"
<*> C.lookupDefault 8000 cfg "port"
<*> (fromText <$> C.require cfg "siteKey")
<*> C.lookup cfg "cookieTimeout"
<*> maybe (mkPGSConfig $ C.subconfig "db" cfg) pure pc
<*> readSmtpConfig cfg
<*> (readBillingConfig $ C.subconfig "billing" cfg)
<*> (fromText <$> C.lookupDefault "/opt/aftok/server/templates/"
cfg
"templatePath"
)
<*> (fromText <$> C.lookupDefault "/opt/aftok/server/static/"
cfg
"staticAssetPath"
)
replacement in server/Aftok/QConfig.hs at line 66

[3.17185]→[3.7525:7545](∅→∅),[3.5887]→[3.7525:7545](∅→∅),[3.7545]→[3.26054:26116](∅→∅)

baseSnapConfig qc =
SC.setHostname (qc ^. hostname) .
SC.setPort (qc ^. port)

[3.17185]

[3.6085]

baseSnapConfig qc = SC.setHostname (qc ^. hostname) . SC.setPort (qc ^. port)
replacement in server/Aftok/Snaplet/Auctions.hs at line 7

[3.608]→[3.2531:2541](∅→∅),[3.897]→[3.2531:2541](∅→∅),[3.2531]→[3.2531:2541](∅→∅)

) where

[3.608]

[3.2541]

)
where
replacement in server/Aftok/Snaplet/Auctions.hs at line 12

[3.33152]→[3.33152:33207](∅→∅)

import Control.Monad.Trans.Maybe (mapMaybeT)

[3.33152]

[3.2573]

import Control.Monad.Trans.Maybe ( mapMaybeT )
replacement in server/Aftok/Snaplet/Auctions.hs at line 16

[3.2636]→[3.1747:1843](∅→∅)

import Data.Hourglass.Types (Seconds (..))
import Data.Thyme.Clock as C

[3.2636]

[3.5646]

import Data.Hourglass.Types ( Seconds(..) )
import Data.Thyme.Clock as C
replacement in server/Aftok/Snaplet/Auctions.hs at line 19

[3.5647]→[3.5647:5690](∅→∅)

import Snap.Snaplet as S

[3.5647]

[3.2723]

import Snap.Snaplet as S
replacement in server/Aftok/Snaplet/Auctions.hs at line 21

[3.2724]→[3.34189:34236](∅→∅),[3.34236]→[3.1891:2050](∅→∅),[3.1891]→[3.1891:2050](∅→∅)

import Aftok.Types (UserId)
import Aftok.Auction (Auction (..), AuctionId, Bid (..), BidId)
import Aftok.Database (createAuction, createBid, findAuction)

[3.2724]

[3.2837]

import Aftok.Types ( UserId )
import Aftok.Auction ( Auction(..)
, AuctionId
, Bid(..)
, BidId
)
import Aftok.Database ( createAuction
, createBid
, findAuction
)
replacement in server/Aftok/Snaplet/Auctions.hs at line 32

[3.2894]→[3.33208:33249](∅→∅)

import Aftok.Util (fromMaybeT)

[3.2865]

[3.2894]

import Aftok.Util ( fromMaybeT )
replacement in server/Aftok/Snaplet/Auctions.hs at line 36

[3.2962]→[3.34237:34288](∅→∅)

import Network.Bippy.Types (Satoshi(..))

[3.2962]

[3.2962]

import Network.Bippy.Types ( Satoshi(..) )
replacement in server/Aftok/Snaplet/Auctions.hs at line 42

[3.5226]→[3.488:590](∅→∅)

p o = CA <$> o .: "raiseAmount"
<*> o .: "auctionStart"
<*> o .: "auctionEnd"

[3.5226]

[3.885]

p o = CA <$> o .: "raiseAmount" <*> o .: "auctionStart" <*> o .: "auctionEnd"
replacement in server/Aftok/Snaplet/Auctions.hs at line 44

[3.886]→[3.886:947](∅→∅)

bidCreateParser :: UserId -> C.UTCTime-> Value -> Parser Bid

[3.886]

[3.5283]

bidCreateParser :: UserId -> C.UTCTime -> Value -> Parser Bid
replacement in server/Aftok/Snaplet/Auctions.hs at line 46

[3.5327]→[3.5327:5457](∅→∅)

p o = Bid uid <$> (Seconds <$> o .: "bidSeconds")
<*> (Satoshi <$> o .: "bidAmount")
<*> pure t

[3.5327]

[3.3306]

p o =
Bid uid
<$> (Seconds <$> o .: "bidSeconds")
<*> (Satoshi <$> o .: "bidAmount")
<*> pure t
replacement in server/Aftok/Snaplet/Auctions.hs at line 54

[3.3383]→[3.3383:3432](∅→∅)

uid <- requireUserId
pid <- requireProjectId

[3.3383]

[3.3432]

uid <- requireUserId
pid <- requireProjectId
replacement in server/Aftok/Snaplet/Auctions.hs at line 57

[3.3470]→[2.4527:4617](∅→∅)

req <- either (snapError 400 . show) pure $ parseEither auctionCreateParser requestBody

[3.3470]

[3.591]

req <- either (snapError 400 . show) pure
$ parseEither auctionCreateParser requestBody
replacement in server/Aftok/Snaplet/Auctions.hs at line 60

[3.622]→[3.2920:2949](∅→∅),[3.2949]→[3.652:740](∅→∅),[3.652]→[3.652:740](∅→∅)

snapEval . createAuction $
Auction pid uid t (Satoshi . raiseAmount $ req) (auctionStart req) (auctionEnd req)

[3.622]

[3.987]

snapEval . createAuction $ Auction pid
uid
t
(Satoshi . raiseAmount $ req)
(auctionStart req)
(auctionEnd req)
replacement in server/Aftok/Snaplet/Auctions.hs at line 71

[3.1105]→[3.33250:33263](∅→∅),[3.33263]→[2.4618:4680](∅→∅),[2.4680]→[3.33326:33408](∅→∅),[3.33326]→[3.33326:33408](∅→∅)

fromMaybeT
(snapError 404 $ "Auction not found for id " <> show aid)
(mapMaybeT snapEval $ findAuction aid uid) -- this will verify auction access

[3.1105]

[3.1245]

fromMaybeT (snapError 404 $ "Auction not found for id " <> show aid)
(mapMaybeT snapEval $ findAuction aid uid) -- this will verify auction access
replacement in server/Aftok/Snaplet/Auctions.hs at line 76

[3.1312]→[3.1312:1400](∅→∅)

uid <- requireUserId
aid <- requireAuctionId
timestamp <- liftIO C.getCurrentTime

[3.1312]

[3.1400]

uid <- requireUserId
aid <- requireAuctionId
timestamp <- liftIO C.getCurrentTime
replacement in server/Aftok/Snaplet/Auctions.hs at line 80

[3.1438]→[2.4681:4783](∅→∅)

bid <- either (snapError 400 . show) pure $ parseEither (bidCreateParser uid timestamp) requestBody

[3.1438]

[3.1541]

bid <- either (snapError 400 . show) pure
$ parseEither (bidCreateParser uid timestamp) requestBody
replacement in server/Aftok/Snaplet/Auth.hs at line 6

[3.7666]→[3.33410:33510](∅→∅),[3.33510]→[3.5724:5780](∅→∅),[3.7666]→[3.5724:5780](∅→∅)

import Control.Error.Util (maybeT)
import Control.Monad.Trans.Maybe (mapMaybeT)
import Data.Attoparsec.ByteString (parseOnly)

[3.7666]

[3.423]

import Control.Error.Util ( maybeT )
import Control.Monad.Trans.Maybe ( mapMaybeT )
import Data.Attoparsec.ByteString ( parseOnly )
replacement in server/Aftok/Snaplet/Auth.hs at line 13

[3.2145]→[3.7887:7950](∅→∅),[3.3758]→[3.7887:7950](∅→∅),[3.7887]→[3.7887:7950](∅→∅)

import Aftok.Util.Http (authHeaderParser)

[3.2145]

[3.489]

import Aftok.Util.Http ( authHeaderParser )
replacement in server/Aftok/Snaplet/Auth.hs at line 16

[3.7978]→[3.17432:17481](∅→∅),[3.17481]→[3.8009:8059](∅→∅),[3.11751]→[3.8009:8059](∅→∅)

import Snap.Snaplet as S
import qualified Snap.Snaplet.Auth as AU

[3.7978]

[3.643]

import Snap.Snaplet as S
import qualified Snap.Snaplet.Auth as AU
replacement in server/Aftok/Snaplet/Auth.hs at line 21

[3.1227]→[3.1227:1247](∅→∅)

req <- getRequest

[3.1227]

[3.1247]

req <- getRequest
replacement in server/Aftok/Snaplet/Auth.hs at line 23

[3.1323]→[3.8105:8203](∅→∅),[3.8203]→[3.1422:1502](∅→∅),[3.1422]→[3.1422:1502](∅→∅)

(uname, pwd) <- either (throwDenied . AU.AuthError) pure $ parseOnly authHeaderParser rawHeader
authResult <- with auth $ AU.loginByUsername uname (AU.ClearText pwd) False

[3.1323]

[3.1502]

(uname, pwd) <- either (throwDenied . AU.AuthError) pure
$ parseOnly authHeaderParser rawHeader
authResult <- with auth $ AU.loginByUsername uname (AU.ClearText pwd) False
replacement in server/Aftok/Snaplet/Auth.hs at line 43

[3.2616]→[3.8513:8575](∅→∅),[3.8575]→[3.2268:2340](∅→∅),[3.2679]→[3.2268:2340](∅→∅),[3.2340]→[3.2754:2785](∅→∅),[3.2754]→[3.2754:2785](∅→∅)

modifyResponse $ (setResponseStatus 401 "Unauthorized") .
(setHeader "WWW-Authenticate" "Basic realm=aftok")
getResponse >>= finishWith

[3.2616]

[3.2785]

modifyResponse
$ (setResponseStatus 401 "Unauthorized")
. (setHeader "WWW-Authenticate" "Basic realm=aftok")
getResponse >>= finishWith
replacement in server/Aftok/Snaplet/Auth.hs at line 50

[3.2863]→[3.2863:2922](∅→∅),[3.2922]→[2.4787:4837](∅→∅),[2.4837]→[3.2973:3004](∅→∅),[3.2973]→[3.2973:3004](∅→∅)

modifyResponse $ setResponseStatus 403 "Access Denied"
writeText $ "Access Denied: " <> show failure
getResponse >>= finishWith

[3.2863]

[3.3004]

modifyResponse $ setResponseStatus 403 "Access Denied"
writeText $ "Access Denied: " <> show failure
getResponse >>= finishWith
replacement in server/Aftok/Snaplet/Billing.hs at line 7

[3.33865]→[3.33865:33875](∅→∅)

) where

[3.33865]

[3.33875]

)
where
replacement in server/Aftok/Snaplet/Billing.hs at line 12

[3.33908]→[3.33908:33945](∅→∅)

import Control.Lens ((^.))

[3.33908]

[3.33945]

import Control.Lens ( (^.) )
replacement in server/Aftok/Snaplet/Billing.hs at line 15

[3.34007]→[3.34007:34098](∅→∅)

import Data.Thyme.Clock as C
import Data.Thyme.Time.Core (toThyme)

[3.34007]

[3.34098]

import Data.Thyme.Clock as C
import Data.Thyme.Time.Core ( toThyme )
replacement in server/Aftok/Snaplet/Billing.hs at line 18

[3.34099]→[3.34099:34142](∅→∅)

import Snap.Snaplet as S

[3.34099]

[3.34142]

import Snap.Snaplet as S
replacement in server/Aftok/Snaplet/Billing.hs at line 20

[3.34143]→[3.34321:34368](∅→∅)

import Aftok.Types (UserId)

[3.34143]

[3.34368]

import Aftok.Types ( UserId )
replacement in server/Aftok/Snaplet/Billing.hs at line 22

[3.34401]→[3.34401:34452](∅→∅)

import Network.Bippy.Types (Satoshi(..))

[3.34401]

[3.34229]

import Network.Bippy.Types ( Satoshi(..) )
replacement in server/Aftok/Snaplet/Billing.hs at line 25

[3.34317]→[3.34317:34407](∅→∅)

import Aftok.Database (createBillable, withProjectAuth, liftdb, DBOp(..))

[3.34286]

[3.34407]

import Aftok.Database ( createBillable
, withProjectAuth
, liftdb
, DBOp(..)
)
replacement in server/Aftok/Snaplet/Billing.hs at line 37

[3.34475]→[3.34629:35053](∅→∅),[3.34629]→[3.34629:35053](∅→∅)

Billable <$> pure pid
<*> pure uid
<*> o .: "name"
<*> o .: "description"
<*> (parseRecurrence' =<< o .: "recurrence")
<*> (Satoshi <$> o .: "amount")
<*> o .: "gracePeriod"
<*> (fmap toThyme <$> o .: "requestExpiryPeriod")
<*> o .:? "paymentRequestEmailTemplate"
<*> o .:? "paymentRequestMemoTemplate"

[3.34475]

[3.35053]

Billable
<$> pure pid
<*> pure uid
<*> o
.: "name"
<*> o
.: "description"
<*> (parseRecurrence' =<< o .: "recurrence")
<*> (Satoshi <$> o .: "amount")
<*> o
.: "gracePeriod"
<*> (fmap toThyme <$> o .: "requestExpiryPeriod")
<*> o
.:? "paymentRequestEmailTemplate"
<*> o
.:? "paymentRequestMemoTemplate"
replacement in server/Aftok/Snaplet/Billing.hs at line 58

[3.35172]→[3.35172:35221](∅→∅)

uid <- requireUserId
pid <- requireProjectId

[3.35172]

[3.35221]

uid <- requireUserId
pid <- requireProjectId
replacement in server/Aftok/Snaplet/Billing.hs at line 61

[3.35259]→[2.4841:4939](∅→∅)

b <- either (snapError 400 . show) pure $ parseEither (parseCreateBillable uid pid) requestBody

[3.35259]

[3.35358]

b <- either (snapError 400 . show) pure
$ parseEither (parseCreateBillable uid pid) requestBody
replacement in server/Aftok/Snaplet/Billing.hs at line 75

[3.35732]→[3.35732:35763](∅→∅)

t <- liftIO C.getCurrentTime

[3.35732]

[3.35763]

t <- liftIO C.getCurrentTime
replacement in server/Aftok/Snaplet/Payments.hs at line 7

[3.3495]→[3.3495:3505](∅→∅)

) where

[3.3495]

[3.9799]

)
where
replacement in server/Aftok/Snaplet/Payments.hs at line 12

[2.4942]→[3.35903:36052](∅→∅),[3.5783]→[3.35903:36052](∅→∅),[3.36052]→[2.4943:4987](∅→∅)

import Control.Lens (view, _1, _2, _Right, _Left, preview, (&), (.~), (^.))
import Control.Monad.Trans.Maybe (mapMaybeT)
import Control.Exception (try)

[2.4942]

[3.36052]

import Control.Lens ( view
, _1
, _2
, _Right
, _Left
, preview
, (&)
, (.~)
, (^.)
)
import Control.Monad.Trans.Maybe ( mapMaybeT )
import Control.Exception ( try )
replacement in server/Aftok/Snaplet/Payments.hs at line 25

[3.1383]→[3.3559:3707](∅→∅),[3.36053]→[3.3559:3707](∅→∅),[3.3559]→[3.3559:3707](∅→∅),[3.3707]→[2.4988:5031](∅→∅),[2.5031]→[3.3707:3750](∅→∅),[3.3707]→[3.3707:3750](∅→∅)

import Data.ProtocolBuffers (decodeMessage)
import Data.Serialize.Get (runGetLazy)
import Data.Thyme.Clock as C
import qualified Data.Text.Encoding as T
import qualified Network.Bippy.Proto as P

[3.36053]

[3.1384]

import Data.ProtocolBuffers ( decodeMessage )
import Data.Serialize.Get ( runGetLazy )
import Data.Thyme.Clock as C
import qualified Data.Text.Encoding as T
import qualified Network.Bippy.Proto as P
replacement in server/Aftok/Snaplet/Payments.hs at line 31

[3.1429]→[3.4:127](∅→∅),[3.127]→[3.1530:1663](∅→∅),[3.1530]→[3.1530:1663](∅→∅)

import Network.HTTP.Client (defaultManagerSettings, managerResponseTimeout, responseTimeoutMicro, HttpException)
import Network.Wreq (asValue, responseBody, defaults, manager, getWith)
import OpenSSL.Session (context)

[3.1429]

[3.9831]

import Network.HTTP.Client ( defaultManagerSettings
, managerResponseTimeout
, responseTimeoutMicro
, HttpException
)
import Network.Wreq ( asValue
, responseBody
, defaults
, manager
, getWith
)
import OpenSSL.Session ( context )
replacement in server/Aftok/Snaplet/Payments.hs at line 44

[3.9832]→[3.1664:1730](∅→∅),[3.1730]→[3.3807:3850](∅→∅),[3.3807]→[3.3807:3850](∅→∅)

import Snap.Core (readRequestBody, logError)
import Snap.Snaplet as S

[3.9832]

[3.5962]

import Snap.Core ( readRequestBody
, logError
)
import Snap.Snaplet as S
replacement in server/Aftok/Snaplet/Payments.hs at line 49

[3.5963]→[3.36054:36098](∅→∅)

import Aftok.Config as AC

[3.5963]

[3.5963]

import Aftok.Config as AC
replacement in server/Aftok/Snaplet/Payments.hs at line 53

[2.5064]→[3.36138:36179](∅→∅),[3.36138]→[3.36138:36179](∅→∅)

import Aftok.Util (fromMaybeT)

[2.5064]

[3.9900]

import Aftok.Util ( fromMaybeT )
replacement in server/Aftok/Snaplet/Payments.hs at line 72

[3.4091]→[3.4091:4144](∅→∅),[3.4144]→[2.5065:5151](∅→∅),[2.5151]→[3.4231:4331](∅→∅),[3.4231]→[3.4231:4331](∅→∅)

preq <- getPaymentRequestHandler'
pmnt <- either
(\msg -> snapError 400 $ "Could not decode payment response: " <> show msg)
pure
(runGetLazy decodeMessage requestBody)
now <- liftIO $ C.getCurrentTime

[3.4091]

[3.1883]

preq <- getPaymentRequestHandler'
pmnt <- either
(\msg -> snapError 400 $ "Could not decode payment response: " <> show msg)
pure
(runGetLazy decodeMessage requestBody)
now <- liftIO $ C.getCurrentTime
replacement in server/Aftok/Snaplet/Payments.hs at line 79

[3.1884]→[3.1884:1957](∅→∅),[3.1957]→[3.128:250](∅→∅)

let opts = defaults & manager .~ Left (opensslManagerSettings context)
& manager .~ Left (defaultManagerSettings { managerResponseTimeout = responseTimeoutMicro 10000 } )

[3.1884]

[3.2063]

let
opts =
defaults
& manager
.~ Left (opensslManagerSettings context)
& manager
.~ Left
(defaultManagerSettings
{ managerResponseTimeout = responseTimeoutMicro 10000
}
)
replacement in server/Aftok/Snaplet/Payments.hs at line 91

[3.2064]→[2.5152:5270](∅→∅)

exchResp <- liftIO . try @HttpException $ asValue =<< (withOpenSSL $ getWith opts (cfg ^. exchangeRateServiceURI))

[3.2064]

[2.5270]

exchResp <-
liftIO
. try @HttpException
$ asValue
=<< (withOpenSSL $ getWith opts (cfg ^. exchangeRateServiceURI))
replacement in server/Aftok/Snaplet/Payments.hs at line 97

[2.5344]→[3.2253:2347](∅→∅),[3.2253]→[3.2253:2347](∅→∅)

let newPayment = Payment (view _1 preq) pmnt now (preview (_Right . responseBody) exchResp)

[2.5344]

[3.2347]

let newPayment = Payment (view _1 preq)
pmnt
now
(preview (_Right . responseBody) exchResp)
replacement in server/Aftok/Snaplet/Payments.hs at line 103

[3.4402]→[3.4402:4484](∅→∅)

getPaymentRequestHandler' :: S.Handler App App (PaymentRequestId, PaymentRequest)

[3.4402]

[3.4484]

getPaymentRequestHandler'
:: S.Handler App App (PaymentRequestId, PaymentRequest)
replacement in server/Aftok/Snaplet/Payments.hs at line 107

[3.4561]→[3.4561:4666](∅→∅),[3.4666]→[3.1750:1786](∅→∅),[3.1750]→[3.1750:1786](∅→∅)

pkey <- maybe
(snapError 400 $ "parameter paymentRequestKey is formatted incorrectly.") pure
(parsePaymentKey pkBytes)

[3.4561]

[3.36359]

pkey <- maybe
(snapError 400 $ "parameter paymentRequestKey is formatted incorrectly.")
pure
(parsePaymentKey pkBytes)
replacement in server/Aftok/Snaplet/Payments.hs at line 112

[3.36372]→[3.36372:36470](∅→∅)

(snapError 404 $ "Outstanding payment request not found for key " <> (view _PaymentKey pkey))

[3.36372]

[3.36470]

( snapError 404
$ "Outstanding payment request not found for key "
<> (view _PaymentKey pkey)
)
replacement in server/Aftok/Snaplet/Projects.hs at line 9

[3.3886]→[3.3886:3896](∅→∅)

) where

[3.3886]

[3.2462]

)
where
replacement in server/Aftok/Snaplet/Projects.hs at line 14

[3.2104]→[3.36573:36639](∅→∅),[3.36639]→[3.2104:2263](∅→∅),[3.2104]→[3.2104:2263](∅→∅),[3.2263]→[2.5346:5454](∅→∅)

import Control.Monad.Trans.Maybe (mapMaybeT, runMaybeT)
import Data.Aeson as A
import Data.Attoparsec.ByteString (takeByteString)
import Data.Thyme.Clock as C
import Filesystem.Path.CurrentOS (encodeString)
import qualified Filesystem.Path.CurrentOS as F

[3.2104]

[3.2263]

import Control.Monad.Trans.Maybe ( mapMaybeT
, runMaybeT
)
import Data.Aeson as A
import Data.Attoparsec.ByteString ( takeByteString )
import Data.Thyme.Clock as C
import Filesystem.Path.CurrentOS ( encodeString )
import qualified Filesystem.Path.CurrentOS as F
replacement in server/Aftok/Snaplet/Projects.hs at line 23

[3.2298]→[3.2298:2350](∅→∅)

import Network.Mail.SMTP as SMTP

[3.2298]

[3.2405]

import Network.Mail.SMTP as SMTP
replacement in server/Aftok/Snaplet/Projects.hs at line 30

[3.3928]→[3.36740:36777](∅→∅)

import Aftok.QConfig as QC

[3.3928]

[3.2529]

import Aftok.QConfig as QC
replacement in server/Aftok/Snaplet/Projects.hs at line 33

[3.2596]→[3.34550:34610](∅→∅),[3.34610]→[3.36778:36819](∅→∅),[3.2596]→[3.36778:36819](∅→∅)

import Aftok.TimeLog.Serialization (depfFromJSON)
import Aftok.Util (fromMaybeT)

[3.2596]

[3.2650]

import Aftok.TimeLog.Serialization ( depfFromJSON )
import Aftok.Util ( fromMaybeT )
replacement in server/Aftok/Snaplet/Projects.hs at line 37

[3.2624]→[3.17960:18009](∅→∅)

import Snap.Snaplet as S

[3.2624]

[3.2725]

import Snap.Snaplet as S
replacement in server/Aftok/Snaplet/Projects.hs at line 43

[3.34636]→[3.34636:34708](∅→∅)

CP <$> v .: "projectName"
<*> (depfFromJSON =<< v .: "depf")

[3.34636]

[3.34708]

CP <$> v .: "projectName" <*> (depfFromJSON =<< v .: "depf")
replacement in server/Aftok/Snaplet/Projects.hs at line 48

[3.3170]→[3.3170:3193](∅→∅)

uid <- requireUserId

[3.3132]

[3.3193]

uid <- requireUserId
replacement in server/Aftok/Snaplet/Projects.hs at line 50

[3.3231]→[2.5455:5527](∅→∅),[3.446]→[3.8840:8871](∅→∅),[2.5527]→[3.8840:8871](∅→∅),[3.3320]→[3.8840:8871](∅→∅)

cp <- either (snapError 400 . show) pure $ A.eitherDecode requestBody
t <- liftIO C.getCurrentTime

[3.3231]

[3.8871]

cp <- either (snapError 400 . show) pure $ A.eitherDecode requestBody
t <- liftIO C.getCurrentTime
replacement in server/Aftok/Snaplet/Projects.hs at line 63

[3.12379]→[3.36820:36833](∅→∅),[3.36833]→[2.5528:5590](∅→∅),[2.5590]→[3.36896:36947](∅→∅),[3.36896]→[3.36896:36947](∅→∅)

fromMaybeT
(snapError 404 $ "Project not found for id " <> show pid)
(mapMaybeT snapEval $ findUserProject uid pid)

[3.12379]

[3.8936]

fromMaybeT (snapError 404 $ "Project not found for id " <> show pid)
(mapMaybeT snapEval $ findUserProject uid pid)
replacement in server/Aftok/Snaplet/Projects.hs at line 68

[3.9021]→[3.9021:9070](∅→∅)

uid <- requireUserId
pid <- requireProjectId

[3.9021]

[3.9070]

uid <- requireUserId
pid <- requireProjectId
replacement in server/Aftok/Snaplet/Projects.hs at line 71

[3.9145]→[3.9145:9176](∅→∅),[3.9176]→[3.2655:2697](∅→∅),[3.2697]→[3.36948:37039](∅→∅),[3.37039]→[3.9278:9326](∅→∅),[3.9278]→[3.9278:9326](∅→∅),[3.9326]→[3.898:988](∅→∅)

t <- liftIO C.getCurrentTime
(Just u, Just p, invCode) <- snapEval $
(,,) <$> (runMaybeT $ findUser uid)
<*> (runMaybeT $ findUserProject uid pid)
<*> createInvitation pid uid toEmail t
liftIO $ sendProjectInviteEmail cfg (p ^. projectName) (u ^. userEmail) toEmail invCode

[3.9145]

[3.988]

t <- liftIO C.getCurrentTime
(Just u, Just p, invCode) <-
snapEval
$ (,,)
<$> (runMaybeT $ findUser uid)
<*> (runMaybeT $ findUserProject uid pid)
<*> createInvitation pid uid toEmail t
liftIO $ sendProjectInviteEmail cfg
(p ^. projectName)
(u ^. userEmail)
toEmail
invCode
replacement in server/Aftok/Snaplet/Projects.hs at line 85

[3.990]→[3.990:1024](∅→∅),[3.1024]→[3.2698:2736](∅→∅),[3.2736]→[3.1063:1199](∅→∅),[3.1063]→[3.1063:1199](∅→∅),[3.1199]→[3.2737:2778](∅→∅),[3.2778]→[3.1241:1273](∅→∅),[3.1241]→[3.1241:1273](∅→∅)

sendProjectInviteEmail :: QConfig
-> ProjectName
-> Email -- Inviting user's email address
-> Email -- Invitee's email address
-> InvitationCode
-> IO ()

[3.990]

[3.2779]

sendProjectInviteEmail
:: QConfig
-> ProjectName
-> Email -- Inviting user's email address
-> Email -- Invitee's email address
-> InvitationCode
-> IO ()
replacement in server/Aftok/Snaplet/Projects.hs at line 93

[3.2837]→[3.26119:26163](∅→∅),[3.26163]→[3.37081:37173](∅→∅),[3.37081]→[3.37081:37173](∅→∅),[3.37173]→[3.26164:26249](∅→∅),[3.26249]→[3.37174:37209](∅→∅),[3.2920]→[3.37174:37209](∅→∅)

let SmtpConfig{..} = cfg ^. QC.smtpConfig
mailer = maybe (sendMailWithLogin _smtpHost) (sendMailWithLogin' _smtpHost) _smtpPort
in buildProjectInviteEmail (cfg ^. templatePath) pn fromEmail toEmail invCode >>=
(mailer _smtpUser _smtpPass)

[3.2837]

[3.2921]

let SmtpConfig {..} = cfg ^. QC.smtpConfig
mailer = maybe (sendMailWithLogin _smtpHost)
(sendMailWithLogin' _smtpHost)
_smtpPort
in buildProjectInviteEmail (cfg ^. templatePath) pn fromEmail toEmail invCode
>>= (mailer _smtpUser _smtpPass)
replacement in server/Aftok/Snaplet/Projects.hs at line 101

[3.9688]→[2.5591:5629](∅→∅),[2.5629]→[3.2969:3008](∅→∅),[3.37246]→[3.2969:3008](∅→∅),[3.2969]→[3.2969:3008](∅→∅),[3.3008]→[3.1666:1804](∅→∅),[3.1666]→[3.1666:1804](∅→∅),[3.1804]→[3.3009:3051](∅→∅),[3.3051]→[3.1847:1882](∅→∅),[3.1847]→[3.1847:1882](∅→∅)

buildProjectInviteEmail :: F.FilePath
-> ProjectName
-> Email -- Inviting user's email address
-> Email -- Invitee's email address
-> InvitationCode
-> IO Mail

[3.9688]

[3.26250]

buildProjectInviteEmail
:: F.FilePath
-> ProjectName
-> Email -- Inviting user's email address
-> Email -- Invitee's email address
-> InvitationCode
-> IO Mail
replacement in server/Aftok/Snaplet/Projects.hs at line 113

[3.2099]→[3.2099:2291](∅→∅),[3.2291]→[3.3096:3165](∅→∅)

let setAttrs = setAttribute "from_email" (fromEmail ^. _Email) .
setAttribute "project_name" pn .
setAttribute "to_email" (toEmail ^. _Email) .
setAttribute "inv_code" (renderInvCode invCode)

[3.2099]

[3.2361]

let setAttrs =
setAttribute "from_email" (fromEmail ^. _Email)
. setAttribute "project_name" pn
. setAttribute "to_email" (toEmail ^. _Email)
. setAttribute "inv_code" (renderInvCode invCode)
replacement in server/Aftok/Snaplet/Projects.hs at line 120

[3.2481]→[3.4:58](∅→∅)

subject = "Welcome to the "<>pn<>" Aftok!"

[3.2481]

[3.2540]

subject = "Welcome to the " <> pn <> " Aftok!"
replacement in server/Aftok/Snaplet/Users.hs at line 7

[3.477]→[3.3476:3486](∅→∅),[3.3157]→[3.3476:3486](∅→∅),[3.3476]→[3.3476:3486](∅→∅)

) where

[3.477]

[3.3486]

)
where
replacement in server/Aftok/Snaplet/Users.hs at line 13

[3.8667]→[3.8667:8708](∅→∅),[3.8708]→[2.5633:5674](∅→∅),[2.5674]→[3.8708:8790](∅→∅),[3.8708]→[3.8708:8790](∅→∅)

import Data.Aeson as A
import qualified Data.Map.Strict as M
import Data.Text as T
import Data.Thyme.Clock as C

[3.8667]

[3.34766]

import Data.Aeson as A
import qualified Data.Map.Strict as M
import Data.Text as T
import Data.Thyme.Clock as C
replacement in server/Aftok/Snaplet/Users.hs at line 18

[3.34767]→[3.34767:34823](∅→∅)

import Network.Haskoin.Address (stringToAddr)

[3.34767]

[3.10431]

import Network.Haskoin.Address ( stringToAddr )
replacement in server/Aftok/Snaplet/Users.hs at line 21

[3.34853]→[3.34853:34920](∅→∅)

import Aftok.Currency.Bitcoin (NetworkId(..), toNetwork)

[3.34853]

[3.8814]

import Aftok.Currency.Bitcoin ( NetworkId(..)
, toNetwork
)
replacement in server/Aftok/Snaplet/Users.hs at line 30

[3.8941]→[3.18225:18266](∅→∅),[3.18266]→[3.8971:9013](∅→∅),[3.8971]→[3.8971:9013](∅→∅)

import Snap.Snaplet as S
import qualified Snap.Snaplet.Auth as AU

[3.8941]

[3.268]

import Snap.Snaplet as S
import qualified Snap.Snaplet.Auth as AU
replacement in server/Aftok/Snaplet/Users.hs at line 42

[3.9104]→[3.10349:10414](∅→∅),[3.10414]→[3.34956:35002](∅→∅),[3.35002]→[3.10478:10540](∅→∅),[3.10478]→[3.10478:10540](∅→∅)

let parseUser = User <$> (UserName <$> v .: "username")
<*> (v .: "btcAddr")
<*> (Email <$> v .: "email")

[3.9104]

[3.10651]

let parseUser =
User
<$> (UserName <$> v .: "username")
<*> (v .: "btcAddr")
<*> (Email <$> v .: "email")
edit in server/Aftok/Snaplet/Users.hs at line 52

[3.10820]

[3.10820]

in CU
<$> parseUser
<*> (fromString <$> v .: "password")
<*> (parseInvitationCodes =<< v .: "invitation_codes")
edit in server/Aftok/Snaplet/Users.hs at line 57

[3.10821]→[3.10821:10961](∅→∅)

in CU <$> parseUser
<*> (fromString <$> v .: "password")
<*> (parseInvitationCodes =<< v .: "invitation_codes")
replacement in server/Aftok/Snaplet/Users.hs at line 63

[3.3592]→[3.751:843](∅→∅),[3.11064]→[3.751:843](∅→∅),[3.751]→[3.751:843](∅→∅),[3.843]→[3.11065:11096](∅→∅)

userData <- maybe (snapError 400 "Could not parse user data") pure $ A.decode requestBody
t <- liftIO C.getCurrentTime

[3.11064]

[3.35003]

userData <- maybe (snapError 400 "Could not parse user data") pure
$ A.decode requestBody
t <- liftIO C.getCurrentTime
replacement in server/Aftok/Snaplet/Users.hs at line 67

[3.35029]→[3.35029:35115](∅→∅),[3.11096]→[3.3593:3691](∅→∅),[3.35115]→[3.3593:3691](∅→∅),[3.843]→[3.3593:3691](∅→∅),[3.3691]→[3.11097:11131](∅→∅),[3.11131]→[3.35116:35202](∅→∅),[3.35202]→[3.501:583](∅→∅),[3.11180]→[3.501:583](∅→∅),[3.583]→[3.11270:11292](∅→∅),[3.11270]→[3.11270:11292](∅→∅)

let addr = stringToAddr (toNetwork nmode BTC) =<< (userData ^. cuser . userAddress)
let createSUser = AU.createUser (userData ^. (cuser.username._UserName)) (userData ^. password)
createQUser = snapEval $ do
userId <- createUser ((userData ^. cuser) & userAddress .~ ((BTC,) <$> addr))
void $ traverse (acceptInvitation userId t) (userData ^. invitationCodes)
return userId

[3.35029]

[3.3764]

let addr =
stringToAddr (toNetwork nmode BTC) =<< (userData ^. cuser . userAddress)
let
createSUser = AU.createUser (userData ^. (cuser . username . _UserName))
(userData ^. password)
createQUser = snapEval $ do
userId <- createUser
((userData ^. cuser) & userAddress .~ ((BTC, ) <$> addr))
void $ traverse (acceptInvitation userId t) (userData ^. invitationCodes)
return userId
replacement in server/Aftok/Snaplet/Users.hs at line 82

[3.660]→[3.660:714](∅→∅),[3.714]→[3.9286:9308](∅→∅),[3.9308]→[3.737:859](∅→∅),[3.737]→[3.737:859](∅→∅),[3.859]→[2.5675:5707](∅→∅)

uid <- requireUserId
t <- liftIO C.getCurrentTime
params <- getParams
invCodes <- maybe
(snapError 400 "invCode parameter is required")
(pure . traverse (parseInvCode . decodeUtf8))
(M.lookup "invCode" params)

[3.660]

[3.9309]

uid <- requireUserId
t <- liftIO C.getCurrentTime
params <- getParams
invCodes <- maybe (snapError 400 "invCode parameter is required")
(pure . traverse (parseInvCode . decodeUtf8))
(M.lookup "invCode" params)
replacement in server/Aftok/Snaplet/Users.hs at line 89

[3.9318]→[3.899:983](∅→∅),[3.899]→[3.899:983](∅→∅)

(\e -> snapError 400 $ "Invitation code was rejected as invalid: " <> T.pack e)

[3.9318]

[3.983]

(\e ->
snapError 400 $ "Invitation code was rejected as invalid: " <> T.pack e
)
replacement in server/Aftok/Snaplet/Util.hs at line 5

[2.5710]→[3.9399:9495](∅→∅),[3.9399]→[3.9399:9495](∅→∅)

import Data.ByteString.Char8 as B
import Data.Thyme.Clock as C

[2.5710]

[3.9495]

import Data.ByteString.Char8 as B
import Data.Thyme.Clock as C
replacement in server/Aftok/Snaplet/Util.hs at line 15

[3.4549]→[3.4549:4599](∅→∅)

t <- MaybeT . pure . parseISO8601 $ B.unpack bs

[3.4549]

[3.4599]

t <- MaybeT . pure . parseISO8601 $ B.unpack bs
replacement in server/Aftok/Snaplet/WorkLog.hs at line 6

[3.9655]→[3.37307:37362](∅→∅)

import Control.Monad.Trans.Maybe (mapMaybeT)

[3.9655]

[3.37362]

import Control.Monad.Trans.Maybe ( mapMaybeT )
replacement in server/Aftok/Snaplet/WorkLog.hs at line 8

[3.37363]→[3.9655:9696](∅→∅),[3.9655]→[3.9655:9696](∅→∅)

import qualified Data.Aeson as A

[3.37363]

[3.9696]

import qualified Data.Aeson as A
replacement in server/Aftok/Snaplet/WorkLog.hs at line 10

[3.9730]→[2.5714:5755](∅→∅),[2.5755]→[3.9730:9812](∅→∅),[3.9730]→[3.9730:9812](∅→∅),[3.9812]→[3.35204:35269](∅→∅)

import qualified Data.Text as T
import Data.Thyme.Clock as C
import Data.UUID as U
import Network.Haskoin.Address (Address, stringToAddr)

[3.9730]

[3.5641]

import qualified Data.Text as T
import Data.Thyme.Clock as C
import Data.UUID as U
import Network.Haskoin.Address ( Address
, stringToAddr
)
replacement in server/Aftok/Snaplet/WorkLog.hs at line 17

[3.5642]→[3.35270:35337](∅→∅)

import Aftok.Currency.Bitcoin (NetworkId(..), toNetwork)

[3.5642]

[3.9836]

import Aftok.Currency.Bitcoin ( NetworkId(..)
, toNetwork
)
replacement in server/Aftok/Snaplet/WorkLog.hs at line 25

[3.9959]→[3.35338:35382](∅→∅),[3.35382]→[3.37364:37405](∅→∅),[3.9959]→[3.37364:37405](∅→∅)

import Aftok.Types (CreditTo(..))
import Aftok.Util (fromMaybeT)

[3.9959]

[3.5728]

import Aftok.Types ( CreditTo(..) )
import Aftok.Util ( fromMaybeT )
replacement in server/Aftok/Snaplet/WorkLog.hs at line 33

[3.10091]→[3.18362:18403](∅→∅)

import Snap.Snaplet as S

[3.10091]

[3.5830]

import Snap.Snaplet as S
replacement in server/Aftok/Snaplet/WorkLog.hs at line 37

[3.10148]→[3.196:245](∅→∅),[3.245]→[3.35383:35409](∅→∅)

uid <- requireUserId
pid <- requireProjectId
nmode <- getNetworkMode

[3.10148]

[3.245]

uid <- requireUserId
pid <- requireProjectId
nmode <- getNetworkMode
replacement in server/Aftok/Snaplet/WorkLog.hs at line 41

[3.283]→[3.283:322](∅→∅),[3.322]→[3.35410:35511](∅→∅),[3.35511]→[2.5756:5849](∅→∅),[2.5849]→[3.35606:35680](∅→∅),[3.35606]→[3.35606:35680](∅→∅)

timestamp <- liftIO C.getCurrentTime
case A.eitherDecode requestBody >>= parseEither (parseLogEntry nmode uid evCtr) of
Left err ->
snapError 400 $ "Unable to parse log entry " <> (show requestBody) <> ": " <> show err
Right entry ->
snapEval $ createEvent pid uid (entry timestamp)

[3.283]

[3.570]

timestamp <- liftIO C.getCurrentTime
case
A.eitherDecode requestBody >>= parseEither (parseLogEntry nmode uid evCtr)
of
Left err ->
snapError 400
$ "Unable to parse log entry "
<> (show requestBody)
<> ": "
<> show err
Right entry -> snapEval $ createEvent pid uid (entry timestamp)
replacement in server/Aftok/Snaplet/WorkLog.hs at line 55

[3.672]→[3.12607:12656](∅→∅),[3.10148]→[3.12607:12656](∅→∅),[3.3246]→[3.12607:12656](∅→∅)

uid <- requireUserId
pid <- requireProjectId

[3.672]

[3.35681]

uid <- requireUserId
pid <- requireProjectId
replacement in server/Aftok/Snaplet/WorkLog.hs at line 59

[3.3427]→[3.5971:6005](∅→∅),[3.4127]→[3.5971:6005](∅→∅),[3.4746]→[3.5971:6005](∅→∅),[3.12656]→[3.5971:6005](∅→∅),[3.35743]→[3.5971:6005](∅→∅),[3.5971]→[3.5971:6005](∅→∅)

addrBytes <- getParam "btcAddr"

[3.35743]

[3.4323]

addrBytes <- getParam "btcAddr"
replacement in server/Aftok/Snaplet/WorkLog.hs at line 61

[3.4361]→[3.3025:3064](∅→∅)

timestamp <- liftIO C.getCurrentTime

[3.4361]

[3.35744]

timestamp <- liftIO C.getCurrentTime
replacement in server/Aftok/Snaplet/WorkLog.hs at line 64

[3.10164]→[2.5850:5932](∅→∅),[2.5932]→[3.10165:10182](∅→∅),[3.12756]→[3.10165:10182](∅→∅),[3.10182]→[3.1103:1142](∅→∅),[3.1142]→[3.35806:35929](∅→∅)

snapError 400 $ "Unable to parse bitcoin address from " <> (show addrBytes)
Just addr ->
snapEval . createEvent pid uid $
LogEntry (CreditToCurrency (BTC, addr))
(evCtr timestamp)
(A.decode requestBody)

[3.10164]

[3.6347]

snapError 400
$ "Unable to parse bitcoin address from "
<> (show addrBytes)
Just addr -> snapEval . createEvent pid uid $ LogEntry
(CreditToCurrency (BTC, addr))
(evCtr timestamp)
(A.decode requestBody)
replacement in server/Aftok/Snaplet/WorkLog.hs at line 80

[3.4930]→[3.12937:12986](∅→∅)

uid <- requireUserId
pid <- requireProjectId

[3.4930]

[3.5005]

uid <- requireUserId
pid <- requireProjectId
replacement in server/Aftok/Snaplet/WorkLog.hs at line 83

[3.5069]→[3.5069:5224](∅→∅),[3.5224]→[3.8478:8589](∅→∅)

ival <- case endpoints of
(Just s, Just e) -> pure $ During s e
(Nothing, Just e) -> pure $ Before e
(Just s, Nothing) -> pure $ After s
(Nothing, Nothing) -> snapError 400 "You must at least one of the \"after\" or \"before\" query parameter"

[3.5069]

[3.12987]

ival <- case endpoints of
(Just s , Just e ) -> pure $ During s e
(Nothing, Just e ) -> pure $ Before e
(Just s , Nothing) -> pure $ After s
(Nothing, Nothing) -> snapError
400
"You must at least one of the \"after\" or \"before\" query parameter"
replacement in server/Aftok/Snaplet/WorkLog.hs at line 94

[3.10203]→[3.13025:13074](∅→∅),[3.3671]→[3.13025:13074](∅→∅)

uid <- requireUserId
pid <- requireProjectId

[3.10203]

[3.37406]

uid <- requireUserId
pid <- requireProjectId
replacement in server/Aftok/Snaplet/WorkLog.hs at line 99

[3.37544]→[3.13216:13259](∅→∅),[3.13216]→[3.13216:13259](∅→∅)

widx <- snapEval $ readWorkIndex pid uid

[3.37544]

[3.3065]

widx <- snapEval $ readWorkIndex pid uid
replacement in server/Aftok/Snaplet/WorkLog.hs at line 105

[3.8755]→[3.13316:13339](∅→∅),[3.13339]→[3.36148:36174](∅→∅)

uid <- requireUserId
nmode <- getNetworkMode

[3.8755]

[3.8828]

uid <- requireUserId
nmode <- getNetworkMode
replacement in server/Aftok/Snaplet/WorkLog.hs at line 108

[3.8865]→[3.10252:10344](∅→∅),[3.10344]→[3.8960:9000](∅→∅),[3.8960]→[3.8960:9000](∅→∅),[3.9146]→[3.9146:9195](∅→∅)

eventId <- maybe
(snapError 400 "eventId parameter is required")
(pure . EventId)
(eventIdBytes >>= U.fromASCIIBytes)
modTime <- ModTime <$> liftIO C.getCurrentTime

[3.8865]

[3.9195]

eventId <- maybe (snapError 400 "eventId parameter is required")
(pure . EventId)
(eventIdBytes >>= U.fromASCIIBytes)
modTime <- ModTime <$> liftIO C.getCurrentTime
replacement in server/Aftok/Snaplet/WorkLog.hs at line 113

[3.9233]→[3.10345:10354](∅→∅),[3.10354]→[2.5996:6025](∅→∅),[2.6025]→[3.13377:13417](∅→∅),[3.13377]→[3.13377:13417](∅→∅),[3.13417]→[3.36175:36241](∅→∅)

either
(snapError 400 . T.pack)
(snapEval . amendEvent uid eventId)
(parseEither (parseEventAmendment nmode modTime) requestJSON)

[3.9233]

either (snapError 400 . T.pack)
(snapEval . amendEvent uid eventId)
(parseEither (parseEventAmendment nmode modTime) requestJSON)
replacement in server/Aftok/Snaplet.hs at line 9

[3.10564]→[3.37546:37606](∅→∅)

import Control.Monad.Trans.Except (runExceptT)

[3.10489]

[3.10608]

import Control.Monad.Trans.Except ( runExceptT )
replacement in server/Aftok/Snaplet.hs at line 11

[3.10660]→[3.6838:6969](∅→∅)

import Data.Attoparsec.ByteString (Parser, parseOnly,
takeByteString)

[3.10660]

[3.6969]

import Data.Attoparsec.ByteString ( Parser
, parseOnly
, takeByteString
)
replacement in server/Aftok/Snaplet.hs at line 17

[3.10751]→[3.6997:7061](∅→∅),[3.7061]→[3.36243:36308](∅→∅)

import Aftok.Auction (AuctionId (..))
import Aftok.Currency.Bitcoin (NetworkMode(..))

[3.1325]

[3.10751]

import Aftok.Auction ( AuctionId(..) )
import Aftok.Currency.Bitcoin ( NetworkMode(..) )
replacement in server/Aftok/Snaplet.hs at line 21

[3.10826]→[3.36309:36384](∅→∅)

import Aftok.Types (UserId(..), ProjectId(..))

[3.10826]

[3.10826]

import Aftok.Types ( UserId(..)
, ProjectId(..)
)
replacement in server/Aftok/Snaplet.hs at line 51

[3.36616]→[3.36616:36697](∅→∅)

:: (MonadSnap m, HasPostgres m, HasNetworkMode m)
=> Program DBOp a
-> m a

[3.36616]

[3.11605]

:: (MonadSnap m, HasPostgres m, HasNetworkMode m) => Program DBOp a -> m a
replacement in server/Aftok/Snaplet.hs at line 55

[2.6097]→[3.11124:11164](∅→∅),[3.11748]→[3.11124:11164](∅→∅),[3.11164]→[3.11789:11872](∅→∅),[3.11789]→[3.11789:11872](∅→∅)

handleDBError (SubjectNotFound) =
snapError 404 "The subject of the requested operation could not be found."

[2.6097]

[3.14166]

handleDBError (SubjectNotFound) = snapError
404
"The subject of the requested operation could not be found."
replacement in server/Aftok/Snaplet.hs at line 62

[3.36724]→[3.36724:36811](∅→∅)

e <- liftPG $ \conn -> liftIO $ runExceptT (runQDBM nmode conn $ interpret liftdb p)

[3.36724]

[3.11945]

e <- liftPG
$ \conn -> liftIO $ runExceptT (runQDBM nmode conn $ interpret liftdb p)
replacement in server/Aftok/Snaplet.hs at line 80

[3.2105]→[2.6138:6222](∅→∅)

maybe (snapError 400 $ "Parameter "<> show name <>" is required") pure maybeBytes

[3.2105]

[3.2190]

maybe (snapError 400 $ "Parameter " <> show name <> " is required")
pure
maybeBytes
replacement in server/Aftok/Snaplet.hs at line 84

[3.2191]→[3.7127:7337](∅→∅),[3.11977]→[3.7127:7337](∅→∅)

parseParam :: MonadSnap m
=> Text -- ^ the name of the parameter to be parsed
-> Parser a -- ^ parser for the value of the parameter
-> m a -- ^ the parsed value

[3.2191]

[3.12036]

parseParam
:: MonadSnap m
=> Text -- ^ the name of the parameter to be parsed
-> Parser a -- ^ parser for the value of the parameter
-> m a -- ^ the parsed value
replacement in server/Aftok/Snaplet.hs at line 92

[3.2230]→[2.6223:6330](∅→∅)

(const . snapError 400 $ "Value of parameter "<> show name <>" could not be parsed to a valid value.")

[3.2230]

[3.2338]

( const
. snapError 400
$ "Value of parameter "
<> show name
<> " could not be parsed to a valid value."
)
replacement in server/Aftok/Snaplet.hs at line 101

[3.7383]→[3.7383:7538](∅→∅)

requireId :: MonadSnap m
=> Text -- ^ name of the parameter
-> (UUID -> a) -- ^ constructor for the identifier
-> m a

[3.7383]

[3.7538]

requireId
:: MonadSnap m
=> Text -- ^ name of the parameter
-> (UUID -> a) -- ^ constructor for the identifier
-> m a
replacement in server/Aftok/Snaplet.hs at line 108

[3.7598]→[3.7598:7787](∅→∅)

maybe (snapError 400 $ "Value of parameter \"" <> name <> "\" is not a valid UUID") pure maybeId
where
idParser = do
bs <- takeByteString
pure $ f <$> fromASCIIBytes bs

[3.7598]

[3.9523]

maybe
(snapError 400 $ "Value of parameter \"" <> name <> "\" is not a valid UUID"
)
pure
maybeId
where
idParser = do
bs <- takeByteString
pure $ f <$> fromASCIIBytes bs
replacement in server/Aftok/Snaplet.hs at line 121

[3.19132]→[3.9648:9750](∅→∅),[3.9648]→[3.9648:9750](∅→∅)

maybe (snapError 400 "Could not interpret request body as a nonempty JSON value.") pure requestBody

[3.19132]

[3.3903]

maybe
(snapError 400 "Could not interpret request body as a nonempty JSON value.")
pure
requestBody
replacement in server/Main.hs at line 5

[3.5260]→[3.26367:26398](∅→∅),[3.26398]→[2.6368:6399](∅→∅),[2.6399]→[3.11228:11294](∅→∅),[3.26398]→[3.11228:11294](∅→∅),[3.5260]→[3.11228:11294](∅→∅),[3.37783]→[3.7988:8139](∅→∅),[3.11294]→[3.7988:8139](∅→∅),[3.8139]→[3.37784:37846](∅→∅)

import Control.Lens ((^.), to)
import Control.Exception (try)
import qualified Data.Aeson as A
import Data.ProtocolBuffers (encodeMessage)
import Data.Serialize.Put (runPutLazy)
import Filesystem.Path.CurrentOS (decodeString, encodeString)

[3.1461]

[3.11294]

import Control.Lens ( (^.)
, to
)
import Control.Exception ( try )
import qualified Data.Aeson as A
import Data.ProtocolBuffers ( encodeMessage )
import Data.Serialize.Put ( runPutLazy )
import Filesystem.Path.CurrentOS ( decodeString
, encodeString
)
replacement in server/Main.hs at line 16

[3.11330]→[2.6400:6443](∅→∅)

import System.IO.Error (IOError)

[3.11330]

[3.918]

import System.IO.Error ( IOError )
replacement in server/Main.hs at line 21

[3.943]→[3.26399:26434](∅→∅),[3.26434]→[3.36813:36849](∅→∅),[3.943]→[3.36813:36849](∅→∅)

import qualified Aftok.Config as C
import Aftok.QConfig as Q

[3.943]

[3.11422]

import qualified Aftok.Config as C
import Aftok.QConfig as Q
replacement in server/Main.hs at line 37

[3.11832]→[3.2241:2285](∅→∅)

import Snap.Util.FileServe (serveDirectory)

[3.11832]

[3.314]

import Snap.Util.FileServe ( serveDirectory )
replacement in server/Main.hs at line 42

[2.6491]→[3.37887:37960](∅→∅),[3.1730]→[3.37887:37960](∅→∅),[3.1117]→[3.8231:8257](∅→∅),[3.1796]→[3.8231:8257](∅→∅),[3.3302]→[3.8231:8257](∅→∅),[3.37960]→[3.8231:8257](∅→∅),[3.8231]→[3.8231:8257](∅→∅)

cfg <- loadQConfig . decodeString $ fromRight "conf/aftok.cfg" cfgPath
sconf <- snapConfig cfg

[2.6491]

[3.8316]

cfg <- loadQConfig . decodeString $ fromRight "conf/aftok.cfg" cfgPath
sconf <- snapConfig cfg
replacement in server/Main.hs at line 48

[3.12436]→[3.11833:11874](∅→∅),[3.11874]→[3.26435:26670](∅→∅)

sesss <- nestSnaplet "sessions" sess $
initCookieSessionManager (cfg ^. authSiteKey . to encodeString)
"quookie"
(Just "aftok.com")
(cfg ^. cookieTimeout)

[3.12436]

[3.26670]

sesss <- nestSnaplet "sessions" sess $ initCookieSessionManager
(cfg ^. authSiteKey . to encodeString)
"quookie"
(Just "aftok.com")
(cfg ^. cookieTimeout)
edit in server/Main.hs at line 55

[3.8755]→[3.36850:36851](∅→∅),[3.36851]→[3.26732:26783](∅→∅),[3.26783]→[3.2274:2275](∅→∅),[3.36883]→[3.2274:2275](∅→∅),[3.8755]→[3.2274:2275](∅→∅),[3.2275]→[3.36884:37016](∅→∅),[3.37016]→[3.38212:38421](∅→∅),[3.38212]→[3.38212:38421](∅→∅),[3.1884]→[3.212:213](∅→∅),[3.2548]→[3.212:213](∅→∅),[3.38421]→[3.212:213](∅→∅),[3.1145]→[3.212:213](∅→∅),[3.213]→[3.1885:1972](∅→∅),[3.1972]→[3.38422:38514](∅→∅)

let nmode = cfg ^. billingConfig . C.networkMode

loginRoute = method GET requireLogin >> redirect "/home"
xhrLoginRoute = void $ method POST requireLogin
registerRoute = void $ method POST registerHandler

inviteRoute = void $ method POST (projectInviteHandler cfg)
acceptInviteRoute = void $ method POST acceptInvitationHandler

projectCreateRoute = serveJSON projectIdJSON $ method POST projectCreateHandler
projectListRoute = serveJSON (fmap qdbProjectJSON) $ method GET projectListHandler
replacement in server/Main.hs at line 56

[3.2398]→[3.2065:2146](∅→∅),[3.2146]→[3.37017:37210](∅→∅),[3.37210]→[3.38515:38516](∅→∅),[3.2492]→[3.38515:38516](∅→∅),[3.38516]→[3.37211:37297](∅→∅)

projectRoute = serveJSON projectJSON $ method GET projectGetHandler
logEntriesRoute = serveJSON (fmap $ logEntryJSON nmode) $ method GET logEntriesHandler
logIntervalsRoute = serveJSON (workIndexJSON nmode) $ method GET loggedIntervalsHandler

payoutsRoute = serveJSON (payoutsJSON nmode) $ method GET payoutsHandler

[3.2398]

[3.38517]

let
nmode = cfg ^. billingConfig . C.networkMode
replacement in server/Main.hs at line 59

[3.38518]→[3.38518:38772](∅→∅)

logWorkRoute f = serveJSON eventIdJSON $ method POST (logWorkHandler f)
logWorkBTCRoute f = serveJSON eventIdJSON $ method POST (logWorkBTCHandler f)
amendEventRoute = serveJSON amendmentIdJSON $ method PUT amendEventHandler

[3.38518]

[3.12970]

loginRoute = method GET requireLogin >> redirect "/home"
xhrLoginRoute = void $ method POST requireLogin
registerRoute = void $ method POST registerHandler
replacement in server/Main.hs at line 63

[3.12971]→[3.2645:2732](∅→∅),[3.2732]→[3.38773:38856](∅→∅),[3.38856]→[3.37298:37382](∅→∅)

auctionCreateRoute = serveJSON auctionIdJSON $ method POST auctionCreateHandler
auctionRoute = serveJSON auctionJSON $ method GET auctionGetHandler
auctionBidRoute = serveJSON bidIdJSON $ method POST auctionBidHandler

[3.12971]

[3.4230]

inviteRoute = void $ method POST (projectInviteHandler cfg)
acceptInviteRoute = void $ method POST acceptInvitationHandler
replacement in server/Main.hs at line 66

[3.4231]→[3.38942:39213](∅→∅)

billableCreateRoute = serveJSON billableIdJSON $ method POST billableCreateHandler
billableListRoute = serveJSON (fmap qdbBillableJSON) $ method GET billableListHandler
subscribeRoute = serveJSON subscriptionIdJSON $ method POST subscribeHandler

[3.4231]

[3.8383]

projectCreateRoute =
serveJSON projectIdJSON $ method POST projectCreateHandler
projectListRoute =
serveJSON (fmap qdbProjectJSON) $ method GET projectListHandler
replacement in server/Main.hs at line 71

[3.8384]→[3.39214:39418](∅→∅),[3.39418]→[3.26784:26901](∅→∅)

payableRequestsRoute = serveJSON billDetailsJSON $ method GET listPayableRequestsHandler
getPaymentRequestRoute = writeLBS . runPutLazy . encodeMessage =<< method GET getPaymentRequestHandler
submitPaymentRoute = serveJSON paymentIdJSON $ method POST (paymentResponseHandler $ cfg ^. billingConfig)

[3.8384]

[3.2549]

projectRoute = serveJSON projectJSON $ method GET projectGetHandler
logEntriesRoute =
serveJSON (fmap $ logEntryJSON nmode) $ method GET logEntriesHandler
logIntervalsRoute =
serveJSON (workIndexJSON nmode) $ method GET loggedIntervalsHandler
replacement in server/Main.hs at line 77

[3.2550]→[3.26902:26983](∅→∅)

addRoutes [ ("static", serveDirectory . encodeString $ cfg ^. staticAssetPath)

[3.2550]

[3.2569]

payoutsRoute = serveJSON (payoutsJSON nmode) $ method GET payoutsHandler
replacement in server/Main.hs at line 79

[3.2570]→[3.37383:37482](∅→∅),[3.2719]→[3.265:316](∅→∅),[3.11923]→[3.265:316](∅→∅),[3.37482]→[3.265:316](∅→∅),[3.265]→[3.265:316](∅→∅),[3.316]→[3.1146:1201](∅→∅),[3.2968]→[3.1146:1201](∅→∅)

, ("login", loginRoute)
, ("login", xhrLoginRoute)
, ("register", registerRoute)
, ("accept_invitation", acceptInviteRoute)

[3.2570]

[3.317]

logWorkRoute f = serveJSON eventIdJSON $ method POST (logWorkHandler f)
logWorkBTCRoute f =
serveJSON eventIdJSON $ method POST (logWorkBTCHandler f)
amendEventRoute = serveJSON amendmentIdJSON $ method PUT amendEventHandler
replacement in server/Main.hs at line 84

[3.318]→[3.448:613](∅→∅),[3.613]→[3.761:920](∅→∅),[3.13135]→[3.761:920](∅→∅),[3.690]→[3.3631:3779](∅→∅),[3.1085]→[3.3631:3779](∅→∅),[3.3216]→[3.3631:3779](∅→∅),[3.12004]→[3.3631:3779](∅→∅),[3.3631]→[3.3631:3779](∅→∅),[3.3779]→[3.39612:39811](∅→∅),[3.39811]→[3.13136:13275](∅→∅),[3.3779]→[3.13136:13275](∅→∅),[3.13275]→[3.691:761](∅→∅),[3.761]→[3.39812:39909](∅→∅)

, ("projects/:projectId/logStart/:btcAddr", logWorkBTCRoute StartWork)
, ("projects/:projectId/logEnd/:btcAddr", logWorkBTCRoute StopWork)
, ("projects/:projectId/logStart", logWorkRoute StartWork)
, ("projects/:projectId/logEnd", logWorkRoute StopWork)
, ("projects/:projectId/logEntries", logEntriesRoute)
, ("projects/:projectId/intervals", logIntervalsRoute)
, ("projects/:projectId/auctions", auctionCreateRoute) -- <|> auctionListRoute
, ("projects/:projectId/billables", billableCreateRoute <|> billableListRoute)
, ("projects/:projectId/payouts", payoutsRoute)
, ("projects/:projectId/invite", inviteRoute)
, ("projects/:projectId", projectRoute)
, ("projects", projectCreateRoute <|> projectListRoute)

[3.318]

[3.321]

auctionCreateRoute =
serveJSON auctionIdJSON $ method POST auctionCreateHandler
auctionRoute = serveJSON auctionJSON $ method GET auctionGetHandler
auctionBidRoute = serveJSON bidIdJSON $ method POST auctionBidHandler
replacement in server/Main.hs at line 89

[3.4299]→[3.1803:1864](∅→∅),[3.1864]→[3.1915:1979](∅→∅)

, ("auctions/:auctionId", auctionRoute)
, ("auctions/:auctionId/bid", auctionBidRoute)

[3.322]

[3.8385]

billableCreateRoute =
serveJSON billableIdJSON $ method POST billableCreateHandler
billableListRoute =
serveJSON (fmap qdbBillableJSON) $ method GET billableListHandler
subscribeRoute =
serveJSON subscriptionIdJSON $ method POST subscribeHandler
replacement in server/Main.hs at line 96

[3.8386]→[3.39910:39973](∅→∅),[3.39973]→[3.8386:8473](∅→∅),[3.8386]→[3.8386:8473](∅→∅),[3.8473]→[3.39974:40062](∅→∅)

, ("subscribe/:billableId", subscribeRoute)
, ("subscriptions/:subscriptionId/payment_requests", payableRequestsRoute)
, ("pay/:paymentRequestKey", getPaymentRequestRoute <|> submitPaymentRoute)

[3.8386]

[3.4299]

payableRequestsRoute =
serveJSON billDetailsJSON $ method GET listPayableRequestsHandler
getPaymentRequestRoute =
writeLBS
. runPutLazy
. encodeMessage
=<< method GET getPaymentRequestHandler
submitPaymentRoute = serveJSON paymentIdJSON
$ method POST (paymentResponseHandler $ cfg ^. billingConfig)
replacement in server/Main.hs at line 106

[3.322]→[3.13275:13332](∅→∅),[3.4300]→[3.13275:13332](∅→∅),[3.13275]→[3.13275:13332](∅→∅),[3.13332]→[3.12005:12019](∅→∅)

, ("events/:eventId/amend", amendEventRoute)
]

[3.4300]

[3.37483]

addRoutes
[ ("static", serveDirectory . encodeString $ cfg ^. staticAssetPath)
, ("login" , loginRoute)
, ("login" , xhrLoginRoute)
, ("register" , registerRoute)
, ("accept_invitation" , acceptInviteRoute)
, ("projects/:projectId/logStart/:btcAddr", logWorkBTCRoute StartWork)
, ("projects/:projectId/logEnd/:btcAddr", logWorkBTCRoute StopWork)
, ("projects/:projectId/logStart" , logWorkRoute StartWork)
, ("projects/:projectId/logEnd" , logWorkRoute StopWork)
, ("projects/:projectId/logEntries" , logEntriesRoute)
, ("projects/:projectId/intervals" , logIntervalsRoute)
, ( "projects/:projectId/auctions"
, auctionCreateRoute
) -- <|> auctionListRoute
, ( "projects/:projectId/billables"
, billableCreateRoute <|> billableListRoute
)
, ("projects/:projectId/payouts", payoutsRoute)
, ("projects/:projectId/invite" , inviteRoute)
, ("projects/:projectId" , projectRoute)
, ("projects" , projectCreateRoute <|> projectListRoute)
, ("auctions/:auctionId" , auctionRoute)
, ("auctions/:auctionId/bid" , auctionBidRoute)
, ("subscribe/:billableId" , subscribeRoute)
, ("subscriptions/:subscriptionId/payment_requests", payableRequestsRoute)
, ("pay/:paymentRequestKey", getPaymentRequestRoute <|> submitPaymentRoute)
, ("events/:eventId/amend" , amendEventRoute)
]
replacement in test/Aftok/AuctionSpec.hs at line 1

[3.704]→[3.117:161](∅→∅),[3.117]→[3.117:161](∅→∅)

module Aftok.AuctionSpec (main, spec) where

[3.89]

[3.161]

module Aftok.AuctionSpec
( main
, spec
)
where
replacement in test/Aftok/AuctionSpec.hs at line 11

[3.309]→[3.705:742](∅→∅)

import Data.Thyme.Clock ()

[3.309]

[3.309]

import Data.Thyme.Clock ( )
replacement in test/Aftok/AuctionSpec.hs at line 13

[3.336]→[3.743:784](∅→∅)

import Text.Read (read)

[3.336]

[3.204]

import Text.Read ( read )
replacement in test/Aftok/AuctionSpec.hs at line 22

[3.365]→[3.785:835](∅→∅)

import Test.HUnit.Base (assertFailure)

[3.365]

[3.835]

import Test.HUnit.Base ( assertFailure )
replacement in test/Aftok/AuctionSpec.hs at line 26

[3.1046]→[3.324:362](∅→∅),[3.362]→[3.1084:1223](∅→∅),[3.1084]→[3.1084:1223](∅→∅)

genBid = Bid <$> (UserId <$> genUUID)
<*> (Seconds <$> arbitrary `suchThat` (>= 0))
<*> genSatoshi `suchThat` (> Satoshi 0)
<*> arbitrary

[3.1046]

[3.398]

genBid =
Bid
<$> (UserId <$> genUUID)
<*> (Seconds <$> arbitrary `suchThat` (>= 0))
<*> genSatoshi
`suchThat` (> Satoshi 0)
<*> arbitrary
replacement in test/Aftok/AuctionSpec.hs at line 36

[3.1231]→[3.695:1190](∅→∅),[3.695]→[3.695:1190](∅→∅),[3.1190]→[3.1232:1240](∅→∅),[3.1240]→[3.1199:1351](∅→∅),[3.1199]→[3.1199:1351](∅→∅),[3.1351]→[3.749:839](∅→∅),[3.749]→[3.749:839](∅→∅)

let testB0 = Bid (UserId nil) (Seconds 3) (Satoshi 100) (read "2016-03-05 15:59:26.033176 UTC")
testB1 = Bid (UserId nil) (Seconds 60) (Satoshi 1000)(read "2016-03-05 15:59:26.033177 UTC")
testB2 = Bid (UserId nil) (Seconds 60) (Satoshi 100) (read "2016-03-05 15:59:26.033178 UTC")
testB3 = Bid (UserId nil) (Seconds 90) (Satoshi 100) (read "2016-03-05 15:59:26.033179 UTC")
testB4 = Bid (UserId nil) (Seconds 60) (Satoshi 100) (read "2016-03-05 15:59:26.033180 UTC")
in do
describe "bid ordering" $ do
it "ensures that bids with lowest seconds/btc ratio are first" $ do
bidOrder testB0 testB1 `shouldBe` LT
bidOrder testB1 testB2 `shouldBe` LT
bidOrder testB2 testB3 `shouldBe` LT

[3.1231]

[3.1352]

let
testB0 = Bid (UserId nil)
(Seconds 3)
(Satoshi 100)
(read "2016-03-05 15:59:26.033176 UTC")
testB1 = Bid (UserId nil)
(Seconds 60)
(Satoshi 1000)
(read "2016-03-05 15:59:26.033177 UTC")
testB2 = Bid (UserId nil)
(Seconds 60)
(Satoshi 100)
(read "2016-03-05 15:59:26.033178 UTC")
testB3 = Bid (UserId nil)
(Seconds 90)
(Satoshi 100)
(read "2016-03-05 15:59:26.033179 UTC")
testB4 = Bid (UserId nil)
(Seconds 60)
(Satoshi 100)
(read "2016-03-05 15:59:26.033180 UTC")
in
do
describe "bid ordering" $ do
it "ensures that bids with lowest seconds/btc ratio are first" $ do
bidOrder testB0 testB1 `shouldBe` LT
bidOrder testB1 testB2 `shouldBe` LT
bidOrder testB2 testB3 `shouldBe` LT
replacement in test/Aftok/AuctionSpec.hs at line 65

[3.1353]→[3.1353:1463](∅→∅)

it "ensures breaks ties in bid ordering by timestamp" $ do
bidOrder testB2 testB4 `shouldBe` LT

[3.1353]

[3.290]

it "ensures breaks ties in bid ordering by timestamp" $ do
bidOrder testB2 testB4 `shouldBe` LT
replacement in test/Aftok/AuctionSpec.hs at line 68

[3.291]→[3.1464:1580](∅→∅),[3.1580]→[3.1241:1605](∅→∅)

describe "winning bids" $ do
it "determines a sufficient number of winners to fulfill the raise amount" $
let result = runAuction' (Satoshi 1250) [testB0, testB1, testB2, testB3, testB4]
split = Bid (UserId nil) (Seconds 30) (Satoshi 50) (testB4 ^. bidTime)
expected = sortBy bidOrder [testB0, testB1, testB2, split]
in case result of
WinningBids winners ->
sortBy bidOrder winners `shouldBe` expected

[3.291]

[3.1605]

describe "winning bids" $ do
it
"determines a sufficient number of winners to fulfill the raise amount"
$ let
result = runAuction' (Satoshi 1250)
[testB0, testB1, testB2, testB3, testB4]
split =
Bid (UserId nil) (Seconds 30) (Satoshi 50) (testB4 ^. bidTime)
expected = sortBy bidOrder [testB0, testB1, testB2, split]
in
case result of
WinningBids winners ->
sortBy bidOrder winners `shouldBe` expected
replacement in test/Aftok/AuctionSpec.hs at line 82

[3.1606]→[3.363:396](∅→∅),[3.396]→[3.1639:1742](∅→∅),[3.1639]→[3.1639:1742](∅→∅)

InsufficientBids _ ->
assertFailure "Sufficinent bids were presented, but auction algorithm asserted otherwise."

[3.1606]

[3.839]

InsufficientBids _ ->
assertFailure
"Sufficinent bids were presented, but auction algorithm asserted otherwise."
replacement in test/Aftok/AuctionSpec.hs at line 86

[3.840]→[3.1743:2103](∅→∅)

it "ensures that the raise amount is fully consumed by the winning bids" $
forAll ((,) <$> genSatoshi <*> listOf genBid) $
\(raiseAmount', bids) ->
case runAuction' raiseAmount' bids of
WinningBids xs -> bidsTotal xs == raiseAmount'
InsufficientBids t -> t == (raiseAmount' - bidsTotal bids)

[3.840]

[3.2103]

it "ensures that the raise amount is fully consumed by the winning bids"
$ forAll ((,) <$> genSatoshi <*> listOf genBid)
$ \(raiseAmount', bids) -> case runAuction' raiseAmount' bids of
WinningBids xs -> bidsTotal xs == raiseAmount'
InsufficientBids t -> t == (raiseAmount' - bidsTotal bids)
replacement in test/Aftok/Generators.hs at line 7

[3.490]→[3.5397:5459](∅→∅)

import Network.Haskoin.Test (ArbitraryAddress (..))

[3.490]

[3.551]

import Network.Haskoin.Test ( ArbitraryAddress(..) )
replacement in test/Aftok/Generators.hs at line 9

[3.552]→[3.5460:5566](∅→∅)

import Aftok (BtcAddr (..))
import Aftok.Types (Satoshi (..))

[3.552]

[3.632]

import Aftok ( BtcAddr(..) )
import Aftok.Types ( Satoshi(..) )
replacement in test/Aftok/PaymentsSpec.hs at line 3

[3.1011]→[3.1011:1056](∅→∅)

module Aftok.PaymentsSpec (main, spec) where

[3.1011]

[3.1056]

module Aftok.PaymentsSpec
( main
, spec
)
where
replacement in test/Aftok/PaymentsSpec.hs at line 14

[3.1140]→[3.1140:1197](∅→∅)

describe "finding unbilled dates" $ do
pure ()

[3.1140]

[3.1197]

describe "finding unbilled dates" $ do
pure ()
replacement in test/Aftok/TimeLogSpec.hs at line 5

[3.149]→[3.915:959](∅→∅)

module Aftok.TimeLogSpec (main, spec) where

[3.149]

[3.1659]

module Aftok.TimeLogSpec
( main
, spec
)
where
replacement in test/Aftok/TimeLogSpec.hs at line 13

[3.2657]→[3.12167:12210](∅→∅)

import Control.Lens ((^.))

[3.2657]

[3.12210]

import Control.Lens ( (^.) )
replacement in test/Aftok/TimeLogSpec.hs at line 15

[3.12244]→[3.12244:12367](∅→∅)

import qualified Data.List.NonEmpty as L
import qualified Data.Map.Strict as M
import Data.Thyme.Time as T

[3.12244]

[3.12367]

import qualified Data.List.NonEmpty as L
import qualified Data.Map.Strict as M
import Data.Thyme.Time as T
replacement in test/Aftok/TimeLogSpec.hs at line 22

[3.1682]→[3.12426:12467](∅→∅),[3.12426]→[3.12426:12467](∅→∅)

import Aftok.Interval as I

[3.1682]

[3.12467]

import Aftok.Interval as I
replacement in test/Aftok/TimeLogSpec.hs at line 31

[3.2261]→[3.2261:2318](∅→∅)

delta <- arbitrary :: Gen (Positive T.NominalDiffTime)

[3.2261]

[3.2318]

delta <- arbitrary :: Gen (Positive T.NominalDiffTime)
replacement in test/Aftok/TimeLogSpec.hs at line 36

[3.2442]→[3.2442:2530](∅→∅)

let deltas = fmap T.fromSeconds <$> ((listOf $ choose (0, 72 * 60 * 60)) :: Gen[Int])

[3.2442]

[3.3532]

let deltas =
fmap T.fromSeconds
<$> ((listOf $ choose (0, 72 * 60 * 60)) :: Gen [Int])
replacement in test/Aftok/TimeLogSpec.hs at line 42

[3.2648]→[3.2648:2749](∅→∅)

let ival = I.interval t (t .+^ d)
in ival : buildIntervals (ival ^. I.end .+^ s) dx

[3.2648]

[3.2749]

let ival = I.interval t (t .+^ d)
in ival : buildIntervals (ival ^. I.end .+^ s) dx
replacement in test/Aftok/TimeLogSpec.hs at line 46

[3.2788]→[3.12638:12665](∅→∅),[3.3800]→[3.12638:12665](∅→∅),[3.236]→[3.3879:3954](∅→∅),[3.3879]→[3.3879:3954](∅→∅),[3.3954]→[3.2789:2821](∅→∅)

startTime <- arbitrary
intervals <- suchThat (buildIntervals startTime <$> deltas) (not.null)
pure $ L.fromList intervals

[3.2788]

[3.2045]

startTime <- arbitrary
intervals <- suchThat (buildIntervals startTime <$> deltas) (not . null)
pure $ L.fromList intervals
replacement in test/Aftok/TimeLogSpec.hs at line 52

[3.2867]→[3.2867:2944](∅→∅),[3.2944]→[3.1683:1736](∅→∅)

let record = do addr <- genBtcAddr
ivals <- genIntervals
pure (CreditToAddress addr, ivals)

[3.2867]

[3.2981]

let record = do
addr <- genBtcAddr
ivals <- genIntervals
pure (CreditToAddress addr, ivals)
replacement in test/Aftok/TimeLogSpec.hs at line 61

[3.198]→[3.12719:12792](∅→∅),[3.39]→[3.2309:2410](∅→∅),[3.12792]→[3.2309:2410](∅→∅),[3.2309]→[3.2309:2410](∅→∅)

it "reduces a log to a work index" $
let testAddrs = catMaybes
[ parseBtcAddr "123"
, parseBtcAddr "456"
, parseBtcAddr "789" ]

[3.198]

[3.4126]

it "reduces a log to a work index"
$ let
testAddrs = catMaybes
[parseBtcAddr "123", parseBtcAddr "456", parseBtcAddr "789"]
replacement in test/Aftok/TimeLogSpec.hs at line 68

[3.2516]→[3.1316:1368](∅→∅)

, parseISO8601 "2014-01-01T00:12:00Z" ]

[3.2516]

[3.4253]

, parseISO8601 "2014-01-01T00:12:00Z"
]
replacement in test/Aftok/TimeLogSpec.hs at line 71

[3.4254]→[3.12835:12876](∅→∅)

ends = toThyme <$> catMaybes

[3.4254]

[3.4127]

ends = toThyme <$> catMaybes
replacement in test/Aftok/TimeLogSpec.hs at line 73

[3.4177]→[3.1369:1421](∅→∅),[3.2674]→[3.1369:1421](∅→∅)

, parseISO8601 "2014-01-01T00:18:00Z" ]

[3.4177]

[3.417]

, parseISO8601 "2014-01-01T00:18:00Z"
]
replacement in test/Aftok/TimeLogSpec.hs at line 78

[3.1451]→[3.1197:1227](∅→∅),[3.3063]→[3.1197:1227](∅→∅),[3.1197]→[3.1197:1227](∅→∅)

addr <- testAddrs

[3.1451]

[3.176]

addr <- testAddrs
edit in test/Aftok/TimeLogSpec.hs at line 89

[3.631]

[3.2824]

in
(workIndex testLogEntries) `shouldBe` expected
replacement in test/Aftok/TimeLogSpec.hs at line 92

[3.2825]→[3.3331:3387](∅→∅),[3.120]→[3.493:494](∅→∅),[3.1514]→[3.493:494](∅→∅),[3.2990]→[3.493:494](∅→∅),[3.3387]→[3.493:494](∅→∅),[3.493]→[3.493:494](∅→∅),[3.494]→[3.3029:3243](∅→∅)

in (workIndex testLogEntries) `shouldBe` expected

it "recovers a work index from events" $
forAll genWorkIndex $ \(WorkIndex widx) ->
let mergeAdjacent ((I.Interval s e) : (I.Interval s' e') : xs) | e == s' = mergeAdjacent $ I.Interval s e' : xs

[3.2825]

[3.351]

it "recovers a work index from events"
$ forAll genWorkIndex
$ \(WorkIndex widx) ->
let
mergeAdjacent ((I.Interval s e) : (I.Interval s' e') : xs)
| e == s' = mergeAdjacent $ I.Interval s e' : xs
replacement in test/Aftok/TimeLogSpec.hs at line 99

[3.409]→[3.409:443](∅→∅)

mergeAdjacent [] = []

[3.409]

[3.443]

mergeAdjacent [] = []
replacement in test/Aftok/TimeLogSpec.hs at line 101

[3.444]→[3.444:550](∅→∅),[3.550]→[3.4441:4505](∅→∅),[3.4441]→[3.4441:4505](∅→∅)

ivalEntries addr ival = LogEntry addr <$> [StartWork (ival ^. start), StopWork (ival ^. end)]
<*> [Nothing]

[3.444]

[3.4635]

ivalEntries addr ival =
LogEntry addr
<$> [StartWork (ival ^. start), StopWork (ival ^. end)]
<*> [Nothing]
replacement in test/Aftok/TimeLogSpec.hs at line 108

[3.552]→[3.960:1048](∅→∅)

widx' = fmap (L.fromList . mergeAdjacent . sortOn I._start . L.toList) widx

[3.552]

[3.4506]

widx' = fmap
(L.fromList . mergeAdjacent . sortOn I._start . L.toList)
widx
replacement in test/Aftok/TimeLogSpec.hs at line 112

[3.4558]→[3.639:729](∅→∅)

in workIndex logEntries `shouldBe` (WorkIndex $ fmap (L.reverse . L.sort) widx')

[3.4558]

[3.3975]

in
workIndex logEntries
`shouldBe` (WorkIndex $ fmap (L.reverse . L.sort) widx')
replacement in test/Aftok/Util/HttpSpec.hs at line 19

[3.5315]→[3.5315:5403](∅→∅)

(parseOnly authHeaderParser rawHeader) `shouldBe` (Right ("nuttycom", "kjntest"))

[3.5315]

[3.5403]

(parseOnly authHeaderParser rawHeader)
`shouldBe` (Right ("nuttycom", "kjntest"))