Fine. I'll use ormolu. At least it doesn't break the code.

[?]

Dec 8, 2020, 5:10 AM

X3ES7NUA42D2BF7CQDDKXM5CLMVCYA3H5YU5KXLPTGDBFPE2LNVAC

Dependencies

[2] SQ7UMLN5 Get z-addr checks working.
[3] F4ONFXF4 Fix signup database issues.
[4] RSEB2NFG Replacing Snap with Scotty.
[5] EKI57EJR Add alternative implementation of auction winner determination.
[6] GKLIPHR5 Fix error in parsing of event metadata
[7] EW2XN7KU Update docker build, clean up migration for payments tables.
[8] DXIGERDT Change order of Docker build to avoid rebuilding the universe.
[9] ZIG57EE6 Fix project selection, end log end on project switch.
[10] 2J37EVJM Check for an open interval on project switch.
[11] A2J7B4SC Initial impl of depreciation function.
[12] 7XN3I3QJ Add 'loggedIntervals' endpoint.
[13] WZUHEZSB Start of migration back toward snap.
[14] 2KZPOGRB Once you get Haskell to compile, the tests pass!
[15] N4NDAZYT Initial implementation of payouts.
[16] TZQJVHBA Add auction functions to ADB.
[17] 2G3GNDDU Event logging is now functioning in postgres.
[18] TLQ72DSJ Lenses, sqlite-simple
[19] 4R7XIYK3 Switch from ClassyPrelude to Relude
[20] 4QX5E5AC Initial compilation of payouts function succeeds.
[21] A6HKMINB Attempting to improve JSON handling.
[22] J6S23MDG Use server timestamps for interval start and end.
[23] BROSTG5K Beginning of modularization of server.
[24] 7KZP4RHZ Switch from Data.Time to Data.Thyme
[25] ENNZIQJG Use live signup API for client.
[26] GLFF5ZDK Factor winningBids for easier testing.
[27] UILI6PIL The route-based logStart/logStop is nicer.
[28] WZFQDWW4 Add retrieval/storage of current exchange rate data to payment recording.
[29] NEDDHXUK Reformat via stylish-haskell
[30] Z24SZOGZ Return richer information from event logging calls.
[31] TNR3TEHK Switch to Postgres + snaplet arch compiles.
[32] UUR6SMCA Add start of specs for auctions.
[33] MJ6R42RC Utility methods for reading key & cert data.
[34] 5OI44E4E Add authentication to auction search.
[35] 4SCFOJGN Specs for recovering intervals from the log now pass.
[36] P6NR2CGX Beginning of implementation of depreciation.
[37] HO2PFRAB Client login now handles response correctly.
[38] SLL7262C Make depreciation functions more flexible.
[39] TJEUE7TY Added OverloadedStrings to eliminate Text fiddling.
[40] B6HWAPDP Modularize & update to recent haskoin.
[41] 7DBNV3GV Initial, stack-based impl of time log event reduction.
[42] O227CEAV Adds storage of original event JSON for some DBOp constructors.
[43] HMDM3B55 Implement core of payments/billing infrastructure.
[44] GMYPBCWE Make docker-compose work.
[45] UWMGUJOW Autoformat sources.
[46] Z3M53KTL Adrift.
[47] 5ZSKPQ3K Add created_at and auction_start timestamps to auction
[48] BWN72T44 Don't accept work timestamp from an external source.
[49] DFOBMSAO Initial work on payments API
[50] UOG5H2TW Default work logging credit to logged-in user.
[51] NVOCQVAS Initial failing tests.
[52] YWNTVA7P Fix broken auction test.
[53] RN7EI6IN Update database layer to use CreditTo
[54] IPG33FAW Add billing daemon
[55] 5DRIWGLU Improving TimeLog specs
[56] KEP5WUFJ Convert project to stack-based build.
[57] O722AOKE Add route to allow crediting of events to users/projects.
[58] IZEVQF62 Work in progress replacing sqlite with postgres.
[59] HBULCDN6 Add tests for auction winner determination algorithm.
[60] 4IQVQL4T Added client for payouts endpoint.
[61] EQXRXRZD Changed to use tasty instead of test-framework
[62] FD7SV5I6 Fix handling of event_t columns.
[63] SCXG6TJW Make log reduction safer in presence of overlapping events.
[64] WJO37T74 Restored the single test to functionality.
[65] Z7KS5XHH Very WIP. Wow.
[66] NJNMO72S Add zcash.com submodule and update client to modern halogen.
[67] 64C6AWH6 Rename Ananke -> Quixotic, project reboot.
[68] 4U7F3CPI THE GREAT RENAMING OF THINGS!
[69] GKGVYBZG Added JSON serialization to TimeLog
[70] BSIUHCGF Add payment response handler.
[71] POX3UAMT Enabling logging of time to contributor/project accounts
[72] 64VI73NP Server now compiles using abstracted SQLite
[73] Y3LIJ5US Add handler for CreatePaymentRequest
[74] OBFPJS2G Project successfully builds and tests under nix.
[75] M3KUPGZK Add invitation email template.
[76] AWWC6P5Z Add migration to include payment network with addresses.
[77] 73NDXDEZ Begin implementation of billing event persistence.
[78] LAROLAYU WIP
[79] EKY7U7SK Finish conversion to stack.
[80] LHJ2HFXV Add property test for auction algorithm.
[81] F2XLL7XW Remove Ord Bid & sort in favor of sortBy
[82] XTBSG4C7 Adding serveJSON combinator to eliminate some boilerplate from handlers.
[83] FXJQACES Ensure that auction is not ended at the time of bid
[84] WAIX6AGN Add event serialization for PaymentRequest & Payment
[85] EYGIUUQZ Restore remainder of endpoints to compiling status.
[86] NMWWP4ZN Trying out Hspec
[87] 5W5M56VJ Move library code to 'lib'
[88] MGOF7IUF Update TASKS list to reflect completed projects.
[89] WO2MINIF Auctions now compile!
[90] Q5X5RYQL stylish-haskell reformatting
[91] 2OIPAQCB Merge branch 'master' of github.com:nuttycom/ananke
[92] JFOEOFGA stylish-haskell formatting.
[93] ADMKQQGC Initial empty Snap project.
[94] DJATFGIC Support client builds in nix-shell --pure.
[95] 4ZLEDBK7 Initial attempts at dockerizing, cabal isn't cooperating.
[96] NAS4BFL4 Trivial stylish-haskell reformat.
[97] RFYEVKZQ Add nix-shell based build environment.
[98] LD4GLVSF More database stuff.
[99] TCOAKCGG Completed conversion to snap.
[100] NLZ3JXLO Fix formatting with stylish-haskell.
[101] 2Y2QZFVF Switch to more modern cabal2nix-based workflow.
[102] 5XFJNUAZ Start of addition of project infrastructure.
[103] M4KM76DG Merge branch 'stackify'
[104] HALRDT2F Added initial auction create route.
[105] U256ZALI Add captcha check to register route.
[106] MB5SHULB Add route for accepting an invitation with an existing account
[107] MWUPXTBF A few steps down a road to be abandoned.
[108] 7VGYLTMU Clean up schema version handling.
[109] LTSVBVA2 Update to a recent haskoin-core. Fix Stack build.
[110] ASF3UPJL Add auction creation and bid handlers
[111] I2KHGVD4 Require project permissions for access to most data.
[112] RPAJLHMT Change to use UUIDs instead of ints for primary keys.
[113] QMEYU4MW Add display for prior intervals.
[114] MMRVIM3F Removes copy/paste error from email invitation subject.
[115] KNSI575V Cleanup of EventLog types.
[116] VJPT6HDR Fix remaining type errors after addition of login handler.
[117] 7HPY3QPF Fix linting errors. (yay hlint!)
[118] SEWTRB6S Implement payment request creation functions.
[119] BXGLKYRX Added primitive user registration handler.
[120] ZTPDQKLA Add changes to event_credit_to_amendments
[121] PT4276XC Add logout functionality.
[122] O2BZOX7M Add signup form, captcha check.
[123] QMRKFEPG Refactor QDB to use a free monad algebra instead.
[124] 6L5BK5EH Use generic SMTP rather than Sendmail-specific mail client.
[125] 3GBSDS5P Fix out-of-date test code, add skeleton for payments spec.
[126] PBD7LZYQ Postgres & auth are beginning to function.
[127] QADKFHAR Adds CreatePayment handler implementation.
[128] OV5AKJHA Remove unused LogInterval type.
[129] Y35QCWYW Minor improvement in WorkIndex type to eliminate duplicated information.
[130] EMVTF2IW WIP moving back to snap.
[131] RSF6UAJK Break out api module for timeline.
[132] GCVQD44V Create amends endpoint, switch to UUID primary keys
[133] 2MNO5FUY Upgrade LTS version
[134] 3QVT6MA6 Add database support for event amend operations.
[135] EFSXYZPO Autoformat everything with brittany.
[136] Z3MK2PJ5 Add GET handler for retrieving auction data.
[137] 75N3UJ4J More progression toward lenses.
[138] 2XQD6KKK Add invitation logic and clean up DBProg error handling.
[139] V2VDN77H Enable postgres configuration via environment variable for Heroku.
[140] AL37SVTC Implement payments service endpoints.
[141] JV3UEPNC Fix Aeson constructors.
[142] O5FVTOM6 Undo JSON silliness, enable a couple more routes.
[143] 4FDQGIXN Make payment request retrieval key an opaque 32-bit hash.
[144] W35DDBFY Factor common JSON conversions up into client lib module.
[145] EZQG2APB Update task list.
[146] ZITLSTYX Fix problems with SQL queries & depreciation function parsing.
[147] 5IDB3IWS Integrate zcashd-based zaddr validation.
[148] ZP62WC47 Begin conversion to build with stack.
[*] AXKKXBWN Initial attempt at writing down my ideas for a company based on trust.

Change contents

file addition: .nvimrc (----------)

[150.2]

nnoremap <leader>h :!~/.nix-profile/bin/hasktags -o tags -c $(find lib server daemon test -name \*.hs) && ~/.nix-profile/bin/ctags --options-maybe=.ctags --options=$HOME/.ctags --append=yes .<CR><CR>

nnoremap <leader>o :!~/.nix-profile/bin/ormolu --mode inplace $(find lib server daemon test -name '*.hs')<CR><CR>
replacement in daemon/AftokD/AftokM.hs at line 1

[4.1458]→[4.1459:1548](∅→∅)

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

[4.1458]

[4.1548]

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
replacement in daemon/AftokD/AftokM.hs at line 4

[4.1581]→[4.1581:1615](∅→∅)

{-# LANGUAGE FlexibleContexts #-}

[4.1581]

[4.1615]

{-# LANGUAGE TemplateHaskell #-}
replacement in daemon/AftokD/AftokM.hs at line 8

[4.426]→[4.1665:1666](∅→∅),[4.1665]→[4.1665:1666](∅→∅),[4.1666]→[4.442:443](∅→∅),[4.443]→[4.3:409](∅→∅),[4.473]→[4.473:645](∅→∅),[4.645]→[4.3:130](∅→∅),[4.130]→[4.2042:2043](∅→∅),[4.1113]→[4.2042:2043](∅→∅),[4.2042]→[4.2042:2043](∅→∅),[4.2043]→[4.1114:1182](∅→∅),[4.1182]→[4.2102:2103](∅→∅),[4.2102]→[4.2102:2103](∅→∅),[4.2103]→[4.1183:1781](∅→∅),[4.191]→[4.1841:2268](∅→∅),[4.57592]→[4.1841:2268](∅→∅),[4.1841]→[4.1841:2268](∅→∅),[4.2268]→[4.2445:2446](∅→∅),[4.2445]→[4.2445:2446](∅→∅),[4.2446]→[4.192:252](∅→∅)

import Control.Error.Util ( maybeT )
import Control.Lens ( (^.)
, makeLenses
, makeClassyPrisms
, traverseOf
, to
)
import Control.Monad.Except ( MonadError
, throwError
)
import Control.Monad.Trans.Except ( withExceptT )
import Control.Monad.Trans.Reader ( mapReaderT )

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

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 Text.StringTemplate ( directoryGroup
, newSTMP
, getStringTemplate
, setManyAttrib
, render
)
import Filesystem.Path.CurrentOS ( encodeString )

import Bippy.Types ( Satoshi )

[4.1643]

[4.2483]

import Aftok.Billing
( Billable,
Billable',
ContactChannel (..),
Subscription',
billable,
contactChannel,
customer,
name,
paymentRequestEmailTemplate,
paymentRequestMemoTemplate,
project,
)
import qualified Aftok.Config as AC
import Aftok.Currency.Bitcoin (satoshi)
import qualified Aftok.Database as DB
import Aftok.Database.PostgreSQL (QDBM (..))
import qualified Aftok.Payments as P
import Aftok.Payments.Types
( PaymentKey (..),
paymentKey,
paymentRequestTotal,
subscription,
)
import Aftok.Project
( Project,
projectName,
)
import Aftok.Types
( ProjectId (..),
User,
UserId,
_Email,
)
import qualified AftokD as D
import Bippy.Types (Satoshi)
import Control.Error.Util (maybeT)
import Control.Lens
( (^.),
makeClassyPrisms,
makeLenses,
to,
traverseOf,
)
import Control.Monad.Except
( MonadError,
throwError,
)
import Control.Monad.Trans.Except (withExceptT)
import Control.Monad.Trans.Reader (mapReaderT)
import Crypto.Random.Types (MonadRandom (..))
import qualified Data.Text as T
import Data.Thyme.Clock as C
import Data.Thyme.Time as C
import Database.PostgreSQL.Simple
( Connection,
connect,
)
import Filesystem.Path.CurrentOS (encodeString)
import qualified Network.Mail.Mime as Mime
import qualified Network.Mail.SMTP as SMTP
import Network.URI
( URI,
parseURI,
)
import Text.StringTemplate
( directoryGroup,
getStringTemplate,
newSTMP,
render,
setManyAttrib,
)
edit in daemon/AftokD/AftokM.hs at line 81

[4.2484]→[4.2330:2506](∅→∅),[4.2566]→[4.2566:2623](∅→∅),[4.2791]→[4.2791:2841](∅→∅),[4.2841]→[4.3046:3106](∅→∅),[4.3106]→[4.2841:2894](∅→∅),[4.2841]→[4.2841:2894](∅→∅),[4.2894]→[2.251:310](∅→∅),[2.310]→[4.2953:3077](∅→∅),[4.2953]→[4.2953:3077](∅→∅),[4.3077]→[4.3107:3241](∅→∅),[4.3241]→[4.3077:4210](∅→∅),[4.3077]→[4.3077:4210](∅→∅),[4.4210]→[4.3089:3090](∅→∅),[4.3089]→[4.3089:3090](∅→∅)

import Aftok.Types ( User
, UserId
, ProjectId(..)
, _Email
)
import Aftok.Currency.Bitcoin ( satoshi )
import qualified Aftok.Config as AC
import Aftok.Billing ( Billable
, Billable'
, Subscription'
, ContactChannel(..)
, contactChannel
, 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
edit in daemon/AftokD/AftokM.hs at line 85

[4.3177]

[4.3177]
replacement in daemon/AftokD/AftokM.hs at line 90

[4.3297]→[4.4211:4254](∅→∅)

_Overdue = _PaymentErr . P._Overdue

[4.3297]

[4.3335]

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

[4.3384]→[4.855:882](∅→∅),[4.882]→[4.3412:3495](∅→∅),[4.3412]→[4.3412:3495](∅→∅)

data AftokMEnv = AftokMEnv
{ _dcfg :: !D.Config
, _conn :: !Connection
, _pcfg :: !P.PaymentsConfig
}

[4.3384]

[4.3495]

data AftokMEnv
= AftokMEnv
{ _dcfg :: !D.Config,
_conn :: !Connection,
_pcfg :: !P.PaymentsConfig
}
replacement in daemon/AftokD/AftokM.hs at line 103

[4.3564]→[4.4255:4370](∅→∅)

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

[4.3564]

[4.3657]

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

[4.3682]→[4.3682:3768](∅→∅)

newtype AftokM a = AftokM { runAftokM :: ReaderT AftokMEnv (ExceptT AftokDErr IO) a }

[4.3682]

[4.3768]

newtype AftokM a = AftokM {runAftokM :: ReaderT AftokMEnv (ExceptT AftokDErr IO) a}
replacement in daemon/AftokD/AftokM.hs at line 142

[4.4620]→[4.4620:4637](∅→∅)

requests <-

[4.4620]

[4.4637]

requests <-
replacement in daemon/AftokD/AftokM.hs at line 150

[4.4823]→[4.4823:5044](∅→∅)

preqCfg = cfg ^. (dcfg . D.paymentRequestConfig)
reqMay = do
preq <- DB.findPaymentRequestId reqId
preq' <- traverseOf P.subscription DB.findSubscriptionBillable preq

[4.4823]

[4.5347]

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 156

[4.5501]→[4.5045:5118](∅→∅)

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

[4.5501]

[4.5569]

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

[4.5614]→[4.5119:5323](∅→∅)

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

[4.5614]

[4.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

[4.1181]→[4.5324:5418](∅→∅),[4.5418]→[4.3242:3321](∅→∅),[4.3321]→[4.5558:5584](∅→∅),[4.5558]→[4.5558:5584](∅→∅)

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

[4.1181]

[4.6092]

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

[4.5653]→[4.5653:5723](∅→∅)

^. (subscription . billable . paymentRequestEmailTemplate)

[4.5653]

[4.6326]

^. (subscription . billable . paymentRequestEmailTemplate)
replacement in daemon/AftokD/AftokM.hs at line 185

[4.3451]→[4.3451:3483](∅→∅)

-- TODO: other channels

[4.3451]

[4.6548]

-- TODO: other channels
replacement in daemon/AftokD/AftokM.hs at line 187

[4.5885]→[4.5885:6125](∅→∅),[4.6125]→[4.6891:6929](∅→∅),[4.6891]→[4.6891:6929](∅→∅),[4.6929]→[4.6126:6280](∅→∅),[4.717]→[4.7078:7092](∅→∅),[4.6280]→[4.7078:7092](∅→∅),[4.7078]→[4.7078:7092](∅→∅)

pname = req ^. (subscription . billable . project . projectName)
total = req ^. (P.paymentRequest . to paymentRequestTotal)
setAttrs = setManyAttrib
[ ("from_email" , fromEmail ^. _Email)
, ("project_name", pname)
, ("to_email" , toEmail ^. _Email)
, ("amount_due" , show $ total ^. satoshi)
, ("payment_url" , show paymentUrl)
]

[4.6596]

[4.1407]

pname = req ^. (subscription . billable . project . projectName)
total = req ^. (P.paymentRequest . to paymentRequestTotal)
setAttrs =
setManyAttrib
[ ("from_email", fromEmail ^. _Email),
("project_name", pname),
("to_email", toEmail ^. _Email),
("amount_due", show $ total ^. satoshi),
("payment_url", show paymentUrl)
]
replacement in daemon/AftokD/AftokM.hs at line 198

[4.1471]→[4.1471:1533](∅→∅),[4.1533]→[4.6281:6358](∅→∅),[4.6358]→[4.57646:57711](∅→∅)

toAddr = Mime.Address Nothing (toEmail ^. _Email)
subject = "Payment is due for your " <> pname <> " subscription!"
body = Mime.plainPart . render $ setAttrs template

[4.1471]

[4.3484]

toAddr = Mime.Address Nothing (toEmail ^. _Email)
subject = "Payment is due for your " <> pname <> " subscription!"
body = Mime.plainPart . render $ setAttrs template
replacement in daemon/AftokD/AftokM.hs at line 203

[4.7418]→[4.6359:6447](∅→∅)

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

[4.7418]

[4.7531]

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

[4.827]→[4.1684:1715](∅→∅),[4.6557]→[4.1684:1715](∅→∅),[4.7728]→[4.1684:1715](∅→∅),[4.1715]→[4.7760:7883](∅→∅),[4.7760]→[4.7760:7883](∅→∅),[4.7883]→[4.828:873](∅→∅),[4.873]→[4.6558:6603](∅→∅),[4.916]→[4.7973:7983](∅→∅),[4.6603]→[4.7973:7983](∅→∅),[4.7973]→[4.7973:7983](∅→∅)

setAttrs = setManyAttrib
[ ("project_name", req ^. (billable . project . projectName))
, ("subscription", req ^. (billable . name))
, ("billing_date", show billingDate)
, ("issue_time" , show requestTime)
]

[4.6557]

[4.7983]

setAttrs =
setManyAttrib
[ ("project_name", req ^. (billable . project . projectName)),
("subscription", req ^. (billable . name)),
("billing_date", show billingDate),
("issue_time", show requestTime)
]
replacement in daemon/AftokD/AftokM.hs at line 224

[4.8210]→[4.6604:6684](∅→∅)

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

[4.8210]

[4.8280]

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

[4.8354]→[4.6685:6804](∅→∅)

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

[4.8354]

[4.6804]

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

[4.8505]→[4.6811:6922](∅→∅)

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

[4.8505]

[4.8606]

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

[4.8770]→[4.6924:6954](∅→∅)

import Control.Lens

[4.8770]

[4.8790]

import qualified Aftok.Config as AC
import Aftok.Types (Email (..))
import Control.Lens
import qualified Data.Configurator as C
import qualified Data.Configurator.Types as CT
import Database.PostgreSQL.Simple (ConnectInfo)
import Filesystem.Path.CurrentOS
( encodeString,
fromText,
)
import qualified Filesystem.Path.CurrentOS as P
replacement in daemon/AftokD.hs at line 17

[4.8791]→[4.8791:8896](∅→∅),[4.8896]→[4.6955:7243](∅→∅)

import qualified Data.Configurator as C
import qualified Data.Configurator.Types as CT
import Database.PostgreSQL.Simple ( ConnectInfo )
import Filesystem.Path.CurrentOS ( fromText
, encodeString
)
import qualified Filesystem.Path.CurrentOS as P

[4.8791]

[4.9015]

data PaymentRequestConfig
= PaymentRequestConfig
{ _aftokHost :: Text,
_templatePath :: P.FilePath,
_billingFromEmail :: Email
}
replacement in daemon/AftokD.hs at line 24

[4.9016]→[4.7244:7359](∅→∅)

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

[4.9016]

[4.9077]

makeLenses ''PaymentRequestConfig
replacement in daemon/AftokD.hs at line 26

[4.9078]→[4.9078:9150](∅→∅),[4.9150]→[4.1127:1159](∅→∅),[4.1159]→[4.9180:9249](∅→∅),[4.9180]→[4.9180:9249](∅→∅)

data PaymentRequestConfig = PaymentRequestConfig
{ _aftokHost :: Text
, _templatePath :: P.FilePath
, _billingFromEmail :: Email
}
makeLenses ''PaymentRequestConfig

[4.9078]

[4.9249]

data Config
= Config
{ _smtpConfig :: AC.SmtpConfig,
_billingConfig :: AC.BillingConfig,
_dbConfig :: ConnectInfo,
_paymentRequestConfig :: PaymentRequestConfig
}
edit in daemon/AftokD.hs at line 34

[4.9250]→[4.9250:9437](∅→∅)

data Config = Config
{ _smtpConfig :: AC.SmtpConfig
, _billingConfig :: AC.BillingConfig
, _dbConfig :: ConnectInfo
, _paymentRequestConfig :: PaymentRequestConfig
}
replacement in daemon/Main.hs at line 1

[4.10159]→[4.10160:10199](∅→∅),[4.10199]→[4.1200:1239](∅→∅)

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}

[4.10159]

[4.7902]

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
replacement in daemon/Main.hs at line 5

[4.7914]→[4.7914:7923](∅→∅)

( main

[4.7914]

[4.7923]

( main,
edit in daemon/Main.hs at line 8

[4.7933]→[4.10224:10225](∅→∅),[4.10224]→[4.10224:10225](∅→∅)
edit in daemon/Main.hs at line 9

[4.1241]

[4.10246]

import qualified AftokD as D
import AftokD.AftokM (createAllPaymentRequests)
import Control.Exception (try)
import Filesystem.Path.CurrentOS (decodeString)
import System.Environment (getEnv)
import System.IO.Error (IOError)
edit in daemon/Main.hs at line 16

[4.10247]→[4.7934:8174](∅→∅),[4.8174]→[4.10341:10342](∅→∅),[4.10341]→[4.10341:10342](∅→∅),[4.10342]→[4.8175:8304](∅→∅),[4.8304]→[4.10419:10420](∅→∅),[4.10419]→[4.10419:10420](∅→∅)

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

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

[4.1381]→[4.8305:8491](∅→∅)

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

[4.1381]

[4.10595]

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

[4.1901]→[4.34:64](∅→∅),[4.34]→[4.34:64](∅→∅),[4.64]→[4.8495:8775](∅→∅),[4.41]→[4.135:162](∅→∅),[4.85]→[4.135:162](∅→∅),[4.8775]→[4.135:162](∅→∅),[4.135]→[4.135:162](∅→∅)

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

[4.5192]

[4.26]

import Aftok.Currency.Bitcoin
( satoshi,
ssub,
)
import Aftok.Types
( ProjectId,
UserId,
)
import Bippy.Types (Satoshi (..))
import Control.Lens
import Data.Hourglass (Seconds (..))
import Data.Ratio ((%))
import Data.Thyme.Clock as C
import Data.Thyme.Format ()
import Data.Traversable (for)
import Data.UUID
replacement in lib/Aftok/Auction.hs at line 22

[4.27]→[4.8776:9106](∅→∅),[4.9106]→[4.256:320](∅→∅)

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

[4.27]

[4.5213]

newtype AuctionId = AuctionId UUID deriving (Show, Eq)
edit in lib/Aftok/Auction.hs at line 24

[4.5214]→[4.21:76](∅→∅)

newtype AuctionId = AuctionId UUID deriving (Show, Eq)
replacement in lib/Aftok/Auction.hs at line 26

[4.5249]→[4.216:239](∅→∅),[4.239]→[4.3:184](∅→∅),[4.88]→[4.5319:5323](∅→∅),[4.165]→[4.5319:5323](∅→∅),[4.184]→[4.5319:5323](∅→∅),[4.189]→[4.5319:5323](∅→∅),[4.270]→[4.5319:5323](∅→∅),[4.351]→[4.5319:5323](∅→∅),[4.1676]→[4.5319:5323](∅→∅),[4.5319]→[4.5319:5323](∅→∅)

data Auction = Auction
{ _projectId :: ProjectId
, _initiator :: UserId
, _createdAt :: C.UTCTime
, _raiseAmount :: Satoshi
, _auctionStart :: C.UTCTime
, _auctionEnd :: C.UTCTime
}

[4.5249]

[4.166]

data Auction
= Auction
{ _projectId :: ProjectId,
_initiator :: UserId,
_createdAt :: C.UTCTime,
_raiseAmount :: Satoshi,
_auctionStart :: C.UTCTime,
_auctionEnd :: C.UTCTime
}
edit in lib/Aftok/Auction.hs at line 39

[4.50]

[4.50]
replacement in lib/Aftok/Auction.hs at line 42

[4.70]→[4.5324:5339](∅→∅),[4.188]→[4.5324:5339](∅→∅),[4.5324]→[4.5324:5339](∅→∅),[4.5339]→[4.89:142](∅→∅),[4.142]→[4.295:322](∅→∅),[4.322]→[4.1677:1706](∅→∅),[4.322]→[4.1677:1706](∅→∅),[4.165]→[4.1677:1706](∅→∅),[4.1706]→[4.57772:57796](∅→∅)

data Bid = Bid
{ _bidUser :: UserId
, _bidSeconds :: Seconds
, _bidAmount :: Satoshi
, _bidTime :: C.UTCTime
} deriving (Eq, Show)

[4.70]

[4.258]

data Bid
= Bid
{ _bidUser :: UserId,
_bidSeconds :: Seconds,
_bidAmount :: Satoshi,
_bidTime :: C.UTCTime
}
deriving (Eq, Show)
replacement in lib/Aftok/Auction.hs at line 53

[4.276]→[4.190:219](∅→∅),[4.219]→[4.352:382](∅→∅),[4.382]→[4.239:273](∅→∅),[4.239]→[4.239:273](∅→∅),[4.273]→[4.383:417](∅→∅),[4.417]→[4.306:310](∅→∅),[4.306]→[4.306:310](∅→∅)

data Commitment = Commitment
{ _baseBid :: Bid
, _commitmentSeconds :: Seconds
, _commitmentAmount :: Satoshi
}

[4.276]

[4.310]

data Commitment
= Commitment
{ _baseBid :: Bid,
_commitmentSeconds :: Seconds,
_commitmentAmount :: Satoshi
}
replacement in lib/Aftok/Auction.hs at line 70

[4.9309]→[4.9309:9449](∅→∅)

where
secs bid = toRational $ bid ^. bidSeconds
btc bid = toRational $ bid ^. bidAmount . satoshi
costRatio bid = secs bid / btc bid

[4.9309]

[4.293]

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 81

[4.443]→[4.9450:9727](∅→∅),[4.63]→[4.652:653](∅→∅),[4.227]→[4.652:653](∅→∅),[4.281]→[4.652:653](∅→∅),[4.470]→[4.652:653](∅→∅),[4.582]→[4.652:653](∅→∅),[4.2463]→[4.652:653](∅→∅),[4.9727]→[4.652:653](∅→∅),[4.652]→[4.652:653](∅→∅),[4.653]→[4.9728:10199](∅→∅),[4.10199]→[4.437:438](∅→∅),[4.1106]→[4.437:438](∅→∅),[4.438]→[4.10200:10230](∅→∅),[4.10230]→[4.444:445](∅→∅),[4.1147]→[4.444:445](∅→∅),[4.445]→[4.10231:10423](∅→∅)

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
|

-- 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
= []

takeWinningBids _ [] = []

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

[4.443]

[4.653]

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
| -- 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 =
[]
takeWinningBids _ [] = []
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

[4.502]→[4.2959:3009](∅→∅),[4.3009]→[4.10424:10539](∅→∅),[4.10539]→[4.664:665](∅→∅),[4.664]→[4.664:665](∅→∅)

x | x <> (bid ^. bidAmount) < raiseAmount' ->
put (x <> bid ^. bidAmount)
>> (pure . Just $ Commitment bid (bid ^. bidSeconds) (bid ^. bidAmount))

[4.502]

[4.665]

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

[4.735]→[4.735:763](∅→∅),[4.763]→[4.1645:1704](∅→∅),[4.1704]→[4.10540:10581](∅→∅)

x | x < raiseAmount' ->
let winFraction r = r % (bid ^. bidAmount . satoshi)
remainderSeconds (Satoshi r) =

[4.735]

[4.10581]

x
| x < raiseAmount' ->
let winFraction r = r % (bid ^. bidAmount . satoshi)
remainderSeconds (Satoshi r) =
replacement in lib/Aftok/Auction.hs at line 117

[4.1812]→[4.3222:3276](∅→∅),[4.10662]→[4.3222:3276](∅→∅),[4.3222]→[4.3222:3276](∅→∅),[4.3276]→[4.10663:10776](∅→∅),[4.3387]→[4.1074:1075](∅→∅),[4.10776]→[4.1074:1075](∅→∅),[4.1074]→[4.1074:1075](∅→∅)

in for (raiseAmount' `ssub` x) $ \remainder ->
put (x <> remainder)
*> (pure $ Commitment bid (remainderSeconds remainder) remainder)

[4.10662]

[4.455]

in for (raiseAmount' `ssub` x) $ \remainder ->
put (x <> remainder)
*> (pure $ Commitment bid (remainderSeconds remainder) remainder)
edit in lib/Aftok/Auction.hs at line 122

[4.1116]→[4.1116:1117](∅→∅)
replacement in lib/Aftok/Billing.hs at line 1

[4.760]→[4.3:73](∅→∅)

{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}

[4.760]

[4.981]

{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
replacement in lib/Aftok/Billing.hs at line 4

[4.1016]→[4.75:110](∅→∅),[4.110]→[4.74:109](∅→∅),[4.1016]→[4.74:109](∅→∅)

{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE TemplateHaskell #-}

[4.1016]

[4.794]

{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE TemplateHaskell #-}
edit in lib/Aftok/Billing.hs at line 8

[2.429]→[4.824:825](∅→∅),[4.824]→[4.824:825](∅→∅),[4.856]→[4.856:857](∅→∅),[4.857]→[4.1814:1815](∅→∅),[4.1815]→[4.110:191](∅→∅),[4.857]→[4.110:191](∅→∅),[4.177]→[4.1017:1056](∅→∅),[4.235]→[4.1017:1056](∅→∅),[4.59]→[4.1017:1056](∅→∅),[4.1056]→[4.236:275](∅→∅),[4.275]→[4.1056:1083](∅→∅),[4.1056]→[4.1056:1083](∅→∅)

import Control.Lens (makeLenses, makePrisms, preview, view, _Just)
import Data.Thyme.Clock as C
import Data.Thyme.Time as T
import Data.UUID
replacement in lib/Aftok/Billing.hs at line 9

[4.915]→[4.3556:3661](∅→∅)

import Aftok.Types (UserId, ProjectId, Email)
import Bippy.Types (Satoshi)

[4.915]

[4.981]

import Aftok.Types (Email, ProjectId, UserId)
import Bippy.Types (Satoshi)
import Control.Lens (_Just, makeLenses, makePrisms, preview, view)
import Data.Thyme.Clock as C
import Data.Thyme.Time as T
import Data.UUID
edit in lib/Aftok/Billing.hs at line 17

[4.1039]

[4.188]
replacement in lib/Aftok/Billing.hs at line 23

[4.199]→[4.199:217](∅→∅),[4.217]→[4.1109:1124](∅→∅),[4.1109]→[4.1109:1124](∅→∅)

-- | SemiMonthly
| Weekly Int

[4.199]

[4.213]

| -- | SemiMonthly
Weekly Int
edit in lib/Aftok/Billing.hs at line 26

[4.225]

[4.1236]
replacement in lib/Aftok/Billing.hs at line 30

[4.267]→[4.226:266](∅→∅)

recurrenceName Annually = "annually"

[4.267]

[4.305]

recurrenceName Annually = "annually"
replacement in lib/Aftok/Billing.hs at line 33

[4.263]→[4.387:425](∅→∅),[4.387]→[4.387:425](∅→∅),[4.425]→[4.267:306](∅→∅)

recurrenceName (Weekly _) = "weekly"
recurrenceName OneTime = "onetime"

[4.263]

[4.462]

recurrenceName (Weekly _) = "weekly"
recurrenceName OneTime = "onetime"
replacement in lib/Aftok/Billing.hs at line 37

[4.506]→[4.307:345](∅→∅)

recurrenceCount Annually = Nothing

[4.506]

[4.541]

recurrenceCount Annually = Nothing
replacement in lib/Aftok/Billing.hs at line 40

[4.304]→[4.616:653](∅→∅),[4.616]→[4.616:653](∅→∅),[4.653]→[4.346:384](∅→∅)

recurrenceCount (Weekly i) = Just i
recurrenceCount OneTime = Nothing

[4.304]

[4.688]

recurrenceCount (Weekly i) = Just i
recurrenceCount OneTime = Nothing
replacement in lib/Aftok/Billing.hs at line 58

[4.1085]→[4.1085:1117](∅→∅),[4.1117]→[4.410:638](∅→∅),[4.638]→[4.305:357](∅→∅),[4.1289]→[4.305:357](∅→∅),[4.357]→[4.10662:10755](∅→∅),[4.357]→[4.1342:1346](∅→∅),[4.10755]→[4.1342:1346](∅→∅),[4.1342]→[4.1342:1346](∅→∅)

data Billable' p u c = Billable
{ _project :: p
, _creator :: u
, _name :: Text
, _description :: Text
, _recurrence :: Recurrence
, _amount :: c
, _gracePeriod :: Days
, _requestExpiryPeriod :: Maybe C.NominalDiffTime
, _paymentRequestEmailTemplate :: Maybe Text
, _paymentRequestMemoTemplate :: Maybe Text
}

[4.1085]

[4.1346]

data Billable' p u c
= Billable
{ _project :: p,
_creator :: u,
_name :: Text,
_description :: Text,
_recurrence :: Recurrence,
_amount :: c,
_gracePeriod :: Days,
_requestExpiryPeriod :: Maybe C.NominalDiffTime,
_paymentRequestEmailTemplate :: Maybe Text,
_paymentRequestMemoTemplate :: Maybe Text
}
edit in lib/Aftok/Billing.hs at line 77

[4.1029]

[4.34]
replacement in lib/Aftok/Billing.hs at line 83

[4.1424]→[4.111:149](∅→∅),[4.149]→[4.3707:3867](∅→∅),[4.3867]→[4.3491:3495](∅→∅),[4.694]→[4.3491:3495](∅→∅)

data Subscription' u b = Subscription
{ _customer :: u
, _billable :: b
, _contactChannel :: ContactChannel
, _startTime :: C.UTCTime
, _endTime :: Maybe C.UTCTime
}

[4.1424]

[4.1586]

data Subscription' u b
= Subscription
{ _customer :: u,
_billable :: b,
_contactChannel :: ContactChannel,
_startTime :: C.UTCTime,
_endTime :: Maybe C.UTCTime
}
replacement in lib/Aftok/Billing.hs at line 98

[4.724]→[4.478:526](∅→∅),[4.478]→[4.478:526](∅→∅)

Annually -> Just . T.addGregorianYearsClip 1

[4.724]

[4.526]

Annually -> Just . T.addGregorianYearsClip 1
replacement in lib/Aftok/Billing.hs at line 100

[4.575]→[4.575:644](∅→∅)

Weekly w -> Just . T.addDays (w * 7)
OneTime -> const Nothing

[4.575]

[4.644]

Weekly w -> Just . T.addDays (w * 7)
OneTime -> const Nothing
edit in lib/Aftok/Billing.hs at line 112

[4.620]→[4.962:963](∅→∅),[4.962]→[4.962:963](∅→∅)
edit in lib/Aftok/Billing.hs at line 116

[4.788]→[4.1138:1139](∅→∅),[4.1138]→[4.1138:1139](∅→∅),[4.1199]→[4.1199:1202](∅→∅)
replacement in lib/Aftok/Config.hs at line 5

[4.10875]→[4.10778:10944](∅→∅),[4.10944]→[4.10914:10966](∅→∅),[4.10914]→[4.10914:10966](∅→∅),[4.10966]→[4.3497:3549](∅→∅),[4.3549]→[4.11019:11046](∅→∅),[4.11019]→[4.11019:11046](∅→∅),[4.11046]→[4.10945:11476](∅→∅)

import Control.Lens ( makeClassy
, (^.)
)
import qualified Data.Configurator as C
import qualified Data.Configurator.Types as C
import Data.X509
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 )

[4.10875]

[4.11258]

import Aftok.Currency.Bitcoin (NetworkMode)
import Aftok.Payments (PaymentsConfig (..))
import qualified Bippy.Types as BT
import Control.Lens
( (^.),
makeClassy,
)
import qualified Data.Configurator as C
import qualified Data.Configurator.Types as C
import Data.X509
import Data.X509.File
( readKeyFile,
readSignedObject,
)
import Database.PostgreSQL.Simple (ConnectInfo (..))
import Filesystem.Path.CurrentOS
( encodeString,
fromText,
)
import qualified Filesystem.Path.CurrentOS as P
import qualified Network.Mail.SMTP as SMTP
import qualified Network.Socket as NS
import Safe (headMay)
replacement in lib/Aftok/Config.hs at line 29

[4.11259]→[4.790:843](∅→∅),[4.843]→[4.11312:11421](∅→∅),[4.57884]→[4.11312:11421](∅→∅),[4.11312]→[4.11312:11421](∅→∅),[4.11421]→[4.11477:11612](∅→∅)

import qualified Bippy.Types as BT
import qualified Network.Mail.SMTP as SMTP
import qualified Network.Socket as NS

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

[4.11259]

[4.11464]

data SmtpConfig
= SmtpConfig
{ _smtpHost :: NS.HostName,
_smtpPort :: Maybe NS.PortNumber,
_smtpUser :: SMTP.UserName,
_smtpPass :: SMTP.Password
}
edit in lib/Aftok/Config.hs at line 37

[4.11465]→[4.11465:11626](∅→∅)

data SmtpConfig = SmtpConfig
{ _smtpHost :: NS.HostName
, _smtpPort :: Maybe NS.PortNumber
, _smtpUser :: SMTP.UserName
, _smtpPass :: SMTP.Password
}
replacement in lib/Aftok/Config.hs at line 39

[4.11651]→[4.11651:11686](∅→∅),[4.11686]→[4.3749:3792](∅→∅),[4.3792]→[4.1966:2050](∅→∅),[4.2050]→[4.11808:11846](∅→∅),[4.11808]→[4.11808:11846](∅→∅),[4.11846]→[4.3793:3797](∅→∅)

data BillingConfig = BillingConfig
{ _networkMode :: NetworkMode
, _signingKeyFile :: P.FilePath
, _certsFile :: P.FilePath
, _exchangeRateServiceURI :: String
}

[4.11651]

[4.11851]

data BillingConfig
= BillingConfig
{ _networkMode :: NetworkMode,
_signingKeyFile :: P.FilePath,
_certsFile :: P.FilePath,
_exchangeRateServiceURI :: String
}
replacement in lib/Aftok/Config.hs at line 76

[4.12946]→[4.12946:13011](∅→∅)

privKeys <- readKeyFile . encodeString $ c ^. signingKeyFile

[4.12946]

[4.13011]

privKeys <- readKeyFile . encodeString $ c ^. signingKeyFile
replacement in lib/Aftok/Config.hs at line 78

[4.13076]→[4.12158:12199](∅→∅)

privKey <- case headMay privKeys of

[4.13076]

[4.13114]

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

[4.12214]→[4.12214:12407](∅→∅)

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

[4.12214]

[4.13343]

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 2

[4.4317]→[4.4317:4405](∅→∅)

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TemplateHaskell #-}

[4.4317]

[4.4405]

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TemplateHaskell #-}
replacement in lib/Aftok/Currency/Bitcoin.hs at line 7

[4.4443]→[4.2053:2054](∅→∅),[4.2054]→[4.12410:12462](∅→∅),[4.12462]→[4.4520:4550](∅→∅),[4.4520]→[4.4520:4550](∅→∅),[4.4550]→[4.846:910](∅→∅),[4.910]→[4.57943:57978](∅→∅),[4.57943]→[4.57943:57978](∅→∅)

import qualified Data.Configurator.Types as C
import Control.Lens
import Bippy.Types ( Satoshi(..) )
import Haskoin.Constants

[4.4443]

[4.4645]

import Bippy.Types (Satoshi (..))
import Control.Lens
import qualified Data.Configurator.Types as C
import Haskoin.Constants
replacement in lib/Aftok/Currency/Bitcoin.hs at line 17

[4.4839]→[4.12528:12575](∅→∅)

ssub _ _ = Nothing

[4.4839]

[4.4858]

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

[4.5115]→[4.12576:12595](∅→∅)

_ -> Nothing

[4.5115]

[4.5130]

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

[4.5298]→[4.12596:12616](∅→∅)

_ -> Nothing

[4.5298]

[4.5313]

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

[4.5398]→[4.12617:12650](∅→∅)

convert _ = Nothing

[4.5398]

[4.5420]

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

[4.5668]→[4.12651:12675](∅→∅)

"btc" -> Just BTC

[4.5668]

[4.5688]

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

[4.5712]→[4.12676:12700](∅→∅)

"bch" -> Just BCH

[4.5712]

[4.5732]

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

[4.5756]→[4.12701:12724](∅→∅)

_ -> Nothing

[4.5756]

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

[4.428]→[4.429:465](∅→∅)

{-# LANGUAGE TemplateHaskell #-}

[4.428]

[4.465]

{-# LANGUAGE TemplateHaskell #-}
replacement in lib/Aftok/Currency/Zcash.hs at line 4

[4.494]→[4.494:519](∅→∅),[4.519]→[2.432:477](∅→∅),[2.477]→[4.538:559](∅→∅),[4.538]→[4.538:559](∅→∅),[4.559]→[2.478:529](∅→∅),[2.529]→[4.559:590](∅→∅),[4.559]→[4.559:590](∅→∅)

( ZAddr(..)
, _ZAddr
, RPCError(..)
, ZValidateAddressErr(..)
, ZcashdConfig(..)
, Zatoshi
, ToZatoshi(..)
, rpcAddViewingKey
, rpcValidateZAddr
) where

[4.494]

[4.590]

( ZAddr (..),
_ZAddr,
RPCError (..),
ZValidateAddressErr (..),
ZcashdConfig (..),
Zatoshi,
ToZatoshi (..),
rpcAddViewingKey,
rpcValidateZAddr,
)
where
replacement in lib/Aftok/Currency/Zcash.hs at line 16

[4.591]→[2.530:588](∅→∅),[2.588]→[4.591:654](∅→∅),[4.591]→[4.591:654](∅→∅),[4.654]→[2.589:648](∅→∅),[2.648]→[4.654:912](∅→∅),[4.654]→[4.654:912](∅→∅)

import Control.Exception ( catch )
import Control.Lens ( makePrisms )
import Control.Monad.Trans.Except ( except )

import qualified Data.Aeson as A
import Data.Aeson ( Value, (.=), (.:), (.:?), object, encode )
import Data.Aeson.Types ( Parser )
import qualified Data.Text.Encoding as T

[4.591]

[4.912]

import Control.Exception (catch)
import Control.Lens (makePrisms)
import Control.Monad.Trans.Except (except)
import Data.Aeson ((.:), (.:?), (.=), Value, encode, object)
import qualified Data.Aeson as A
import Data.Aeson.Types (Parser)
import qualified Data.Text.Encoding as T
import Network.HTTP.Client
( HttpException,
Manager,
RequestBody (..),
applyBasicAuth,
defaultRequest,
host,
httpLbs,
method,
port,
requestBody,
responseBody,
responseStatus,
)
import Network.HTTP.Types (Status, statusCode)
edit in lib/Aftok/Currency/Zcash.hs at line 39

[4.913]→[4.913:1037](∅→∅),[4.1037]→[2.649:713](∅→∅),[2.713]→[4.1037:1370](∅→∅),[4.1037]→[4.1037:1370](∅→∅),[4.1370]→[2.714:779](∅→∅),[2.779]→[4.1370:1491](∅→∅),[4.1370]→[4.1370:1491](∅→∅),[4.1491]→[2.780:781](∅→∅)

import Network.HTTP.Client ( Manager
, RequestBody(..)
, HttpException
, defaultRequest
, responseBody
, responseStatus
, httpLbs
, host, port, method, requestBody
, applyBasicAuth
)
import Network.HTTP.Types ( Status, statusCode )
replacement in lib/Aftok/Currency/Zcash.hs at line 45

[4.1492]→[4.1492:1536](∅→∅)

newtype ZAddr = ZAddr { zaddrText :: Text }

[4.1492]

[4.1536]

newtype ZAddr = ZAddr {zaddrText :: Text}
edit in lib/Aftok/Currency/Zcash.hs at line 47

[4.1563]

[4.1563]
edit in lib/Aftok/Currency/Zcash.hs at line 52

[2.922]

[2.922]
replacement in lib/Aftok/Currency/Zcash.hs at line 66

[4.1622]→[4.1622:1700](∅→∅),[4.1700]→[2.1114:1158](∅→∅),[2.1158]→[4.1700:1704](∅→∅),[4.1700]→[4.1700:1704](∅→∅)

data ZcashdConfig = ZcashdConfig
{ zcashdHost :: Text
, zcashdPort :: Int
, rpcUser :: Text
, rpcPassword :: Text
}

[4.1622]

[2.1159]

data ZcashdConfig
= ZcashdConfig
{ zcashdHost :: Text,
zcashdPort :: Int,
rpcUser :: Text,
rpcPassword :: Text
}
replacement in lib/Aftok/Currency/Zcash.hs at line 75

[2.1181]→[2.1181:1241](∅→∅)

ZValidateAddress :: Text -> RPCCall ZValidateAddressResp

[2.1181]

[2.1241]

ZValidateAddress :: Text -> RPCCall ZValidateAddressResp
replacement in lib/Aftok/Currency/Zcash.hs at line 92

[2.1690]→[2.1690:2154](∅→∅)

let req = applyBasicAuth (T.encodeUtf8 $ rpcUser cfg) (T.encodeUtf8 $ rpcPassword cfg) $
defaultRequest { host = T.encodeUtf8 $ zcashdHost cfg
, port = zcashdPort cfg
, method = "POST"
, requestBody = RequestBodyLBS . encode $ toRequestBody call
}

response <- ExceptT $ catch
(Right <$> httpLbs req mgr)
(pure . Left . HttpError)

[2.1690]

[2.2154]

let req =
applyBasicAuth (T.encodeUtf8 $ rpcUser cfg) (T.encodeUtf8 $ rpcPassword cfg) $
defaultRequest
{ host = T.encodeUtf8 $ zcashdHost cfg,
port = zcashdPort cfg,
method = "POST",
requestBody = RequestBodyLBS . encode $ toRequestBody call
}
response <-
ExceptT $
catch
(Right <$> httpLbs req mgr)
(pure . Left . HttpError)
replacement in lib/Aftok/Currency/Zcash.hs at line 108

[2.2299]→[2.2299:2337](∅→∅)

_ -> Left (ServiceError status)

[2.2299]

[2.2337]

_ -> Left (ServiceError status)
replacement in lib/Aftok/Currency/Zcash.hs at line 118

[2.2427]→[2.2427:2571](∅→∅)

data ZValidateAddressResp = ZValidateAddressResp
{ vzrIsValid :: Bool
--, vzrAddress :: Maybe Text
, vzrAddrType :: Maybe ZAddrType
}

[2.2427]

[2.2571]

data ZValidateAddressResp
= ZValidateAddressResp
{ vzrIsValid :: Bool,
--, vzrAddress :: Maybe Text
vzrAddrType :: Maybe ZAddrType
}
replacement in lib/Aftok/Currency/Zcash.hs at line 129

[4.1857]→[4.1857:2053](∅→∅)

validateZAddrRequest addr = object
[ "jsonrpc" .= ("1.0" :: Text)
, "id" .= ("aftok-z_validateaddress" :: Text)
, "method" .= ("z_validateaddress" :: Text)
, "params" .= [addr]
]

[4.1857]

[4.2053]

validateZAddrRequest addr =
object
[ "jsonrpc" .= ("1.0" :: Text),
"id" .= ("aftok-z_validateaddress" :: Text),
"method" .= ("z_validateaddress" :: Text),
"params" .= [addr]
]
replacement in lib/Aftok/Currency/Zcash.hs at line 154

[2.3125]→[2.3125:3222](∅→∅),[2.3222]→[4.2755:2756](∅→∅),[4.2755]→[4.2755:2756](∅→∅)

-- <*> res .:? "address"
<*> parseAddrType res

[2.3125]

[4.2756]

-- <*> res .:? "address"
<*> parseAddrType res
replacement in lib/Aftok/Currency/Zcash.hs at line 162

[2.3425]→[2.3425:3601](∅→∅)

except $ if vzrIsValid resp
then
case vzrAddrType resp of
Nothing -> Left (RPCError DataMissing)
Just Sprout -> Left (RPCError SproutAddress)

[2.3425]

[2.3601]

except $
if vzrIsValid resp
then case vzrAddrType resp of
Nothing -> Left (RPCError DataMissing)
Just Sprout -> Left (RPCError SproutAddress)
replacement in lib/Aftok/Currency/Zcash.hs at line 168

[2.3644]→[2.3644:3688](∅→∅)

else
Left $ RPCError ZAddrInvalid

[2.3644]

[4.2834]

else Left $ RPCError ZAddrInvalid
replacement in lib/Aftok/Currency/Zcash.hs at line 172

[4.3241]→[2.3706:3814](∅→∅)

data ZImportViewingKeyResp = ZImportViewingKeyResp
{ addressType :: ZAddrType
-- , address :: ZAddr
}

[4.3241]

[2.3814]

data ZImportViewingKeyResp
= ZImportViewingKeyResp
{ addressType :: ZAddrType
-- , address :: ZAddr
}
replacement in lib/Aftok/Currency/Zcash.hs at line 183

[2.4045]→[2.4045:4085](∅→∅)

-- <*> (ZAddr <$> v .: "address")

[2.4045]

[2.4085]

-- <*> (ZAddr <$> v .: "address")
edit in lib/Aftok/Currency/Zcash.hs at line 186

[2.4164]→[2.4164:4165](∅→∅)
replacement in lib/Aftok/Currency/Zcash.hs at line 194

[2.4350]→[2.4350:4592](∅→∅)

importViewingKeyRequest vk = object
[ "jsonrpc" .= ("1.0" :: Text)
, "id" .= ("aftok-z_importviewingkey" :: Text)
, "method" .= ("z_importviewingkey" :: Text)
, "params" .= [vk, "no"] -- no need to rescan, for our purposes
]

[2.4350]

[2.4592]

importViewingKeyRequest vk =
object
[ "jsonrpc" .= ("1.0" :: Text),
"id" .= ("aftok-z_importviewingkey" :: Text),
"method" .= ("z_importviewingkey" :: Text),
"params" .= [vk, "no"] -- no need to rescan, for our purposes
]
edit in lib/Aftok/Currency/Zcash.hs at line 208

[2.4901]→[2.4901:4906](∅→∅)
replacement in lib/Aftok/Currency.hs at line 3

[4.5838]→[4.12726:12843](∅→∅)

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

[4.5838]

[4.5917]

import Data.Aeson (Value)
import Data.Aeson.Types (Parser)
replacement in lib/Aftok/Currency.hs at line 6

[4.5918]→[4.5918:6011](∅→∅)

data Network a = Network
{ addressFromJSON :: Parser a
, addressToJSON :: a -> Value
}

[4.5918]

data Network a
= Network
{ addressFromJSON :: Parser a,
addressToJSON :: a -> Value
}
replacement in lib/Aftok/Database/PostgreSQL/Types.hs at line 3

[4.6120]→[4.12847:13268](∅→∅)

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

[4.6120]

[4.6367]

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

[4.6368]→[4.6368:6453](∅→∅)

newtype SerDepFunction = SerDepFunction { unSerDepFunction :: DepreciationFunction }

[4.6368]

[4.6453]

newtype SerDepFunction = SerDepFunction {unSerDepFunction :: DepreciationFunction}
replacement in lib/Aftok/Database/PostgreSQL.hs at line 1

[4.456]→[4.849:893](∅→∅)

{-# LANGUAGE GADTs #-}

[4.456]

[4.893]

{-# LANGUAGE GADTs #-}
replacement in lib/Aftok/Database/PostgreSQL.hs at line 3

[4.937]→[4.2059:2103](∅→∅),[4.2103]→[4.13497:13541](∅→∅),[4.937]→[4.13497:13541](∅→∅)

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE QuasiQuotes #-}

[4.937]

[4.565]

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE QuasiQuotes #-}
replacement in lib/Aftok/Database/PostgreSQL.hs at line 7

[4.13303]→[4.13303:13328](∅→∅)

( QDBM(..)
, runQDBM

[4.13303]

[4.13328]

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

[4.623]→[4.13339:13396](∅→∅),[4.2172]→[4.969:999](∅→∅),[4.6734]→[4.969:999](∅→∅),[4.13396]→[4.969:999](∅→∅),[4.969]→[4.969:999](∅→∅),[4.999]→[4.57981:58040](∅→∅),[4.58040]→[4.13627:13967](∅→∅),[4.13627]→[4.13627:13967](∅→∅),[4.13967]→[4.1165:1197](∅→∅),[4.1165]→[4.1165:1197](∅→∅),[4.1197]→[4.13968:14316](∅→∅),[4.14316]→[4.329:381](∅→∅),[4.381]→[4.14316:14368](∅→∅),[4.14316]→[4.14316:14368](∅→∅),[4.14368]→[4.1315:1348](∅→∅),[4.1315]→[4.1315:1348](∅→∅),[4.1348]→[4.14369:14426](∅→∅),[4.14426]→[4.1409:1453](∅→∅),[4.1409]→[4.1409:1453](∅→∅),[4.1453]→[4.1033:1087](∅→∅),[4.1087]→[4.1507:1559](∅→∅),[4.1827]→[4.1507:1559](∅→∅),[4.1507]→[4.1507:1559](∅→∅),[4.1559]→[4.14427:14700](∅→∅)

import Prelude hiding ( null )
import Control.Lens
import Control.Monad.Trans.Except ( throwE )
import Crypto.Random.Types ( MonadRandom
, getRandomBytes
)
import Data.Aeson ( Value
, toJSON
)
import Data.Hourglass
import qualified Data.List as L
import Data.ProtocolBuffers ( decodeMessage
, encodeMessage
)
import Data.Serialize.Get ( runGet )
import Data.Serialize.Put ( runPut )
import qualified Data.Text as T
import Data.Thyme.Clock as C
import Data.Thyme.Time
import Data.UUID ( UUID )
import Database.PostgreSQL.Simple
import Database.PostgreSQL.Simple.FromField
import Database.PostgreSQL.Simple.FromRow
import Database.PostgreSQL.Simple.SqlQQ
( sql )
import Database.PostgreSQL.Simple.Types
( Null )
import Safe ( headMay )

[4.623]

[4.1011]

import qualified Aftok.Auction as A
import qualified Aftok.Billing as B
import Aftok.Currency.Bitcoin
import Aftok.Currency.Zcash (ZAddr (..), _ZAddr)
import Aftok.Database
import Aftok.Database.PostgreSQL.Types
( SerDepFunction (..),
)
import Aftok.Interval
import Aftok.Json
( billableJSON,
createSubscriptionJSON,
paymentJSON,
paymentRequestJSON,
)
import Aftok.Payments.Types
import qualified Aftok.Project as P
import Aftok.TimeLog
import Aftok.Types
import Bippy.Types (Satoshi (..))
import Control.Lens
import Control.Monad.Trans.Except (throwE)
import Crypto.Random.Types
( MonadRandom,
getRandomBytes,
)
import Data.Aeson
( Value,
toJSON,
)
import Data.Hourglass
import qualified Data.List as L
import Data.ProtocolBuffers
( decodeMessage,
encodeMessage,
)
import Data.Serialize.Get (runGet)
import Data.Serialize.Put (runPut)
import qualified Data.Text as T
import Data.Thyme.Clock as C
import Data.Thyme.Time
import Data.UUID (UUID)
import Database.PostgreSQL.Simple
import Database.PostgreSQL.Simple.FromField
import Database.PostgreSQL.Simple.FromRow
import Database.PostgreSQL.Simple.SqlQQ
( sql,
)
import Database.PostgreSQL.Simple.Types
( Null,
)
import Haskoin.Address
( Address,
addrToText,
textToAddr,
)
import Haskoin.Constants (Network)
import Safe (headMay)
import Prelude hiding (null)
edit in lib/Aftok/Database/PostgreSQL.hs at line 72

[4.1012]→[4.14701:14753](∅→∅),[4.14753]→[2.4909:4961](∅→∅),[2.4961]→[4.6735:6775](∅→∅),[4.14805]→[4.6735:6775](∅→∅),[4.1722]→[4.6735:6775](∅→∅),[4.6775]→[4.3818:3886](∅→∅),[4.203]→[4.1614:1646](∅→∅),[4.535]→[4.1614:1646](∅→∅),[4.1207]→[4.1614:1646](∅→∅),[4.1369]→[4.1614:1646](∅→∅),[4.1722]→[4.1614:1646](∅→∅),[4.3886]→[4.1614:1646](∅→∅),[4.6775]→[4.1614:1646](∅→∅),[4.1614]→[4.1614:1646](∅→∅),[4.1646]→[4.14806:14926](∅→∅),[4.6851]→[4.1646:1678](∅→∅),[4.14926]→[4.1646:1678](∅→∅),[4.1646]→[4.1646:1678](∅→∅),[4.1678]→[4.14927:15244](∅→∅),[4.15244]→[4.1085:1123](∅→∅),[4.1085]→[4.1085:1123](∅→∅),[4.1123]→[4.15245:15297](∅→∅),[4.240]→[4.1678:1738](∅→∅),[4.595]→[4.1678:1738](∅→∅),[4.1082]→[4.1678:1738](∅→∅),[4.1339]→[4.1678:1738](∅→∅),[4.15297]→[4.1678:1738](∅→∅),[4.1678]→[4.1678:1738](∅→∅),[4.1738]→[4.913:1035](∅→∅),[4.1035]→[4.58147:58269](∅→∅),[4.58147]→[4.58147:58269](∅→∅),[4.58269]→[4.15546:15596](∅→∅),[4.15546]→[4.15546:15596](∅→∅),[4.15596]→[4.1036:1096](∅→∅),[4.476]→[4.1123:1124](∅→∅),[4.476]→[4.1123:1124](∅→∅),[4.1096]→[4.1123:1124](∅→∅),[4.1201]→[4.1123:1124](∅→∅),[4.1738]→[4.1123:1124](∅→∅),[4.7076]→[4.1123:1124](∅→∅),[4.15656]→[4.1123:1124](∅→∅),[4.58322]→[4.1123:1124](∅→∅),[4.1101]→[4.1123:1124](∅→∅)

import qualified Aftok.Auction as A
import qualified Aftok.Billing as B
import Aftok.Currency.Bitcoin
import Aftok.Currency.Zcash (ZAddr(..), _ZAddr)
import Aftok.Database
import Aftok.Database.PostgreSQL.Types
( SerDepFunction(..) )
import Aftok.Interval
import Aftok.Json ( billableJSON
, createSubscriptionJSON
, paymentJSON
, paymentRequestJSON
)
import Aftok.Payments.Types
import qualified Aftok.Project as P
import Aftok.TimeLog
import Aftok.Types
import Bippy.Types ( Satoshi(..) )
import Haskoin.Address ( Address
, textToAddr
, addrToText
)
import Haskoin.Constants ( Network )
replacement in lib/Aftok/Database/PostgreSQL.hs at line 96

[4.7497]→[4.15671:15795](∅→∅)

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

[4.7497]

[4.15795]

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

[4.7761]→[4.15820:15890](∅→∅)

address <- fieldWith $ addrFieldParser (toNetwork mode networkId)

[4.7761]

[4.7829]

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

[4.58363]→[4.1097:1307](∅→∅)

let err = returnError
ConversionFailed
f
( "could not deserialize value "
<> T.unpack fieldValue
<> " to a valid BTC address for network "
<> show n
)

[4.58363]

[4.2131]

let err =
returnError
ConversionFailed
f
( "could not deserialize value "
<> T.unpack fieldValue
<> " to a valid BTC address for network "
<> show n
)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 138

[4.1923]→[4.16036:16250](∅→∅)

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

[4.1923]

[4.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 153

[4.294]→[4.16313:16405](∅→∅)

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

[4.294]

[4.4201]

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

[4.4400]→[4.1308:1421](∅→∅),[4.1421]→[4.1464:1541](∅→∅),[4.1541]→[4.1495:1735](∅→∅),[4.1495]→[4.1495:1735](∅→∅)

where
parser :: Text -> RowParser (CreditTo (NetworkId, Address))
parser = \case
"credit_to_address" ->
CreditToCurrency <$> (btcAddressParser mode <* nullField <* nullField)
"credit_to_user" ->
CreditToUser <$> (nullField *> nullField *> idParser UserId <* nullField)
"credit_to_project" ->
CreditToProject
<$> (nullField *> nullField *> nullField *> idParser ProjectId)
_ -> empty

[4.4400]

[4.1409]

where
parser :: Text -> RowParser (CreditTo (NetworkId, Address))
parser = \case
"credit_to_address" ->
CreditToCurrency <$> (btcAddressParser mode <* nullField <* nullField)
"credit_to_user" ->
CreditToUser <$> (nullField *> nullField *> idParser UserId <* nullField)
"credit_to_project" ->
CreditToProject
<$> (nullField *> nullField *> nullField *> idParser ProjectId)
_ -> empty
replacement in lib/Aftok/Database/PostgreSQL.hs at line 179

[4.2598]→[4.17143:17228](∅→∅)

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

[4.2598]

[4.9084]

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

[4.17557]→[4.1585:1749](∅→∅)

<*> (
(maybe empty pure =<< fmap (RecoverByEmail . Email) <$> field)
<|>
(maybe empty pure =<< fmap (RecoverByZAddr . ZAddr) <$> field)
)

[4.17557]

[4.3061]

<*> ( (maybe empty pure =<< fmap (RecoverByEmail . Email) <$> field)
<|> (maybe empty pure =<< fmap (RecoverByZAddr . ZAddr) <$> field)
)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 242

[4.2308]→[4.2308:2350](∅→∅)

"monthly" -> B.Monthly <$> field

[4.2308]

[4.2350]

"monthly" -> B.Monthly <$> field
replacement in lib/Aftok/Database/PostgreSQL.hs at line 244

[4.2408]→[4.2408:2527](∅→∅),[4.1420]→[4.3920:3941](∅→∅),[4.2246]→[4.3920:3941](∅→∅),[4.2527]→[4.3920:3941](∅→∅),[4.3920]→[4.3920:3941](∅→∅)

"weekly" -> B.Weekly <$> field
"onetime" -> nullField *> pure B.OneTime
_ -> empty
in field >>= prec

[4.2408]

[4.3941]

"weekly" -> B.Weekly <$> field
"onetime" -> nullField *> pure B.OneTime
_ -> empty
in field >>= prec
replacement in lib/Aftok/Database/PostgreSQL.hs at line 264

[4.18451]→[4.18451:18511](∅→∅)

<*> fmap toThyme field
<*> fmap toThyme field

[4.18451]

[4.2528]

<*> fmap toThyme field
<*> fmap toThyme field
replacement in lib/Aftok/Database/PostgreSQL.hs at line 283

[4.9533]→[4.2566:2605](∅→∅),[4.3186]→[4.2566:2605](∅→∅)

ids <- lift . lift $ query conn q d

[4.9533]

[4.1579]

ids <- lift . lift $ query conn q d
replacement in lib/Aftok/Database/PostgreSQL.hs at line 299

[4.532]→[4.263:264](∅→∅),[4.263]→[4.263:264](∅→∅),[4.264]→[4.18673:18813](∅→∅),[4.517]→[4.384:385](∅→∅),[4.623]→[4.384:385](∅→∅),[4.1089]→[4.384:385](∅→∅),[4.4268]→[4.384:385](∅→∅),[4.18813]→[4.384:385](∅→∅),[4.384]→[4.384:385](∅→∅),[4.385]→[4.18814:18936](∅→∅),[4.746]→[4.248:249](∅→∅),[4.18936]→[4.248:249](∅→∅),[4.248]→[4.248:249](∅→∅)

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

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

[4.532]

[4.747]

storeEvent (CreateSubscription uid bid t) =
Just $
storeEventJSON
(Just uid)
"create_subscription"
(createSubscriptionJSON uid bid t)
storeEvent (CreatePaymentRequest req) =
Just $
storeEventJSON Nothing "create_payment_request" (paymentRequestJSON req)
edit in lib/Aftok/Database/PostgreSQL.hs at line 310

[4.847]→[4.350:351](∅→∅),[4.350]→[4.350:351](∅→∅)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 339

[4.14581]→[4.19203:19250](∅→∅),[4.19250]→[4.95:123](∅→∅),[4.123]→[4.58364:58396](∅→∅),[4.58396]→[4.19284:19349](∅→∅),[4.19284]→[4.19284:19349](∅→∅)

( pid
, uid
, creditToName c
, renderNetworkId nid
, addrToText network addr
, eventName e
, fromThyme $ e ^. eventTime
, m

[4.14581]

[4.19349]

( pid,
uid,
creditToName c,
renderNetworkId nid,
addrToText network addr,
eventName e,
fromThyme $ e ^. eventTime,
m
replacement in lib/Aftok/Database/PostgreSQL.hs at line 348

[4.2276]→[4.762:763](∅→∅),[4.4546]→[4.762:763](∅→∅),[4.10338]→[4.762:763](∅→∅),[4.19357]→[4.762:763](∅→∅),[4.762]→[4.762:763](∅→∅),[4.763]→[4.19358:19438](∅→∅)

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

[4.19357]

[4.14644]

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

[4.14850]→[4.19439:19570](∅→∅),[4.974]→[4.1807:1808](∅→∅),[4.1090]→[4.1807:1808](∅→∅),[4.2557]→[4.1807:1808](∅→∅),[4.4908]→[4.1807:1808](∅→∅),[4.10601]→[4.1807:1808](∅→∅),[4.19570]→[4.1807:1808](∅→∅),[4.3405]→[4.1807:1808](∅→∅),[4.1808]→[4.19571:19648](∅→∅)

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

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

[4.14850]

[4.10662]

( pid,
uid,
creditToName c,
pid' ^. _ProjectId,
eventName e,
fromThyme $ e ^. eventTime,
m
)
CreditToUser uid' ->
pinsert
EventId
[sql| INSERT INTO work_events
replacement in lib/Aftok/Database/PostgreSQL.hs at line 371

[4.15099]→[4.19649:19777](∅→∅),[4.1230]→[4.3405:3406](∅→∅),[4.1714]→[4.3405:3406](∅→∅),[4.2097]→[4.3405:3406](∅→∅),[4.5259]→[4.3405:3406](∅→∅),[4.19777]→[4.3405:3406](∅→∅),[4.3405]→[4.3405:3406](∅→∅)

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

[4.15099]

[4.10817]

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

[4.10880]→[4.19778:19828](∅→∅),[4.19828]→[4.10926:10964](∅→∅),[4.10926]→[4.10926:10964](∅→∅)

headMay <$> pquery
(qdbLogEntryParser mode)
[sql| SELECT project_id, user_id,

[4.10880]

[4.565]

headMay
<$> pquery
(qdbLogEntryParser mode)
[sql| SELECT project_id, user_id,
replacement in lib/Aftok/Database/PostgreSQL.hs at line 389

[4.15373]→[4.5540:5555](∅→∅),[4.5540]→[4.5540:5555](∅→∅),[4.432]→[4.1083:1084](∅→∅),[4.2034]→[4.1083:1084](∅→∅),[4.2226]→[4.1083:1084](∅→∅),[4.5555]→[4.1083:1084](∅→∅),[4.1083]→[4.1083:1084](∅→∅)

(Only eid)

[4.15373]

[4.2262]

(Only eid)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 393

[4.2347]→[4.2347:2372](∅→∅),[4.2372]→[4.19861:19889](∅→∅),[4.19861]→[4.19861:19889](∅→∅),[4.19889]→[4.695:730](∅→∅)

(Before e) -> pquery
(logEntryParser mode)
[sql| SELECT credit_to_type,

[4.2347]

[4.730]

(Before e) ->
pquery
(logEntryParser mode)
[sql| SELECT credit_to_type,
replacement in lib/Aftok/Database/PostgreSQL.hs at line 405

[4.2522]→[4.2522:2586](∅→∅),[4.2586]→[4.20043:20071](∅→∅),[4.20043]→[4.20043:20071](∅→∅),[4.20071]→[4.831:866](∅→∅)

(pid, uid, fromThyme e, limit)
(During s e) -> pquery
(logEntryParser mode)
[sql| SELECT credit_to_type,

[4.2522]

[4.866]

(pid, uid, fromThyme e, limit)
(During s e) ->
pquery
(logEntryParser mode)
[sql| SELECT credit_to_type,
replacement in lib/Aftok/Database/PostgreSQL.hs at line 418

[4.2719]→[4.2719:2793](∅→∅),[4.2793]→[4.20235:20263](∅→∅),[4.20235]→[4.20235:20263](∅→∅),[4.20263]→[4.967:1002](∅→∅)

(pid, uid, fromThyme s, fromThyme e, limit)
(After s) -> pquery
(logEntryParser mode)
[sql| SELECT credit_to_type,

[4.2719]

[4.7432]

(pid, uid, fromThyme s, fromThyme e, limit)
(After s) ->
pquery
(logEntryParser mode)
[sql| SELECT credit_to_type,
replacement in lib/Aftok/Database/PostgreSQL.hs at line 430

[4.2935]→[4.2935:3058](∅→∅)

(pid, uid, fromThyme s, limit)
(Always) -> pquery
(logEntryParser mode)
[sql| SELECT credit_to_type,

[4.2935]

[4.3058]

(pid, uid, fromThyme s, limit)
(Always) ->
pquery
(logEntryParser mode)
[sql| SELECT credit_to_type,
replacement in lib/Aftok/Database/PostgreSQL.hs at line 443

[4.3399]→[4.3399:3423](∅→∅),[4.317]→[4.1951:1952](∅→∅),[4.2276]→[4.1951:1952](∅→∅),[4.3423]→[4.1951:1952](∅→∅),[4.6355]→[4.1951:1952](∅→∅),[4.8155]→[4.1951:1952](∅→∅),[4.12014]→[4.1951:1952](∅→∅),[4.1951]→[4.1951:1952](∅→∅),[4.1952]→[4.20390:20508](∅→∅)

(pid, uid, limit)

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

[4.3399]

[4.12081]

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

[4.16519]→[4.20509:20558](∅→∅),[4.1617]→[4.2903:2904](∅→∅),[4.2902]→[4.2903:2904](∅→∅),[4.3401]→[4.2903:2904](∅→∅),[4.6609]→[4.2903:2904](∅→∅),[4.20558]→[4.2903:2904](∅→∅),[4.2527]→[4.2903:2904](∅→∅)

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

[4.16519]

[4.12127]

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

[4.16725]→[4.20594:20670](∅→∅),[4.20670]→[4.216:246](∅→∅),[4.246]→[4.58397:58431](∅→∅)

( eid
, fromThyme $ mt ^. _ModTime
, creditToName c
, renderNetworkId nid
, addrToText network addr

[4.16725]

[4.20706]

( eid,
fromThyme $ mt ^. _ModTime,
creditToName c,
renderNetworkId nid,
addrToText network addr
replacement in lib/Aftok/Database/PostgreSQL.hs at line 467

[4.2984]→[4.1932:1933](∅→∅),[4.6998]→[4.1932:1933](∅→∅),[4.12532]→[4.1932:1933](∅→∅),[4.20716]→[4.1932:1933](∅→∅),[4.1932]→[4.1932:1933](∅→∅),[4.1933]→[4.20717:20821](∅→∅)

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

[4.20716]

[4.12612]

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

[4.16933]→[4.20822:20897](∅→∅),[4.3092]→[4.2208:2209](∅→∅),[4.7298]→[4.2208:2209](∅→∅),[4.12767]→[4.2208:2209](∅→∅),[4.20897]→[4.2208:2209](∅→∅),[4.2208]→[4.2208:2209](∅→∅),[4.2209]→[4.20898:20999](∅→∅)

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

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

[4.16933]

[4.12847]

(eid, fromThyme $ mt ^. _ModTime, creditToName c, pid ^. _ProjectId)
CreditToUser uid ->
pinsert
AmendmentId
[sql| INSERT INTO event_credit_to_amendments
replacement in lib/Aftok/Database/PostgreSQL.hs at line 480

[4.17138]→[4.21000:21072](∅→∅),[4.2764]→[4.4597:4598](∅→∅),[4.7587]→[4.4597:4598](∅→∅),[4.21072]→[4.4597:4598](∅→∅),[4.4597]→[4.4597:4598](∅→∅),[4.4598]→[4.21073:21199](∅→∅)

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

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

[4.17138]

[4.12990]

(eid, fromThyme $ mt ^. _ModTime, creditToName c, uid ^. _UserId)
pgEval (AmendEvent (EventId eid) (MetadataChange mt v)) =
pinsert
AmendmentId
[sql| INSERT INTO event_metadata_amendments
replacement in lib/Aftok/Database/PostgreSQL.hs at line 487

[4.17304]→[4.21200:21239](∅→∅),[4.2998]→[4.4861:4862](∅→∅),[4.7842]→[4.4861:4862](∅→∅),[4.21239]→[4.4861:4862](∅→∅),[4.4861]→[4.4861:4862](∅→∅)

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

[4.17304]

[4.13040]

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

[4.13084]→[4.21240:21320](∅→∅),[4.21320]→[4.1103:1136](∅→∅)

mode <- askNetworkMode
logEntries <- pquery
(logEntryParser mode)
[sql| SELECT credit_to_type,

[4.13084]

[4.1136]

mode <- askNetworkMode
logEntries <-
pquery
(logEntryParser mode)
[sql| SELECT credit_to_type,
replacement in lib/Aftok/Database/PostgreSQL.hs at line 498

[4.17557]→[4.8032:8047](∅→∅),[4.8032]→[4.8032:8047](∅→∅)

(Only pid)

[4.17557]

[4.8047]

(Only pid)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 500

[4.254]→[4.5182:5183](∅→∅),[4.541]→[4.5182:5183](∅→∅),[4.585]→[4.5182:5183](∅→∅),[4.760]→[4.5182:5183](∅→∅),[4.760]→[4.5182:5183](∅→∅),[4.3079]→[4.5182:5183](∅→∅),[4.3239]→[4.5182:5183](∅→∅),[4.8077]→[4.5182:5183](∅→∅),[4.5182]→[4.5182:5183](∅→∅),[4.5183]→[4.21321:21452](∅→∅)

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

[4.8077]

[4.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 505

[4.17710]→[4.21453:21608](∅→∅),[4.3373]→[4.5424:5425](∅→∅),[4.3440]→[4.5424:5425](∅→∅),[4.8414]→[4.5424:5425](∅→∅),[4.21608]→[4.5424:5425](∅→∅),[4.5424]→[4.5424:5425](∅→∅),[4.5425]→[4.21609:21761](∅→∅)

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

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

[4.17710]

[4.13602]

( auc ^. (A.projectId . _ProjectId),
auc ^. (A.initiator . _UserId),
auc ^. (A.raiseAmount . satoshi),
auc ^. (A.auctionEnd . to fromThyme)
)
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 517

[4.17889]→[4.21762:21795](∅→∅),[4.703]→[4.5524:5525](∅→∅),[4.3430]→[4.5524:5525](∅→∅),[4.3799]→[4.5524:5525](∅→∅),[4.8632]→[4.5524:5525](∅→∅),[4.21795]→[4.5524:5525](∅→∅),[4.5524]→[4.5524:5525](∅→∅),[4.5525]→[4.21796:21943](∅→∅)

(Only (aucId ^. A._AuctionId))

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

[4.17889]

[4.17996]

(Only (aucId ^. A._AuctionId))
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 523

[4.18045]→[4.21944:22117](∅→∅),[4.647]→[4.667:668](∅→∅),[4.3588]→[4.667:668](∅→∅),[4.3976]→[4.667:668](∅→∅),[4.9007]→[4.667:668](∅→∅),[4.22117]→[4.667:668](∅→∅),[4.273]→[4.667:668](∅→∅),[4.668]→[4.22118:22325](∅→∅),[4.273]→[4.704:705](∅→∅),[4.913]→[4.704:705](∅→∅),[4.963]→[4.704:705](∅→∅),[4.3217]→[4.704:705](∅→∅),[4.3651]→[4.704:705](∅→∅),[4.3717]→[4.704:705](∅→∅),[4.4200]→[4.704:705](∅→∅),[4.9180]→[4.704:705](∅→∅),[4.22325]→[4.704:705](∅→∅),[4.5525]→[4.704:705](∅→∅)

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

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))

[4.18045]

[4.13783]

( aucId,
bid ^. (A.bidUser . _UserId),
case bid ^. A.bidSeconds of
(Seconds i) -> i,
bid ^. (A.bidAmount . satoshi),
bid ^. (A.bidTime . to fromThyme)
)
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 540

[3.47]→[4.22348:22386](∅→∅),[4.14185]→[4.22348:22386](∅→∅),[4.22386]→[4.1820:1944](∅→∅)

( user' ^. (username . _UserName)
, user' ^? userAccountRecovery . _RecoverByEmail . _Email
, user' ^? userAccountRecovery . _RecoverByZAddr . _ZAddr

[3.47]

[4.9510]

( user' ^. (username . _UserName),
user' ^? userAccountRecovery . _RecoverByEmail . _Email,
user' ^? userAccountRecovery . _RecoverByZAddr . _ZAddr
edit in lib/Aftok/Database/PostgreSQL.hs at line 544

[4.4375]→[4.1368:1369](∅→∅),[4.9516]→[4.1368:1369](∅→∅),[4.1368]→[4.1368:1369](∅→∅)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 545

[4.14281]→[4.22422:22443](∅→∅),[4.22443]→[4.1945:2043](∅→∅),[4.1430]→[4.9648:9663](∅→∅),[4.2043]→[4.9648:9663](∅→∅),[4.18409]→[4.9648:9663](∅→∅),[4.9648]→[4.9648:9663](∅→∅),[4.9663]→[4.3218:3219](∅→∅),[4.4565]→[4.3218:3219](∅→∅)

headMay <$> pquery
userParser
[sql| SELECT handle, recovery_email, recovery_zaddr FROM users WHERE id = ? |]
(Only uid)

[4.14256]

[4.14321]

headMay
<$> pquery
userParser
[sql| SELECT handle, recovery_email, recovery_zaddr FROM users WHERE id = ? |]
(Only uid)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 551

[4.14363]→[4.2044:2215](∅→∅)

headMay <$> pquery
((,) <$> idParser UserId <*> userParser)
[sql| SELECT id, handle, recovery_email, recovery_zaddr FROM users WHERE handle = ? |]
(Only h)

[4.14363]

[4.2215]

headMay
<$> pquery
((,) <$> idParser UserId <*> userParser)
[sql| SELECT id, handle, recovery_email, recovery_zaddr FROM users WHERE handle = ? |]
(Only h)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 558

[4.14388]→[4.22466:22487](∅→∅),[4.22487]→[4.2266:2399](∅→∅),[4.2399]→[4.9825:9826](∅→∅),[4.9825]→[4.9825:9826](∅→∅)

headMay <$> pquery
(btcAddressParser mode)
[sql| SELECT default_payment_network, default_payment_addr FROM users WHERE id = ? |]
(Only uid)

[4.14388]

[4.14456]

headMay
<$> pquery
(btcAddressParser mode)
[sql| SELECT default_payment_network, default_payment_addr FROM users WHERE id = ? |]
(Only uid)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 565

[4.9941]→[4.14529:14651](∅→∅)

void $ pexec
[sql| INSERT INTO invitations (project_id, invitor_id, invitee_email, invitation_key, invitation_time)

[4.9941]

[4.18674]

void $
pexec
[sql| INSERT INTO invitations (project_id, invitor_id, invitee_email, invitation_key, invitation_time)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 569

[4.18710]→[4.10089:10145](∅→∅),[4.10089]→[4.10089:10145](∅→∅)

(pid, uid, e, P.renderInvCode invCode, fromThyme t)

[4.18710]

[4.10145]

(pid, uid, e, P.renderInvCode invCode, fromThyme t)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 571

[4.10160]→[4.10160:10161](∅→∅),[4.10161]→[4.22538:22692](∅→∅)

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

[4.10160]

[4.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 577

[4.18895]→[4.22693:22723](∅→∅),[4.3556]→[4.3741:3742](∅→∅),[4.4565]→[4.3741:3742](∅→∅),[4.10399]→[4.3741:3742](∅→∅),[4.22723]→[4.3741:3742](∅→∅),[4.1369]→[4.3741:3742](∅→∅)

(Only $ P.renderInvCode ic)

[4.18895]

[4.5024]

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

[4.5088]→[4.14780:14795](∅→∅),[4.14795]→[4.18912:18993](∅→∅),[4.18912]→[4.18912:18993](∅→∅),[4.18993]→[4.10558:10596](∅→∅),[4.10558]→[4.10558:10596](∅→∅),[4.10596]→[4.18994:18995](∅→∅),[4.18995]→[4.14796:14897](∅→∅)

void $ pexec
[sql| UPDATE invitations SET acceptance_time = ? WHERE invitation_key = ? |]
(fromThyme t, P.renderInvCode ic)

void $ pexec
[sql| INSERT INTO project_companions (project_id, user_id, invited_by, joined_at)

[4.5088]

[4.14897]

void $
pexec
[sql| UPDATE invitations SET acceptance_time = ? WHERE invitation_key = ? |]
(fromThyme t, P.renderInvCode ic)
void $
pexec
[sql| INSERT INTO project_companions (project_id, user_id, invited_by, joined_at)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 589

[4.19219]→[4.10800:10843](∅→∅),[4.10800]→[4.10800:10843](∅→∅),[4.10843]→[4.3835:3836](∅→∅),[4.3835]→[4.3835:3836](∅→∅),[4.3836]→[4.22724:22862](∅→∅)

(uid, fromThyme t, P.renderInvCode ic)

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

[4.19219]

[4.19337]

(uid, fromThyme t, P.renderInvCode ic)
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 595

[4.19383]→[4.22863:23010](∅→∅),[4.15248]→[4.19384:19385](∅→∅),[4.23010]→[4.19384:19385](∅→∅),[4.11143]→[4.19384:19385](∅→∅)

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

[4.19383]

[4.19385]

( 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 602

[4.23077]→[4.19483:19484](∅→∅),[4.19483]→[4.19483:19484](∅→∅),[4.19484]→[4.23078:23161](∅→∅)

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

[4.23077]

[4.15307]

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

[4.19689]→[4.23162:23191](∅→∅),[4.11143]→[4.4290:4291](∅→∅),[4.15420]→[4.4290:4291](∅→∅),[4.19722]→[4.4290:4291](∅→∅),[4.23191]→[4.4290:4291](∅→∅),[4.4290]→[4.4290:4291](∅→∅),[4.4291]→[4.23192:23384](∅→∅),[4.696]→[4.946:947](∅→∅),[4.4398]→[4.946:947](∅→∅),[4.4842]→[4.946:947](∅→∅),[4.11340]→[4.946:947](∅→∅),[4.23384]→[4.946:947](∅→∅),[4.5654]→[4.946:947](∅→∅),[4.947]→[4.23385:23482](∅→∅),[4.23482]→[4.3887:4013](∅→∅)

(Only (pid ^. _ProjectId))

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

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

[4.19689]

[4.15643]

(Only (pid ^. _ProjectId))
pgEval (FindProject (ProjectId pid)) =
headMay
<$> pquery
projectParser
[sql| SELECT project_name, inception_date, initiator_id, depreciation_fn FROM projects WHERE id = ? |]
(Only pid)
pgEval (FindUserProjects (UserId uid)) =
pquery
((,) <$> idParser ProjectId <*> projectParser)
[sql| SELECT DISTINCT ON (p.inception_date, p.id) p.id, p.project_name, p.inception_date, p.initiator_id, p.depreciation_fn
replacement in lib/Aftok/Database/PostgreSQL.hs at line 624

[4.4091]→[4.23572:23585](∅→∅),[4.20174]→[4.23572:23585](∅→∅),[4.5054]→[4.1013:1014](∅→∅),[4.11657]→[4.1013:1014](∅→∅),[4.23585]→[4.1013:1014](∅→∅),[4.1013]→[4.1013:1014](∅→∅),[4.1014]→[4.23586:23794](∅→∅),[4.5465]→[4.1042:1043](∅→∅),[4.11872]→[4.1042:1043](∅→∅),[4.15832]→[4.1042:1043](∅→∅),[4.23794]→[4.1042:1043](∅→∅),[4.5766]→[4.1042:1043](∅→∅)

(uid, uid)

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)

[4.4091]

[4.15833]

(uid, uid)
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 641

[4.20634]→[4.16070:16106](∅→∅),[4.5356]→[4.12210:12236](∅→∅),[4.16106]→[4.12210:12236](∅→∅),[4.12210]→[4.12210:12236](∅→∅),[4.12236]→[4.5357:5529](∅→∅),[4.5529]→[4.3017:3044](∅→∅),[4.3044]→[4.20635:20720](∅→∅)

( b ^. (B.project . _ProjectId)
, eventId ^. _EventId
, b ^. B.name
, b ^. B.description
, b ^. (B.recurrence . to B.recurrenceName)
, b ^. (B.recurrence . to B.recurrenceCount)
, b ^. (B.amount . satoshi)
, b ^. (B.gracePeriod)
, b ^. (B.paymentRequestEmailTemplate)
, b ^. (B.paymentRequestMemoTemplate)

[4.20634]

[4.12451]

( b ^. (B.project . _ProjectId),
eventId ^. _EventId,
b ^. B.name,
b ^. B.description,
b ^. (B.recurrence . to B.recurrenceName),
b ^. (B.recurrence . to B.recurrenceCount),
b ^. (B.amount . satoshi),
b ^. (B.gracePeriod),
b ^. (B.paymentRequestEmailTemplate),
b ^. (B.paymentRequestMemoTemplate)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 652

[4.12457]→[4.3718:3719](∅→∅),[4.5684]→[4.3718:3719](∅→∅),[4.3719]→[4.23823:23953](∅→∅)

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

[4.12457]

[4.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 662

[4.21120]→[4.23954:23986](∅→∅),[4.23986]→[4.21121:21122](∅→∅),[4.5628]→[4.21121:21122](∅→∅),[4.21122]→[4.23987:24148](∅→∅)

(Only (bid ^. B._BillableId))

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

[4.21120]

[4.16500]

(Only (bid ^. B._BillableId))
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 672

[4.21589]→[4.24149:24178](∅→∅),[4.5628]→[4.3942:3943](∅→∅),[4.12804]→[4.3942:3943](∅→∅),[4.16712]→[4.3942:3943](∅→∅),[4.21622]→[4.3942:3943](∅→∅),[4.24178]→[4.3942:3943](∅→∅),[4.3942]→[4.3942:3943](∅→∅)

(Only (pid ^. _ProjectId))

[4.21589]

[4.16713]

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

[4.21790]→[4.24211:24240](∅→∅),[4.24240]→[4.590:619](∅→∅),[4.590]→[4.590:619](∅→∅),[4.619]→[4.24241:24274](∅→∅),[4.24274]→[4.1327:1354](∅→∅),[4.647]→[4.1327:1354](∅→∅)

( view _UserId uid
, view B._BillableId bid
, view _EventId eventId
, fromThyme start_date

[4.21790]

[4.647]

( view _UserId uid,
view B._BillableId bid,
view _EventId eventId,
fromThyme start_date
replacement in lib/Aftok/Database/PostgreSQL.hs at line 685

[4.653]→[4.3074:3075](∅→∅),[4.5781]→[4.3074:3075](∅→∅),[4.3075]→[4.24275:24347](∅→∅),[4.24347]→[4.3914:3982](∅→∅)

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

[4.653]

[4.16985]

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

[4.21948]→[4.24401:24437](∅→∅),[4.3287]→[4.5781:5782](∅→∅),[4.24437]→[4.5781:5782](∅→∅),[4.5781]→[4.5781:5782](∅→∅),[4.5782]→[4.24438:24543](∅→∅),[4.24543]→[4.3983:4062](∅→∅)

(Only (sid ^. B._SubscriptionId))

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

[4.21948]

[4.17151]

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

[4.22234]→[4.24608:24646](∅→∅),[4.6107]→[4.811:812](∅→∅),[4.17304]→[4.811:812](∅→∅),[4.24646]→[4.811:812](∅→∅),[4.811]→[4.811:812](∅→∅),[4.812]→[4.6108:6109](∅→∅)

(uid ^. _UserId, pid ^. _ProjectId)

[4.22234]

[4.17305]

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

[4.656]→[4.6158:6206](∅→∅),[4.3476]→[4.6158:6206](∅→∅),[4.22445]→[4.6158:6206](∅→∅),[4.1044]→[4.6158:6206](∅→∅),[4.6206]→[4.1540:1566](∅→∅),[4.1093]→[4.1540:1566](∅→∅),[4.1566]→[4.1029:1129](∅→∅),[4.684]→[4.3477:3568](∅→∅),[4.1129]→[4.3477:3568](∅→∅),[4.1180]→[4.3477:3568](∅→∅)

( req ^. (subscription . B._SubscriptionId)
, eventId ^. _EventId
, req ^. (paymentRequest . to (runPut . encodeMessage))
, req ^. (paymentKey . _PaymentKey)
, req ^. (paymentRequestTime . to fromThyme)
, req ^. (billingDate . to fromThyme)

[4.22445]

[4.1180]

( req ^. (subscription . B._SubscriptionId),
eventId ^. _EventId,
req ^. (paymentRequest . to (runPut . encodeMessage)),
req ^. (paymentKey . _PaymentKey),
req ^. (paymentRequestTime . to fromThyme),
req ^. (billingDate . to fromThyme)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 716

[4.1186]→[4.1567:1568](∅→∅),[4.1568]→[4.24679:24806](∅→∅),[4.24806]→[4.17588:17674](∅→∅),[4.17588]→[4.17588:17674](∅→∅)

pgEval (FindPaymentRequest (PaymentKey k)) = headMay <$> pquery
((,) <$> idParser PaymentRequestId <*> paymentRequestParser)
[sql| SELECT id, subscription_id, request_data, url_key, request_time, billing_date

[4.1186]

[4.17674]

pgEval (FindPaymentRequest (PaymentKey k)) =
headMay
<$> pquery
((,) <$> idParser PaymentRequestId <*> paymentRequestParser)
[sql| SELECT id, subscription_id, request_data, url_key, request_time, billing_date
replacement in lib/Aftok/Database/PostgreSQL.hs at line 724

[4.1379]→[4.753:764](∅→∅),[4.22741]→[4.753:764](∅→∅),[4.753]→[4.753:764](∅→∅),[4.764]→[4.22742:22743](∅→∅),[4.22743]→[4.24807:24905](∅→∅),[4.24905]→[4.17731:17813](∅→∅),[4.22841]→[4.17731:17813](∅→∅)

(Only k)

pgEval (FindPaymentRequestId (PaymentRequestId prid)) = headMay <$> pquery
paymentRequestParser
[sql| SELECT subscription_id, request_data, url_key, request_time, billing_date

[4.22741]

[4.17813]

(Only k)
pgEval (FindPaymentRequestId (PaymentRequestId prid)) =
headMay
<$> pquery
paymentRequestParser
[sql| SELECT subscription_id, request_data, url_key, request_time, billing_date
replacement in lib/Aftok/Database/PostgreSQL.hs at line 732

[4.22979]→[4.22979:22993](∅→∅),[4.764]→[4.1590:1591](∅→∅),[4.22993]→[4.1590:1591](∅→∅),[4.3796]→[4.1590:1591](∅→∅),[4.1591]→[4.24906:25011](∅→∅),[4.25011]→[4.17914:18000](∅→∅),[4.17914]→[4.17914:18000](∅→∅)

(Only prid)

pgEval (FindPaymentRequests sid) = pquery
((,) <$> idParser PaymentRequestId <*> paymentRequestParser)
[sql| SELECT id, subscription_id, request_data, url_key, request_time, billing_date

[4.22979]

[4.18000]

(Only prid)
pgEval (FindPaymentRequests sid) =
pquery
((,) <$> idParser PaymentRequestId <*> paymentRequestParser)
[sql| SELECT id, subscription_id, request_data, url_key, request_time, billing_date
replacement in lib/Aftok/Database/PostgreSQL.hs at line 739

[4.23220]→[4.4036:4073](∅→∅),[4.4036]→[4.4036:4073](∅→∅)

(Only (sid ^. B._SubscriptionId))

[4.23220]

[4.716]

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

[4.25025]→[4.25025:25196](∅→∅)

(,,,)
<$> (PaymentKey <$> field)
<*> paymentRequestParser
<*> subscriptionParser
<*> billableParser
in pquery

[4.25025]

[4.25196]

(,,,)
<$> (PaymentKey <$> field)
<*> paymentRequestParser
<*> subscriptionParser
<*> billableParser
in pquery
edit in lib/Aftok/Database/PostgreSQL.hs at line 763

[4.25284]→[4.1641:1642](∅→∅),[4.1641]→[4.1641:1642](∅→∅)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 770

[4.24201]→[4.4218:4259](∅→∅),[4.4218]→[4.4218:4259](∅→∅),[4.4259]→[4.260:286](∅→∅),[4.260]→[4.260:286](∅→∅),[4.286]→[4.4260:4351](∅→∅),[4.4351]→[4.369:394](∅→∅)

( p ^. (request . _PaymentRequestId)
, eventId ^. _EventId
, p ^. (payment . to (runPut . encodeMessage))
, p ^. (paymentDate . to fromThyme)
, p ^. exchangeRates

[4.24201]

[4.339]

( p ^. (request . _PaymentRequestId),
eventId ^. _EventId,
p ^. (payment . to (runPut . encodeMessage)),
p ^. (paymentDate . to fromThyme),
p ^. exchangeRates
replacement in lib/Aftok/Database/PostgreSQL.hs at line 776

[4.345]→[4.4352:4353](∅→∅),[4.4353]→[4.25310:25394](∅→∅),[4.25394]→[4.18756:18822](∅→∅),[4.18756]→[4.18756:18822](∅→∅)

pgEval (FindPayments rid) = pquery
((,) <$> idParser PaymentId <*> paymentParser)
[sql| SELECT id, payment_request_id, payment_data, payment_date

[4.345]

[4.18822]

pgEval (FindPayments rid) =
pquery
((,) <$> idParser PaymentId <*> paymentParser)
[sql| SELECT id, payment_request_id, payment_data, payment_date
replacement in lib/Aftok/Database/PostgreSQL.hs at line 782

[4.24389]→[4.4553:4589](∅→∅),[4.4553]→[4.4553:4589](∅→∅),[4.345]→[4.1044:1045](∅→∅),[4.3943]→[4.1044:1045](∅→∅),[4.4589]→[4.1044:1045](∅→∅),[4.5684]→[4.1044:1045](∅→∅),[4.12988]→[4.1044:1045](∅→∅),[4.751]→[4.1044:1045](∅→∅)

(Only (rid ^. _PaymentRequestId))

[4.24389]

[4.6249]

(Only (rid ^. _PaymentRequestId))
replacement in lib/Aftok/Database.hs at line 2

[4.39]→[4.1657:1693](∅→∅),[4.1693]→[4.6343:6379](∅→∅),[4.39]→[4.6343:6379](∅→∅),[4.6379]→[4.1694:1730](∅→∅),[4.1730]→[4.6380:6416](∅→∅),[4.75]→[4.6380:6416](∅→∅),[4.6416]→[4.24426:24462](∅→∅)

{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TemplateHaskell #-}

[4.39]

[4.426]

{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
replacement in lib/Aftok/Database.hs at line 11

[4.4986]→[4.2692:2693](∅→∅),[4.2693]→[4.25396:25684](∅→∅),[4.1844]→[4.173:207](∅→∅),[4.4647]→[4.173:207](∅→∅),[4.6460]→[4.173:207](∅→∅),[4.25747]→[4.173:207](∅→∅),[4.173]→[4.173:207](∅→∅),[4.207]→[4.25748:25908](∅→∅),[4.3484]→[4.25908:25968](∅→∅),[4.25908]→[4.25908:25968](∅→∅),[4.246]→[4.6576:6577](∅→∅),[4.1410]→[4.6576:6577](∅→∅),[4.1893]→[4.6576:6577](∅→∅),[4.2726]→[4.6576:6577](∅→∅),[4.4553]→[4.6576:6577](∅→∅),[4.5900]→[4.6576:6577](∅→∅),[4.25968]→[4.6576:6577](∅→∅),[4.6576]→[4.6576:6577](∅→∅),[4.6577]→[4.18846:18875](∅→∅),[4.18875]→[4.25969:26021](∅→∅),[4.26021]→[2.4963:5015](∅→∅),[2.5015]→[4.26073:26135](∅→∅),[4.26073]→[4.26073:26135](∅→∅),[4.770]→[4.301:333](∅→∅),[4.800]→[4.301:333](∅→∅),[4.1183]→[4.301:333](∅→∅),[4.1990]→[4.301:333](∅→∅),[4.3988]→[4.301:333](∅→∅),[4.18931]→[4.301:333](∅→∅),[4.26135]→[4.301:333](∅→∅),[4.301]→[4.301:333](∅→∅),[4.333]→[4.6461:6499](∅→∅),[4.6499]→[4.26136:26188](∅→∅),[4.840]→[4.333:364](∅→∅),[4.2039]→[4.333:364](∅→∅),[4.26188]→[4.333:364](∅→∅),[4.333]→[4.333:364](∅→∅),[4.4051]→[4.364:392](∅→∅),[4.364]→[4.364:392](∅→∅)

import Control.Lens ( view
, (^.)
, makeClassyPrisms
, traverseOf
)
import Data.AffineSpace
import Data.Thyme.Clock as C
import Data.Thyme.Time as T
( Day )
import Safe ( headMay )

import Aftok.Types
import Aftok.Auction as A
import Aftok.Billing as B
import Aftok.Currency.Bitcoin ( NetworkId )
import Aftok.Interval
import Aftok.Payments.Types
import Aftok.Project as P
import Aftok.TimeLog
import Aftok.Util

[4.4986]

[4.5919]

import Aftok.Auction as A
import Aftok.Billing as B
import Aftok.Currency.Bitcoin (NetworkId)
import Aftok.Interval
import Aftok.Payments.Types
import Aftok.Project as P
import Aftok.TimeLog
import Aftok.Types
import Aftok.Util
import Control.Lens
( (^.),
makeClassyPrisms,
traverseOf,
view,
)
import Data.AffineSpace
import Data.Thyme.Clock as C
import Data.Thyme.Time as T
( Day,
)
import Haskoin.Address (Address)
import Safe (headMay)
replacement in lib/Aftok/Database.hs at line 34

[4.5920]→[4.1737:1797](∅→∅)

import Haskoin.Address ( Address )

[4.5920]

[4.18985]

type KeyedLogEntry a = (ProjectId, UserId, LogEntry a)
edit in lib/Aftok/Database.hs at line 36

[4.18986]→[4.18986:19041](∅→∅)

type KeyedLogEntry a = (ProjectId, UserId, LogEntry a)
edit in lib/Aftok/Database.hs at line 37

[4.26276]

[4.26276]
replacement in lib/Aftok/Database.hs at line 43

[4.6156]→[4.2401:2555](∅→∅)

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

[4.6156]

[4.2555]

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

[4.1961]→[4.6305:6306](∅→∅),[4.2615]→[4.6305:6306](∅→∅),[4.4710]→[4.6305:6306](∅→∅),[4.19328]→[4.6305:6306](∅→∅),[4.26462]→[4.6305:6306](∅→∅),[4.6305]→[4.6305:6306](∅→∅),[4.6306]→[4.1962:2154](∅→∅)

CreateProject :: Project -> DBOp ProjectId
FindProject :: ProjectId -> DBOp (Maybe Project)
ListProjects :: DBOp [ProjectId]
FindSubscribers :: ProjectId -> DBOp [UserId]

[4.2615]

[4.2154]

CreateProject :: Project -> DBOp ProjectId
FindProject :: ProjectId -> DBOp (Maybe Project)
ListProjects :: DBOp [ProjectId]
FindSubscribers :: ProjectId -> DBOp [UserId]
replacement in lib/Aftok/Database.hs at line 54

[4.2378]→[4.2378:2442](∅→∅)

FindInvitation :: InvitationCode -> DBOp (Maybe Invitation)

[4.2378]

[4.2442]

FindInvitation :: InvitationCode -> DBOp (Maybe Invitation)
replacement in lib/Aftok/Database.hs at line 56

[4.2513]→[4.6534:6535](∅→∅),[4.4781]→[4.6534:6535](∅→∅),[4.27005]→[4.6534:6535](∅→∅),[4.6534]→[4.6534:6535](∅→∅),[4.6535]→[4.2514:2886](∅→∅),[4.2886]→[4.6857:6858](∅→∅),[4.19690]→[4.6857:6858](∅→∅),[4.27362]→[4.6857:6858](∅→∅),[4.6857]→[4.6857:6858](∅→∅),[4.6858]→[4.2887:3099](∅→∅),[4.3099]→[4.4052:4053](∅→∅),[4.4827]→[4.4052:4053](∅→∅),[4.27571]→[4.4052:4053](∅→∅),[4.7074]→[4.4052:4053](∅→∅),[4.4053]→[4.3100:3284](∅→∅),[4.3284]→[4.13382:13383](∅→∅),[4.4886]→[4.13382:13383](∅→∅),[4.24705]→[4.13382:13383](∅→∅),[4.27753]→[4.13382:13383](∅→∅),[4.13382]→[4.13382:13383](∅→∅)

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

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

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

[4.2513]

[4.3285]

CreateEvent :: ProjectId -> UserId -> LogEntry BTCNet -> DBOp EventId
AmendEvent :: EventId -> EventAmendment BTCNet -> DBOp AmendmentId
FindEvent :: EventId -> DBOp (Maybe (KeyedLogEntry BTCNet))
FindEvents :: ProjectId -> UserId -> RangeQuery -> Word32 -> DBOp [LogEntry BTCNet]
ReadWorkIndex :: ProjectId -> DBOp (WorkIndex BTCNet)
CreateAuction :: Auction -> DBOp AuctionId
FindAuction :: AuctionId -> DBOp (Maybe Auction)
CreateBid :: AuctionId -> Bid -> DBOp BidId
FindBids :: AuctionId -> DBOp [(BidId, Bid)]
CreateBillable :: UserId -> Billable -> DBOp BillableId
FindBillable :: BillableId -> DBOp (Maybe Billable)
FindBillables :: ProjectId -> DBOp [(BillableId, Billable)]
replacement in lib/Aftok/Database.hs at line 69

[4.3362]→[4.3362:3515](∅→∅),[4.1865]→[4.4199:4200](∅→∅),[4.3515]→[4.4199:4200](∅→∅),[4.6654]→[4.4199:4200](∅→∅),[4.13451]→[4.4199:4200](∅→∅),[4.27981]→[4.4199:4200](∅→∅),[4.4199]→[4.4199:4200](∅→∅),[4.4200]→[4.3516:3897](∅→∅),[4.991]→[4.5194:5195](∅→∅),[4.1755]→[4.5194:5195](∅→∅),[4.1929]→[4.5194:5195](∅→∅),[4.3897]→[4.5194:5195](∅→∅),[4.24781]→[4.5194:5195](∅→∅),[4.28358]→[4.5194:5195](∅→∅),[4.5194]→[4.5194:5195](∅→∅),[4.5195]→[4.3898:4012](∅→∅)

FindSubscription :: SubscriptionId -> DBOp (Maybe Subscription)
FindSubscriptions :: UserId -> ProjectId -> DBOp [(SubscriptionId, Subscription)]

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

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

[4.3362]

[4.7074]

FindSubscription :: SubscriptionId -> DBOp (Maybe Subscription)
FindSubscriptions :: UserId -> ProjectId -> DBOp [(SubscriptionId, Subscription)]
CreatePaymentRequest :: PaymentRequest -> DBOp PaymentRequestId
FindPaymentRequests :: SubscriptionId -> DBOp [(PaymentRequestId, PaymentRequest)]
FindUnpaidRequests :: SubscriptionId -> DBOp [BillDetail]
FindPaymentRequest :: PaymentKey -> DBOp (Maybe (PaymentRequestId, PaymentRequest))
FindPaymentRequestId :: PaymentRequestId -> DBOp (Maybe PaymentRequest)
CreatePayment :: Payment -> DBOp PaymentId
FindPayments :: PaymentRequestId -> DBOp [(PaymentId, Payment)]
RaiseDBError :: forall x y. DBError -> DBOp x -> DBOp y
replacement in lib/Aftok/Database.hs at line 80

[4.7075]→[4.4013:4073](∅→∅)

RaiseDBError :: forall x y. DBError -> DBOp x -> DBOp y

[4.7075]

[4.7204]

data OpForbiddenReason
= UserNotProjectMember
| UserNotEventLogger
| UserNotSubscriber SubscriptionId
| InvitationExpired
| InvitationAlreadyAccepted
| AuctionEnded
deriving (Eq, Show, Typeable)
replacement in lib/Aftok/Database.hs at line 89

[4.7205]→[4.7205:7295](∅→∅),[4.7295]→[4.1930:1988](∅→∅),[4.1988]→[4.4843:4937](∅→∅),[4.7295]→[4.4843:4937](∅→∅),[4.4937]→[4.66:104](∅→∅),[4.104]→[4.4937:4990](∅→∅),[4.4937]→[4.4937:4990](∅→∅)

data OpForbiddenReason = UserNotProjectMember
| UserNotEventLogger
| UserNotSubscriber SubscriptionId
| InvitationExpired
| InvitationAlreadyAccepted
| AuctionEnded
deriving (Eq, Show, Typeable)

[4.7205]

[4.4990]

data DBError
= OpForbidden UserId OpForbiddenReason
| SubjectNotFound
| EventStorageFailed
deriving (Eq, Show, Typeable)
edit in lib/Aftok/Database.hs at line 95

[4.4991]→[4.4991:5074](∅→∅),[4.5074]→[4.13603:13637](∅→∅),[4.13637]→[4.5074:5117](∅→∅),[4.5074]→[4.5074:5117](∅→∅)

data DBError = OpForbidden UserId OpForbiddenReason
| SubjectNotFound
| EventStorageFailed
deriving (Eq, Show, Typeable)
replacement in lib/Aftok/Database.hs at line 168

[4.557]→[4.28570:28654](∅→∅)

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

[4.557]

[4.625]

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

[4.5600]→[4.28655:28769](∅→∅)

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

[4.5600]

[4.5692]

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

[4.8285]→[4.677:757](∅→∅),[4.28892]→[4.677:757](∅→∅),[4.6140]→[4.677:757](∅→∅),[4.757]→[4.8286:8335](∅→∅),[4.8335]→[4.758:803](∅→∅),[4.6275]→[4.758:803](∅→∅),[4.803]→[4.8336:8393](∅→∅)

Just i | t .-. (i ^. invitationTime) > fromSeconds (60 * 60 * 72 :: Int) ->
raiseOpForbidden uid InvitationExpired act
Just i | isJust (i ^. acceptanceTime) ->
raiseOpForbidden uid InvitationAlreadyAccepted act

[4.28892]

[4.28893]

Just i
| t .-. (i ^. invitationTime) > fromSeconds (60 * 60 * 72 :: Int) ->
raiseOpForbidden uid InvitationExpired act
Just i
| isJust (i ^. acceptanceTime) ->
raiseOpForbidden uid InvitationAlreadyAccepted act
replacement in lib/Aftok/Database.hs at line 203

[4.8566]→[4.28969:29053](∅→∅)

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

[4.8566]

[4.819]

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

[4.8692]→[4.29054:29145](∅→∅)

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

[4.8692]

[4.8764]

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

[4.8812]→[4.29146:29181](∅→∅)

let act = AmendEvent eid a

[4.8812]

[4.6524]

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

[4.6586]→[4.8553:8596](∅→∅),[4.8596]→[4.29182:29282](∅→∅)

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

[4.6586]

[4.1146]

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

[4.4025]→[4.29283:29294](∅→∅),[4.29294]→[4.4074:4171](∅→∅)

findEvents
:: (MonadDB m)
=> ProjectId
-> UserId
-> RangeQuery
-> Word32
-> m [LogEntry BTCNet]

[4.4025]

[4.3664]

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

[4.5572]→[4.29371:29467](∅→∅)

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

[4.5572]

[4.5666]

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

[4.5730]→[4.29468:29572](∅→∅)

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

[4.5730]

[4.5825]

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

[4.4655]→[4.29573:29670](∅→∅)

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

[4.4655]

[4.6032]

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

[4.1595]→[4.29671:29768](∅→∅)

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

[4.1595]

[4.25813]

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

[4.25872]→[4.29769:29854](∅→∅)

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

[4.25872]

[4.25955]

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

[4.178]→[4.883:892](∅→∅),[4.883]→[4.883:892](∅→∅)

in do

[4.178]

[4.29855]

in do
replacement in lib/Aftok/Database.hs at line 284

[4.29893]→[4.29893:29964](∅→∅)

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

[4.29893]

[4.29964]

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

[4.402]→[4.402:411](∅→∅)

in do

[4.402]

[4.29982]

in do
replacement in lib/Aftok/Database.hs at line 292

[4.30016]→[4.30016:30133](∅→∅)

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

[4.30016]

[4.30133]

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

[4.176]→[4.609:618](∅→∅)

in do

[4.176]

[4.30192]

in do
replacement in lib/Aftok/Interval.hs at line 4

[4.3657]→[4.30369:30426](∅→∅),[4.30426]→[4.3715:3749](∅→∅),[4.3749]→[4.30458:30517](∅→∅),[4.30458]→[4.30458:30517](∅→∅),[4.30517]→[4.55:77](∅→∅),[4.3228]→[4.55:77](∅→∅)

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

[4.3657]

[4.30518]

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

[4.3689]→[4.1726:1727](∅→∅),[4.487]→[4.1726:1727](∅→∅)

[4.1494]

[4.2728]

import Control.Lens
( (^.),
makeLenses,
)
import Data.Aeson
import Data.Aeson.Types
import Data.AffineSpace
import Data.Thyme.Clock as C
import Data.Thyme.Format.Aeson ()
import Data.Thyme.LocalTime ()
replacement in lib/Aftok/Interval.hs at line 30

[4.2729]→[4.30529:30695](∅→∅),[4.30695]→[4.3750:3846](∅→∅),[4.3750]→[4.3750:3846](∅→∅),[4.3846]→[4.30696:30852](∅→∅)

import Control.Lens ( makeLenses
, (^.)
)
import Data.Aeson
import Data.Aeson.Types
import Data.AffineSpace
import Data.Thyme.Clock as C
import Data.Thyme.Format.Aeson ( )
import Data.Thyme.LocalTime ( )

[4.2729]

[4.1544]

data Interval
= Interval
{ _start :: C.UTCTime,
_end :: C.UTCTime
}
deriving (Show, Eq, Ord)
edit in lib/Aftok/Interval.hs at line 37

[4.1545]→[4.540:587](∅→∅),[4.587]→[4.3981:4028](∅→∅),[4.4028]→[4.78:130](∅→∅),[4.635]→[4.78:130](∅→∅)

data Interval = Interval { _start :: C.UTCTime
, _end :: C.UTCTime
} deriving (Show, Eq, Ord)
replacement in lib/Aftok/Interval.hs at line 40

[4.3789]→[4.3789:3915](∅→∅)

= Before { _end' :: C.UTCTime }
| During { _start' :: C.UTCTime, _end' :: C.UTCTime }
| After { _start' :: C.UTCTime }

[4.3789]

[4.3915]

= Before {_end' :: C.UTCTime}
| During {_start' :: C.UTCTime, _end' :: C.UTCTime}
| After {_start' :: C.UTCTime}
edit in lib/Aftok/Interval.hs at line 44

[4.3926]

[4.3926]
replacement in lib/Aftok/Interval.hs at line 64

[4.3543]→[4.1597:1634](∅→∅)

parseIntervalJSON _ = mzero

[4.3543]

parseIntervalJSON _ = mzero
replacement in lib/Aftok/Json.hs at line 2

[4.3609]→[4.966:1002](∅→∅),[4.1002]→[4.20345:20381](∅→∅),[4.20381]→[4.2335:2371](∅→∅),[4.1002]→[4.2335:2371](∅→∅),[4.1002]→[4.881:917](∅→∅),[4.2371]→[4.881:917](∅→∅),[4.3609]→[4.881:917](∅→∅),[4.917]→[4.20382:20418](∅→∅),[4.20418]→[4.10049:10085](∅→∅),[4.917]→[4.10049:10085](∅→∅)

{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}

[4.3609]

[4.127]

{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
edit in lib/Aftok/Json.hs at line 10

[4.1667]→[4.155:156](∅→∅),[4.155]→[4.155:156](∅→∅),[4.949]→[4.1965:1966](∅→∅),[4.1553]→[4.1965:1966](∅→∅),[4.20510]→[4.1965:1966](∅→∅),[4.177]→[4.1965:1966](∅→∅),[4.1966]→[4.30854:31084](∅→∅),[4.31084]→[4.4093:4145](∅→∅),[4.20654]→[4.1014:1076](∅→∅),[4.31150]→[4.1014:1076](∅→∅),[4.1014]→[4.1014:1076](∅→∅),[4.1076]→[4.31151:31360](∅→∅),[4.454]→[4.1132:1159](∅→∅),[4.1691]→[4.1132:1159](∅→∅),[4.31360]→[4.1132:1159](∅→∅),[4.1132]→[4.1132:1159](∅→∅),[4.1159]→[4.31361:31977](∅→∅),[4.36]→[4.231:232](∅→∅),[4.790]→[4.231:232](∅→∅),[4.1270]→[4.231:232](∅→∅),[4.1438]→[4.231:232](∅→∅),[4.3149]→[4.231:232](∅→∅),[4.3769]→[4.231:232](∅→∅),[4.31977]→[4.231:232](∅→∅),[4.231]→[4.231:232](∅→∅),[4.232]→[4.4173:4231](∅→∅),[4.4231]→[4.32036:32160](∅→∅),[4.58573]→[4.32036:32160](∅→∅),[4.32036]→[4.32036:32160](∅→∅),[4.32160]→[4.58574:58635](∅→∅),[4.58635]→[4.32223:32273](∅→∅),[4.32223]→[4.32223:32273](∅→∅),[4.32273]→[4.20815:20856](∅→∅),[4.20815]→[4.20815:20856](∅→∅),[4.4212]→[4.32274:32326](∅→∅),[4.20856]→[4.32274:32326](∅→∅),[4.32326]→[2.5017:5069](∅→∅),[2.5069]→[4.1326:1358](∅→∅),[4.32378]→[4.1326:1358](∅→∅),[4.1326]→[4.1326:1358](∅→∅),[4.1358]→[4.519:551](∅→∅),[4.32442]→[4.32442:32494](∅→∅),[4.171]→[4.1358:1389](∅→∅),[4.1029]→[4.1358:1389](∅→∅),[4.10114]→[4.1358:1389](∅→∅),[4.32494]→[4.1358:1389](∅→∅),[4.1358]→[4.1358:1389](∅→∅),[4.1389]→[4.172:201](∅→∅),[4.201]→[4.32495:32560](∅→∅)

import Control.FromSum ( fromMaybeM
, fromEitherM
)
import Control.Lens hiding ( (.=) )
import qualified Control.Lens as L
import Data.Aeson
import Data.Aeson.Types
import qualified Data.Attoparsec.ByteString.Char8
as PC
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Char8 as C
import Data.Data
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

import Haskoin.Address ( Address
, addrToJSON
, addrFromJSON
, textToAddr
)

import Aftok.Currency.Bitcoin
import Aftok.Auction as A
import qualified Aftok.Billing as B
import Aftok.Interval
import Aftok.Payments
import Aftok.Project as P
import Aftok.TimeLog
import Aftok.Types
import Aftok.Util ( traverseKeys )
replacement in lib/Aftok/Json.hs at line 11

[4.273]→[4.32561:32614](∅→∅),[4.32614]→[4.1446:1489](∅→∅),[4.1446]→[4.1446:1489](∅→∅)

import qualified Language.Haskell.TH as TH
import Language.Haskell.TH.Quote

[4.273]

[4.323]

import Aftok.Auction as A
import qualified Aftok.Billing as B
import Aftok.Currency.Bitcoin
import Aftok.Interval
import Aftok.Payments
import Aftok.Project as P
import Aftok.TimeLog
import Aftok.Types
import Aftok.Util (traverseKeys)
import Control.FromSum
( fromEitherM,
fromMaybeM,
)
import Control.Lens hiding ((.=))
import qualified Control.Lens as L
import Data.Aeson
import Data.Aeson.Types
import qualified Data.Attoparsec.ByteString.Char8 as PC
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Char8 as C
import Data.Data
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
import Haskoin.Address
( Address,
addrFromJSON,
addrToJSON,
textToAddr,
)
import qualified Language.Haskell.TH as TH
import Language.Haskell.TH.Quote
replacement in lib/Aftok/Json.hs at line 52

[4.324]→[4.3847:3941](∅→∅),[4.3991]→[4.3991:4042](∅→∅)

data Version = Version { majorVersion :: Word8
, minorVersion :: Word8
} deriving (Typeable, Data)

[4.324]

[4.484]

data Version
= Version
{ majorVersion :: Word8,
minorVersion :: Word8
}
deriving (Typeable, Data)
replacement in lib/Aftok/Json.hs at line 73

[4.21160]→[4.32716:32983](∅→∅)

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."
}

[4.21160]

[4.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 91

[4.187]→[4.1583:1587](∅→∅),[4.1587]→[4.4474:4578](∅→∅),[4.4474]→[4.4474:4578](∅→∅)

{-|
- Convenience function to allow dispatch of different serialized
- versions to different parsers.
-}

[4.187]

[4.652]

-- |
-- - Convenience function to allow dispatch of different serialized
-- - versions to different parsers.
replacement in lib/Aftok/Json.hs at line 97

[4.803]→[4.2885:2965](∅→∅)

vers <- fromEitherM fail $ PC.parseOnly versionParser (T.encodeUtf8 verstr)

[4.803]

[4.804]

vers <- fromEitherM fail $ PC.parseOnly versionParser (T.encodeUtf8 verstr)
replacement in lib/Aftok/Json.hs at line 111

[4.940]→[4.940:1001](∅→∅),[4.1001]→[4.1884:1924](∅→∅)

unv1 name f = unversion name $ p where
p (Version 1 0) = f
p ver = badVersion name ver

[4.940]

[4.939]

unv1 name f = unversion name $ p
where
p (Version 1 0) = f
p ver = badVersion name ver
replacement in lib/Aftok/Json.hs at line 116

[4.940]→[4.33071:33133](∅→∅)

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

[4.940]

[4.21705]

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

[4.21727]→[4.33134:33233](∅→∅)

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

[4.21727]

[4.5114]

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

[4.2437]→[4.4213:4263](∅→∅)

idValue :: forall a . Getter a UUID -> a -> Value

[4.2437]

[4.21821]

idValue :: forall a. Getter a UUID -> a -> Value
replacement in lib/Aftok/Json.hs at line 134

[4.1700]→[4.4264:4321](∅→∅)

idJSON :: forall a . Text -> Getter a UUID -> a -> Value

[4.1700]

[4.33340]

idJSON :: forall a. Text -> Getter a UUID -> a -> Value
replacement in lib/Aftok/Json.hs at line 145

[4.5298]→[4.33471:33632](∅→∅)

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

[4.5298]

[4.26515]

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

[4.571]→[4.33633:33823](∅→∅)

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

[4.571]

[4.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 176

[4.21955]→[4.33879:34058](∅→∅)

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

[4.21955]

[4.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 191

[4.22551]→[4.22551:22602](∅→∅)

ver -> badVersion "EventAmendment" ver

[4.22551]

[4.22602]

ver -> badVersion "EventAmendment" ver
replacement in lib/Aftok/Json.hs at line 193

[4.22603]→[4.22603:22616](∅→∅),[4.22616]→[4.34164:34431](∅→∅),[4.34431]→[4.58636:58682](∅→∅)

parseBtcAddr
:: 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, ))
(textToAddr (toNetwork nmode net) addrText)

[4.22603]

[4.22927]

parseBtcAddr ::
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,))
(textToAddr (toNetwork nmode net) addrText)
replacement in lib/Aftok/Json.hs at line 206

[4.22928]→[4.22928:22944](∅→∅),[4.22944]→[4.34480:34549](∅→∅)

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

[4.22928]

[4.23017]

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

[4.23091]→[4.34550:34635](∅→∅)

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

[4.23091]

[4.23174]

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

[4.23200]→[4.34636:34993](∅→∅)

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

[4.23200]

[4.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
parseCreditToUser =
fmap CreditToUser . parseId _UserId =<< o .: "creditToUser"
parseCreditToProject =
fmap CreditToProject . parseId _ProjectId =<< o .: "creditToProject"
notFound =
fail $ "Value " <> show o <> " does not represent a CreditTo value."
in parseCreditToAddr
<|> parseCreditToUser
<|> parseCreditToProject
<|> notFound
edit in lib/Aftok/Json.hs at line 235

[4.23543]→[4.34994:35084](∅→∅),[4.35084]→[4.23637:23638](∅→∅),[4.23637]→[4.23637:23638](∅→∅),[4.23638]→[4.35085:35187](∅→∅),[4.35187]→[4.23744:23745](∅→∅),[4.23744]→[4.23744:23745](∅→∅),[4.23745]→[4.35188:35377](∅→∅),[4.35377]→[4.23831:23832](∅→∅),[4.23831]→[4.23831:23832](∅→∅)

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

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

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

[4.35478]→[4.35478:35725](∅→∅),[4.35725]→[4.24181:24182](∅→∅),[4.2139]→[4.24181:24182](∅→∅),[4.24182]→[4.35726:35810](∅→∅),[4.35810]→[4.24264:24385](∅→∅),[4.24264]→[4.24264:24385](∅→∅),[4.24385]→[4.35811:35923](∅→∅)

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)]

parsePayoutsJSON
:: NetworkMode -> Value -> Parser (Payouts (NetworkId, Address))
parsePayoutsJSON nmode = unversion "Payouts" $ p where
p :: Version -> Object -> Parser (Payouts (NetworkId, Address))
p (Version 1 _) val = Payouts <$> join
(traverseKeys (parseBtcAddr nmode BTC) <$> parseJSON (Object val))

[4.35478]

[4.24497]

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 247

[4.24498]→[4.24498:24522](∅→∅),[4.24522]→[4.35924:35954](∅→∅)

p (Version 2 0) val =
let parsePayoutRecord x =

[4.24498]

[4.35954]

parsePayoutsJSON ::
NetworkMode -> Value -> Parser (Payouts (NetworkId, Address))
parsePayoutsJSON nmode = unversion "Payouts" $ p
where
p :: Version -> Object -> Parser (Payouts (NetworkId, Address))
p (Version 1 _) val =
Payouts
<$> join
(traverseKeys (parseBtcAddr nmode BTC) <$> parseJSON (Object val))
p (Version 2 0) val =
let parsePayoutRecord x =
replacement in lib/Aftok/Json.hs at line 261

[4.36073]→[4.36073:36185](∅→∅)

in Payouts
. MS.fromList
<$> (traverse parsePayoutRecord =<< parseJSON (Object val))

[4.36073]

[4.24755]

in Payouts
. MS.fromList
<$> (traverse parsePayoutRecord =<< parseJSON (Object val))
p ver x = badVersion "Payouts" ver x
edit in lib/Aftok/Json.hs at line 266

[4.24756]→[4.36186:36225](∅→∅),[4.1439]→[4.1904:1905](∅→∅),[4.2139]→[4.1904:1905](∅→∅),[4.3622]→[4.1904:1905](∅→∅),[4.5410]→[4.1904:1905](∅→∅),[4.24799]→[4.1904:1905](∅→∅),[4.36225]→[4.1904:1905](∅→∅),[4.1904]→[4.1904:1905](∅→∅)

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

[4.24892]→[4.4301:4602](∅→∅)

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

[4.24892]

[4.2061]

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

[4.5024]→[4.36708:36800](∅→∅),[4.36708]→[4.36708:36800](∅→∅)

[ "creditTo" .= creditToJSON nmode c
, "event" .= logEventJSON' ev
, "eventMeta" .= m

[4.5024]

[4.36800]

[ "creditTo" .= creditToJSON nmode c,
"event" .= logEventJSON' ev,
"eventMeta" .= m
replacement in lib/Aftok/Json.hs at line 310

[4.2627]→[4.36805:36887](∅→∅),[4.36887]→[4.2726:2768](∅→∅),[4.2726]→[4.2726:2768](∅→∅),[4.2768]→[4.36888:36988](∅→∅),[4.36988]→[4.2874:2916](∅→∅),[4.2874]→[4.2874:2916](∅→∅),[4.2916]→[4.25241:25322](∅→∅)

[ "projectId" .= idValue (B.project . _ProjectId) b
, "name" .= (b ^. B.name)
, "description" .= (b ^. B.description)
, "recurrence" .= recurrenceJSON' (b ^. B.recurrence)
, "amount" .= (b ^. (B.amount . satoshi))
, "gracePeriod" .= (b ^. B.gracePeriod)
, "requestExpiryPeriod" .= (Clock.toSeconds' <$> (b ^. B.requestExpiryPeriod))

[4.2627]

[4.2993]

[ "projectId" .= idValue (B.project . _ProjectId) b,
"name" .= (b ^. B.name),
"description" .= (b ^. B.description),
"recurrence" .= recurrenceJSON' (b ^. B.recurrence),
"amount" .= (b ^. (B.amount . satoshi)),
"gracePeriod" .= (b ^. B.gracePeriod),
"requestExpiryPeriod" .= (Clock.toSeconds' <$> (b ^. B.requestExpiryPeriod))
replacement in lib/Aftok/Json.hs at line 324

[4.1886]→[4.36989:37049](∅→∅)

recurrenceJSON' B.Annually = object ["annually" .= Null]

[4.1886]

[4.37049]

recurrenceJSON' B.Annually = object ["annually" .= Null]
replacement in lib/Aftok/Json.hs at line 327

[4.6442]→[4.37128:37263](∅→∅)

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

[4.6442]

[4.5681]

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

[4.2374]→[4.37264:37432](∅→∅)

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

[4.2374]

[4.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 344

[4.3359]→[4.37433:37485](∅→∅),[4.37485]→[4.2608:2670](∅→∅),[4.2608]→[4.2608:2670](∅→∅),[4.2670]→[4.37486:37564](∅→∅)

[ "user_id" .= idValue (B.customer . _UserId) sub
, "billable_id" .= idValue (B.billable . B._BillableId) sub
, "start_time" .= view B.startTime sub
, "end_time" .= view B.endTime sub

[4.3359]

[4.3557]

[ "user_id" .= idValue (B.customer . _UserId) sub,
"billable_id" .= idValue (B.billable . B._BillableId) sub,
"start_time" .= view B.startTime sub,
"end_time" .= view B.endTime sub
replacement in lib/Aftok/Json.hs at line 358

[4.3694]→[4.2671:2793](∅→∅),[4.2793]→[4.601:770](∅→∅),[4.601]→[4.601:770](∅→∅)

[ "subscription_id" .= idValue (subscription . B._SubscriptionId) r
, "payment_request_protobuf_64" .= view prBytes r
, "url_key" .= view (paymentKey . _PaymentKey) r
, "payment_request_time" .= view paymentRequestTime r
, "billing_date" .= view (billingDate . to showGregorian) r

[4.3694]

[4.4007]

[ "subscription_id" .= idValue (subscription . B._SubscriptionId) r,
"payment_request_protobuf_64" .= view prBytes r,
"url_key" .= view (paymentKey . _PaymentKey) r,
"payment_request_time" .= view paymentRequestTime r,
"billing_date" .= view (billingDate . to showGregorian) r
replacement in lib/Aftok/Json.hs at line 364

[4.4011]→[4.37565:37661](∅→∅)

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

[4.4011]

[4.4011]

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

[4.4171]→[4.37738:37921](∅→∅)

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

[4.4171]

[4.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 385

[4.1008]→[4.37922:38203](∅→∅)

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)

[4.1008]

[4.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 402

[4.25383]→[4.38204:38307](∅→∅)

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

[4.25383]

[4.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 405

[4.27208]→[4.38308:38365](∅→∅)

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

[4.27208]

[4.25384]

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

[4.5640]→[4.25425:25703](∅→∅),[4.25703]→[4.2159:2211](∅→∅),[4.3941]→[4.2159:2211](∅→∅)

parseEventAmendment
:: NetworkMode
-> ModTime
-> Value
-> Parser (EventAmendment (NetworkId, Address))
parseEventAmendment nmode t = unversion "EventAmendment" $ p where
p (Version 1 _) = parseEventAmendmentV1 nmode t
p (Version 2 0) = parseEventAmendmentV2 nmode t
p ver = badVersion "EventAmendment" ver

[4.5640]

[4.1956]

parseEventAmendment ::
NetworkMode ->
ModTime ->
Value ->
Parser (EventAmendment (NetworkId, Address))
parseEventAmendment nmode t = unversion "EventAmendment" $ p
where
p (Version 1 _) = parseEventAmendmentV1 nmode t
p (Version 2 0) = parseEventAmendmentV2 nmode t
p ver = badVersion "EventAmendment" ver
replacement in lib/Aftok/Json.hs at line 419

[4.1957]→[4.25704:25818](∅→∅)

parseEventAmendmentV1
:: NetworkMode
-> ModTime
-> Object
-> Parser (EventAmendment (NetworkId, Address))

[4.1957]

[4.25818]

parseEventAmendmentV1 ::
NetworkMode ->
ModTime ->
Object ->
Parser (EventAmendment (NetworkId, Address))
replacement in lib/Aftok/Json.hs at line 425

[4.25852]→[4.38366:38771](∅→∅)

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

[4.25852]

[4.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 433

[4.2513]→[4.26083:26197](∅→∅)

parseEventAmendmentV2
:: NetworkMode
-> ModTime
-> Object
-> Parser (EventAmendment (NetworkId, Address))

[4.2513]

[4.26197]

parseEventAmendmentV2 ::
NetworkMode ->
ModTime ->
Object ->
Parser (EventAmendment (NetworkId, Address))
replacement in lib/Aftok/Json.hs at line 439

[4.26231]→[4.38772:39177](∅→∅)

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

[4.26231]

[4.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 447

[4.3863]→[4.26463:26658](∅→∅),[4.148]→[4.4722:4747](∅→∅),[4.1445]→[4.4722:4747](∅→∅),[4.26658]→[4.4722:4747](∅→∅),[4.4722]→[4.4722:4747](∅→∅),[4.4747]→[4.39178:39316](∅→∅),[4.236]→[4.4801:4837](∅→∅),[4.26754]→[4.4801:4837](∅→∅),[4.39316]→[4.4801:4837](∅→∅),[4.4801]→[4.4801:4837](∅→∅),[4.39]→[4.138:191](∅→∅),[4.4837]→[4.138:191](∅→∅),[4.347]→[4.138:191](∅→∅)

parseLogEntry
:: NetworkMode
-> UserId
-> (UTCTime -> LogEvent)
-> Value
-> Parser (UTCTime -> (LogEntry (NetworkId, Address)))
parseLogEntry nmode uid f = unversion "LogEntry" p where
p (Version 2 0) o = do
creditTo' <- o .:? "creditTo" >>= maybe (pure $ CreditToUser uid)
(parseCreditToV2 nmode)
eventMeta' <- o .:? "eventMeta"
pure $ \t -> LogEntry creditTo' (f t) eventMeta'

[4.3863]

[4.664]

parseLogEntry ::
NetworkMode ->
UserId ->
(UTCTime -> LogEvent) ->
Value ->
Parser (UTCTime -> (LogEntry (NetworkId, Address)))
parseLogEntry nmode uid f = unversion "LogEntry" p
where
p (Version 2 0) o = do
creditTo' <-
o .:? "creditTo"
>>= maybe
(pure $ CreditToUser uid)
(parseCreditToV2 nmode)
eventMeta' <- o .:? "eventMeta"
pure $ \t -> LogEntry creditTo' (f t) eventMeta'
p ver o = badVersion "LogEntry" ver o
edit in lib/Aftok/Json.hs at line 465

[4.665]→[4.26755:26795](∅→∅),[4.26795]→[4.3226:3227](∅→∅),[4.3226]→[4.3226:3227](∅→∅)

p ver o = badVersion "LogEntry" ver o
replacement in lib/Aftok/Json.hs at line 467

[4.26816]→[4.39317:39616](∅→∅),[4.3263]→[4.987:988](∅→∅),[4.4874]→[4.987:988](∅→∅),[4.27850]→[4.987:988](∅→∅),[4.39616]→[4.987:988](∅→∅),[4.987]→[4.987:988](∅→∅),[4.988]→[4.39617:39875](∅→∅)

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'

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

[4.26816]

[4.3264]

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'
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 1

[4.10545]→[4.2139:2209](∅→∅)

{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}

[4.10545]

[4.6635]

{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
replacement in lib/Aftok/Payments/Types.hs at line 4

[4.6670]→[4.4381:4416](∅→∅),[4.4416]→[4.2210:2245](∅→∅),[4.6670]→[4.2210:2245](∅→∅)

{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE TemplateHaskell #-}

[4.6670]

[4.10579]

{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE TemplateHaskell #-}
edit in lib/Aftok/Payments/Types.hs at line 9

[4.10615]

[4.10646]

import Aftok.Billing
( Billable,
Subscription,
SubscriptionId,
)
import qualified Bippy.Proto as P
import Bippy.Types
( Satoshi (..),
expiryTime,
getExpires,
getPaymentDetails,
)
import Control.Lens
( makeLenses,
makePrisms,
view,
)
import Data.Aeson (Value)
import qualified Data.Text as T
import Data.Thyme.Clock as C
import Data.Thyme.Time as C
import Data.UUID
import Haskoin.Address.Base58 (decodeBase58Check)
edit in lib/Aftok/Payments/Types.hs at line 33

[4.10647]

[4.3602]

newtype PaymentRequestId = PaymentRequestId UUID deriving (Show, Eq)
edit in lib/Aftok/Payments/Types.hs at line 35

[4.3603]→[4.39878:40105](∅→∅),[4.1973]→[4.10703:10704](∅→∅),[4.2308]→[4.10703:10704](∅→∅),[4.4485]→[4.10703:10704](∅→∅),[4.40105]→[4.10703:10704](∅→∅),[4.10703]→[4.10703:10704](∅→∅),[4.10704]→[4.40106:40320](∅→∅),[4.2064]→[4.10746:10774](∅→∅),[4.2351]→[4.10746:10774](∅→∅),[4.3694]→[4.10746:10774](∅→∅),[4.40320]→[4.10746:10774](∅→∅),[4.10746]→[4.10746:10774](∅→∅),[4.10774]→[4.4689:4802](∅→∅),[4.4802]→[4.40434:40675](∅→∅),[4.58782]→[4.40434:40675](∅→∅),[4.40434]→[4.40434:40675](∅→∅),[4.40675]→[4.4803:4873](∅→∅),[4.1241]→[4.10816:10817](∅→∅),[4.2433]→[4.10816:10817](∅→∅),[4.4873]→[4.10816:10817](∅→∅),[4.27112]→[4.10816:10817](∅→∅),[4.40745]→[4.10816:10817](∅→∅),[4.58845]→[4.10816:10817](∅→∅),[4.10816]→[4.10816:10817](∅→∅),[4.10817]→[2.5072:5131](∅→∅),[2.5131]→[4.40805:40983](∅→∅),[4.40805]→[4.40805:40983](∅→∅),[4.2317]→[4.10857:10927](∅→∅),[4.2488]→[4.10857:10927](∅→∅),[4.4564]→[4.10857:10927](∅→∅),[4.40983]→[4.10857:10927](∅→∅),[4.10857]→[4.10857:10927](∅→∅)

import Control.Lens ( makeLenses
, makePrisms
, view
)

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

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

import Aftok.Billing ( Billable
, Subscription
, SubscriptionId
)

newtype PaymentRequestId = PaymentRequestId UUID deriving (Show, Eq)
edit in lib/Aftok/Payments/Types.hs at line 38

[4.11013]

[4.11013]
edit in lib/Aftok/Payments/Types.hs at line 44

[4.1294]

[4.1294]
replacement in lib/Aftok/Payments/Types.hs at line 47

[4.11037]→[4.11037:11150](∅→∅),[4.11150]→[4.2318:2356](∅→∅),[4.2356]→[4.6796:6833](∅→∅),[4.11150]→[4.6796:6833](∅→∅),[4.6833]→[4.3695:3728](∅→∅),[4.3728]→[4.6866:6912](∅→∅),[4.6866]→[4.6866:6912](∅→∅)

data PaymentRequest' s = PaymentRequest
{ _subscription :: s
, _paymentRequest :: P.PaymentRequest
, _paymentKey :: PaymentKey
, _paymentRequestTime :: C.UTCTime
, _billingDate :: C.Day
} deriving (Functor, Foldable, Traversable)

[4.11037]

[4.11191]

data PaymentRequest' s
= PaymentRequest
{ _subscription :: s,
_paymentRequest :: P.PaymentRequest,
_paymentKey :: PaymentKey,
_paymentRequestTime :: C.UTCTime,
_billingDate :: C.Day
}
deriving (Functor, Foldable, Traversable)
replacement in lib/Aftok/Payments/Types.hs at line 61

[4.11275]→[4.11275:11301](∅→∅),[4.11301]→[4.822:944](∅→∅),[4.944]→[4.6913:6959](∅→∅),[4.11383]→[4.6913:6959](∅→∅)

data Payment' r = Payment
{ _request :: r
, _payment :: P.Payment
, _paymentDate :: C.UTCTime
, _exchangeRates :: Maybe Value
} deriving (Functor, Foldable, Traversable)

[4.11275]

[4.11387]

data Payment' r
= Payment
{ _request :: r,
_payment :: P.Payment,
_paymentDate :: C.UTCTime,
_exchangeRates :: Maybe Value
}
deriving (Functor, Foldable, Traversable)
replacement in lib/Aftok/Payments/Types.hs at line 79

[4.7098]→[4.40984:41047](∅→∅)

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

[4.7098]

[4.2489]

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

[4.3782]→[4.2924:3029](∅→∅),[4.3029]→[4.41145:41250](∅→∅),[4.41145]→[4.41145:41250](∅→∅)

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

[4.3782]

[4.2571]

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

[4.5686]→[4.2574:2613](∅→∅)

{-# LANGUAGE FlexibleContexts #-}

[4.5686]

[4.2613]

{-# LANGUAGE FlexibleContexts #-}
replacement in lib/Aftok/Payments.hs at line 3

[4.2652]→[4.2652:2691](∅→∅)

{-# LANGUAGE TemplateHaskell #-}

[4.2652]

[4.5720]

{-# LANGUAGE TemplateHaskell #-}
replacement in lib/Aftok/Payments.hs at line 6

[4.2714]→[4.11546:11604](∅→∅),[4.11546]→[4.11546:11604](∅→∅)

( module Aftok.Payments
, module Aftok.Payments.Types

[4.2714]

[4.4875]

( module Aftok.Payments,
module Aftok.Payments.Types,
replacement in lib/Aftok/Payments.hs at line 11

[4.5781]→[4.5781:5782](∅→∅)

[4.5750]

[4.3882]

import Aftok.Billing
import Aftok.Currency.Bitcoin
( NetworkId (..),
NetworkMode,
satoshi,
toNetwork,
)
import Aftok.Database
import Aftok.Payments.Types
import Aftok.Project (depf)
import qualified Aftok.TimeLog as TL
import Aftok.Types
( ProjectId,
UserId,
)
import qualified Bippy as B
import qualified Bippy.Proto as P
import qualified Bippy.Types as BT
import Control.Error.Util (maybeT)
import Control.Lens
( (%~),
(^.),
makeClassy,
makeClassyPrisms,
review,
traverseOf,
view,
)
import Control.Lens.Tuple
import Control.Monad.Except
( MonadError,
throwError,
)
import qualified Crypto.PubKey.RSA.Types as RSA
( Error (..),
PrivateKey,
)
import Crypto.Random.Types
( MonadRandom,
getRandomBytes,
)
import Data.AffineSpace ((.+^))
import Data.Map.Strict (assocs)
import Data.Thyme.Clock as C
import Data.Thyme.Time as T
import Haskoin.Address (Address (..))
import Haskoin.Address.Base58 (encodeBase58Check)
import Haskoin.Script (ScriptOutput (..))
import Network.URI
replacement in lib/Aftok/Payments.hs at line 61

[4.3883]→[4.4886:5406](∅→∅),[4.2905]→[4.11677:11713](∅→∅),[4.5406]→[4.11677:11713](∅→∅),[4.7517]→[4.11677:11713](∅→∅),[4.28572]→[4.11677:11713](∅→∅),[4.11677]→[4.11677:11713](∅→∅),[4.11713]→[4.5407:5981](∅→∅),[4.586]→[4.5839:5840](∅→∅),[4.2275]→[4.5839:5840](∅→∅),[4.2429]→[4.5839:5840](∅→∅),[4.3100]→[4.5839:5840](∅→∅),[4.5981]→[4.5839:5840](∅→∅),[4.11880]→[4.5839:5840](∅→∅),[4.5839]→[4.5839:5840](∅→∅),[4.5840]→[4.5982:6203](∅→∅),[4.3292]→[4.5916:5917](∅→∅),[4.6203]→[4.5916:5917](∅→∅),[4.12016]→[4.5916:5917](∅→∅),[4.5916]→[4.5916:5917](∅→∅),[4.5917]→[4.6204:6564](∅→∅),[4.3493]→[4.12157:12186](∅→∅),[4.6564]→[4.12157:12186](∅→∅),[4.59122]→[4.12157:12186](∅→∅),[4.12157]→[4.12157:12186](∅→∅),[4.12186]→[4.5959:5960](∅→∅),[4.5959]→[4.5959:5960](∅→∅),[4.5960]→[4.6565:6682](∅→∅),[4.6744]→[4.6744:6794](∅→∅),[4.6794]→[2.5133:5164](∅→∅),[2.5164]→[4.6795:7089](∅→∅),[4.2352]→[4.6795:7089](∅→∅),[4.7089]→[4.3624:3656](∅→∅),[4.27489]→[4.3624:3656](∅→∅),[4.2352]→[4.3624:3656](∅→∅),[4.3656]→[4.12296:12334](∅→∅),[4.2352]→[4.12296:12334](∅→∅),[4.12334]→[4.7090:7200](∅→∅)

import Control.Error.Util ( maybeT )
import Control.Lens ( makeClassy
, makeClassyPrisms
, review
, view
, (%~)
, (^.)
, traverseOf
)
import Control.Lens.Tuple
import Control.Monad.Except ( MonadError
, throwError
)
import qualified Crypto.PubKey.RSA.Types as RSA
( Error(..)
, PrivateKey
)
import Crypto.Random.Types ( MonadRandom
, getRandomBytes
)

import Data.AffineSpace ( (.+^) )
import Data.Map.Strict ( assocs )
import Data.Thyme.Clock as C
import Data.Thyme.Time as T

import qualified Bippy as B
import qualified Bippy.Proto as P
import qualified Bippy.Types as BT
import Haskoin.Address ( Address(..) )
import Haskoin.Address.Base58 ( encodeBase58Check )
import Haskoin.Script ( ScriptOutput(..) )
import Network.URI

import Aftok.Types ( UserId
, ProjectId
)
import Aftok.Billing
import Aftok.Currency.Bitcoin ( NetworkId(..)
, NetworkMode
, satoshi
, toNetwork
)
import Aftok.Database
import Aftok.Payments.Types
import Aftok.Project ( depf )
import qualified Aftok.TimeLog as TL

[4.3883]

[4.12459]

data PaymentsConfig
= PaymentsConfig
{ _networkMode :: !NetworkMode,
_signingKey :: !RSA.PrivateKey,
_pkiData :: !BT.PKIData
}
edit in lib/Aftok/Payments.hs at line 68

[4.12460]→[4.28644:28681](∅→∅),[4.28681]→[4.27539:27643](∅→∅),[4.3876]→[4.12579:12583](∅→∅),[4.27643]→[4.12579:12583](∅→∅),[4.28778]→[4.12579:12583](∅→∅),[4.12579]→[4.12579:12583](∅→∅)

data PaymentsConfig = PaymentsConfig
{ _networkMode :: !NetworkMode
, _signingKey :: !RSA.PrivateKey
, _pkiData :: !BT.PKIData
}
replacement in lib/Aftok/Payments.hs at line 70

[4.7760]→[4.7760:7803](∅→∅),[4.7803]→[4.2492:2525](∅→∅),[4.2525]→[4.28808:29071](∅→∅),[4.29071]→[4.2613:2657](∅→∅),[4.2613]→[4.2613:2657](∅→∅),[4.2657]→[4.27644:27735](∅→∅),[4.27735]→[4.29164:29196](∅→∅),[4.29164]→[4.29164:29196](∅→∅),[4.29196]→[4.2703:2743](∅→∅),[4.2703]→[4.2703:2743](∅→∅),[4.2743]→[4.29197:29427](∅→∅),[4.29427]→[4.27736:27775](∅→∅),[4.2837]→[4.8102:8106](∅→∅),[4.5100]→[4.8102:8106](∅→∅),[4.27775]→[4.8102:8106](∅→∅),[4.29467]→[4.8102:8106](∅→∅),[4.8102]→[4.8102:8106](∅→∅)

data BillingOps (m :: * -> *) = BillingOps
{ -- | generator for user memo
memoGen :: Subscription' UserId Billable -- ^ subscription being billed
-> T.Day -- ^ billing date
-> C.UTCTime -- ^ payment request generation time
-> m (Maybe Text)
-- | generator for payment response URL
, uriGen :: PaymentKey -- ^ payment key to be included in the URL
-> m (Maybe URI)
-- | generator for merchant payload
, payloadGen :: Subscription' UserId Billable -- ^ subscription being billed
-> T.Day -- ^ billing date
-> C.UTCTime -- ^ payment request generation time
-> m (Maybe ByteString)
}

[4.7760]

[4.8106]

data BillingOps (m :: * -> *)
= BillingOps
{ -- | generator for user memo
memoGen ::
Subscription' UserId Billable -> -- subscription being billed
T.Day -> -- billing date
C.UTCTime -> -- payment request generation time
m (Maybe Text),
-- | generator for payment response URL
uriGen ::
PaymentKey -> -- payment key to be included in the URL
m (Maybe URI),
-- | generator for merchant payload
payloadGen ::
Subscription' UserId Billable -> -- subscription being billed
T.Day -> -- billing date
C.UTCTime -> -- payment request generation time
m (Maybe ByteString)
}
replacement in lib/Aftok/Payments.hs at line 91

[4.4107]→[4.29468:29724](∅→∅)

= Paid !Payment -- ^ the request was paid with the specified payment
| Unpaid !PaymentRequest -- ^ the request has not been paid, but has not yet expired
| Expired !PaymentRequest -- ^ the request was not paid prior to the expiration date

[4.4107]

[4.12610]

= -- | the request was paid with the specified payment
Paid !Payment
| -- | the request has not been paid, but has not yet expired
Unpaid !PaymentRequest
| -- | the request was not paid prior to the expiration date
Expired !PaymentRequest
edit in lib/Aftok/Payments.hs at line 102

[4.27804]

[4.8460]
replacement in lib/Aftok/Payments.hs at line 110

[4.29955]→[4.7201:7632](∅→∅)

createPaymentRequests
:: ( MonadRandom m
, MonadReader r m
, HasPaymentsConfig r
, MonadError e m
, AsPaymentError e
, MonadDB m
)
=> BillingOps m -- ^ generators for payment request components
-> C.UTCTime -- ^ timestamp for payment request creation
-> UserId -- ^ customer responsible for payment
-> ProjectId -- ^ project whose worklog is to be paid
-> m [PaymentRequestId]

[4.29955]

[4.9049]

createPaymentRequests ::
( MonadRandom m,
MonadReader r m,
HasPaymentsConfig r,
MonadError e m,
AsPaymentError e,
MonadDB m
) =>
-- | generators for payment request components
BillingOps m ->
-- | timestamp for payment request creation
C.UTCTime ->
-- | customer responsible for payment
UserId ->
-- | project whose worklog is to be paid
ProjectId ->
m [PaymentRequestId]
replacement in lib/Aftok/Payments.hs at line 131

[4.9183]→[4.7633:7784](∅→∅),[4.7784]→[4.9325:9342](∅→∅),[4.9325]→[4.9325:9342](∅→∅),[4.9342]→[4.4262:4287](∅→∅),[4.4287]→[4.9369:9384](∅→∅),[4.9369]→[4.9369:9384](∅→∅),[4.9396]→[4.9396:9458](∅→∅)

createSubscriptionPaymentRequests
:: ( MonadRandom m
, MonadReader r m
, HasPaymentsConfig r
, MonadError e m
, AsPaymentError e
, MonadDB m
)
=> BillingOps m
-> C.UTCTime
-> (SubscriptionId, Subscription)
-> m [PaymentRequestId]

[4.9183]

[4.2917]

createSubscriptionPaymentRequests ::
( MonadRandom m,
MonadReader r m,
HasPaymentsConfig r,
MonadError e m,
AsPaymentError e,
MonadDB m
) =>
BillingOps m ->
C.UTCTime ->
(SubscriptionId, Subscription) ->
m [PaymentRequestId]
replacement in lib/Aftok/Payments.hs at line 145

[4.7802]→[4.7802:7919](∅→∅)

maybeT (raiseSubjectNotFound . FindBillable $ sub ^. billable) pure
$ traverseOf billable findBillable sub

[4.7802]

[4.9653]

maybeT (raiseSubjectNotFound . FindBillable $ sub ^. billable) pure $
traverseOf billable findBillable sub
replacement in lib/Aftok/Payments.hs at line 148

[4.9698]→[4.7920:7941](∅→∅)

billableDates <-

[4.9698]

[4.7941]

billableDates <-
replacement in lib/Aftok/Payments.hs at line 150

[4.8011]→[4.8011:8083](∅→∅)

$ takeWhile (< view _utctDay now)
$ billingSchedule billableSub

[4.8011]

[4.2976]

$ takeWhile (< view _utctDay now)
$ billingSchedule billableSub
replacement in lib/Aftok/Payments.hs at line 154

[4.9950]→[4.8084:8222](∅→∅),[4.8222]→[4.10079:10096](∅→∅),[4.10079]→[4.10079:10096](∅→∅),[4.10096]→[4.4313:4338](∅→∅),[4.4338]→[4.10123:10138](∅→∅),[4.10123]→[4.10123:10138](∅→∅),[4.10150]→[4.10150:10170](∅→∅),[4.10170]→[4.5101:5136](∅→∅),[4.5136]→[4.10198:10233](∅→∅),[4.10198]→[4.10198:10233](∅→∅)

createPaymentRequest
:: ( MonadRandom m
, MonadReader r m
, HasPaymentsConfig r
, MonadError e m
, AsPaymentError e
, MonadDB m
)
=> BillingOps m
-> C.UTCTime
-> SubscriptionId
-> Subscription' UserId Billable
-> T.Day
-> m PaymentRequestId

[4.9950]

[4.3049]

createPaymentRequest ::
( MonadRandom m,
MonadReader r m,
HasPaymentsConfig r,
MonadError e m,
AsPaymentError e,
MonadDB m
) =>
BillingOps m ->
C.UTCTime ->
SubscriptionId ->
Subscription' UserId Billable ->
T.Day ->
m PaymentRequestId
replacement in lib/Aftok/Payments.hs at line 169

[4.3096]→[4.8223:8240](∅→∅)

cfg <- ask

[4.3096]

[4.946]

cfg <- ask
replacement in lib/Aftok/Payments.hs at line 171

[4.1016]→[4.27805:27871](∅→∅),[4.27871]→[4.3193:3260](∅→∅),[4.3193]→[4.3193:3260](∅→∅)

pkey <- PaymentKey . encodeBase58Check <$> getRandomBytes 32
memo <- memoGen ops sub bday now
uri <- uriGen ops pkey

[4.1016]

[4.3260]

pkey <- PaymentKey . encodeBase58Check <$> getRandomBytes 32
memo <- memoGen ops sub bday now
uri <- uriGen ops pkey
replacement in lib/Aftok/Payments.hs at line 176

[4.10455]→[4.10455:10604](∅→∅)

reqErr <- B.createPaymentRequest (cfg ^. signingKey) (cfg ^. pkiData) details
req <- either (throwError . review _SigningError) pure reqErr

[4.10455]

[4.3302]

reqErr <- B.createPaymentRequest (cfg ^. signingKey) (cfg ^. pkiData) details
req <- either (throwError . review _SigningError) pure reqErr
replacement in lib/Aftok/Payments.hs at line 184

[4.10845]→[4.8241:8632](∅→∅)

findUnbilledDates
:: (MonadDB m, MonadError e m, AsPaymentError e)
=> C.UTCTime -- ^ the date against which payment request expiration should be checked
-> Billable
-> [(PaymentRequestId, PaymentRequest)] -- ^ the list of existing payment requests
-> [T.Day] -- ^ the list of expected billing days
-> m [T.Day] -- ^ the list of billing days for which no payment request exists

[4.10845]

[4.8632]

findUnbilledDates ::
(MonadDB m, MonadError e m, AsPaymentError e) =>
-- | the date against which payment request expiration should be checked
C.UTCTime ->
Billable ->
-- | the list of existing payment requests
[(PaymentRequestId, PaymentRequest)] ->
-- | the list of expected billing days
[T.Day] ->
-- | the list of billing days for which no payment request exists
m [T.Day]
replacement in lib/Aftok/Payments.hs at line 197

[4.11421]→[4.11421:11474](∅→∅),[4.11474]→[4.8687:9008](∅→∅)

EQ -> getRequestStatus now p >>= \s -> case s of
Expired r ->
if view _utctDay now > addDays (view gracePeriod b) (view billingDate r)
then throwError (review _Overdue (r ^. subscription))
else fmap (d :) $ findUnbilledDates now b px dx -- d will be rebilled
_ -> findUnbilledDates now b ps ds -- if paid or unpaid, nothing to do

[4.11421]

[4.4542]

EQ ->
getRequestStatus now p >>= \s -> case s of
Expired r ->
if view _utctDay now > addDays (view gracePeriod b) (view billingDate r)
then throwError (review _Overdue (r ^. subscription))
else fmap (d :) $ findUnbilledDates now b px dx -- d will be rebilled
_ -> findUnbilledDates now b ps ds -- if paid or unpaid, nothing to do
edit in lib/Aftok/Payments.hs at line 208

[4.611]→[4.11974:11975](∅→∅)
replacement in lib/Aftok/Payments.hs at line 211

[4.12126]→[4.9009:9236](∅→∅)

getRequestStatus
:: (MonadDB m)
=> C.UTCTime -- ^ the date against which request expiration should be checked
-> (PaymentRequestId, PaymentRequest) -- ^ the request for which to find a payment
-> m PaymentRequestStatus

[4.12126]

[4.4629]

getRequestStatus ::
(MonadDB m) =>
-- | the date against which request expiration should be checked
C.UTCTime ->
-- | the request for which to find a payment
(PaymentRequestId, PaymentRequest) ->
m PaymentRequestStatus
replacement in lib/Aftok/Payments.hs at line 220

[4.5206]→[4.30166:30226](∅→∅)

in maybe ifUnpaid Paid <$> runMaybeT (findPayment reqid)

[4.5206]

[4.13890]

in maybe ifUnpaid Paid <$> runMaybeT (findPayment reqid)
replacement in lib/Aftok/Payments.hs at line 224

[4.12639]→[4.27872:27914](∅→∅),[4.27914]→[4.9237:9333](∅→∅),[4.9333]→[4.27999:28354](∅→∅),[4.27999]→[4.27999:28354](∅→∅)

createPaymentDetails
:: ( MonadRandom m
, MonadReader r m
, HasPaymentsConfig r
, MonadError e m
, AsPaymentError e
, MonadDB m
)
=> T.Day -- ^ payout date (billing date)
-> C.UTCTime -- ^ timestamp of payment request creation
-> Maybe Text -- ^ user memo
-> Maybe URI -- ^ payment response URL
-> Maybe ByteString -- ^ merchant payload
-> Billable -- ^ billing information
-> m P.PaymentDetails

[4.12639]

[4.13150]

createPaymentDetails ::
( MonadRandom m,
MonadReader r m,
HasPaymentsConfig r,
MonadError e m,
AsPaymentError e,
MonadDB m
) =>
-- | payout date (billing date)
T.Day ->
-- | timestamp of payment request creation
C.UTCTime ->
-- | user memo
Maybe Text ->
-- | payment response URL
Maybe URI ->
-- | merchant payload
Maybe ByteString ->
-- | billing information
Billable ->
m P.PaymentDetails
replacement in lib/Aftok/Payments.hs at line 252

[4.14564]→[4.9445:9824](∅→∅)

pure $ B.createPaymentDetails (toNetwork (cfg ^. networkMode) BTC)
outputs
(T.fromThyme billingTime)
expiry
memo
uri
payload
where payoutTime = T.mkUTCTime payoutDate (fromInteger 0)

[4.14564]

[4.14659]

pure $
B.createPaymentDetails
(toNetwork (cfg ^. networkMode) BTC)
outputs
(T.fromThyme billingTime)
expiry
memo
uri
payload
where
payoutTime = T.mkUTCTime payoutDate (fromInteger 0)
replacement in lib/Aftok/Payments.hs at line 264

[4.14660]→[4.14660:14661](∅→∅),[4.14661]→[4.28397:28537](∅→∅)

getProjectPayouts
:: (MonadDB m, MonadError e m, AsPaymentError e)
=> C.UTCTime
-> ProjectId
-> m (TL.Payouts (NetworkId, Address))

[4.14660]

[4.14736]

getProjectPayouts ::
(MonadDB m, MonadError e m, AsPaymentError e) =>
C.UTCTime ->
ProjectId ->
m (TL.Payouts (NetworkId, Address))
replacement in lib/Aftok/Payments.hs at line 272

[4.14820]→[4.14820:14894](∅→∅)

in maybe (raiseSubjectNotFound projectOp) pure =<< liftdb projectOp

[4.14820]

[4.14894]

in maybe (raiseSubjectNotFound projectOp) pure =<< liftdb projectOp
replacement in lib/Aftok/Payments.hs at line 276

[4.14994]→[4.14994:14995](∅→∅),[4.14995]→[4.28538:28697](∅→∅)

createPayoutsOutputs
:: (MonadDB m, MonadError e m, AsPaymentError e)
=> C.UTCTime
-> BT.Satoshi
-> TL.Payouts (NetworkId, Address)
-> m [BT.Output]

[4.14994]

[4.4875]

createPayoutsOutputs ::
(MonadDB m, MonadError e m, AsPaymentError e) =>
C.UTCTime ->
BT.Satoshi ->
TL.Payouts (NetworkId, Address) ->
m [BT.Output]
replacement in lib/Aftok/Payments.hs at line 285

[4.15254]→[4.15254:15322](∅→∅)

in join <$> traverse (uncurry (createOutputs t)) payoutFractions

[4.15253]

[4.15322]

in join <$> traverse (uncurry (createOutputs t)) payoutFractions
replacement in lib/Aftok/Payments.hs at line 287

[4.642]→[4.6029:6030](∅→∅),[4.15323]→[4.6029:6030](∅→∅),[4.6029]→[4.6029:6030](∅→∅),[4.6030]→[4.28773:28926](∅→∅)

createOutputs
:: (MonadDB m, MonadError e m, AsPaymentError e)
=> C.UTCTime
-> TL.CreditTo (NetworkId, Address)
-> BT.Satoshi
-> m [BT.Output]

[4.15323]

[4.28926]

createOutputs ::
(MonadDB m, MonadError e m, AsPaymentError e) =>
C.UTCTime ->
TL.CreditTo (NetworkId, Address) ->
BT.Satoshi ->
m [BT.Output]
edit in lib/Aftok/Payments.hs at line 295

[4.666]→[4.6085:6086](∅→∅),[4.15513]→[4.6085:6086](∅→∅),[4.6085]→[4.6085:6086](∅→∅)
edit in lib/Aftok/Payments.hs at line 297

[4.29096]→[4.29096:29097](∅→∅)
replacement in lib/Aftok/Payments.hs at line 301

[4.29228]→[4.9825:9890](∅→∅),[4.744]→[4.6287:6288](∅→∅),[4.9890]→[4.6287:6288](∅→∅),[4.15733]→[4.6287:6288](∅→∅),[4.29283]→[4.6287:6288](∅→∅),[4.30520]→[4.6287:6288](∅→∅),[4.6287]→[4.6287:6288](∅→∅)

other -> throwError $ review _IllegalAddress other

[4.29228]

[4.15734]

other -> throwError $ review _IllegalAddress other
edit in lib/Aftok/Payments.hs at line 305

[4.15858]→[4.798:799](∅→∅),[4.798]→[4.798:799](∅→∅)
replacement in lib/Aftok/Payments.hs at line 309

[4.5208]→[4.9891:9987](∅→∅)

findPayableRequests
:: (MonadDB m) => UserId -> SubscriptionId -> C.UTCTime -> m [BillDetail]

[4.5208]

[4.5302]

findPayableRequests ::
(MonadDB m) => UserId -> SubscriptionId -> C.UTCTime -> m [BillDetail]
replacement in lib/Aftok/Payments.hs at line 315

[4.10076]→[4.10076:10247](∅→∅)

where
findOp = FindUnpaidRequests sid
checkAccess d = if view (_3 . customer) d == uid
then pure [d]
else raiseOpForbidden uid (UserNotSubscriber sid) findOp

[4.10076]

where
findOp = FindUnpaidRequests sid
checkAccess d =
if view (_3 . customer) d == uid
then pure [d]
else raiseOpForbidden uid (UserNotSubscriber sid) findOp
edit in lib/Aftok/Project.hs at line 5

[4.1097]

[4.1128]

import Aftok.Types
import Control.Lens
( makeLenses,
makePrisms,
)
import Crypto.Random.Types
( MonadRandom,
getRandomBytes,
)
import qualified Data.ByteString as BS
import Data.ByteString.Base64.URL as B64
import Data.Thyme.Clock as C
edit in lib/Aftok/Project.hs at line 18

[4.1129]→[4.3885:3886](∅→∅),[4.3886]→[4.41340:41689](∅→∅),[4.16058]→[4.6468:6469](∅→∅),[4.41689]→[4.6468:6469](∅→∅),[4.1198]→[4.6468:6469](∅→∅),[4.6469]→[4.41690:41849](∅→∅),[4.41849]→[4.1381:1382](∅→∅),[4.1381]→[4.1381:1382](∅→∅),[4.1382]→[4.29285:29314](∅→∅),[4.29314]→[4.1460:1461](∅→∅),[4.1460]→[4.1460:1461](∅→∅)

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

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

import Aftok.Types
replacement in lib/Aftok/Project.hs at line 20

[4.16060]→[4.1485:1650](∅→∅),[4.1485]→[4.1485:1650](∅→∅)

data Project = Project
{ _projectName :: ProjectName
, _inceptionDate :: C.UTCTime
, _initiator :: UserId
, _depf :: DepreciationFunction
}

[4.16060]

[4.1650]

data Project
= Project
{ _projectName :: ProjectName,
_inceptionDate :: C.UTCTime,
_initiator :: UserId,
_depf :: DepreciationFunction
}
edit in lib/Aftok/Project.hs at line 31

[4.1737]

[4.1737]
replacement in lib/Aftok/Project.hs at line 47

[4.2181]→[4.2181:2378](∅→∅)

data Invitation = Invitation
{ _projectId :: ProjectId
, _invitingUser :: UserId
, _invitedEmail :: Email
, _invitationTime :: C.UTCTime
, _acceptanceTime :: Maybe C.UTCTime
}

[4.2181]

[4.2378]

data Invitation
= Invitation
{ _projectId :: ProjectId,
_invitingUser :: UserId,
_invitedEmail :: Email,
_invitationTime :: C.UTCTime,
_acceptanceTime :: Maybe C.UTCTime
}
edit in lib/Aftok/Project.hs at line 57

[4.2402]→[4.2402:2403](∅→∅)
replacement in lib/Aftok/TimeLog/Serialization.hs at line 1

[4.29337]→[4.29338:29374](∅→∅)

{-# LANGUAGE LambdaCase #-}

[4.29337]

[4.29410]

{-# LANGUAGE LambdaCase #-}
replacement in lib/Aftok/TimeLog/Serialization.hs at line 4

[4.29446]→[4.29446:29478](∅→∅)

( depfFromJSON
, depfToJSON

[4.29446]

[4.41852]

( depfFromJSON,
depfToJSON,
edit in lib/Aftok/TimeLog/Serialization.hs at line 9

[4.3968]

[4.29545]

import Aftok.Types
import Data.Aeson
( (.:),
(.=),
Value (..),
object,
)
import Data.Aeson.Types (Parser)
import Data.Text (unpack)
edit in lib/Aftok/TimeLog/Serialization.hs at line 19

[4.29546]→[4.41922:42258](∅→∅),[4.42316]→[4.42316:42375](∅→∅),[4.4005]→[4.29676:29677](∅→∅),[4.42375]→[4.29676:29677](∅→∅),[4.29676]→[4.29676:29677](∅→∅),[4.29677]→[4.42376:42405](∅→∅),[4.42405]→[4.29696:29697](∅→∅),[4.29696]→[4.29696:29697](∅→∅)

import Data.Aeson ( Value(..)
, (.=)
, (.:)
, object
)
import Data.Aeson.Types ( Parser )
import Data.Text ( unpack )

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

[4.29760]→[4.42406:42571](∅→∅)

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

[4.29760]

[4.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 30

[4.30104]→[4.42572:42611](∅→∅)

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

[4.30104]

[4.30140]

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

[4.30269]→[4.30269:30365](∅→∅)

dep = Months <$> (args .: "dep")
in LinearDepreciation <$> undep <*> dep

[4.30269]

[4.30365]

dep = Months <$> (args .: "dep")
in LinearDepreciation <$> undep <*> dep
edit in lib/Aftok/TimeLog/Serialization.hs at line 38

[4.30436]→[4.30436:30437](∅→∅)
edit in lib/Aftok/TimeLog/Serialization.hs at line 39

[4.42690]→[4.30519:30521](∅→∅),[4.30519]→[4.30519:30521](∅→∅)
replacement in lib/Aftok/TimeLog.hs at line 1

[4.846]→[4.30564:30600](∅→∅),[4.30636]→[4.4101:4137](∅→∅),[4.443]→[4.4101:4137](∅→∅)

{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TemplateHaskell #-}

[4.846]

[4.883]

{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TemplateHaskell #-}
replacement in lib/Aftok/TimeLog.hs at line 5

[4.4159]→[4.10249:10599](∅→∅),[4.10599]→[4.6557:6580](∅→∅),[4.5584]→[4.6557:6580](∅→∅),[4.6580]→[4.10600:10675](∅→∅),[4.24]→[4.961:973](∅→∅),[4.107]→[4.961:973](∅→∅),[4.5371]→[4.961:973](∅→∅),[4.5635]→[4.961:973](∅→∅),[4.10675]→[4.961:973](∅→∅),[4.961]→[4.961:973](∅→∅),[4.987]→[4.25:48](∅→∅)

( LogEntry(..)
, creditTo
, event
, eventMeta
, CreditTo(..)
, _CreditToCurrency
, _CreditToUser
, _CreditToProject
, creditToName
, LogEvent(..)
, eventName
, nameEvent
, eventTime
, WorkIndex(WorkIndex)
, _WorkIndex
, workIndex
, DepF
, toDepF
, EventId(EventId)
, _EventId
, ModTime(ModTime)
, _ModTime
, EventAmendment(..)
, AmendmentId(AmendmentId)
, _AmendmentId
, Payouts(..)
, _Payouts
, payouts
, linearDepreciation

[4.4159]

[4.10676]

( LogEntry (..),
creditTo,
event,
eventMeta,
CreditTo (..),
_CreditToCurrency,
_CreditToUser,
_CreditToProject,
creditToName,
LogEvent (..),
eventName,
nameEvent,
eventTime,
WorkIndex (WorkIndex),
_WorkIndex,
workIndex,
DepF,
toDepF,
EventId (EventId),
_EventId,
ModTime (ModTime),
_ModTime,
EventAmendment (..),
AmendmentId (AmendmentId),
_AmendmentId,
Payouts (..),
_Payouts,
payouts,
linearDepreciation,
replacement in lib/Aftok/TimeLog.hs at line 37

[4.998]→[4.10687:10745](∅→∅),[4.10745]→[4.4192:4258](∅→∅),[4.30765]→[4.4192:4258](∅→∅),[4.587]→[4.4192:4258](∅→∅),[4.4258]→[4.10746:10798](∅→∅),[4.10798]→[4.4299:4333](∅→∅),[4.4299]→[4.4299:4333](∅→∅),[4.4333]→[4.10799:12005](∅→∅),[4.12005]→[4.4578:4639](∅→∅),[4.4578]→[4.4578:4639](∅→∅),[4.4639]→[4.12006:12221](∅→∅),[4.862]→[4.618:619](∅→∅),[4.4639]→[4.618:619](∅→∅),[4.12221]→[4.618:619](∅→∅),[4.31256]→[4.618:619](∅→∅),[4.122]→[4.618:619](∅→∅),[4.4663]→[4.4663:4695](∅→∅),[4.4695]→[4.31257:31286](∅→∅)

import Control.Arrow ( (&&&) )
import Control.Lens
import Data.AdditiveGroup
import Data.Aeson as A
import Data.AffineSpace
import Data.Eq ( Eq
, (==)
)
import Data.Either ( Either(..)
, rights
)
import Data.Foldable as F
import Data.Function ( ($)
, (.)
, id
)
import Data.Functor ( fmap )
import Data.Heap as H
import Data.List.NonEmpty as L
import Data.Maybe ( Maybe(..) )
import Data.Map.Strict as MS
import Data.Ord ( Ord(..)
, Ordering(..)
)
import Data.Ratio ( Rational )
import Data.Text ( Text )
import Data.Thyme.Clock as C
import Data.UUID
import Data.VectorSpace
import Prelude ( (/)
, (*)
)
import Text.Show ( Show )

import Aftok.Interval
import Aftok.Types

[4.998]

[4.31286]

import Aftok.Interval
import Aftok.Types
import Control.Arrow ((&&&))
import Control.Lens
import Data.AdditiveGroup
import Data.Aeson as A
import Data.AffineSpace
import Data.Either
( Either (..),
rights,
)
import Data.Eq
( (==),
Eq,
)
import Data.Foldable as F
import Data.Function
( ($),
(.),
id,
)
import Data.Functor (fmap)
import Data.Heap as H
import Data.List.NonEmpty as L
import Data.Map.Strict as MS
import Data.Maybe (Maybe (..))
import Data.Ord
( Ord (..),
Ordering (..),
)
import Data.Ratio (Rational)
import Data.Text (Text)
import Data.Thyme.Clock as C
import Data.UUID
import Data.VectorSpace
import Text.Show (Show)
import Prelude
( (*),
(/),
)
replacement in lib/Aftok/TimeLog.hs at line 80

[4.1225]→[4.31317:31510](∅→∅)

{-|
- The depreciation function should return a value between 0 and 1;
- this result is multiplied by the length of an interval of work to determine
- the depreciated value of the work.
-}

[4.1225]

[4.31510]

-- |
-- - The depreciation function should return a value between 0 and 1;
-- - this result is multiplied by the length of an interval of work to determine
-- - the depreciated value of the work.
replacement in lib/Aftok/TimeLog.hs at line 86

[4.31552]→[4.30522:30632](∅→∅),[4.1225]→[4.30522:30632](∅→∅),[4.2178]→[4.1237:1271](∅→∅),[4.30632]→[4.1237:1271](∅→∅),[4.1237]→[4.1237:1271](∅→∅)

data LogEvent = StartWork { _eventTime :: !C.UTCTime }
| StopWork { _eventTime :: !C.UTCTime }
deriving (Show, Eq)

[4.31552]

[4.2179]

data LogEvent
= StartWork {_eventTime :: !C.UTCTime}
| StopWork {_eventTime :: !C.UTCTime}
deriving (Show, Eq)
replacement in lib/Aftok/TimeLog.hs at line 94

[4.1322]→[4.1322:1484](∅→∅)

compare (StartWork t0) (StopWork t1) = if t0 == t1 then GT else compare t0 t1
compare (StopWork t0) (StartWork t1) = if t0 == t1 then LT else compare t0 t1

[4.1322]

[4.1484]

compare (StartWork t0) (StopWork t1) = if t0 == t1 then GT else compare t0 t1
compare (StopWork t0) (StartWork t1) = if t0 == t1 then LT else compare t0 t1
replacement in lib/Aftok/TimeLog.hs at line 97

[4.1540]→[4.1540:1596](∅→∅)

compare (StopWork t0) (StopWork t1) = compare t0 t1

[4.1540]

[4.211]

compare (StopWork t0) (StopWork t1) = compare t0 t1
replacement in lib/Aftok/TimeLog.hs at line 101

[4.1661]→[4.1661:1694](∅→∅)

eventName (StopWork _) = "stop"

[4.1661]

[4.431]

eventName (StopWork _) = "stop"
replacement in lib/Aftok/TimeLog.hs at line 105

[4.31639]→[4.31639:31701](∅→∅)

nameEvent "stop" = Just StopWork
nameEvent _ = Nothing

[4.31639]

[4.5441]

nameEvent "stop" = Just StopWork
nameEvent _ = Nothing
replacement in lib/Aftok/TimeLog.hs at line 108

[4.5442]→[4.31702:31761](∅→∅),[4.31761]→[4.30749:30812](∅→∅),[4.30749]→[4.30749:30812](∅→∅),[4.1816]→[4.613:637](∅→∅),[4.4238]→[4.613:637](∅→∅),[4.30812]→[4.613:637](∅→∅),[4.613]→[4.613:637](∅→∅)

data LogEntry a = LogEntry
{ _creditTo :: !(CreditTo a)
, _event :: !LogEvent
, _eventMeta :: !(Maybe A.Value)
} deriving (Show, Eq)

[4.5442]

[4.4239]

data LogEntry a
= LogEntry
{ _creditTo :: !(CreditTo a),
_event :: !LogEvent,
_eventMeta :: !(Maybe A.Value)
}
deriving (Show, Eq)
replacement in lib/Aftok/TimeLog.hs at line 121

[4.1865]→[4.343:383](∅→∅),[4.5004]→[4.343:383](∅→∅),[4.343]→[4.343:383](∅→∅)

in ordElems a `compare` ordElems b

[4.5004]

[4.1724]

in ordElems a `compare` ordElems b
edit in lib/Aftok/TimeLog.hs at line 124

[4.6720]

[4.5735]
edit in lib/Aftok/TimeLog.hs at line 128

[4.928]

[4.5791]
edit in lib/Aftok/TimeLog.hs at line 137

[4.6937]

[4.6937]
edit in lib/Aftok/TimeLog.hs at line 141

[4.31997]

[4.6021]
edit in lib/Aftok/TimeLog.hs at line 145

[4.32089]

[4.468]
replacement in lib/Aftok/TimeLog.hs at line 152

[4.9529]→[4.344:348](∅→∅),[4.2354]→[4.344:348](∅→∅),[4.348]→[4.1244:1422](∅→∅)

{-|
- Given a depreciation function, the "current" time, and a foldable functor of log intervals,
- produce the total, depreciated length of work to be credited to an address.
-}

[4.9529]

[4.16169]

-- |
-- - Given a depreciation function, the "current" time, and a foldable functor of log intervals,
-- - produce the total, depreciated length of work to be credited to an address.
replacement in lib/Aftok/TimeLog.hs at line 158

[4.1577]→[4.1577:1766](∅→∅)

{-|
- Payouts are determined by computing a depreciated duration value for
- each work interval. This function computes the percentage of the total
- work allocated to each address.
-}

[4.1577]

[4.32090]

-- |
-- - Payouts are determined by computing a depreciated duration value for
-- - each work interval. This function computes the percentage of the total
-- - work allocated to each address.
replacement in lib/Aftok/TimeLog.hs at line 166

[4.12354]→[4.12354:12412](∅→∅),[4.213]→[4.1011:1012](∅→∅),[4.573]→[4.1011:1012](∅→∅),[4.884]→[4.1011:1012](∅→∅),[4.1199]→[4.1011:1012](∅→∅),[4.1905]→[4.1011:1012](∅→∅),[4.4956]→[4.1011:1012](∅→∅),[4.6834]→[4.1011:1012](∅→∅),[4.12412]→[4.1011:1012](∅→∅),[4.1011]→[4.1011:1012](∅→∅)

(^+^ total) &&& id $ workCredit dep ptime ivals

[4.12354]

[4.1333]

(^+^ total) &&& id $ workCredit dep ptime ivals
replacement in lib/Aftok/TimeLog.hs at line 168

[4.1978]→[4.1978:2046](∅→∅)

in Payouts $ fmap ((/ toSeconds totalTime) . toSeconds) keyTimes

[4.1402]

[4.1581]

in Payouts $ fmap ((/ toSeconds totalTime) . toSeconds) keyTimes
replacement in lib/Aftok/TimeLog.hs at line 170

[4.1582]→[4.3075:3156](∅→∅)

workIndex :: forall a f . (Ord a, Foldable f) => f (LogEntry a) -> (WorkIndex a)

[4.1582]

[4.4957]

workIndex :: forall a f. (Ord a, Foldable f) => f (LogEntry a) -> (WorkIndex a)
replacement in lib/Aftok/TimeLog.hs at line 173

[4.1461]→[4.12497:12566](∅→∅),[4.1525]→[4.844:845](∅→∅),[4.12566]→[4.844:845](∅→∅),[4.844]→[4.844:845](∅→∅),[4.845]→[4.12567:12737](∅→∅)

rawIndex = F.foldl' appendLogEntry MS.empty sortedEntries

accum
:: (CreditTo a)
-> [Either LogEvent Interval]
-> Map (CreditTo a) (NonEmpty Interval)
-> Map (CreditTo a) (NonEmpty Interval)

[4.1461]

[4.4981]

rawIndex = F.foldl' appendLogEntry MS.empty sortedEntries
accum ::
(CreditTo a) ->
[Either LogEvent Interval] ->
Map (CreditTo a) (NonEmpty Interval) ->
Map (CreditTo a) (NonEmpty Interval)
replacement in lib/Aftok/TimeLog.hs at line 182

[4.967]→[4.967:1025](∅→∅)

in WorkIndex $ MS.foldrWithKey accum MS.empty rawIndex

[4.966]

[4.448]

in WorkIndex $ MS.foldrWithKey accum MS.empty rawIndex
replacement in lib/Aftok/TimeLog.hs at line 184

[4.449]→[4.1897:2114](∅→∅)

{-|
- The values of the raw index map are either complete intervals (which may be
- extended if a new start is encountered at the same instant as the end of the
- interval) or start events awaiting completion.
-}

[4.449]

[4.32226]

-- |
-- - The values of the raw index map are either complete intervals (which may be
-- - extended if a new start is encountered at the same instant as the end of the
-- - interval) or start events awaiting completion.
replacement in lib/Aftok/TimeLog.hs at line 193

[4.12804]→[4.12804:12880](∅→∅)

combine (StartWork t) (StopWork t') | t' > t = Right $ Interval t t'

[4.12804]

[4.12880]

combine (StartWork t) (StopWork t') | t' > t = Right $ Interval t t'
replacement in lib/Aftok/TimeLog.hs at line 195

[4.12978]→[4.12978:13136](∅→∅),[4.13136]→[4.2489:2490](∅→∅),[4.1002]→[4.2489:2490](∅→∅)

combine (e1@(StopWork _)) (e2@(StopWork _)) = Left $ min e1 e2 -- ignore redundant ends
combine _ e2 = Left e2

[4.12978]

[4.2490]

combine (e1@(StopWork _)) (e2@(StopWork _)) = Left $ min e1 e2 -- ignore redundant ends
combine _ e2 = Left e2
replacement in lib/Aftok/TimeLog.hs at line 199

[4.2655]→[4.13137:13201](∅→∅)

extension ival (StartWork t) | containsInclusive t ival =

[4.2655]

[4.13201]

extension ival (StartWork t)
| containsInclusive t ival =
edit in lib/Aftok/TimeLog.hs at line 203

[4.320]→[4.2252:2253](∅→∅),[4.1002]→[4.2252:2253](∅→∅),[4.1069]→[4.2252:2253](∅→∅),[4.2782]→[4.2252:2253](∅→∅),[4.4694]→[4.2252:2253](∅→∅),[4.2252]→[4.2252:2253](∅→∅)
replacement in lib/Aftok/TimeLog.hs at line 211

[4.1093]→[4.13245:13287](∅→∅),[4.13287]→[4.1158:1186](∅→∅),[4.870]→[4.1158:1186](∅→∅)

_ -> [Left ev]
in MS.insert k ivals idx

[4.1093]

[4.22]

_ -> [Left ev]
in MS.insert k ivals idx
replacement in lib/Aftok/TimeLog.hs at line 214

[4.57]→[4.2047:2114](∅→∅),[4.2117]→[4.2117:2121](∅→∅),[4.2121]→[4.13288:13544](∅→∅)

{-|
- A very simple linear function for calculating depreciation.
-}
linearDepreciation
:: Months -- ^ The number of initial months during which no depreciation occurs
-> Months -- ^ The number of months over which each logged interval will be depreciated
-> DepF -- ^ The resulting configured depreciation function.

[4.23]

[4.5127]

-- |
-- - A very simple linear function for calculating depreciation.
linearDepreciation ::
-- | The number of initial months during which no depreciation occurs
Months ->
-- | The number of months over which each logged interval will be depreciated
Months ->
-- | The resulting configured depreciation function.
DepF
edit in lib/Aftok/TimeLog.hs at line 226

[4.2508]→[4.323:324](∅→∅),[4.375]→[4.323:324](∅→∅)
edit in lib/Aftok/TimeLog.hs at line 228

[4.375]→[4.970:971](∅→∅),[4.389]→[4.970:971](∅→∅),[4.1131]→[4.970:971](∅→∅),[4.2613]→[4.970:971](∅→∅),[4.5246]→[4.970:971](∅→∅),[4.10010]→[4.970:971](∅→∅),[4.970]→[4.970:971](∅→∅)
replacement in lib/Aftok/TimeLog.hs at line 229

[4.2646]→[4.13545:13707](∅→∅),[4.13707]→[4.5266:5287](∅→∅),[4.558]→[4.5266:5287](∅→∅)

depPct dt = if dt < monthsLength undepLength
then 1
else toSeconds (max zeroV (maxDepreciable ^-^ dt))
/ toSeconds maxDepreciable
in \ptime ival ->

[4.2646]

[4.13708]

depPct dt =
if dt < monthsLength undepLength
then 1
else
toSeconds (max zeroV (maxDepreciable ^-^ dt))
/ toSeconds maxDepreciable
in \ptime ival ->
replacement in lib/Aftok/TimeLog.hs at line 237

[4.13768]→[4.13768:13806](∅→∅)

in depreciation *^ ilen ival

[4.13768]

in depreciation *^ ilen ival
replacement in lib/Aftok/Types.hs at line 1

[4.805]→[4.32359:32395](∅→∅),[4.32431]→[4.32431:32467](∅→∅)

{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TemplateHaskell #-}

[4.805]

[4.850]

{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TemplateHaskell #-}
edit in lib/Aftok/Types.hs at line 5

[4.6638]→[4.876:877](∅→∅),[4.32493]→[4.876:877](∅→∅),[4.876]→[4.876:877](∅→∅),[4.877]→[4.42692:42864](∅→∅),[4.42922]→[4.42922:43324](∅→∅),[4.43324]→[4.3888:3946](∅→∅)

import Control.Lens ( makeLenses
, makePrisms
)
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 )
import Aftok.Currency.Zcash ( ZAddr )
edit in lib/Aftok/Types.hs at line 6

[4.32940]

[4.32940]

import Aftok.Currency.Zcash (ZAddr)
import Control.Lens
( makeLenses,
makePrisms,
)
import Data.Eq (Eq)
import Data.Functor (Functor)
import Data.Ord (Ord)
import Data.Text (Text)
import Data.UUID (UUID)
import Text.Show (Show)
import Prelude (Integer)
edit in lib/Aftok/Types.hs at line 20

[4.32995]

[4.32995]
edit in lib/Aftok/Types.hs at line 24

[4.33069]

[4.33069]
edit in lib/Aftok/Types.hs at line 28

[4.33139]

[4.33139]
edit in lib/Aftok/Types.hs at line 34

[4.3992]

[4.3288]
edit in lib/Aftok/Types.hs at line 36

[4.3317]

[4.3317]

data User
= User
{ _username :: !UserName,
_userAccountRecovery :: !(AccountRecovery ZAddr)
}
edit in lib/Aftok/Types.hs at line 43

[4.3318]→[4.3318:3374](∅→∅),[4.3374]→[4.3993:4047](∅→∅),[4.3420]→[4.33266:33270](∅→∅),[4.4047]→[4.33266:33270](∅→∅),[4.33266]→[4.33266:33270](∅→∅)

data User = User
{ _username :: !UserName
, _userAccountRecovery :: !(AccountRecovery ZAddr)
}
edit in lib/Aftok/Types.hs at line 46

[4.33349]

[4.33349]
replacement in lib/Aftok/Types.hs at line 50

[4.33389]→[4.33389:33660](∅→∅)

-- payouts are made directly via a cryptocurrency network
= CreditToCurrency !a
-- payouts are distributed as requested by the specified contributor
| CreditToUser !UserId
-- payouts are distributed to this project's contributors
| CreditToProject !ProjectId

[4.33389]

[4.33660]

= -- payouts are made directly via a cryptocurrency network
CreditToCurrency !a
| -- payouts are distributed as requested by the specified contributor
CreditToUser !UserId
| -- payouts are distributed to this project's contributors
CreditToProject !ProjectId
edit in lib/Aftok/Types.hs at line 57

[4.33696]

[4.33696]
replacement in lib/Aftok/Types.hs at line 62

[4.33807]→[4.43325:43434](∅→∅)

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

[4.33807]

[4.33914]

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

[4.5356]→[4.316:317](∅→∅),[4.316]→[4.316:317](∅→∅)

[4.294]

[4.4010]

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

[4.4011]→[4.5357:5401](∅→∅),[4.317]→[4.5357:5401](∅→∅),[4.5401]→[4.43437:43549](∅→∅),[4.5504]→[4.430:431](∅→∅),[4.43549]→[4.430:431](∅→∅),[4.430]→[4.430:431](∅→∅)

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

[4.43705]→[4.5505:5561](∅→∅),[4.718]→[4.5505:5561](∅→∅)

b64 <- string "Basic " *> takeWhile1 isBase64Char

[4.43705]

[4.775]

b64 <- string "Basic " *> takeWhile1 isBase64Char
edit in lib/Aftok/Util/Http.hs at line 22

[4.43795]→[4.989:990](∅→∅),[4.989]→[4.989:990](∅→∅)
replacement in lib/Aftok/Util.hs at line 2

[4.16358]→[4.4967:5011](∅→∅)

{-# LANGUAGE RankNTypes #-}

[4.16358]

[4.10090]

{-# LANGUAGE RankNTypes #-}
edit in lib/Aftok/Util.hs at line 5

[4.10115]→[4.10115:10116](∅→∅)
replacement in lib/Aftok/Util.hs at line 6

[4.30980]→[4.4013:4014](∅→∅),[4.4014]→[4.43797:43856](∅→∅),[4.31025]→[4.5594:5637](∅→∅),[4.43856]→[4.5594:5637](∅→∅),[4.5594]→[4.5594:5637](∅→∅),[4.43916]→[4.31078:31079](∅→∅),[4.31078]→[4.31078:31079](∅→∅),[4.31079]→[4.5637:5676](∅→∅),[4.5637]→[4.5637:5676](∅→∅),[4.5676]→[4.43917:43969](∅→∅)

import Control.Error.Util ( maybeT )
import Control.Monad.Free.Church

import Data.Functor.Coyoneda
import Data.Map.Strict as M

[4.30980]

[4.10199]

import Control.Error.Util (maybeT)
import Control.Monad.Free.Church
import Data.Functor.Coyoneda
import Data.Map.Strict as M
replacement in lib/Aftok/Util.hs at line 11

[4.10200]→[4.5012:5061](∅→∅),[4.5061]→[4.16409:16446](∅→∅),[4.16409]→[4.16409:16446](∅→∅)

newtype Program (f :: * -> *) (a :: *) = Program
{ runProgram :: F (Coyoneda f) a }

[4.10200]

[4.16446]

newtype Program (f :: * -> *) (a :: *)
= Program
{runProgram :: F (Coyoneda f) a}
replacement in lib/Aftok/Util.hs at line 17

[4.10293]→[4.43970:44040](∅→∅)

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

[4.10293]

[4.5677]

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

[4.6966]→[4.6966:7007](∅→∅)

in foldrWithKey insf (pure M.empty) m

[4.6966]

[4.31080]

in foldrWithKey insf (pure M.empty) m
edit in server/Aftok/QConfig.hs at line 1

[4.4500]→[4.24882:24915](∅→∅)

{-# LANGUAGE TemplateHaskell #-}
edit in server/Aftok/QConfig.hs at line 2

[4.24950]

[4.24950]

{-# LANGUAGE TemplateHaskell #-}
edit in server/Aftok/QConfig.hs at line 5

[4.4528]→[4.4528:4529](∅→∅)
replacement in server/Aftok/QConfig.hs at line 6

[4.4552]→[4.44117:44283](∅→∅),[4.4067]→[4.32426:32479](∅→∅),[4.24991]→[4.32426:32479](∅→∅),[4.44283]→[4.32426:32479](∅→∅),[4.4552]→[4.32426:32479](∅→∅),[4.32479]→[4.6593:6698](∅→∅),[4.6593]→[4.6593:6698](∅→∅),[4.6698]→[4.4068:4120](∅→∅),[4.4120]→[4.44284:44575](∅→∅),[4.4237]→[4.4736:4737](∅→∅),[4.6900]→[4.4736:4737](∅→∅),[4.7805]→[4.4736:4737](∅→∅),[4.25162]→[4.4736:4737](∅→∅),[4.32612]→[4.4736:4737](∅→∅),[4.44575]→[4.4736:4737](∅→∅),[4.4736]→[4.4736:4737](∅→∅),[4.4737]→[4.6901:7028](∅→∅)

import Control.Lens ( makeLenses
, (^.)
)
import qualified Data.ByteString.Char8 as C8
import qualified Data.Configurator as C
import qualified Data.Configurator.Types as CT
import qualified Data.List as L
import System.Environment ( getEnvironment )
import Filesystem.Path.CurrentOS ( fromText
, encodeString
)
import qualified Filesystem.Path.CurrentOS as P

import Snap.Core
import qualified Snap.Http.Server.Config as SC
import Snap.Snaplet.PostgresqlSimple

[4.4552]

[4.4838]

import Aftok.Config
import Aftok.Currency.Zcash (ZcashdConfig (..))
import Aftok.Snaplet.Users (CaptchaConfig (..))
import Control.Lens
( (^.),
makeLenses,
)
import qualified Data.ByteString.Char8 as C8
import qualified Data.Configurator as C
import qualified Data.Configurator.Types as CT
import qualified Data.List as L
import Filesystem.Path.CurrentOS
( encodeString,
fromText,
)
import qualified Filesystem.Path.CurrentOS as P
import Snap.Core
import qualified Snap.Http.Server.Config as SC
import Snap.Snaplet.PostgresqlSimple
import System.Environment (getEnvironment)
replacement in server/Aftok/QConfig.hs at line 27

[4.4839]→[4.4449:4506](∅→∅),[4.4506]→[4.32613:32643](∅→∅),[4.4839]→[4.32613:32643](∅→∅),[4.32643]→[4.3989:4046](∅→∅)

import Aftok.Currency.Zcash (ZcashdConfig(..))
import Aftok.Config
import Aftok.Snaplet.Users (CaptchaConfig(..))

[4.4839]

[4.216]

data QConfig
= QConfig
{ _hostname :: C8.ByteString,
_port :: Int,
_authSiteKey :: P.FilePath,
_cookieTimeout :: Maybe Int,
_pgsConfig :: PGSConfig,
_smtpConfig :: SmtpConfig,
_billingConfig :: BillingConfig,
_templatePath :: P.FilePath,
_staticAssetPath :: P.FilePath,
_recaptchaSecret :: CaptchaConfig,
_zcashdConfig :: ZcashdConfig
}
edit in server/Aftok/QConfig.hs at line 42

[4.217]→[4.4840:4863](∅→∅),[4.4840]→[4.4840:4863](∅→∅),[4.4863]→[4.4238:4274](∅→∅),[4.4274]→[4.25196:25222](∅→∅),[4.25196]→[4.25196:25222](∅→∅),[4.25222]→[4.4275:4308](∅→∅),[4.4308]→[4.25253:25386](∅→∅),[4.25253]→[4.25253:25386](∅→∅),[4.25386]→[4.4309:4377](∅→∅),[4.4377]→[4.4047:4085](∅→∅),[4.4085]→[4.4507:4542](∅→∅),[4.4085]→[4.534:538](∅→∅),[4.4377]→[4.534:538](∅→∅),[4.4542]→[4.534:538](∅→∅),[4.7325]→[4.534:538](∅→∅),[4.9618]→[4.534:538](∅→∅),[4.25450]→[4.534:538](∅→∅),[4.32737]→[4.534:538](∅→∅),[4.34143]→[4.534:538](∅→∅),[4.534]→[4.534:538](∅→∅)

data QConfig = QConfig
{ _hostname :: C8.ByteString
, _port :: Int
, _authSiteKey :: P.FilePath
, _cookieTimeout :: Maybe Int
, _pgsConfig :: PGSConfig
, _smtpConfig :: SmtpConfig
, _billingConfig :: BillingConfig
, _templatePath :: P.FilePath
, _staticAssetPath :: P.FilePath
, _recaptchaSecret :: CaptchaConfig
, _zcashdConfig :: ZcashdConfig
}
replacement in server/Aftok/QConfig.hs at line 61

[4.44903]→[4.44903:45067](∅→∅)

<*> (fromText <$> C.lookupDefault "/opt/aftok/server/templates/"
cfg
"templatePath"

[4.44903]

[4.45067]

<*> ( fromText
<$> C.lookupDefault
"/opt/aftok/server/templates/"
cfg
"templatePath"
replacement in server/Aftok/QConfig.hs at line 67

[4.45077]→[4.45077:45241](∅→∅)

<*> (fromText <$> C.lookupDefault "/opt/aftok/server/static/"
cfg
"staticAssetPath"

[4.45077]

[4.45241]

<*> ( fromText
<$> C.lookupDefault
"/opt/aftok/server/static/"
cfg
"staticAssetPath"
replacement in server/Aftok/QConfig.hs at line 79

[2.5211]→[2.5211:5344](∅→∅)

<*> C.require cfg "rpcPort"
<*> C.require cfg "rpcUser"
<*> C.require cfg "rpcPassword"

[2.5211]

[4.7968]

<*> C.require cfg "rpcPort"
<*> C.require cfg "rpcUser"
<*> C.require cfg "rpcPassword"
edit in server/Aftok/QConfig.hs at line 90

[4.6293]→[4.6293:6294](∅→∅)
replacement in server/Aftok/Snaplet/Auctions.hs at line 4

[4.2506]→[4.2506:2531](∅→∅),[4.2531]→[4.875:897](∅→∅),[4.897]→[4.586:608](∅→∅)

( auctionCreateHandler
, auctionGetHandler
, auctionBidHandler

[4.2506]

[4.45333]

( auctionCreateHandler,
auctionGetHandler,
auctionBidHandler,
edit in server/Aftok/Snaplet/Auctions.hs at line 9

[4.45343]→[4.2541:2542](∅→∅),[4.2541]→[4.2541:2542](∅→∅),[4.2542]→[4.4525:4526](∅→∅),[4.4526]→[4.33151:33152](∅→∅),[4.2573]→[4.33151:33152](∅→∅),[4.33152]→[4.45344:45406](∅→∅),[4.33207]→[4.2573:2636](∅→∅),[4.45406]→[4.2573:2636](∅→∅),[4.2573]→[4.2573:2636](∅→∅),[4.2636]→[4.45407:45523](∅→∅),[4.45523]→[4.5646:5647](∅→∅),[4.1843]→[4.5646:5647](∅→∅),[4.5647]→[4.45524:45576](∅→∅),[4.1843]→[4.2723:2724](∅→∅),[4.5690]→[4.2723:2724](∅→∅),[4.45576]→[4.2723:2724](∅→∅),[4.2723]→[4.2723:2724](∅→∅),[4.2724]→[4.45577:46158](∅→∅),[4.860]→[4.2837:2865](∅→∅),[4.963]→[4.2837:2865](∅→∅),[4.2050]→[4.2837:2865](∅→∅),[4.46158]→[4.2837:2865](∅→∅),[4.2837]→[4.2837:2865](∅→∅),[4.2865]→[4.46159:46222](∅→∅)

import Control.Monad.Trans.Maybe ( mapMaybeT )

import Data.Aeson
import Data.Aeson.Types
import Data.Hourglass.Types ( Seconds(..) )
import Data.Thyme.Clock as C

import Snap.Snaplet as S

import Aftok.Types ( UserId )
import Aftok.Auction ( Auction(..)
, AuctionId
, Bid(..)
, BidId
)
import Aftok.Database ( createAuction
, createBid
, findAuction
)
import Aftok.Json
import Aftok.Util ( fromMaybeT )
replacement in server/Aftok/Snaplet/Auctions.hs at line 10

[4.2895]→[4.5691:5722](∅→∅),[4.5722]→[4.2926:2962](∅→∅),[4.17233]→[4.2926:2962](∅→∅),[4.2926]→[4.2926:2962](∅→∅),[4.2962]→[4.13811:13875](∅→∅)

import Aftok.Snaplet
import Aftok.Snaplet.Auth
import Bippy.Types ( Satoshi(..) )

[4.2895]

[4.2962]

import Aftok.Auction
( Auction (..),
AuctionId,
Bid (..),
BidId,
)
import Aftok.Database
( createAuction,
createBid,
findAuction,
)
import Aftok.Json
import Aftok.Snaplet
import Aftok.Snaplet.Auth
import Aftok.Types (UserId)
import Aftok.Util (fromMaybeT)
import Bippy.Types (Satoshi (..))
import Control.Monad.Trans.Maybe (mapMaybeT)
import Data.Aeson
import Data.Aeson.Types
import Data.Hourglass.Types (Seconds (..))
import Data.Thyme.Clock as C
import Snap.Snaplet as S
replacement in server/Aftok/Snaplet/Auctions.hs at line 34

[4.2994]→[4.377:487](∅→∅)

data AuctionCreateRequest = CA { raiseAmount :: Word64, auctionStart :: C.UTCTime , auctionEnd :: C.UTCTime }

[4.2963]

[4.3076]

data AuctionCreateRequest = CA {raiseAmount :: Word64, auctionStart :: C.UTCTime, auctionEnd :: C.UTCTime}
replacement in server/Aftok/Snaplet/Auctions.hs at line 37

[4.3137]→[4.5180:5226](∅→∅),[4.5226]→[4.46288:46368](∅→∅)

auctionCreateParser = unv1 "auctions" p where
p o = CA <$> o .: "raiseAmount" <*> o .: "auctionStart" <*> o .: "auctionEnd"

[4.3137]

[4.885]

auctionCreateParser = unv1 "auctions" p
where
p o = CA <$> o .: "raiseAmount" <*> o .: "auctionStart" <*> o .: "auctionEnd"
replacement in server/Aftok/Snaplet/Auctions.hs at line 42

[4.46431]→[4.5283:5327](∅→∅),[4.947]→[4.5283:5327](∅→∅),[4.5327]→[4.46432:46552](∅→∅)

bidCreateParser uid t = unv1 "bids" p where
p o =
Bid uid
<$> (Seconds <$> o .: "bidSeconds")
<*> (Satoshi <$> o .: "bidAmount")
<*> pure t

[4.46431]

[4.3306]

bidCreateParser uid t = unv1 "bids" p
where
p o =
Bid uid
<$> (Seconds <$> o .: "bidSeconds")
<*> (Satoshi <$> o .: "bidAmount")
<*> pure t
replacement in server/Aftok/Snaplet/Auctions.hs at line 52

[4.3383]→[4.46553:46618](∅→∅)

uid <- requireUserId
pid <- requireProjectId

[4.3383]

[4.3432]

uid <- requireUserId
pid <- requireProjectId
replacement in server/Aftok/Snaplet/Auctions.hs at line 55

[4.3470]→[4.46619:46721](∅→∅)

req <- either (snapError 400 . show) pure
$ parseEither auctionCreateParser requestBody

[4.3470]

[4.591]

req <-
either (snapError 400 . show) pure $
parseEither auctionCreateParser requestBody
replacement in server/Aftok/Snaplet/Auctions.hs at line 59

[4.622]→[4.46722:47020](∅→∅)

snapEval . createAuction $ Auction pid
uid
t
(Satoshi . raiseAmount $ req)
(auctionStart req)
(auctionEnd req)

[4.622]

[4.987]

snapEval . createAuction $
Auction
pid
uid
t
(Satoshi . raiseAmount $ req)
(auctionStart req)
(auctionEnd req)
replacement in server/Aftok/Snaplet/Auctions.hs at line 72

[4.1105]→[4.47021:47183](∅→∅)

fromMaybeT (snapError 404 $ "Auction not found for id " <> show aid)
(mapMaybeT snapEval $ findAuction aid uid) -- this will verify auction access

[4.1105]

[4.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 78

[4.1312]→[4.47184:47290](∅→∅)

uid <- requireUserId
aid <- requireAuctionId
timestamp <- liftIO C.getCurrentTime

[4.1312]

[4.1400]

uid <- requireUserId
aid <- requireAuctionId
timestamp <- liftIO C.getCurrentTime
replacement in server/Aftok/Snaplet/Auctions.hs at line 82

[4.1438]→[4.47291:47405](∅→∅)

bid <- either (snapError 400 . show) pure
$ parseEither (bidCreateParser uid timestamp) requestBody

[4.1438]

[4.1541]

bid <-
either (snapError 400 . show) pure $
parseEither (bidCreateParser uid timestamp) requestBody
replacement in server/Aftok/Snaplet/Auth.hs at line 6

[4.263]→[4.7636:7666](∅→∅),[4.7666]→[4.47407:47528](∅→∅),[4.47528]→[4.13877:14038](∅→∅),[4.14038]→[4.47528:47590](∅→∅),[4.310217]→[4.47528:47590](∅→∅),[4.47528]→[4.47528:47590](∅→∅),[4.1993]→[4.423:424](∅→∅),[4.5780]→[4.423:424](∅→∅),[4.7800]→[4.423:424](∅→∅),[4.8267]→[4.423:424](∅→∅),[4.10832]→[4.423:424](∅→∅),[4.47590]→[4.423:424](∅→∅),[4.423]→[4.423:424](∅→∅),[4.424]→[4.34290:34319](∅→∅),[4.1293]→[4.7824:7856](∅→∅),[4.2113]→[4.7824:7856](∅→∅),[4.34319]→[4.7824:7856](∅→∅),[4.7824]→[4.7824:7856](∅→∅),[4.3758]→[4.2114:2145](∅→∅),[4.2145]→[4.47591:47660](∅→∅)

import Control.Lens
import Control.Error.Util ( maybeT )
import Control.Monad.Trans.Maybe ( mapMaybeT )
import Data.Aeson ( (.:) )
import qualified Data.Aeson as A
import qualified Data.Aeson.Types as A
import Data.Attoparsec.ByteString ( parseOnly )

import Aftok.Types
import Aftok.Database
import Aftok.Snaplet
import Aftok.Util.Http ( authHeaderParser )

[4.263]

[4.489]

import Aftok.Database
import Aftok.Snaplet
import Aftok.Types
import Aftok.Util.Http (authHeaderParser)
import Control.Error.Util (maybeT)
import Control.Lens
import Control.Monad.Trans.Maybe (mapMaybeT)
import Data.Aeson ((.:))
import qualified Data.Aeson as A
import qualified Data.Aeson.Types as A
import Data.Attoparsec.ByteString (parseOnly)
import Snap.Core
import Snap.Snaplet as S
import qualified Snap.Snaplet.Auth as AU
replacement in server/Aftok/Snaplet/Auth.hs at line 21

[4.490]→[4.7951:7978](∅→∅),[4.7978]→[4.47661:47766](∅→∅)

import Snap.Core
import Snap.Snaplet as S
import qualified Snap.Snaplet.Auth as AU

[4.490]

[4.643]

data LoginRequest
= LoginRequest
{ loginUser :: Text,
loginPass :: Text
}
edit in server/Aftok/Snaplet/Auth.hs at line 27

[4.644]→[4.310218:310300](∅→∅)

data LoginRequest = LoginRequest
{ loginUser :: Text
, loginPass :: Text
}
replacement in server/Aftok/Snaplet/Auth.hs at line 36

[4.10876]→[4.14128:14222](∅→∅)

requireLoginWith
:: (forall a . () -> S.Handler App App a) -> S.Handler App App AU.AuthUser

[4.10876]

[4.10967]

requireLoginWith ::
(forall a. () -> S.Handler App App a) -> S.Handler App App AU.AuthUser
replacement in server/Aftok/Snaplet/Auth.hs at line 41

[4.11090]→[4.47797:47899](∅→∅),[4.14323]→[4.47797:47899](∅→∅),[4.1323]→[4.47797:47899](∅→∅)

(uname, pwd) <- either (throwDenied . AU.AuthError) pure
$ parseOnly authHeaderParser rawHeader

[4.14323]

[4.47899]

(uname, pwd) <-
either (throwDenied . AU.AuthError) pure $
parseOnly authHeaderParser rawHeader
replacement in server/Aftok/Snaplet/Auth.hs at line 52

[4.14416]→[4.14416:14497](∅→∅)

Left _ -> snapError 400 $ "Unable to parse login credentials object."

[4.14416]

[4.310842]

Left _ -> snapError 400 $ "Unable to parse login credentials object."
replacement in server/Aftok/Snaplet/Auth.hs at line 54

[4.310874]→[4.14498:14639](∅→∅)

authResult <- with auth $ AU.loginByUsername
(loginUser credentials)
(AU.ClearText (encodeUtf8 $ loginPass credentials))
False

[4.310874]

[4.1502]

authResult <-
with auth $
AU.loginByUsername
(loginUser credentials)
(AU.ClearText (encodeUtf8 $ loginPass credentials))
False
replacement in server/Aftok/Snaplet/Auth.hs at line 80

[4.2616]→[4.47978:48097](∅→∅)

modifyResponse
$ (setResponseStatus 401 "Unauthorized")
. (setHeader "WWW-Authenticate" "Basic realm=aftok")

[4.2616]

[4.48097]

modifyResponse $
(setResponseStatus 401 "Unauthorized")
. (setHeader "WWW-Authenticate" "Basic realm=aftok")
edit in server/Aftok/Snaplet/Auth.hs at line 90

[4.48261]→[4.3004:3005](∅→∅),[4.3004]→[4.3004:3005](∅→∅)
replacement in server/Aftok/Snaplet/Billing.hs at line 4

[4.33794]→[4.33794:33865](∅→∅)

( billableCreateHandler
, billableListHandler
, subscribeHandler

[4.33794]

[4.48263]

( billableCreateHandler,
billableListHandler,
subscribeHandler,
replacement in server/Aftok/Snaplet/Billing.hs at line 10

[4.33876]→[4.4839:4840](∅→∅)

[4.33876]

[4.33907]

import Aftok.Billing
import Aftok.Database
( DBOp (..),
createBillable,
liftdb,
withProjectAuth,
)
import Aftok.Json
import Aftok.Snaplet
import Aftok.Snaplet.Auth
import Aftok.Types
import Bippy.Types (Satoshi (..))
import Control.Lens ((^.))
import Data.Aeson
import Data.Aeson.Types
import Data.Thyme.Clock as C
import Data.Thyme.Time.Core (toThyme)
import Snap.Snaplet as S
edit in server/Aftok/Snaplet/Billing.hs at line 29

[4.33908]→[4.48274:48331](∅→∅),[4.48331]→[4.33945:34007](∅→∅),[4.33945]→[4.33945:34007](∅→∅),[4.34007]→[4.48332:48444](∅→∅),[4.48444]→[4.34098:34099](∅→∅),[4.34098]→[4.34098:34099](∅→∅),[4.34099]→[4.48445:48497](∅→∅),[4.48497]→[4.34142:34143](∅→∅),[4.34142]→[4.34142:34143](∅→∅),[4.34143]→[2.5347:5378](∅→∅),[2.5378]→[4.14755:14819](∅→∅),[4.34401]→[4.14755:14819](∅→∅),[4.14819]→[4.34229:34286](∅→∅),[4.34452]→[4.34229:34286](∅→∅),[4.48622]→[4.34229:34286](∅→∅),[4.59532]→[4.34229:34286](∅→∅),[4.34229]→[4.34229:34286](∅→∅),[4.34286]→[4.48623:48920](∅→∅),[4.48920]→[4.34407:34476](∅→∅),[4.34407]→[4.34407:34476](∅→∅)

import Control.Lens ( (^.) )
import Data.Aeson
import Data.Aeson.Types
import Data.Thyme.Clock as C
import Data.Thyme.Time.Core ( toThyme )

import Snap.Snaplet as S

import Aftok.Billing
import Bippy.Types ( Satoshi(..) )
import Aftok.Json
import Aftok.Types
import Aftok.Database ( createBillable
, withProjectAuth
, liftdb
, DBOp(..)
)

import Aftok.Snaplet
import Aftok.Snaplet.Auth
replacement in server/Aftok/Snaplet/Billing.hs at line 30

[4.34547]→[4.34547:34606](∅→∅),[4.34606]→[4.34453:34475](∅→∅),[4.34475]→[4.48921:49321](∅→∅),[4.49321]→[4.35053:35054](∅→∅),[4.35053]→[4.35053:35054](∅→∅),[4.35054]→[4.34476:34516](∅→∅)

parseCreateBillable uid pid = unversion "Billable" p where
p (Version 1 0) o =
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"

p ver o = badVersion "Billable" ver o

[4.34547]

[4.35090]

parseCreateBillable uid pid = unversion "Billable" p
where
p (Version 1 0) o =
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"
p ver o = badVersion "Billable" ver o
replacement in server/Aftok/Snaplet/Billing.hs at line 53

[4.35172]→[4.49322:49387](∅→∅)

uid <- requireUserId
pid <- requireProjectId

[4.35172]

[4.35221]

uid <- requireUserId
pid <- requireProjectId
replacement in server/Aftok/Snaplet/Billing.hs at line 56

[4.35259]→[4.49388:49500](∅→∅)

b <- either (snapError 400 . show) pure
$ parseEither (parseCreateBillable uid pid) requestBody

[4.35259]

[4.35358]

b <-
either (snapError 400 . show) pure $
parseEither (parseCreateBillable uid pid) requestBody
replacement in server/Aftok/Snaplet/Billing.hs at line 71

[4.35732]→[4.49501:49534](∅→∅)

t <- liftIO C.getCurrentTime

[4.35732]

[4.35763]

t <- liftIO C.getCurrentTime
edit in server/Aftok/Snaplet/Billing.hs at line 73

[4.35830]→[4.34517:34518](∅→∅)
replacement in server/Aftok/Snaplet/Payments.hs at line 4

[4.3408]→[4.3408:3495](∅→∅)

( listPayableRequestsHandler
, getPaymentRequestHandler
, paymentResponseHandler

[4.3408]

[4.49536]

( listPayableRequestsHandler,
getPaymentRequestHandler,
paymentResponseHandler,
edit in server/Aftok/Snaplet/Payments.hs at line 9

[4.3505]→[4.9799:9800](∅→∅),[4.49546]→[4.9799:9800](∅→∅),[4.9799]→[4.9799:9800](∅→∅),[4.35902]→[4.5782:5783](∅→∅),[4.9831]→[4.5782:5783](∅→∅),[4.5783]→[4.4941:4942](∅→∅),[4.4942]→[4.49547:49879](∅→∅),[4.49933]→[4.49933:50211](∅→∅),[4.4987]→[4.36052:36053](∅→∅),[4.50211]→[4.36052:36053](∅→∅),[4.36052]→[4.36052:36053](∅→∅),[4.36053]→[4.50212:50445](∅→∅),[4.50445]→[4.14821:14873](∅→∅),[4.14873]→[4.1384:1429](∅→∅),[4.50497]→[4.1384:1429](∅→∅),[4.59578]→[4.1384:1429](∅→∅),[4.3750]→[4.1384:1429](∅→∅),[4.1429]→[4.50498:51235](∅→∅),[4.1663]→[4.9831:9832](∅→∅),[4.3750]→[4.9831:9832](∅→∅),[4.5919]→[4.9831:9832](∅→∅),[4.51235]→[4.9831:9832](∅→∅),[4.9831]→[4.9831:9832](∅→∅),[4.9832]→[4.51236:51463](∅→∅)

import Control.Lens ( view
, _1
, _2
, _Right
, _Left
, preview
, (.~)
, (^.)
)
import Control.Monad.Trans.Maybe ( mapMaybeT )
import Control.Exception ( try )

import Data.ProtocolBuffers ( decodeMessage )
import Data.Serialize.Get ( runGetLazy )
import Data.Thyme.Clock as C
import qualified Data.Text.Encoding as T
import qualified Bippy.Proto as P
import Network.HTTP.Client.OpenSSL
import Network.HTTP.Client ( defaultManagerSettings
, managerResponseTimeout
, responseTimeoutMicro
, HttpException
)
import Network.Wreq ( asValue
, responseBody
, defaults
, manager
, getWith
)
import OpenSSL.Session ( context )

import Snap.Core ( readRequestBody
, logError
)
import Snap.Snaplet as S
replacement in server/Aftok/Snaplet/Payments.hs at line 10

[4.5963]→[4.51464:51517](∅→∅),[4.51517]→[2.5380:5411](∅→∅),[2.5411]→[4.3851:3883](∅→∅),[4.5996]→[4.3851:3883](∅→∅),[4.3883]→[4.5032:5064](∅→∅),[4.5064]→[4.51518:51581](∅→∅),[4.1595]→[4.9900:9901](∅→∅),[4.6028]→[4.9900:9901](∅→∅),[4.36179]→[4.9900:9901](∅→∅),[4.51581]→[4.9900:9901](∅→∅),[4.9900]→[4.9900:9901](∅→∅),[4.1775]→[4.6029:6096](∅→∅),[4.9901]→[4.6029:6096](∅→∅)

import Aftok.Config as AC
import Aftok.Billing
import Aftok.Database
import Aftok.Payments
import Aftok.Util ( fromMaybeT )

import Aftok.Snaplet
import Aftok.Snaplet.Auth

[4.5963]

[4.9958]

import Aftok.Billing
import Aftok.Config as AC
import Aftok.Database
import Aftok.Payments
import Aftok.Snaplet
import Aftok.Snaplet.Auth
import Aftok.Util (fromMaybeT)
import qualified Bippy.Proto as P
import Control.Exception (try)
import Control.Lens
( (.~),
(^.),
_1,
_2,
_Left,
_Right,
preview,
view,
)
import Control.Monad.Trans.Maybe (mapMaybeT)
import Data.ProtocolBuffers (decodeMessage)
import Data.Serialize.Get (runGetLazy)
import qualified Data.Text.Encoding as T
import Data.Thyme.Clock as C
import Network.HTTP.Client
( HttpException,
defaultManagerSettings,
managerResponseTimeout,
responseTimeoutMicro,
)
import Network.HTTP.Client.OpenSSL
import Network.Wreq
( asValue,
defaults,
getWith,
manager,
responseBody,
)
import OpenSSL.Session (context)
import Snap.Core
( logError,
readRequestBody,
)
import Snap.Snaplet as S
replacement in server/Aftok/Snaplet/Payments.hs at line 69

[4.4091]→[4.51582:51781](∅→∅)

preq <- getPaymentRequestHandler'
pmnt <- either
(\msg -> snapError 400 $ "Could not decode payment response: " <> show msg)
pure
(runGetLazy decodeMessage requestBody)

[4.4091]

[4.51781]

preq <- getPaymentRequestHandler'
pmnt <-
either
(\msg -> snapError 400 $ "Could not decode payment response: " <> show msg)
pure
(runGetLazy decodeMessage requestBody)
replacement in server/Aftok/Snaplet/Payments.hs at line 76

[4.51816]→[4.1883:1884](∅→∅),[4.4331]→[4.1883:1884](∅→∅),[4.1884]→[4.51817:52090](∅→∅),[4.250]→[4.2063:2064](∅→∅),[4.52090]→[4.2063:2064](∅→∅),[4.2063]→[4.2063:2064](∅→∅)

let
opts =
defaults
& manager
.~ Left (opensslManagerSettings context)
& manager
.~ Left
(defaultManagerSettings
{ managerResponseTimeout = responseTimeoutMicro 10000
}
)

[4.51816]

[4.52091]

let opts =
defaults
& manager
.~ Left (opensslManagerSettings context)
& manager
.~ Left
( defaultManagerSettings
{ managerResponseTimeout = responseTimeoutMicro 10000
}
)
replacement in server/Aftok/Snaplet/Payments.hs at line 88

[4.52116]→[4.52116:52228](∅→∅)

. try @HttpException
$ asValue
=<< (withOpenSSL $ getWith opts (cfg ^. exchangeRateServiceURI))

[4.52116]

[4.5270]

. try @HttpException
$ asValue
=<< (withOpenSSL $ getWith opts (cfg ^. exchangeRateServiceURI))
replacement in server/Aftok/Snaplet/Payments.hs at line 92

[4.5344]→[4.52229:52404](∅→∅)

let newPayment = Payment (view _1 preq)
pmnt
now
(preview (_Right . responseBody) exchResp)

[4.5344]

[4.2347]

let newPayment =
Payment
(view _1 preq)
pmnt
now
(preview (_Right . responseBody) exchResp)
replacement in server/Aftok/Snaplet/Payments.hs at line 100

[4.4402]→[4.52405:52489](∅→∅)

getPaymentRequestHandler'
:: S.Handler App App (PaymentRequestId, PaymentRequest)

[4.4402]

[4.4484]

getPaymentRequestHandler' ::
S.Handler App App (PaymentRequestId, PaymentRequest)
replacement in server/Aftok/Snaplet/Payments.hs at line 104

[4.4561]→[4.52490:52626](∅→∅)

pkey <- maybe
(snapError 400 $ "parameter paymentRequestKey is formatted incorrectly.")
pure
(parsePaymentKey pkBytes)

[4.4561]

[4.36359]

pkey <-
maybe
(snapError 400 $ "parameter paymentRequestKey is formatted incorrectly.")
pure
(parsePaymentKey pkBytes)
replacement in server/Aftok/Snaplet/Payments.hs at line 110

[4.36372]→[4.52627:52735](∅→∅)

( snapError 404
$ "Outstanding payment request not found for key "
<> (view _PaymentKey pkey)

[4.36372]

[4.52735]

( snapError 404 $
"Outstanding payment request not found for key "
<> (view _PaymentKey pkey)
edit in server/Aftok/Snaplet/Payments.hs at line 115

[4.4686]→[4.5392:5393](∅→∅),[4.36521]→[4.5392:5393](∅→∅),[4.17958]→[4.5392:5393](∅→∅),[4.5393]→[4.6833:6835](∅→∅)
replacement in server/Aftok/Snaplet/Projects.hs at line 5

[4.2177]→[4.3791:3886](∅→∅),[4.3791]→[4.3791:3886](∅→∅)

( projectCreateHandler
, projectListHandler
, projectGetHandler
, projectInviteHandler

[4.2177]

[4.52743]

( projectCreateHandler,
projectListHandler,
projectGetHandler,
projectInviteHandler,
edit in server/Aftok/Snaplet/Projects.hs at line 12

[4.2463]

[4.2485]

import Aftok.Config
import Aftok.Database
import Aftok.Project
import Aftok.QConfig as QC
import Aftok.Snaplet
import Aftok.Snaplet.Auth
import Aftok.TimeLog.Serialization (depfFromJSON)
import Aftok.Types
import Aftok.Util (fromMaybeT)
import Control.Lens
import Control.Monad.Trans.Maybe (mapMaybeT)
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
import Network.Mail.Mime
import Network.Mail.SMTP as SMTP
import Snap.Core
import Snap.Snaplet as S
import Text.StringTemplate
replacement in server/Aftok/Snaplet/Projects.hs at line 34

[4.2486]→[4.2074:2104](∅→∅),[4.2104]→[4.14875:14937](∅→∅),[4.14937]→[4.52924:53212](∅→∅),[4.52924]→[4.52924:53212](∅→∅),[4.5454]→[4.2263:2298](∅→∅),[4.36708]→[4.2263:2298](∅→∅),[4.53212]→[4.2263:2298](∅→∅),[4.2263]→[4.2263:2298](∅→∅),[4.2298]→[4.53213:53268](∅→∅),[4.53268]→[4.2405:2442](∅→∅),[4.2405]→[4.2405:2442](∅→∅)

import Control.Lens
import Control.Monad.Trans.Maybe ( mapMaybeT )
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
import Network.Mail.Mime
import Network.Mail.SMTP as SMTP
import Text.StringTemplate

[4.2486]

[4.8816]

data ProjectCreateRequest = CP {cpn :: Text, cpdepf :: DepreciationFunction}
edit in server/Aftok/Snaplet/Projects.hs at line 36

[4.8817]→[4.34520:34549](∅→∅),[4.34549]→[4.36709:36739](∅→∅),[4.2466]→[4.36709:36739](∅→∅),[4.36739]→[4.2466:2498](∅→∅),[4.2466]→[4.2466:2498](∅→∅),[4.2498]→[4.3897:3928](∅→∅),[4.3928]→[4.53269:53322](∅→∅),[4.36777]→[4.2529:2596](∅→∅),[4.53322]→[4.2529:2596](∅→∅),[4.2529]→[4.2529:2596](∅→∅),[4.2596]→[4.53323:53451](∅→∅),[4.2497]→[4.2650:2651](∅→∅),[4.2596]→[4.2650:2651](∅→∅),[4.36819]→[4.2650:2651](∅→∅),[4.53451]→[4.2650:2651](∅→∅),[4.2650]→[4.2650:2651](∅→∅),[4.2651]→[4.2597:2624](∅→∅),[4.2624]→[4.53452:53504](∅→∅),[4.2654]→[4.2725:2726](∅→∅),[4.18009]→[4.2725:2726](∅→∅),[4.53504]→[4.2725:2726](∅→∅),[4.2725]→[4.2725:2726](∅→∅),[4.2726]→[4.3929:4008](∅→∅),[4.4008]→[4.2791:2792](∅→∅),[4.12066]→[4.2791:2792](∅→∅),[4.2791]→[4.2791:2792](∅→∅)

import Aftok.Types
import Aftok.Config
import Aftok.Database
import Aftok.Project
import Aftok.QConfig as QC
import Aftok.Snaplet
import Aftok.Snaplet.Auth
import Aftok.TimeLog.Serialization ( depfFromJSON )
import Aftok.Util ( fromMaybeT )

import Snap.Core
import Snap.Snaplet as S

data ProjectCreateRequest = CP { cpn :: Text, cpdepf :: DepreciationFunction }
replacement in server/Aftok/Snaplet/Projects.hs at line 43

[4.3132]→[4.53571:53602](∅→∅)

uid <- requireUserId

[4.3132]

[4.3193]

uid <- requireUserId
replacement in server/Aftok/Snaplet/Projects.hs at line 45

[4.3231]→[4.53603:53725](∅→∅)

cp <- either (snapError 400 . show) pure $ A.eitherDecode requestBody
t <- liftIO C.getCurrentTime

[4.3231]

[4.8871]

cp <- either (snapError 400 . show) pure $ A.eitherDecode requestBody
t <- liftIO C.getCurrentTime
replacement in server/Aftok/Snaplet/Projects.hs at line 58

[4.12379]→[4.53726:53857](∅→∅)

fromMaybeT (snapError 404 $ "Project not found for id " <> show pid)
(mapMaybeT snapEval $ findUserProject uid pid)

[4.12379]

[4.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 64

[4.9021]→[4.4149:4242](∅→∅)

uid <- requireUserId
pid <- requireProjectId

[4.9021]

[4.9070]

uid <- requireUserId
pid <- requireProjectId
replacement in server/Aftok/Snaplet/Projects.hs at line 67

[4.9145]→[4.4243:4298](∅→∅)

t <- liftIO C.getCurrentTime

[4.9145]

[4.4298]

t <- liftIO C.getCurrentTime
replacement in server/Aftok/Snaplet/Projects.hs at line 69

[4.4321]→[4.54038:54051](∅→∅),[4.54038]→[4.54038:54051](∅→∅),[4.54051]→[4.4322:4380](∅→∅),[4.4380]→[4.54145:54279](∅→∅),[4.54145]→[4.54145:54279](∅→∅),[4.54279]→[4.4381:4443](∅→∅),[4.4443]→[4.54330:54414](∅→∅),[4.54330]→[4.54330:54414](∅→∅),[4.54414]→[4.988:989](∅→∅),[4.988]→[4.988:989](∅→∅)

snapEval
$ (,)
<$> (runMaybeT $ findUserProject uid pid)
<*> createInvitation pid uid toEmail t
liftIO $ sendProjectInviteEmail cfg
(p ^. projectName)
(Email "noreply@aftok.com")
toEmail
invCode

[4.4321]

[4.989]

snapEval $
(,)
<$> (runMaybeT $ findUserProject uid pid)
<*> createInvitation pid uid toEmail t
liftIO $
sendProjectInviteEmail
cfg
(p ^. projectName)
(Email "noreply@aftok.com")
toEmail
invCode
replacement in server/Aftok/Snaplet/Projects.hs at line 81

[4.990]→[4.54415:54593](∅→∅)

sendProjectInviteEmail
:: QConfig
-> ProjectName
-> Email -- Inviting user's email address
-> Email -- Invitee's email address
-> InvitationCode
-> IO ()

[4.990]

[4.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 90

[4.54639]→[4.54639:54881](∅→∅)

mailer = maybe (sendMailWithLogin _smtpHost)
(sendMailWithLogin' _smtpHost)
_smtpPort
in buildProjectInviteEmail (cfg ^. templatePath) pn fromEmail toEmail invCode

[4.54639]

[4.54881]

mailer =
maybe
(sendMailWithLogin _smtpHost)
(sendMailWithLogin' _smtpHost)
_smtpPort
in buildProjectInviteEmail (cfg ^. templatePath) pn fromEmail toEmail invCode
replacement in server/Aftok/Snaplet/Projects.hs at line 98

[4.1578]→[4.9687:9688](∅→∅),[4.2922]→[4.9687:9688](∅→∅),[4.9687]→[4.9687:9688](∅→∅),[4.9688]→[4.54923:55107](∅→∅)

buildProjectInviteEmail
:: F.FilePath
-> ProjectName
-> Email -- Inviting user's email address
-> Email -- Invitee's email address
-> InvitationCode
-> IO Mail

[4.2922]

[4.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 111

[4.55129]→[4.55129:55376](∅→∅)

setAttribute "from_email" (fromEmail ^. _Email)
. setAttribute "project_name" pn
. setAttribute "to_email" (toEmail ^. _Email)
. setAttribute "inv_code" (renderInvCode invCode)

[4.55129]

[4.2361]

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 116

[4.2424]→[4.2424:2481](∅→∅),[4.2481]→[4.55377:55435](∅→∅),[4.55435]→[4.59580:59640](∅→∅),[4.59640]→[4.2604:2676](∅→∅),[4.2604]→[4.2604:2676](∅→∅),[4.2676]→[4.3685:3686](∅→∅),[4.10398]→[4.3685:3686](∅→∅),[4.3685]→[4.3685:3686](∅→∅),[4.3686]→[4.10399:10400](∅→∅)

toAddr = Address Nothing (toEmail ^. _Email)
subject = "Welcome to the " <> pn <> " Aftok!"
body = plainPart . render $ setAttrs template
in pure $ SMTP.simpleMail fromAddr [toAddr] [] [] subject [body]

[4.2424]

toAddr = Address Nothing (toEmail ^. _Email)
subject = "Welcome to the " <> pn <> " Aftok!"
body = plainPart . render $ setAttrs template
in pure $ SMTP.simpleMail fromAddr [toAddr] [] [] subject [body]
replacement in server/Aftok/Snaplet/Users.hs at line 1

[4.3234]→[4.9758:9795](∅→∅)

{-# LANGUAGE OverloadedStrings #-}

[4.3234]

[4.3072]

{-# LANGUAGE OverloadedStrings #-}
replacement in server/Aftok/Snaplet/Users.hs at line 3

[4.3105]→[4.34732:34765](∅→∅)

{-# LANGUAGE TupleSections #-}

[4.3105]

[4.3411]

{-# LANGUAGE TupleSections #-}
replacement in server/Aftok/Snaplet/Users.hs at line 6

[4.8604]→[4.4249:4319](∅→∅),[4.4319]→[4.9796:9856](∅→∅),[4.477]→[4.9796:9856](∅→∅),[4.9856]→[4.4765:4785](∅→∅)

( acceptInvitationHandler
, checkZAddrHandler
, registerHandler
, CaptchaConfig(..)
, CaptchaError(..)
, checkCaptcha
, RegisterOps(..)

[4.8604]

[4.55437]

( acceptInvitationHandler,
checkZAddrHandler,
registerHandler,
CaptchaConfig (..),
CaptchaError (..),
checkCaptcha,
RegisterOps (..),
replacement in server/Aftok/Snaplet/Users.hs at line 16

[4.8636]→[4.3509:3510](∅→∅),[4.3509]→[4.3509:3510](∅→∅),[4.3510]→[4.5631:5632](∅→∅),[4.5632]→[2.5413:5482](∅→∅),[2.5482]→[4.4445:4508](∅→∅),[4.8667]→[4.4445:4508](∅→∅),[4.4508]→[4.9857:9909](∅→∅),[4.8667]→[4.9857:9909](∅→∅),[4.9909]→[4.4509:4620](∅→∅),[4.4620]→[2.5483:5538](∅→∅),[2.5538]→[4.4620:4670](∅→∅),[4.4620]→[4.4620:4670](∅→∅),[4.4670]→[4.55500:55604](∅→∅),[4.9970]→[4.55500:55604](∅→∅),[4.55500]→[4.55500:55604](∅→∅),[4.55604]→[4.9971:10023](∅→∅),[4.10023]→[4.55604:55656](∅→∅),[4.55604]→[4.55604:55656](∅→∅),[4.55656]→[4.34766:34767](∅→∅),[4.8790]→[4.34766:34767](∅→∅),[4.34767]→[4.4671:4970](∅→∅),[4.4970]→[4.10127:10193](∅→∅),[4.10127]→[4.10127:10193](∅→∅),[4.10193]→[4.4971:5196](∅→∅),[4.5196]→[4.10271:10334](∅→∅),[4.10271]→[4.10271:10334](∅→∅),[4.8790]→[4.10431:10432](∅→∅),[4.10334]→[4.10431:10432](∅→∅),[4.15002]→[4.10431:10432](∅→∅),[4.34823]→[4.10431:10432](∅→∅),[4.55722]→[4.10431:10432](∅→∅),[4.59697]→[4.10431:10432](∅→∅),[4.10431]→[4.10431:10432](∅→∅),[4.10432]→[2.5539:5628](∅→∅),[4.4378]→[4.4786:4948](∅→∅),[2.5628]→[4.4786:4948](∅→∅),[4.10432]→[4.4786:4948](∅→∅),[4.5016]→[4.5016:5337](∅→∅),[4.5337]→[4.5289:5290](∅→∅),[4.5289]→[4.5289:5290](∅→∅),[4.4087]→[4.8846:8913](∅→∅),[4.5290]→[4.8846:8913](∅→∅),[4.8846]→[4.8846:8913](∅→∅)

import Control.Lens ( makeLenses, (^.) )
import Control.FromSum ( fromMaybeM )
import qualified Data.Aeson as A
import Data.Aeson ( (.:)
, (.:?)
, (.=)
)
import qualified Data.Map.Strict as M
import Data.Text as T
import Data.Text.Encoding as T
import Data.Thyme.Clock as C

import Network.HTTP.Client ( parseRequest
, responseBody
, responseStatus
, httpLbs
)
import Network.HTTP.Client.TLS ( newTlsManager )
import Network.HTTP.Client.MultipartFormData
( formDataBody
, partBS
)
import Network.HTTP.Types.Status ( statusCode )

import Aftok.Currency.Zcash ( ZAddr, RPCError, ZValidateAddressErr )
import Aftok.Database ( createUser, acceptInvitation )
import Aftok.Project ( InvitationCode, parseInvCode )
import Aftok.Types ( UserId, User(..)
, AccountRecovery(..)
, Email(..)
, UserName(..), _UserName
)

import Aftok.Snaplet
import Aftok.Snaplet.Auth

[4.3487]

[4.3650]

import Aftok.Currency.Zcash (RPCError, ZAddr, ZValidateAddressErr)
import Aftok.Database (acceptInvitation, createUser)
import Aftok.Project (InvitationCode, parseInvCode)
import Aftok.Snaplet
import Aftok.Snaplet.Auth
import Aftok.Types
( AccountRecovery (..),
Email (..),
User (..),
UserId,
UserName (..),
_UserName,
)
import Control.FromSum (fromMaybeM)
import Control.Lens ((^.), makeLenses)
import Data.Aeson
( (.:),
(.:?),
(.=),
)
import qualified Data.Aeson as A
import qualified Data.Map.Strict as M
import Data.Text as T
import Data.Text.Encoding as T
import Data.Thyme.Clock as C
import Network.HTTP.Client
( httpLbs,
parseRequest,
responseBody,
responseStatus,
)
import Network.HTTP.Client.MultipartFormData
( formDataBody,
partBS,
)
import Network.HTTP.Client.TLS (newTlsManager)
import Network.HTTP.Types.Status (statusCode)
import qualified Snap.Core as S
import qualified Snap.Snaplet as S
import qualified Snap.Snaplet.Auth as AU
replacement in server/Aftok/Snaplet/Users.hs at line 57

[4.3651]→[4.5291:5395](∅→∅),[4.5395]→[4.55950:56003](∅→∅),[4.10439]→[4.55950:56003](∅→∅),[4.55950]→[4.55950:56003](∅→∅)

import qualified Snap.Core as S
import qualified Snap.Snaplet as S
import qualified Snap.Snaplet.Auth as AU

[4.3651]

[2.5629]

data RegisterOps m
= RegisterOps
{ validateZAddr :: Text -> m (Either (RPCError ZValidateAddressErr) ZAddr),
sendConfirmationEmail :: Email -> m ()
}
replacement in server/Aftok/Snaplet/Users.hs at line 63

[2.5630]→[2.5630:5787](∅→∅)

data RegisterOps m = RegisterOps
{ validateZAddr :: Text -> m (Either (RPCError ZValidateAddressErr) ZAddr)
, sendConfirmationEmail :: Email -> m ()
}

[2.5630]

[4.5338]

data RegUser
= RegUser
{ _username :: !UserName,
_userAccountRecovery :: !(AccountRecovery Text)
}
edit in server/Aftok/Snaplet/Users.hs at line 69

[4.5339]→[4.5339:5458](∅→∅)

data RegUser = RegUser
{ _username :: !UserName
, _userAccountRecovery :: !(AccountRecovery Text)
}
replacement in server/Aftok/Snaplet/Users.hs at line 71

[4.269]→[4.5396:5435](∅→∅),[4.5435]→[4.5480:5512](∅→∅),[4.5464]→[4.9043:9078](∅→∅),[4.5512]→[4.9043:9078](∅→∅),[4.34955]→[4.9043:9078](∅→∅),[4.9043]→[4.9043:9078](∅→∅),[4.9078]→[4.5465:5494](∅→∅),[4.5494]→[4.10433:10474](∅→∅),[4.9078]→[4.10433:10474](∅→∅),[4.345]→[4.10433:10474](∅→∅),[4.10474]→[4.345:349](∅→∅),[4.345]→[4.345:349](∅→∅)

data RegisterRequest = RegisterRequest
{ _regUser :: RegUser
, _password :: ByteString
, _captchaToken :: Text
, _invitationCodes :: [InvitationCode]
}

[4.269]

[4.5495]

data RegisterRequest
= RegisterRequest
{ _regUser :: RegUser,
_password :: ByteString,
_captchaToken :: Text,
_invitationCodes :: [InvitationCode]
}
replacement in server/Aftok/Snaplet/Users.hs at line 86

[4.4444]→[4.4444:4509](∅→∅)

"zaddr" -> RecoverByZAddr <$> v .: "recoveryZAddr"

[4.4444]

[4.5798]

"zaddr" -> RecoverByZAddr <$> v .: "recoveryZAddr"
replacement in server/Aftok/Snaplet/Users.hs at line 88

[4.5823]→[4.5571:5664](∅→∅),[4.5664]→[4.10651:10652](∅→∅),[4.5910]→[4.10651:10652](∅→∅),[4.10540]→[4.10651:10652](∅→∅),[4.56168]→[4.10651:10652](∅→∅),[4.10651]→[4.10651:10652](∅→∅)

user <- RegUser <$> (UserName <$> v .: "username")
<*> pure recovery

[4.5823]

[4.5911]

user <-
RegUser <$> (UserName <$> v .: "username")
<*> pure recovery
edit in server/Aftok/Snaplet/Users.hs at line 95

[3.269]→[4.10820:10821](∅→∅),[4.5801]→[4.10820:10821](∅→∅),[4.56316]→[4.10820:10821](∅→∅),[4.10820]→[4.10820:10821](∅→∅)
replacement in server/Aftok/Snaplet/Users.hs at line 96

[4.6030]→[4.6030:6202](∅→∅)

parseInvitationCodes c = either
(\e -> fail $ "Invitation code was rejected as invalid: " <> e)
pure
(traverse parseInvCode c)

[4.6030]

[4.634]

parseInvitationCodes c =
either
(\e -> fail $ "Invitation code was rejected as invalid: " <> e)
pure
(traverse parseInvCode c)
replacement in server/Aftok/Snaplet/Users.hs at line 110

[2.5973]→[2.5973:6198](∅→∅)

RegParseError msg -> A.object
[ "parseError" .= msg ]
RegCaptchaError e -> A.object
[ "captchaError" .= (show e :: Text) ]
RegZAddrError zerr -> A.object
[ "zaddrError" .= (show zerr :: Text) ]

[2.5973]

[4.4424]

RegParseError msg ->
A.object
["parseError" .= msg]
RegCaptchaError e ->
A.object
["captchaError" .= (show e :: Text)]
RegZAddrError zerr ->
A.object
["zaddrError" .= (show zerr :: Text)]
replacement in server/Aftok/Snaplet/Users.hs at line 123

[4.4624]→[4.4624:4785](∅→∅)

zaddrBytes <- maybe (snapError 400 "zaddr parameter is required")
pure
(listToMaybe =<< M.lookup "zaddr" params)

[4.4624]

[2.6199]

zaddrBytes <-
maybe
(snapError 400 "zaddr parameter is required")
pure
(listToMaybe =<< M.lookup "zaddr" params)
replacement in server/Aftok/Snaplet/Users.hs at line 130

[4.4874]→[4.4874:4889](∅→∅)

Left _ ->

[4.4874]

[4.4889]

Left _ ->
edit in server/Aftok/Snaplet/Users.hs at line 134

[4.5004]→[4.5004:5005](∅→∅)
replacement in server/Aftok/Snaplet/Users.hs at line 137

[4.5910]→[4.6289:6326](∅→∅),[4.6289]→[4.6289:6326](∅→∅)

rbody <- S.readRequestBody 4096

[4.5910]

[4.6326]

rbody <- S.readRequestBody 4096
edit in server/Aftok/Snaplet/Users.hs at line 139

[4.6412]→[4.5008:5009](∅→∅)
edit in server/Aftok/Snaplet/Users.hs at line 145

[4.6061]→[4.6600:6601](∅→∅),[2.6445]→[4.6600:6601](∅→∅),[4.6600]→[4.6600:6601](∅→∅)
replacement in server/Aftok/Snaplet/Users.hs at line 152

[4.6330]→[2.6496:6517](∅→∅)

Left err ->

[4.6330]

[2.6517]

Left err ->
edit in server/Aftok/Snaplet/Users.hs at line 157

[4.5165]→[4.6465:6466](∅→∅),[4.6465]→[4.6465:6466](∅→∅)
replacement in server/Aftok/Snaplet/Users.hs at line 158

[4.6499]→[4.56546:56552](∅→∅),[4.6636]→[4.56546:56552](∅→∅),[4.59777]→[4.56546:56552](∅→∅),[4.56546]→[4.56546:56552](∅→∅),[4.56552]→[4.6500:6621](∅→∅),[4.6621]→[4.56684:56716](∅→∅),[4.56684]→[4.56684:56716](∅→∅),[4.56716]→[4.6622:6675](∅→∅),[4.6675]→[4.6684:6784](∅→∅),[4.6684]→[4.6684:6784](∅→∅)

let
uname = userData ^. (regUser . username)
createSUser = AU.createUser (uname ^. _UserName) (userData ^. password)
createQUser = snapEval $ do
userId <- createUser $ User uname acctRecovery
void $ traverse (acceptInvitation userId now) (userData ^. invitationCodes)
pure userId

[4.6499]

[4.10557]

let uname = userData ^. (regUser . username)
createSUser = AU.createUser (uname ^. _UserName) (userData ^. password)
createQUser = snapEval $ do
userId <- createUser $ User uname acctRecovery
void $ traverse (acceptInvitation userId now) (userData ^. invitationCodes)
pure userId
edit in server/Aftok/Snaplet/Users.hs at line 166

[4.9285]→[4.584:585](∅→∅),[4.11344]→[4.584:585](∅→∅)
replacement in server/Aftok/Snaplet/Users.hs at line 169

[4.660]→[4.56910:56938](∅→∅),[4.56938]→[4.6785:6823](∅→∅),[4.6823]→[4.10596:10622](∅→∅),[4.56976]→[4.10596:10622](∅→∅),[4.10622]→[4.57000:57068](∅→∅),[4.57000]→[4.57000:57068](∅→∅),[4.57068]→[4.10623:10691](∅→∅),[4.10691]→[4.57134:57182](∅→∅),[4.57134]→[4.57134:57182](∅→∅)

uid <- requireUserId
now <- liftIO C.getCurrentTime
params <- S.getParams
invCodes <- maybe (snapError 400 "invCode parameter is required")
(pure . traverse (parseInvCode . T.decodeUtf8))
(M.lookup "invCode" params)

[4.660]

[4.9309]

uid <- requireUserId
now <- liftIO C.getCurrentTime
params <- S.getParams
invCodes <-
maybe
(snapError 400 "invCode parameter is required")
(pure . traverse (parseInvCode . T.decodeUtf8))
(M.lookup "invCode" params)
replacement in server/Aftok/Snaplet/Users.hs at line 178

[4.9318]→[4.57183:57272](∅→∅)

(\e ->
snapError 400 $ "Invitation code was rejected as invalid: " <> T.pack e

[4.9318]

[4.57272]

( \e ->
snapError 400 $ "Invitation code was rejected as invalid: " <> T.pack e
edit in server/Aftok/Snaplet/Users.hs at line 183

[4.1064]→[4.9319:9320](∅→∅)
replacement in server/Aftok/Snaplet/Users.hs at line 196

[4.10941]→[4.10941:11000](∅→∅)

data CaptchaConfig = CaptchaConfig
{ secretKey :: Text }

[4.10941]

[4.11000]

data CaptchaConfig
= CaptchaConfig
{secretKey :: Text}
replacement in server/Aftok/Snaplet/Users.hs at line 200

[4.11001]→[4.11001:11097](∅→∅)

data CaptchaResponse = CaptchaResponse
{ success :: Bool
, errorCodes :: [CaptchaError]
}

[4.11001]

[4.11097]

data CaptchaResponse
= CaptchaResponse
{ success :: Bool,
errorCodes :: [CaptchaError]
}
replacement in server/Aftok/Snaplet/Users.hs at line 210

[4.6927]→[4.6927:6947](∅→∅)

.: "success"

[4.6927]

[4.6947]

.: "success"
replacement in server/Aftok/Snaplet/Users.hs at line 212

[4.7012]→[4.7012:7420](∅→∅)

where
toError = \case
"missing-input-secret" -> MissingInputSecret
"invalid-input-secret" -> InvalidInputSecret
"missing-input-response" -> MissingInputResponse
"invalid-input-response" -> InvalidInputResponse
"bad-request" -> BadRequest
"timeout-or-duplicate" -> TimeoutOrDuplicate
other -> CaptchaError $ "Unexpected error code: " <> other

[4.7012]

[4.7420]

where
toError = \case
"missing-input-secret" -> MissingInputSecret
"invalid-input-secret" -> InvalidInputSecret
"missing-input-response" -> MissingInputResponse
"invalid-input-response" -> InvalidInputResponse
"bad-request" -> BadRequest
"timeout-or-duplicate" -> TimeoutOrDuplicate
other -> CaptchaError $ "Unexpected error code: " <> other
replacement in server/Aftok/Snaplet/Users.hs at line 225

[4.11863]→[4.7495:7751](∅→∅)

request <- parseRequest "https://www.google.com/recaptcha/api/siteverify"
reqWithBody <- formDataBody
[ partBS "secret" (T.encodeUtf8 $ secretKey cfg)
, partBS "response" (T.encodeUtf8 token)
]
request
manager <- newTlsManager

[4.11863]

[4.12093]

request <- parseRequest "https://www.google.com/recaptcha/api/siteverify"
reqWithBody <-
formDataBody
[ partBS "secret" (T.encodeUtf8 $ secretKey cfg),
partBS "response" (T.encodeUtf8 token)
]
request
manager <- newTlsManager
replacement in server/Aftok/Snaplet/Users.hs at line 240

[4.12433]→[4.7980:8070](∅→∅)

Left
$ [CaptchaError $ "Unexpected status code: " <> T.pack (show errCode)]

[4.12433]

Left $
[CaptchaError $ "Unexpected status code: " <> T.pack (show errCode)]
replacement in server/Aftok/Snaplet/Util.hs at line 3

[4.4267]→[4.15004:15176](∅→∅),[4.8504]→[4.5709:5710](∅→∅),[4.15176]→[4.5709:5710](∅→∅),[4.4267]→[4.5709:5710](∅→∅),[4.5710]→[4.57280:57384](∅→∅),[4.57384]→[4.9495:9563](∅→∅),[4.9495]→[4.9495:9563](∅→∅)

import Data.Attoparsec.ByteString ( parseOnly )
import Data.Attoparsec.ByteString.Char8
( decimal )

import Data.ByteString.Char8 as B
import Data.Thyme.Clock as C
import Data.Thyme.Time
import Data.Time.ISO8601

[4.4267]

[4.4411]

import Data.Attoparsec.ByteString (parseOnly)
import Data.Attoparsec.ByteString.Char8
( decimal,
)
import Data.ByteString.Char8 as B
import Data.Thyme.Clock as C
import Data.Thyme.Time
import Data.Time.ISO8601
import Snap.Core
edit in server/Aftok/Snaplet/Util.hs at line 13

[4.4412]→[4.9564:9591](∅→∅),[4.9591]→[4.4429:4430](∅→∅),[4.4429]→[4.4429:4430](∅→∅)

import Snap.Core
replacement in server/Aftok/Snaplet/Util.hs at line 16

[4.4549]→[4.57385:57436](∅→∅)

t <- MaybeT . pure . parseISO8601 $ B.unpack bs

[4.4549]

[4.4599]

t <- MaybeT . pure . parseISO8601 $ B.unpack bs
replacement in server/Aftok/Snaplet/WorkLog.hs at line 1

[4.5424]→[4.5304:5340](∅→∅),[4.5340]→[4.2746:2781](∅→∅),[4.5424]→[4.2746:2781](∅→∅),[4.2781]→[4.5521:5522](∅→∅),[4.3286]→[4.5521:5522](∅→∅),[4.5521]→[4.5521:5522](∅→∅),[4.9624]→[4.5544:5545](∅→∅),[4.5544]→[4.5544:5545](∅→∅),[4.5545]→[4.5712:5713](∅→∅),[4.5713]→[4.15178:15235](∅→∅),[4.62]→[4.57438:57500](∅→∅),[4.15235]→[4.57438:57500](∅→∅),[4.9655]→[4.57438:57500](∅→∅),[4.57500]→[4.37362:37363](∅→∅),[4.37362]→[4.37362:37363](∅→∅),[4.37363]→[4.57501:57553](∅→∅),[4.57553]→[4.15236:15293](∅→∅),[4.118]→[4.311005:311057](∅→∅),[4.15293]→[4.311005:311057](∅→∅),[4.57553]→[4.311005:311057](∅→∅),[4.311057]→[4.57554:57710](∅→∅),[4.9730]→[4.57554:57710](∅→∅),[4.57710]→[4.15294:15352](∅→∅),[4.15352]→[4.59829:59890](∅→∅),[4.59829]→[4.59829:59890](∅→∅),[4.59890]→[4.57831:57881](∅→∅),[4.57831]→[4.57831:57881](∅→∅),[4.3024]→[4.5641:5642](∅→∅),[4.4322]→[4.5641:5642](∅→∅),[4.9812]→[4.5641:5642](∅→∅),[4.35269]→[4.5641:5642](∅→∅),[4.57881]→[4.5641:5642](∅→∅),[4.5641]→[4.5641:5642](∅→∅),[4.5642]→[4.57882:57946](∅→∅),[4.57946]→[4.119:181](∅→∅),[4.181]→[4.57946:58056](∅→∅),[4.57946]→[4.57946:58056](∅→∅),[4.1102]→[4.9836:9928](∅→∅),[4.2230]→[4.9836:9928](∅→∅),[4.35337]→[4.9836:9928](∅→∅),[4.58056]→[4.9836:9928](∅→∅),[4.9836]→[4.9836:9928](∅→∅),[4.9928]→[4.4089:4120](∅→∅),[4.4120]→[4.9928:9959](∅→∅),[4.9928]→[4.9928:9959](∅→∅),[4.9959]→[4.15353:15522](∅→∅),[4.268]→[4.58122:58185](∅→∅),[4.15522]→[4.58122:58185](∅→∅),[4.59963]→[4.58122:58185](∅→∅),[4.58122]→[4.58122:58185](∅→∅)

{-# LANGUAGE TupleSections #-}
module Aftok.Snaplet.WorkLog where

import Control.Lens ( (^.) )
import Control.Monad.Trans.Maybe ( mapMaybeT )

import qualified Data.Aeson as A
import Data.Aeson ( (.=) )
import qualified Data.Aeson.Types as A
import qualified Data.Text as T
import Data.Thyme.Clock as C
import Data.UUID as U
import Haskoin.Address ( Address
, textToAddr
)

import Aftok.Currency.Bitcoin ( NetworkId(..)
, NetworkMode
, toNetwork
)
import Aftok.Database
import Aftok.Interval
import Aftok.Json
import Aftok.Project
import Aftok.TimeLog
import Aftok.Types ( _ProjectId
, _UserId
)
import Aftok.Util ( fromMaybeT )

[4.5424]

[4.5728]

{-# LANGUAGE TupleSections #-}
replacement in server/Aftok/Snaplet/WorkLog.hs at line 3

[4.5729]→[4.9960:10063](∅→∅)

import Aftok.Snaplet
import Aftok.Snaplet.Auth
import Aftok.Snaplet.Util

[4.5729]

[4.5755]

module Aftok.Snaplet.WorkLog where
replacement in server/Aftok/Snaplet/WorkLog.hs at line 5

[4.5756]→[4.10064:10091](∅→∅),[4.10091]→[4.58186:58238](∅→∅)

import Snap.Core
import Snap.Snaplet as S

[4.5756]

[4.5830]

import Aftok.Currency.Bitcoin
( NetworkId (..),
NetworkMode,
toNetwork,
)
import Aftok.Database
import Aftok.Interval
import Aftok.Json
import Aftok.Project
import Aftok.Snaplet
import Aftok.Snaplet.Auth
import Aftok.Snaplet.Util
import Aftok.TimeLog
import Aftok.Types
( _ProjectId,
_UserId,
)
import Aftok.Util (fromMaybeT)
import Control.Lens ((^.))
import Control.Monad.Trans.Maybe (mapMaybeT)
import Data.Aeson ((.=))
import qualified Data.Aeson as A
import qualified Data.Aeson.Types as A
import qualified Data.Text as T
import Data.Thyme.Clock as C
import Data.UUID as U
import Haskoin.Address
( Address,
textToAddr,
)
import Snap.Core
import Snap.Snaplet as S
replacement in server/Aftok/Snaplet/WorkLog.hs at line 38

[4.5831]→[4.15523:15622](∅→∅)

logWorkHandler
:: (C.UTCTime -> LogEvent)
-> S.Handler App App (EventId, KeyedLogEntry BTCNet)

[4.5831]

[4.10122]

logWorkHandler ::
(C.UTCTime -> LogEvent) ->
S.Handler App App (EventId, KeyedLogEntry BTCNet)
replacement in server/Aftok/Snaplet/WorkLog.hs at line 42

[4.10148]→[4.58239:58336](∅→∅)

uid <- requireUserId
pid <- requireProjectId
nmode <- getNetworkMode

[4.10148]

[4.245]

uid <- requireUserId
pid <- requireProjectId
nmode <- getNetworkMode
replacement in server/Aftok/Snaplet/WorkLog.hs at line 46

[4.283]→[4.58337:58385](∅→∅),[4.58385]→[4.15623:15714](∅→∅),[4.15714]→[4.58466:58555](∅→∅),[4.311141]→[4.58466:58555](∅→∅),[4.58466]→[4.58466:58555](∅→∅)

timestamp <- liftIO C.getCurrentTime
case
A.eitherDecode requestBody
>>= A.parseEither (parseLogEntry nmode uid evCtr)
of
Left err ->
snapError 400
$ "Unable to parse log entry "

[4.283]

[4.58555]

timestamp <- liftIO C.getCurrentTime
case A.eitherDecode requestBody
>>= A.parseEither (parseLogEntry nmode uid evCtr) of
Left err ->
snapError 400 $
"Unable to parse log entry "
replacement in server/Aftok/Snaplet/WorkLog.hs at line 55

[4.58627]→[4.5437:5579](∅→∅),[4.5579]→[4.15715:15854](∅→∅),[4.15854]→[4.5695:5708](∅→∅),[4.5695]→[4.5695:5708](∅→∅)

Right entry -> do
eid <- snapEval $ createEvent pid uid (entry timestamp)
ev <- snapEval $ findEvent eid
maybe
( snapError 500
$ "An error occured retrieving the newly created event record."
)
(pure . (eid, ))
ev

[4.58627]

[4.570]

Right entry -> do
eid <- snapEval $ createEvent pid uid (entry timestamp)
ev <- snapEval $ findEvent eid
maybe
( snapError 500 $
"An error occured retrieving the newly created event record."
)
(pure . (eid,))
ev
replacement in server/Aftok/Snaplet/WorkLog.hs at line 67

[4.672]→[4.58698:58751](∅→∅)

uid <- requireUserId
pid <- requireProjectId

[4.672]

[4.35681]

uid <- requireUserId
pid <- requireProjectId
replacement in server/Aftok/Snaplet/WorkLog.hs at line 71

[4.35743]→[4.58752:58788](∅→∅)

addrBytes <- getParam "btcAddr"

[4.35743]

[4.4323]

addrBytes <- getParam "btcAddr"
replacement in server/Aftok/Snaplet/WorkLog.hs at line 73

[4.4361]→[4.58789:58830](∅→∅)

timestamp <- liftIO C.getCurrentTime

[4.4361]

[4.59964]

timestamp <- liftIO C.getCurrentTime
replacement in server/Aftok/Snaplet/WorkLog.hs at line 76

[4.10164]→[4.58831:59079](∅→∅)

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)

[4.10164]

[4.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 94

[4.4691]→[4.59080:59141](∅→∅),[4.14963]→[4.59080:59141](∅→∅),[4.4930]→[4.59080:59141](∅→∅)

uid <- requireUserId
pid <- requireProjectId

[4.4691]

[4.5005]

uid <- requireUserId
pid <- requireProjectId
replacement in server/Aftok/Snaplet/WorkLog.hs at line 98

[4.4723]→[4.4723:4841](∅→∅)

(Just s , Just e ) -> During s e
(Nothing, Just e ) -> Before e
(Just s , Nothing) -> After s

[4.4723]

[4.4841]

(Just s, Just e) -> During s e
(Nothing, Just e) -> Before e
(Just s, Nothing) -> After s
replacement in server/Aftok/Snaplet/WorkLog.hs at line 110

[4.10203]→[4.59426:59483](∅→∅),[4.59483]→[4.37406:37430](∅→∅),[4.13074]→[4.37406:37430](∅→∅),[4.37430]→[4.5933:5995](∅→∅),[4.5995]→[4.37493:37544](∅→∅),[4.37493]→[4.37493:37544](∅→∅),[4.37544]→[4.59484:59528](∅→∅)

uid <- requireUserId
pid <- requireProjectId
project <- fromMaybeT
(snapError 400 $ "Project not found for id " <> show pid)
(mapMaybeT snapEval $ findUserProject uid pid)
widx <- snapEval $ readWorkIndex pid uid

[4.10203]

[4.3065]

uid <- requireUserId
pid <- requireProjectId
project <-
fromMaybeT
(snapError 400 $ "Project not found for id " <> show pid)
(mapMaybeT snapEval $ findUserProject uid pid)
widx <- snapEval $ readWorkIndex pid uid
replacement in server/Aftok/Snaplet/WorkLog.hs at line 122

[4.8755]→[4.59529:59594](∅→∅)

uid <- requireUserId
nmode <- getNetworkMode

[4.8755]

[4.8828]

uid <- requireUserId
nmode <- getNetworkMode
replacement in server/Aftok/Snaplet/WorkLog.hs at line 125

[4.8865]→[4.59595:59821](∅→∅)

eventId <- maybe (snapError 400 "eventId parameter is required")
(pure . EventId)
(eventIdBytes >>= U.fromASCIIBytes)
modTime <- ModTime <$> liftIO C.getCurrentTime

[4.8865]

[4.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 132

[4.9233]→[4.59822:59901](∅→∅),[4.59901]→[4.311142:311215](∅→∅)

either (snapError 400 . T.pack)
(snapEval . amendEvent uid eventId)
(A.parseEither (parseEventAmendment nmode modTime) requestJSON)

[4.9233]

[4.269]

either
(snapError 400 . T.pack)
(snapEval . amendEvent uid eventId)
(A.parseEither (parseEventAmendment nmode modTime) requestJSON)
replacement in server/Aftok/Snaplet/WorkLog.hs at line 137

[4.270]→[4.15946:16041](∅→∅)

keyedLogEntryJSON
:: NetworkMode -> (EventId, KeyedLogEntry (NetworkId, Address)) -> A.Value

[4.270]

[4.16041]

keyedLogEntryJSON ::
NetworkMode -> (EventId, KeyedLogEntry (NetworkId, Address)) -> A.Value
replacement in server/Aftok/Snaplet/WorkLog.hs at line 141

[4.16094]→[4.16094:16278](∅→∅),[4.16278]→[4.574:575](∅→∅),[4.574]→[4.574:575](∅→∅)

. obj
$ [ "eventId" .= idValue _EventId eid
, "projectId" .= idValue _ProjectId pid
, "loggedBy" .= idValue _UserId uid
]
<> logEntryFields nmode ev

[4.16094]

. obj
$ [ "eventId" .= idValue _EventId eid,
"projectId" .= idValue _ProjectId pid,
"loggedBy" .= idValue _UserId uid
]
<> logEntryFields nmode ev
replacement in server/Aftok/Snaplet.hs at line 2

[4.10391]→[4.10391:10426](∅→∅)

{-# LANGUAGE TemplateHaskell #-}

[4.10391]

[4.1158]

{-# LANGUAGE TemplateHaskell #-}
replacement in server/Aftok/Snaplet.hs at line 6

[4.10458]→[4.1214:1215](∅→∅),[4.1214]→[4.1214:1215](∅→∅),[4.1215]→[4.6027:6028](∅→∅),[4.6028]→[4.10459:10489](∅→∅),[4.1215]→[4.10459:10489](∅→∅),[4.37606]→[4.10608:10660](∅→∅),[4.60037]→[4.10608:10660](∅→∅),[4.10608]→[4.10608:10660](∅→∅),[4.10660]→[4.60038:60270](∅→∅),[4.60270]→[2.6654:6727](∅→∅),[2.6727]→[4.1324:1325](∅→∅),[4.6996]→[4.1324:1325](∅→∅),[4.10727]→[4.1324:1325](∅→∅),[4.11434]→[4.1324:1325](∅→∅),[4.1324]→[4.1324:1325](∅→∅),[4.1325]→[4.60271:60405](∅→∅),[4.60405]→[2.6728:7012](∅→∅),[2.7012]→[4.60406:60581](∅→∅),[4.10826]→[4.60406:60581](∅→∅),[4.7126]→[4.10826:10854](∅→∅),[4.36384]→[4.10826:10854](∅→∅),[4.60581]→[4.10826:10854](∅→∅),[4.10826]→[4.10826:10854](∅→∅),[4.3093]→[4.1432:1433](∅→∅),[4.10854]→[4.1432:1433](∅→∅),[4.13497]→[4.1432:1433](∅→∅),[4.1432]→[4.1432:1433](∅→∅),[4.1433]→[2.7013:7748](∅→∅),[2.7748]→[4.18755:18807](∅→∅),[4.10882]→[4.18755:18807](∅→∅),[4.18807]→[4.10912:10965](∅→∅),[4.10912]→[4.10912:10965](∅→∅),[4.10965]→[2.7749:8120](∅→∅)

import Control.Lens
import qualified Data.Aeson as A
import Data.Attoparsec.ByteString ( Parser
, parseOnly
, takeByteString
)
import Data.UUID ( UUID, fromASCIIBytes )

import Aftok.Auction ( AuctionId(..) )
import Aftok.Currency.Bitcoin ( NetworkMode(..) )
import Aftok.Database ( DBError(..)
, DBOp
, liftdb
)
import Aftok.Database.PostgreSQL ( runQDBM )
import Aftok.Types ( UserId(..)
, ProjectId(..)
)
import Aftok.Util

import Snap.Core ( MonadSnap
, getParam
, readRequestBody
, setResponseCode
, modifyResponse
, finishWith
, getResponse
, writeText
, writeLBS
, setResponseStatus
, logError
)
import Snap.Snaplet as S
import qualified Snap.Snaplet.Auth as AU
import Snap.Snaplet.PostgresqlSimple ( Postgres
, HasPostgres(..)
, setLocalPostgresState
, liftPG
)
import Snap.Snaplet.Session ( SessionManager )

[4.1192]

[4.1688]

import Aftok.Auction (AuctionId (..))
import Aftok.Currency.Bitcoin (NetworkMode (..))
import Aftok.Database
( DBError (..),
DBOp,
liftdb,
)
import Aftok.Database.PostgreSQL (runQDBM)
import Aftok.Types
( ProjectId (..),
UserId (..),
)
import Aftok.Util
import Control.Lens
import qualified Data.Aeson as A
import Data.Attoparsec.ByteString
( Parser,
parseOnly,
takeByteString,
)
import Data.UUID (UUID, fromASCIIBytes)
import Snap.Core
( MonadSnap,
finishWith,
getParam,
getResponse,
logError,
modifyResponse,
readRequestBody,
setResponseCode,
setResponseStatus,
writeLBS,
writeText,
)
import Snap.Snaplet as S
import qualified Snap.Snaplet.Auth as AU
import Snap.Snaplet.PostgresqlSimple
( HasPostgres (..),
Postgres,
liftPG,
setLocalPostgresState,
)
import Snap.Snaplet.Session (SessionManager)
edit in server/Aftok/Snaplet.hs at line 50

[4.1689]

[2.8121]

data App
= App
{ _networkMode :: NetworkMode,
_sess :: Snaplet SessionManager,
_db :: Snaplet Postgres,
_auth :: Snaplet (AU.AuthManager App)
}
edit in server/Aftok/Snaplet.hs at line 58

[2.8122]→[4.11051:11066](∅→∅),[4.1689]→[4.11051:11066](∅→∅),[4.11066]→[4.36385:36453](∅→∅),[4.13534]→[4.1770:1846](∅→∅),[4.36453]→[4.1770:1846](∅→∅),[4.1770]→[4.1770:1846](∅→∅)

data App = App
{ _networkMode :: NetworkMode
, _sess :: Snaplet SessionManager
, _db :: Snaplet Postgres
, _auth :: Snaplet (AU.AuthManager App)
}
replacement in server/Aftok/Snaplet.hs at line 70

[4.36607]→[4.36607:36616](∅→∅),[4.36616]→[4.60582:60659](∅→∅)

snapEval
:: (MonadSnap m, HasPostgres m, HasNetworkMode m) => Program DBOp a -> m a

[4.36607]

[4.11605]

snapEval ::
(MonadSnap m, HasPostgres m, HasNetworkMode m) => Program DBOp a -> m a
replacement in server/Aftok/Snaplet.hs at line 75

[4.6097]→[4.60660:60791](∅→∅)

handleDBError (SubjectNotFound) = snapError
404
"The subject of the requested operation could not be found."

[4.6097]

[4.14166]

handleDBError (SubjectNotFound) =
snapError
404
"The subject of the requested operation could not be found."
edit in server/Aftok/Snaplet.hs at line 81

[4.14284]→[4.11872:11873](∅→∅),[4.11872]→[4.11872:11873](∅→∅)
replacement in server/Aftok/Snaplet.hs at line 82

[4.36724]→[4.60792:60887](∅→∅)

e <- liftPG
$ \conn -> liftIO $ runExceptT (runQDBM nmode conn $ interpret liftdb p)

[4.36724]

[4.11945]

e <- liftPG $
\conn -> liftIO $ runExceptT (runQDBM nmode conn $ interpret liftdb p)
edit in server/Aftok/Snaplet.hs at line 102

[4.3096]→[2.8519:8520](∅→∅)
replacement in server/Aftok/Snaplet.hs at line 110

[4.2105]→[4.60888:60990](∅→∅)

maybe (snapError 400 $ "Parameter " <> show name <> " is required")
pure
maybeBytes

[4.2105]

[4.2190]

maybe
(snapError 400 $ "Parameter " <> show name <> " is required")
pure
maybeBytes
replacement in server/Aftok/Snaplet.hs at line 115

[4.2191]→[4.60991:61176](∅→∅)

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

[4.2191]

[4.12036]

parseParam ::
MonadSnap m =>
-- | the name of the parameter to be parsed
Text ->
-- | parser for the value of the parameter
Parser a ->
-- | the parsed value
m a
replacement in server/Aftok/Snaplet.hs at line 126

[4.2230]→[4.61177:61305](∅→∅)

( const
. snapError 400
$ "Value of parameter "
<> show name
<> " could not be parsed to a valid value."

[4.2230]

[4.61305]

( const
. snapError 400
$ "Value of parameter "
<> show name
<> " could not be parsed to a valid value."
replacement in server/Aftok/Snaplet.hs at line 135

[4.7383]→[4.61312:61445](∅→∅)

requireId
:: MonadSnap m
=> Text -- ^ name of the parameter
-> (UUID -> a) -- ^ constructor for the identifier
-> m a

[4.7383]

[4.7538]

requireId ::
MonadSnap m =>
-- | name of the parameter
Text ->
-- | constructor for the identifier
(UUID -> a) ->
m a
replacement in server/Aftok/Snaplet.hs at line 145

[4.61454]→[4.61454:61535](∅→∅)

(snapError 400 $ "Value of parameter \"" <> name <> "\" is not a valid UUID"

[4.61454]

[4.61535]

( snapError 400 $ "Value of parameter \"" <> name <> "\" is not a valid UUID"
replacement in server/Aftok/Snaplet.hs at line 149

[4.61562]→[4.61562:61645](∅→∅)

where
idParser = do
bs <- takeByteString
pure $ f <$> fromASCIIBytes bs

[4.61562]

[4.9523]

where
idParser = do
bs <- takeByteString
pure $ f <$> fromASCIIBytes bs
edit in server/Aftok/Snaplet.hs at line 167

[4.7985]→[4.7985:7986](∅→∅)
replacement in server/Main.hs at line 5

[4.1461]→[4.61762:62333](∅→∅),[4.62333]→[4.6680:6776](∅→∅),[4.6776]→[4.11294:11330](∅→∅),[4.8139]→[4.11294:11330](∅→∅),[4.37846]→[4.11294:11330](∅→∅),[4.62333]→[4.11294:11330](∅→∅),[4.11294]→[4.11294:11330](∅→∅),[4.11330]→[4.62334:62394](∅→∅),[4.626]→[4.918:919](∅→∅),[4.1661]→[4.918:919](∅→∅),[4.6443]→[4.918:919](∅→∅),[4.7624]→[4.918:919](∅→∅),[4.7747]→[4.918:919](∅→∅),[4.11330]→[4.918:919](∅→∅),[4.62394]→[4.918:919](∅→∅),[4.256]→[4.918:919](∅→∅),[4.919]→[4.6777:6846](∅→∅),[4.6846]→[4.11331:11390](∅→∅),[4.919]→[4.11331:11390](∅→∅),[4.648]→[4.942:943](∅→∅),[4.1188]→[4.942:943](∅→∅),[4.3134]→[4.942:943](∅→∅),[4.6917]→[4.942:943](∅→∅),[4.11390]→[4.942:943](∅→∅),[4.2567]→[4.942:943](∅→∅),[4.943]→[4.62395:62499](∅→∅),[4.36849]→[4.11422:11453](∅→∅),[4.62499]→[4.11422:11453](∅→∅),[4.11422]→[4.11422:11453](∅→∅),[4.11489]→[4.4122:4162](∅→∅),[4.4162]→[4.37847:37886](∅→∅),[4.37886]→[4.2232:2268](∅→∅),[4.4162]→[4.2232:2268](∅→∅),[4.2268]→[4.8140:8180](∅→∅),[4.2268]→[4.11489:11605](∅→∅),[4.4162]→[4.11489:11605](∅→∅),[4.8180]→[4.11489:11605](∅→∅),[4.11489]→[4.11489:11605](∅→∅)

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
)
import Network.HTTP.Client ( Manager, newManager, defaultManagerSettings )
import System.Environment
import System.IO.Error ( IOError )

import Aftok.Currency.Zcash ( rpcValidateZAddr )
import Aftok.Json
import Aftok.TimeLog

import qualified Aftok.Config as C
import Aftok.QConfig as Q
import Aftok.Snaplet
import Aftok.Snaplet.Auctions
import Aftok.Snaplet.Billing
import Aftok.Snaplet.Auth
import Aftok.Snaplet.Payments
import Aftok.Snaplet.Projects
import Aftok.Snaplet.Users
import Aftok.Snaplet.WorkLog

[4.1461]

[4.782]

import qualified Aftok.Config as C
import Aftok.Currency.Zcash (rpcValidateZAddr)
import Aftok.Json
import Aftok.QConfig as Q
import Aftok.Snaplet
import Aftok.Snaplet.Auctions
import Aftok.Snaplet.Auth
import Aftok.Snaplet.Billing
import Aftok.Snaplet.Payments
import Aftok.Snaplet.Projects
import Aftok.Snaplet.Users
import Aftok.Snaplet.WorkLog
import Aftok.TimeLog
import Control.Exception (try)
import Control.Lens
( (^.),
to,
)
import qualified Data.Aeson as A
import Data.ProtocolBuffers (encodeMessage)
import Data.Serialize.Put (runPutLazy)
import Filesystem.Path.CurrentOS
( decodeString,
encodeString,
)
import Network.HTTP.Client (Manager, defaultManagerSettings, newManager)
import Snap.Core
import Snap.Snaplet
import qualified Snap.Snaplet.Auth as AU
import Snap.Snaplet.Auth.Backends.PostgresqlSimple
import Snap.Snaplet.PostgresqlSimple
import Snap.Snaplet.Session.Backends.CookieSession
import Snap.Util.FileServe (serveDirectory)
import System.Environment
import System.IO.Error (IOError)
edit in server/Main.hs at line 41

[4.783]→[4.11606:11663](∅→∅),[4.11663]→[4.16280:16333](∅→∅),[4.11379]→[4.11724:11771](∅→∅),[4.16333]→[4.11724:11771](∅→∅),[4.11724]→[4.11724:11771](∅→∅),[4.11771]→[4.2179:2240](∅→∅),[4.2240]→[4.11771:11832](∅→∅),[4.11771]→[4.11771:11832](∅→∅),[4.11832]→[4.62500:62567](∅→∅),[4.2285]→[4.314:315](∅→∅),[4.8170]→[4.314:315](∅→∅),[4.11832]→[4.314:315](∅→∅),[4.62567]→[4.314:315](∅→∅),[4.314]→[4.314:315](∅→∅)

import Snap.Core
import Snap.Snaplet
import qualified Snap.Snaplet.Auth as AU
import Snap.Snaplet.PostgresqlSimple
import Snap.Snaplet.Auth.Backends.PostgresqlSimple
import Snap.Snaplet.Session.Backends.CookieSession
import Snap.Util.FileServe ( serveDirectory )
replacement in server/Main.hs at line 44

[4.6491]→[4.62568:62673](∅→∅)

cfg <- loadQConfig . decodeString $ fromRight "conf/aftok.cfg" cfgPath
sconf <- snapConfig cfg

[4.6491]

[4.8316]

cfg <- loadQConfig . decodeString $ fromRight "conf/aftok.cfg" cfgPath
sconf <- snapConfig cfg
replacement in server/Main.hs at line 49

[4.6970]→[4.6970:7004](∅→∅),[4.7004]→[2.8522:8583](∅→∅),[4.5225]→[4.7109:7157](∅→∅),[2.8583]→[4.7109:7157](∅→∅),[4.7109]→[4.7109:7157](∅→∅)

registerOps mgr cfg = RegisterOps
{ validateZAddr = rpcValidateZAddr mgr (_zcashdConfig cfg)
, sendConfirmationEmail = const $ pure ()
}

[4.6970]

[4.7157]

registerOps mgr cfg =
RegisterOps
{ validateZAddr = rpcValidateZAddr mgr (_zcashdConfig cfg),
sendConfirmationEmail = const $ pure ()
}
replacement in server/Main.hs at line 60

[4.7245]→[4.16334:16404](∅→∅),[4.11435]→[4.16334:16404](∅→∅)

sesss <- nestSnaplet "sessions" sess
$ initCookieSessionManager

[4.7245]

[4.16404]

sesss <-
nestSnaplet "sessions" sess $
initCookieSessionManager
replacement in server/Main.hs at line 67

[4.11552]→[4.26670:26731](∅→∅),[4.16487]→[4.26670:26731](∅→∅),[4.62847]→[4.26670:26731](∅→∅),[4.26670]→[4.26670:26731](∅→∅)

pgs <- nestSnaplet "db" db $ pgsInit' (cfg ^. pgsConfig)

[4.16487]

[4.8692]

pgs <- nestSnaplet "db" db $ pgsInit' (cfg ^. pgsConfig)
replacement in server/Main.hs at line 69

[4.2064]→[4.2397:2398](∅→∅),[4.12738]→[4.2397:2398](∅→∅),[4.38514]→[4.2397:2398](∅→∅),[4.2397]→[4.2397:2398](∅→∅),[4.2398]→[4.62848:62915](∅→∅),[4.37297]→[4.38517:38518](∅→∅),[4.62915]→[4.38517:38518](∅→∅),[4.2570]→[4.38517:38518](∅→∅),[4.38518]→[4.11553:11620](∅→∅),[4.11620]→[4.311217:311276](∅→∅),[4.62984]→[4.311217:311276](∅→∅),[4.311276]→[4.11621:11732](∅→∅),[4.2644]→[4.12970:12971](∅→∅),[4.38772]→[4.12970:12971](∅→∅),[4.63099]→[4.12970:12971](∅→∅),[4.12970]→[4.12970:12971](∅→∅),[4.12971]→[4.5226:5294](∅→∅),[4.5294]→[4.7246:7337](∅→∅),[4.12971]→[4.7246:7337](∅→∅),[4.7337]→[4.63100:63237](∅→∅),[4.8158]→[4.63100:63237](∅→∅),[4.12576]→[4.63100:63237](∅→∅),[4.12971]→[4.63100:63237](∅→∅),[4.1802]→[4.4230:4231](∅→∅),[4.1914]→[4.4230:4231](∅→∅),[4.2893]→[4.4230:4231](∅→∅),[4.37382]→[4.4230:4231](∅→∅),[4.38941]→[4.4230:4231](∅→∅),[4.63237]→[4.4230:4231](∅→∅),[4.4230]→[4.4230:4231](∅→∅),[4.4231]→[4.63238:63421](∅→∅),[4.2495]→[4.8383:8384](∅→∅),[4.4874]→[4.8383:8384](∅→∅),[4.39213]→[4.8383:8384](∅→∅),[4.63421]→[4.8383:8384](∅→∅),[4.8383]→[4.8383:8384](∅→∅),[4.8384]→[4.16488:16560](∅→∅),[4.16560]→[4.15247:15275](∅→∅),[4.15247]→[4.15247:15275](∅→∅),[4.15275]→[4.4952:5020](∅→∅),[4.5020]→[4.8961:9051](∅→∅),[4.15343]→[4.8961:9051](∅→∅),[4.9051]→[4.2549:2550](∅→∅),[4.15343]→[4.2549:2550](∅→∅),[4.26901]→[4.2549:2550](∅→∅),[4.39532]→[4.2549:2550](∅→∅),[4.63689]→[4.2549:2550](∅→∅),[4.2979]→[4.2549:2550](∅→∅),[4.2570]→[4.5710:5806](∅→∅),[4.5806]→[4.15429:15523](∅→∅),[4.15523]→[4.16561:16640](∅→∅),[4.16640]→[4.5021:5112](∅→∅),[4.15608]→[4.5021:5112](∅→∅),[4.5112]→[4.15706:15796](∅→∅),[4.15706]→[4.15706:15796](∅→∅),[4.15796]→[4.317:318](∅→∅),[4.64011]→[4.317:318](∅→∅),[4.1201]→[4.317:318](∅→∅),[4.318]→[4.64012:64102](∅→∅),[4.64102]→[4.16641:16790](∅→∅),[4.854]→[4.321:322](∅→∅),[4.9213]→[4.321:322](∅→∅),[4.16790]→[4.321:322](∅→∅),[4.39909]→[4.321:322](∅→∅),[4.64251]→[4.321:322](∅→∅),[4.13275]→[4.321:322](∅→∅),[4.322]→[4.64252:64528](∅→∅),[4.64528]→[4.8385:8386](∅→∅),[4.1979]→[4.8385:8386](∅→∅),[4.8386]→[4.64529:64886](∅→∅),[4.1864]→[4.4299:4300](∅→∅),[4.1979]→[4.4299:4300](∅→∅),[4.2440]→[4.4299:4300](∅→∅),[4.4930]→[4.4299:4300](∅→∅),[4.8577]→[4.4299:4300](∅→∅),[4.40062]→[4.4299:4300](∅→∅),[4.64886]→[4.4299:4300](∅→∅),[4.4299]→[4.4299:4300](∅→∅)

let
nmode = cfg ^. billingConfig . C.networkMode

loginRoute = method GET requireLogin >> redirect "/app"
xhrLoginRoute = void $ method POST requireLoginXHR
checkLoginRoute = void $ method GET requireUser
logoutRoute = method GET (with auth AU.logout)

checkZAddrRoute = void $ method GET (checkZAddrHandler rops)
registerRoute = void $ method POST (registerHandler rops (cfg ^. recaptchaSecret))
inviteRoute = void $ method POST (projectInviteHandler cfg)
acceptInviteRoute = void $ method POST acceptInvitationHandler

projectCreateRoute =
serveJSON projectIdJSON $ method POST projectCreateHandler
projectListRoute =
serveJSON (fmap qdbProjectJSON) $ method GET projectListHandler

projectRoute = serveJSON projectJSON $ method GET projectGetHandler
projectWorkIndexRoute =
serveJSON (workIndexJSON nmode) (method GET projectWorkIndex)
projectPayoutsRoute =
serveJSON (payoutsJSON nmode) $ method GET payoutsHandler

logWorkRoute f =
serveJSON (keyedLogEntryJSON nmode) $ method POST (logWorkHandler f)
-- logWorkBTCRoute f =
-- serveJSON eventIdJSON $ method POST (logWorkBTCHandler f)
amendEventRoute = serveJSON amendmentIdJSON $ method PUT amendEventHandler
userEventsRoute =
serveJSON (fmap $ logEntryJSON nmode) $ method GET userEvents

userWorkIndexRoute =
serveJSON (workIndexJSON nmode) $ method GET userWorkIndex

auctionCreateRoute =
serveJSON auctionIdJSON $ method POST auctionCreateHandler
auctionRoute = serveJSON auctionJSON $ method GET auctionGetHandler
auctionBidRoute = serveJSON bidIdJSON $ method POST auctionBidHandler

billableCreateRoute =
serveJSON billableIdJSON $ method POST billableCreateHandler
billableListRoute =
serveJSON (fmap qdbBillableJSON) $ method GET billableListHandler
subscribeRoute =
serveJSON subscriptionIdJSON $ method POST subscribeHandler

payableRequestsRoute =
serveJSON billDetailsJSON $ method GET listPayableRequestsHandler
getPaymentRequestRoute =
writeLBS
. runPutLazy
. encodeMessage
=<< method GET getPaymentRequestHandler
submitPaymentRoute = serveJSON paymentIdJSON
$ method POST (paymentResponseHandler $ cfg ^. billingConfig)

[4.8755]

[4.64887]

let nmode = cfg ^. billingConfig . C.networkMode
loginRoute = method GET requireLogin >> redirect "/app"
xhrLoginRoute = void $ method POST requireLoginXHR
checkLoginRoute = void $ method GET requireUser
logoutRoute = method GET (with auth AU.logout)
checkZAddrRoute = void $ method GET (checkZAddrHandler rops)
registerRoute = void $ method POST (registerHandler rops (cfg ^. recaptchaSecret))
inviteRoute = void $ method POST (projectInviteHandler cfg)
acceptInviteRoute = void $ method POST acceptInvitationHandler
projectCreateRoute =
serveJSON projectIdJSON $ method POST projectCreateHandler
projectListRoute =
serveJSON (fmap qdbProjectJSON) $ method GET projectListHandler
projectRoute = serveJSON projectJSON $ method GET projectGetHandler
projectWorkIndexRoute =
serveJSON (workIndexJSON nmode) (method GET projectWorkIndex)
projectPayoutsRoute =
serveJSON (payoutsJSON nmode) $ method GET payoutsHandler
logWorkRoute f =
serveJSON (keyedLogEntryJSON nmode) $ method POST (logWorkHandler f)
-- logWorkBTCRoute f =
-- serveJSON eventIdJSON $ method POST (logWorkBTCHandler f)
amendEventRoute = serveJSON amendmentIdJSON $ method PUT amendEventHandler
userEventsRoute =
serveJSON (fmap $ logEntryJSON nmode) $ method GET userEvents
userWorkIndexRoute =
serveJSON (workIndexJSON nmode) $ method GET userWorkIndex
auctionCreateRoute =
serveJSON auctionIdJSON $ method POST auctionCreateHandler
auctionRoute = serveJSON auctionJSON $ method GET auctionGetHandler
auctionBidRoute = serveJSON bidIdJSON $ method POST auctionBidHandler
billableCreateRoute =
serveJSON billableIdJSON $ method POST billableCreateHandler
billableListRoute =
serveJSON (fmap qdbBillableJSON) $ method GET billableListHandler
subscribeRoute =
serveJSON subscriptionIdJSON $ method POST subscribeHandler
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 117

[4.64899]→[4.64899:64972](∅→∅),[4.64972]→[4.16791:16973](∅→∅),[4.16973]→[4.5295:5337](∅→∅),[4.5337]→[4.16973:17035](∅→∅),[4.16973]→[4.16973:17035](∅→∅),[4.17035]→[4.15797:15954](∅→∅),[4.65217]→[4.15797:15954](∅→∅),[4.15954]→[4.17036:17806](∅→∅),[4.16733]→[4.66061:66436](∅→∅),[4.17806]→[4.66061:66436](∅→∅),[4.66061]→[4.66061:66436](∅→∅)

[ ("static", serveDirectory . encodeString $ cfg ^. staticAssetPath)
, ("login" , loginRoute)
, ("login" , xhrLoginRoute)
, ("logout" , logoutRoute)
, ("login/check", checkLoginRoute)
, ("register" , registerRoute)
, ("validate_zaddr", checkZAddrRoute)
, ( "accept_invitation"
, acceptInviteRoute
)
-- , ("projects/:projectId/logStart/:btcAddr" , logWorkBTCRoute StartWork)
-- , ("projects/:projectId/logEnd/:btcAddr" , logWorkBTCRoute StopWork)
, ("user/projects/:projectId/logStart" , logWorkRoute StartWork)
, ("user/projects/:projectId/logEnd" , logWorkRoute StopWork)
, ("user/projects/:projectId/events" , userEventsRoute)
, ("user/projects/:projectId/workIndex", userWorkIndexRoute)
, ("projects/:projectId/workIndex" , projectWorkIndexRoute)
, ( "projects/:projectId/auctions"
, auctionCreateRoute
) -- <|> auctionListRoute)
, ( "projects/:projectId/billables"
, billableCreateRoute <|> billableListRoute
)
, ("projects/:projectId/payouts", projectPayoutsRoute)
, ("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)

[4.64899]

[4.66436]

[ ("static", serveDirectory . encodeString $ cfg ^. staticAssetPath),
("login", loginRoute),
("login", xhrLoginRoute),
("logout", logoutRoute),
("login/check", checkLoginRoute),
("register", registerRoute),
("validate_zaddr", checkZAddrRoute),
( "accept_invitation",
acceptInviteRoute
),
-- , ("projects/:projectId/logStart/:btcAddr" , logWorkBTCRoute StartWork)
-- , ("projects/:projectId/logEnd/:btcAddr" , logWorkBTCRoute StopWork)
("user/projects/:projectId/logStart", logWorkRoute StartWork),
("user/projects/:projectId/logEnd", logWorkRoute StopWork),
("user/projects/:projectId/events", userEventsRoute),
("user/projects/:projectId/workIndex", userWorkIndexRoute),
("projects/:projectId/workIndex", projectWorkIndexRoute),
( "projects/:projectId/auctions",
auctionCreateRoute
), -- <|> auctionListRoute)
( "projects/:projectId/billables",
billableCreateRoute <|> billableListRoute
),
("projects/:projectId/payouts", projectPayoutsRoute),
("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)
edit in shell.nix at line 23

[4.38]→[4.17808:17837](∅→∅)

haskellPackages.brittany
replacement in test/Aftok/AuctionSpec.hs at line 2

[4.66471]→[4.66471:66489](∅→∅)

( main
, spec

[4.66471]

[4.66489]

( main,
spec,
replacement in test/Aftok/AuctionSpec.hs at line 7

[4.277]→[4.542:543](∅→∅),[4.543]→[4.6495:6496](∅→∅),[4.6496]→[4.543:573](∅→∅),[4.543]→[4.543:573](∅→∅),[4.573]→[4.277:309](∅→∅),[4.277]→[4.277:309](∅→∅),[4.309]→[4.17841:17898](∅→∅),[4.58]→[4.66500:66552](∅→∅),[4.17898]→[4.66500:66552](∅→∅),[4.309]→[4.66500:66552](∅→∅),[4.66552]→[4.17899:17951](∅→∅),[4.112]→[4.66553:66610](∅→∅),[4.17951]→[4.66553:66610](∅→∅),[4.336]→[4.66553:66610](∅→∅)

import Control.Lens
import Data.Hourglass
import Data.List ( (!!) )
import Data.Thyme.Clock ( )
import qualified Data.UUID.V4 as U
import Text.Read ( read )

[4.162]

[4.64072]

import Aftok.Auction
import Aftok.Generators
import Aftok.Types
import Bippy.Test.Types (arbitrarySatoshi)
import Bippy.Types (Satoshi (..))
import Control.Lens
import Data.Hourglass
import Data.List ((!!))
import Data.Thyme.Clock ()
import qualified Data.UUID.V4 as U
import Haskoin.Constants (btc)
import Test.HUnit.Base (assertFailure)
import Test.Hspec
import Test.QuickCheck
import Text.Read (read)
edit in test/Aftok/AuctionSpec.hs at line 23

[4.64073]→[4.64073:64129](∅→∅),[4.64129]→[4.204:205](∅→∅),[4.66610]→[4.204:205](∅→∅),[4.784]→[4.204:205](∅→∅),[4.205]→[4.64130:64263](∅→∅),[4.64263]→[4.228:323](∅→∅),[4.228]→[4.228:323](∅→∅),[4.323]→[4.336:365](∅→∅),[4.650]→[4.336:365](∅→∅),[4.784]→[4.336:365](∅→∅),[4.336]→[4.336:365](∅→∅),[4.365]→[4.66611:66677](∅→∅),[4.66677]→[4.835:868](∅→∅),[4.835]→[4.835:868](∅→∅),[4.965]→[4.965:966](∅→∅)

import Haskoin.Constants ( btc )

import Bippy.Types ( Satoshi(..) )
import Bippy.Test.Types ( arbitrarySatoshi )
import Aftok.Auction
import Aftok.Generators
import Aftok.Types

import Test.Hspec
import Test.HUnit.Base ( assertFailure )
import Test.QuickCheck
replacement in test/Aftok/AuctionSpec.hs at line 26

[4.66693]→[4.66693:66786](∅→∅),[4.66786]→[4.64264:64300](∅→∅)

<$> (UserId <$> genUUID)
<*> (Seconds <$> arbitrary `suchThat` (>= 0))
<*> arbitrarySatoshi btc

[4.66693]

[4.66812]

<$> (UserId <$> genUUID)
<*> (Seconds <$> arbitrary `suchThat` (>= 0))
<*> arbitrarySatoshi btc
replacement in test/Aftok/AuctionSpec.hs at line 30

[4.66841]→[4.66841:66866](∅→∅)

<*> arbitrary

[4.66841]

[4.64301]

<*> arbitrary
replacement in test/Aftok/AuctionSpec.hs at line 38

[4.184]→[4.184:964](∅→∅)

let testB0 = Bid (users !! 0)
(Seconds 3)
(Satoshi 100)
(read "2016-03-05 15:59:20.000000 UTC")
testB1 = Bid (users !! 1)
(Seconds 60)
(Satoshi 1000)
(read "2016-03-05 15:59:21.000000 UTC")
testB2 = Bid (users !! 2)
(Seconds 60)
(Satoshi 100)
(read "2016-03-05 15:59:22.000000 UTC")
testB3 = Bid (users !! 3)
(Seconds 90)
(Satoshi 100)
(read "2016-03-05 15:59:23.000000 UTC")
testB4 = Bid (users !! 4)
(Seconds 60)
(Satoshi 100)
(read "2016-03-05 15:59:24.000000 UTC")

[4.184]

[4.964]

let testB0 =
Bid
(users !! 0)
(Seconds 3)
(Satoshi 100)
(read "2016-03-05 15:59:20.000000 UTC")
testB1 =
Bid
(users !! 1)
(Seconds 60)
(Satoshi 1000)
(read "2016-03-05 15:59:21.000000 UTC")
testB2 =
Bid
(users !! 2)
(Seconds 60)
(Satoshi 100)
(read "2016-03-05 15:59:22.000000 UTC")
testB3 =
Bid
(users !! 3)
(Seconds 90)
(Satoshi 100)
(read "2016-03-05 15:59:23.000000 UTC")
testB4 =
Bid
(users !! 4)
(Seconds 60)
(Satoshi 100)
(read "2016-03-05 15:59:24.000000 UTC")
edit in test/Aftok/AuctionSpec.hs at line 73

[4.1196]→[4.1352:1353](∅→∅),[4.67877]→[4.1352:1353](∅→∅),[4.839]→[4.1352:1353](∅→∅)
edit in test/Aftok/AuctionSpec.hs at line 75

[4.1303]→[4.290:291](∅→∅),[4.1463]→[4.290:291](∅→∅),[4.67992]→[4.290:291](∅→∅),[4.839]→[4.290:291](∅→∅)
replacement in test/Aftok/AuctionSpec.hs at line 76

[4.1335]→[4.17952:18031](∅→∅),[4.18031]→[4.1422:1434](∅→∅),[4.1422]→[4.1422:1434](∅→∅),[4.1434]→[4.18032:18051](∅→∅)

it "determines a sufficient number of winners to fulfill the raise amount"
$ let
result =

[4.1335]

[4.18051]

it "determines a sufficient number of winners to fulfill the raise amount" $
let result =
replacement in test/Aftok/AuctionSpec.hs at line 82

[4.1714]→[4.1714:1750](∅→∅)

in
case result of

[4.1714]

[4.18132]

in case result of
edit in test/Aftok/AuctionSpec.hs at line 84

[4.1843]→[4.1605:1606](∅→∅),[4.18211]→[4.1605:1606](∅→∅),[4.68584]→[4.1605:1606](∅→∅),[4.1605]→[4.1605:1606](∅→∅)
edit in test/Aftok/AuctionSpec.hs at line 87

[4.428]→[4.839:840](∅→∅),[4.1742]→[4.839:840](∅→∅),[4.1852]→[4.839:840](∅→∅),[4.1999]→[4.839:840](∅→∅),[4.68752]→[4.839:840](∅→∅),[4.839]→[4.839:840](∅→∅)
replacement in test/Aftok/AuctionSpec.hs at line 90

[4.2212]→[4.2212:2349](∅→∅)

WinningBids xs -> bidsTotal xs == raiseAmount'
InsufficientBids t -> t == (raiseAmount' `subs` bidsTotal bids)

[4.2212]

[4.2103]

WinningBids xs -> bidsTotal xs == raiseAmount'
InsufficientBids t -> t == (raiseAmount' `subs` bidsTotal bids)
edit in test/Aftok/Generators.hs at line 2

[4.429]→[4.429:430](∅→∅),[4.461]→[4.461:462](∅→∅),[4.462]→[4.6498:6499](∅→∅),[4.6499]→[4.462:489](∅→∅),[4.462]→[4.462:489](∅→∅)

import Data.UUID
replacement in test/Aftok/Generators.hs at line 3

[4.633]→[4.633:666](∅→∅)

import Test.QuickCheck

[4.633]

[4.666]

import Data.UUID
import Test.QuickCheck
edit in test/Aftok/Generators.hs at line 8

[4.763]→[4.763:764](∅→∅)
replacement in test/Aftok/PaymentsSpec.hs at line 4

[4.69339]→[4.69339:69357](∅→∅)

( main
, spec

[4.69339]

[4.69357]

( main,
spec,
edit in test/Aftok/PaymentsSpec.hs at line 9

[4.1057]

[4.6501]

import Test.Hspec
edit in test/Aftok/PaymentsSpec.hs at line 11

[4.6502]→[4.1088:1117](∅→∅),[4.1088]→[4.1088:1117](∅→∅)

import Test.Hspec
replacement in test/Aftok/PaymentsSpec.hs at line 15

[4.69421]→[4.1197:1572](∅→∅),[4.1197]→[4.1197:1572](∅→∅)

--it "returns the billing date in the presence of an expired payment request" $
-- forAll ((,) <$> genSatoshi <*> listOf genBid) $
-- \(raiseAmount', bids) ->
-- case runAuction' raiseAmount' bids of
-- WinningBids xs -> bidsTotal xs == raiseAmount'
-- InsufficientBids t -> t == (raiseAmount' - bidsTotal bids)

[4.69421]

[4.1572]

--it "returns the billing date in the presence of an expired payment request" $
-- forAll ((,) <$> genSatoshi <*> listOf genBid) $
-- \(raiseAmount', bids) ->
-- case runAuction' raiseAmount' bids of
-- WinningBids xs -> bidsTotal xs == raiseAmount'
-- InsufficientBids t -> t == (raiseAmount' - bidsTotal bids)
edit in test/Aftok/PaymentsSpec.hs at line 25

[4.1605]→[4.1605:1606](∅→∅)
replacement in test/Aftok/TimeLogSpec.hs at line 1

[4.12060]→[4.12060:12097](∅→∅)

{-# LANGUAGE OverloadedStrings #-}

[4.3665]

[4.12097]

{-# LANGUAGE OverloadedStrings #-}
replacement in test/Aftok/TimeLogSpec.hs at line 6

[4.69448]→[4.69448:69466](∅→∅)

( main
, spec

[4.69448]

[4.69466]

( main,
spec,
replacement in test/Aftok/TimeLogSpec.hs at line 11

[4.1660]→[4.6504:6505](∅→∅)

[4.1660]

[4.2656]

import qualified Aftok.Interval as I
import Aftok.TimeLog
import Control.Lens ((^.))
import Data.AffineSpace
import qualified Data.List.NonEmpty as L
import qualified Data.Map.Strict as M
import Data.Thyme.Time as T
import Data.Time.ISO8601
import Haskoin.Address (Address)
import Haskoin.Util.Arbitrary.Address (arbitraryAddress)
import Test.Hspec
import Test.QuickCheck
edit in test/Aftok/TimeLogSpec.hs at line 24

[4.2657]→[4.69477:69534](∅→∅),[4.69534]→[4.12210:12244](∅→∅),[4.12210]→[4.12210:12244](∅→∅),[4.12244]→[4.69535:69691](∅→∅),[4.69691]→[4.12367:12402](∅→∅),[4.12367]→[4.12367:12402](∅→∅),[4.12402]→[4.18213:18273](∅→∅),[4.12402]→[4.1860:1861](∅→∅),[4.18273]→[4.1860:1861](∅→∅),[4.64591]→[4.1860:1861](∅→∅),[4.1860]→[4.1860:1861](∅→∅),[4.1861]→[4.64592:64644](∅→∅),[4.64644]→[4.12467:12498](∅→∅),[4.69744]→[4.12467:12498](∅→∅),[4.12467]→[4.12467:12498](∅→∅),[4.1887]→[4.269:270](∅→∅),[4.3615]→[4.269:270](∅→∅),[4.5683]→[4.269:270](∅→∅),[4.12498]→[4.269:270](∅→∅),[4.269]→[4.269:270](∅→∅),[4.270]→[4.12499:12560](∅→∅),[4.12560]→[4.18274:18343](∅→∅),[4.357]→[4.2088:2089](∅→∅),[4.1962]→[4.2088:2089](∅→∅),[4.2188]→[4.2088:2089](∅→∅),[4.3491]→[4.2088:2089](∅→∅),[4.18343]→[4.2088:2089](∅→∅),[4.64712]→[4.2088:2089](∅→∅),[4.2088]→[4.2088:2089](∅→∅)

import Control.Lens ( (^.) )
import Data.AffineSpace
import qualified Data.List.NonEmpty as L
import qualified Data.Map.Strict as M
import Data.Thyme.Time as T
import Data.Time.ISO8601
import Haskoin.Address ( Address )

import qualified Aftok.Interval as I
import Aftok.TimeLog

import Test.Hspec
import Test.QuickCheck
import Haskoin.Util.Arbitrary.Address ( arbitraryAddress )
replacement in test/Aftok/TimeLogSpec.hs at line 33

[4.69822]→[4.69822:69918](∅→∅),[4.2530]→[4.3532:3533](∅→∅),[4.69918]→[4.3532:3533](∅→∅),[4.3532]→[4.3532:3533](∅→∅)

fmap T.fromSeconds
<$> ((listOf $ choose (0, 72 * 60 * 60)) :: Gen [Int])

[4.69822]

[4.2531]

fmap T.fromSeconds
<$> ((listOf $ choose (0, 72 * 60 * 60)) :: Gen [Int])
replacement in test/Aftok/TimeLogSpec.hs at line 36

[4.2602]→[4.2602:2648](∅→∅)

buildIntervals t (d : s : dx) | d > 0 =

[4.2602]

[4.69919]

buildIntervals t (d : s : dx)
| d > 0 =
replacement in test/Aftok/TimeLogSpec.hs at line 39

[4.69963]→[4.69963:70024](∅→∅)

in ival : buildIntervals (ival ^. I.end .+^ s) dx

[4.69963]

[4.2749]

in ival : buildIntervals (ival ^. I.end .+^ s) dx
replacement in test/Aftok/TimeLogSpec.hs at line 41

[4.2779]→[4.2779:2788](∅→∅)

in do

[4.2779]

[4.70025]

in do
replacement in test/Aftok/TimeLogSpec.hs at line 50

[4.65053]→[4.65053:65087](∅→∅)

addr <- arbitraryAddress

[4.65053]

[4.70220]

addr <- arbitraryAddress
replacement in test/Aftok/TimeLogSpec.hs at line 53

[4.65132]→[4.65132:65182](∅→∅)

in WorkIndex . M.fromList <$> listOf recordGen

[4.65132]

[4.2219]

in WorkIndex . M.fromList <$> listOf recordGen
replacement in test/Aftok/TimeLogSpec.hs at line 60

[4.65287]→[4.65287:65328](∅→∅),[4.82]→[4.2466:2516](∅→∅),[4.12834]→[4.2466:2516](∅→∅),[4.65328]→[4.2466:2516](∅→∅),[4.2466]→[4.2466:2516](∅→∅),[4.2516]→[4.70451:70515](∅→∅),[4.761]→[4.4253:4254](∅→∅),[4.1368]→[4.4253:4254](∅→∅),[4.2568]→[4.4253:4254](∅→∅),[4.3807]→[4.4253:4254](∅→∅),[4.70515]→[4.4253:4254](∅→∅),[4.4253]→[4.4253:4254](∅→∅),[4.4254]→[4.70516:70555](∅→∅),[4.12876]→[4.4127:4177](∅→∅),[4.70555]→[4.4127:4177](∅→∅),[4.125]→[4.4127:4177](∅→∅),[4.4177]→[4.70556:70620](∅→∅),[4.151]→[4.417:418](∅→∅),[4.772]→[4.417:418](∅→∅),[4.1126]→[4.417:418](∅→∅),[4.1421]→[4.417:418](∅→∅),[4.2789]→[4.417:418](∅→∅),[4.2973]→[4.417:418](∅→∅),[4.3212]→[4.417:418](∅→∅),[4.3949]→[4.417:418](∅→∅),[4.70620]→[4.417:418](∅→∅),[4.4526]→[4.417:418](∅→∅)

let starts = toThyme <$> catMaybes
[ parseISO8601 "2014-01-01T00:08:00Z"
, parseISO8601 "2014-01-01T00:12:00Z"
]

ends = toThyme <$> catMaybes
[ parseISO8601 "2014-01-01T00:11:59Z"
, parseISO8601 "2014-01-01T00:18:00Z"
]

[4.65287]

[4.65329]

let starts =
toThyme
<$> catMaybes
[ parseISO8601 "2014-01-01T00:08:00Z",
parseISO8601 "2014-01-01T00:12:00Z"
]
ends =
toThyme
<$> catMaybes
[ parseISO8601 "2014-01-01T00:11:59Z",
parseISO8601 "2014-01-01T00:18:00Z"
]
replacement in test/Aftok/TimeLogSpec.hs at line 74

[4.1451]→[4.70621:70661](∅→∅)

addr <- testAddrs

[4.1451]

[4.65390]

addr <- testAddrs
edit in test/Aftok/TimeLogSpec.hs at line 77

[4.286]→[4.1452:1453](∅→∅),[4.1854]→[4.1452:1453](∅→∅),[4.65503]→[4.1452:1453](∅→∅),[4.3173]→[4.1452:1453](∅→∅)
edit in test/Aftok/TimeLogSpec.hs at line 81

[4.485]→[4.3173:3174](∅→∅),[4.1751]→[4.3173:3174](∅→∅),[4.4256]→[4.3173:3174](∅→∅),[4.3173]→[4.3173:3174](∅→∅)
replacement in test/Aftok/TimeLogSpec.hs at line 82

[4.4334]→[4.561:631](∅→∅),[4.561]→[4.561:631](∅→∅),[4.631]→[4.65613:65614](∅→∅)

expected = WorkIndex $ fmap (L.reverse . L.sort) expected'

[4.4334]

[4.65614]

expected = WorkIndex $ fmap (L.reverse . L.sort) expected'
edit in test/Aftok/TimeLogSpec.hs at line 84

[4.631]→[4.2824:2825](∅→∅),[4.1332]→[4.2824:2825](∅→∅),[4.1935]→[4.2824:2825](∅→∅),[4.3322]→[4.2824:2825](∅→∅),[4.3330]→[4.2824:2825](∅→∅),[4.65667]→[4.2824:2825](∅→∅),[4.70730]→[4.2824:2825](∅→∅),[4.493]→[4.2824:2825](∅→∅)
replacement in test/Aftok/TimeLogSpec.hs at line 87

[4.70831]→[4.70831:70916](∅→∅)

let
mergeAdjacent ((I.Interval s e) : (I.Interval s' e') : xs)

[4.70831]

[4.70916]

let mergeAdjacent ((I.Interval s e) : (I.Interval s' e') : xs)
replacement in test/Aftok/TimeLogSpec.hs at line 90

[4.409]→[4.70980:71020](∅→∅),[4.71020]→[4.443:444](∅→∅),[4.443]→[4.443:444](∅→∅)

mergeAdjacent [] = []

[4.409]

[4.71021]

mergeAdjacent [] = []
edit in test/Aftok/TimeLogSpec.hs at line 95

[4.183]→[4.4635:4636](∅→∅),[4.601]→[4.4635:4636](∅→∅),[4.1625]→[4.4635:4636](∅→∅),[4.2239]→[4.4635:4636](∅→∅),[4.3085]→[4.4635:4636](∅→∅),[4.3656]→[4.4635:4636](∅→∅),[4.4029]→[4.4635:4636](∅→∅),[4.4505]→[4.4635:4636](∅→∅),[4.71187]→[4.4635:4636](∅→∅),[4.4635]→[4.4635:4636](∅→∅)
replacement in test/Aftok/TimeLogSpec.hs at line 96

[4.3717]→[4.551:552](∅→∅),[4.552]→[4.71188:71304](∅→∅)

widx' = fmap
(L.fromList . mergeAdjacent . sortOn I._start . L.toList)
widx

[4.3717]

[4.4506]

widx' =
fmap
(L.fromList . mergeAdjacent . sortOn I._start . L.toList)
widx
replacement in test/Aftok/TimeLogSpec.hs at line 101

[4.4558]→[4.71305:71351](∅→∅)

in
workIndex logEntries

[4.4558]

[4.71351]

in workIndex logEntries
replacement in test/Aftok/Util/HttpSpec.hs at line 1

[4.12944]→[4.12944:12981](∅→∅)

{-# LANGUAGE OverloadedStrings #-}

[4.4932]

[4.12981]

{-# LANGUAGE OverloadedStrings #-}
edit in test/Aftok/Util/HttpSpec.hs at line 5

[4.3704]→[4.5045:5046](∅→∅),[4.5045]→[4.5045:5046](∅→∅),[4.5046]→[4.6508:6509](∅→∅),[4.6509]→[4.5067:5068](∅→∅),[4.13050]→[4.5067:5068](∅→∅),[4.5067]→[4.5067:5068](∅→∅),[4.5068]→[4.13051:13128](∅→∅)

import Aftok.Util.Http
import Data.Attoparsec.ByteString
replacement in test/Aftok/Util/HttpSpec.hs at line 6

[4.5130]→[4.13129:13157](∅→∅)

import Test.Hspec

[4.5130]

[4.5148]

import Aftok.Util.Http
import Data.Attoparsec.ByteString
import Test.Hspec
edit in test/Aftok/Util/HttpSpec.hs at line 15

[4.5314]→[4.5314:5315](∅→∅)
edit in test/Aftok/Util/HttpSpec.hs at line 20

[4.5436]→[4.5436:5438](∅→∅)