Preliminary work to add support for Zcash payments.

Dependencies

• [2] Z7CQXTU7 Update login scripts, add script for XHR login interface.
• [3] ONSJNBNF Use the more useful `workIndex` endpoint for list_intervals script.
• [4] X3ES7NUA Fine. I'll use ormolu. At least it doesn't break the code.
• [5] BROSTG5K Beginning of modularization of server.
• [6] VRMUVBP6 Make log script work on OSX.
• [7] QADKFHAR Adds CreatePayment handler implementation.
• [8] KEP5WUFJ Convert project to stack-based build.
• [9] 4U7F3CPI THE GREAT RENAMING OF THINGS!
• [10] RSF6UAJK Break out api module for timeline.
• [11] LTSVBVA2 Update to a recent haskoin-core. Fix Stack build.
• [12] 5DRIWGLU Improving TimeLog specs
• [13] OV5AKJHA Remove unused LogInterval type.
• [14] TZQJVHBA Add auction functions to ADB.
• [15] O722AOKE Add route to allow crediting of events to users/projects.
• [16] 73NDXDEZ Begin implementation of billing event persistence.
• [17] JFOEOFGA stylish-haskell formatting.
• [18] XTBSG4C7 Adding serveJSON combinator to eliminate some boilerplate from handlers.
• [19] QMEYU4MW Add display for prior intervals.
• [20] HMDM3B55 Implement core of payments/billing infrastructure.
• [21] NAS4BFL4 Trivial stylish-haskell reformat.
• [22] I2KHGVD4 Require project permissions for access to most data.
• [23] RPAJLHMT Change to use UUIDs instead of ints for primary keys.
• [24] NJNMO72S Add zcash.com submodule and update client to modern halogen.
• [25] AWWC6P5Z Add migration to include payment network with addresses.
• [26] E7GQXOID Allow the use of a local .env file to store username/project ID for UI scripts.
• [27] 7KZP4RHZ Switch from Data.Time to Data.Thyme
• [28] JV3UEPNC Fix Aeson constructors.
• [29] 5XFJNUAZ Start of addition of project infrastructure.
• [30] BXGLKYRX Added primitive user registration handler.
• [31] EZQG2APB Update task list.
• [32] A6HKMINB Attempting to improve JSON handling.
• [33] GKGVYBZG Added JSON serialization to TimeLog
• [34] Y35QCWYW Minor improvement in WorkIndex type to eliminate duplicated information.
• [35] WAIX6AGN Add event serialization for PaymentRequest & Payment
• [36] 4FDQGIXN Make payment request retrieval key an opaque 32-bit hash.
• [37] OBFPJS2G Project successfully builds and tests under nix.
• [38] Z24SZOGZ Return richer information from event logging calls.
• [39] LHJ2HFXV Add property test for auction algorithm.
• [40] ZKFETYRK Print network information in address parse failure message.
• [41] UWMGUJOW Autoformat sources.
• [42] 4R7XIYK3 Switch from ClassyPrelude to Relude
• [43] WO2MINIF Auctions now compile!
• [44] M4KM76DG Merge branch 'stackify'
• [45] POX3UAMT Enabling logging of time to contributor/project accounts
• [46] PBD7LZYQ Postgres & auth are beginning to function.
• [47] ASF3UPJL Add auction creation and bid handlers
• [48] 2J37EVJM Check for an open interval on project switch.
• [49] SQ7UMLN5 Get z-addr checks working.
• [50] Y3LIJ5US Add handler for CreatePaymentRequest
• [51] QMRKFEPG Refactor QDB to use a free monad algebra instead.
• [52] SOIAMXLW Build versioned docker images.
• [53] Z3MK2PJ5 Add GET handler for retrieving auction data.
• [54] 2G3GNDDU Event logging is now functioning in postgres.
• [55] LLKTCDRD Minor reorg of aftok.com paths.
• [56] ZIG57EE6 Fix project selection, end log end on project switch.
• [57] G4BS4NND Add simple shell script demonstrating how to invite a companion.
• [58] ZP62WC47 Begin conversion to build with stack.
• [59] GKLIPHR5 Fix error in parsing of event metadata
• [60] LAROLAYU WIP
• [61] HALRDT2F Added initial auction create route.
• [62] GCVQD44V Create amends endpoint, switch to UUID primary keys
• [63] RN7EI6IN Update database layer to use CreditTo
• [64] SEWTRB6S Implement payment request creation functions.
• [65] AL37SVTC Implement payments service endpoints.
• [66] 4QX5E5AC Initial compilation of payouts function succeeds.
• [67] BSIUHCGF Add payment response handler.
• [68] 5OI44E4E Add authentication to auction search.
• [69] 7DBNV3GV Initial, stack-based impl of time log event reduction.
• [70] U256ZALI Add captcha check to register route.
• [71] SFWL5626 Initial release of UI.
• [72] NEDDHXUK Reformat via stylish-haskell
• [73] EW2XN7KU Update docker build, clean up migration for payments tables.
• [74] EFSXYZPO Autoformat everything with brittany.
• [75] 2MNO5FUY Upgrade LTS version
• [76] UILI6PIL The route-based logStart/logStop is nicer.
• [77] 3QVT6MA6 Add database support for event amend operations.
• [78] EMVTF2IW WIP moving back to snap.
• [79] B6HWAPDP Modularize & update to recent haskoin.
• [80] MB5SHULB Add route for accepting an invitation with an existing account
• [81] 7VGYLTMU Clean up schema version handling.
• [82] J6S23MDG Use server timestamps for interval start and end.
• [83] 3GBSDS5P Fix out-of-date test code, add skeleton for payments spec.
• [84] ENNZIQJG Use live signup API for client.
• [85] QU5FW67R Add project selection to time tracker.
• [86] 4SCFOJGN Specs for recovering intervals from the log now pass.
• [87] 5ZSKPQ3K Add created_at and auction_start timestamps to auction
• [88] NVOCQVAS Initial failing tests.
• [89] TLQ72DSJ Lenses, sqlite-simple
• [90] IZEVQF62 Work in progress replacing sqlite with postgres.
• [91] 7HPY3QPF Fix linting errors. (yay hlint!)
• [92] HYV3VQAD Fix a couple of stupid typos.
• [93] BWN72T44 Don't accept work timestamp from an external source.
• [94] NLZ3JXLO Fix formatting with stylish-haskell.
• [95] LD4GLVSF More database stuff.
• [96] XZLSHL4D The server is now (tenuously) running, and serving pages via SSL!
• [97] UOG5H2TW Default work logging credit to logged-in user.
• [98] FD7SV5I6 Fix handling of event_t columns.
• [99] SCXG6TJW Make log reduction safer in presence of overlapping events.
• [100] 2KZPOGRB Once you get Haskell to compile, the tests pass!
• [101] ZTPDQKLA Add changes to event_credit_to_amendments
• [102] O2BZOX7M Add signup form, captcha check.
• [103] CDHZL3RP Add a couple of other CLI utilities for interacing with the service.
• [104] EKY7U7SK Finish conversion to stack.
• [105] O5FVTOM6 Undo JSON silliness, enable a couple more routes.
• [106] XJ4EYMIH Let curl prompt for http password, rather than bash.
• [107] 64C6AWH6 Rename Ananke -> Quixotic, project reboot.
• [108] Q5X5RYQL stylish-haskell reformatting
• [109] 2XQD6KKK Add invitation logic and clean up DBProg error handling.
• [110] KNSI575V Cleanup of EventLog types.
• [111] P6NR2CGX Beginning of implementation of depreciation.
• [112] RSEB2NFG Replacing Snap with Scotty.
• [113] O227CEAV Adds storage of original event JSON for some DBOp constructors.
• [114] WZFQDWW4 Add retrieval/storage of current exchange rate data to payment recording.
• [115] IPG33FAW Add billing daemon
• [116] SLL7262C Make depreciation functions more flexible.
• [117] SPJCFHXW Update shell scripts to point to https://aftok.com and prompt for input.
• [118] 4IQVQL4T Added client for payouts endpoint.
• [119] 3MERL4JA Fix incorrect variable in invitation script.
• [120] EKI57EJR Add alternative implementation of auction winner determination.
• [121] TNR3TEHK Switch to Postgres + snaplet arch compiles.
• [122] W35DDBFY Factor common JSON conversions up into client lib module.
• [123] FXJQACES Ensure that auction is not ended at the time of bid
• [124] NSRSSSTR Update nginx.conf, make aftok host configurable for cli scripts.
• [125] 5IDB3IWS Integrate zcashd-based zaddr validation.
• [126] F4ONFXF4 Fix signup database issues.
• [127] DFOBMSAO Initial work on payments API
• [128] NMWWP4ZN Trying out Hspec
• [129] Z7KS5XHH Very WIP. Wow.
• [*] LEINLS3X Update deployment documentation.
• [*] 2WOOGXDH Use dbmigrations to manage database state.
• [*] ADMKQQGC Initial empty Snap project.

Change contents

• replacement in Makefile at line 4
  [5.9]→[5.9:92](∅→∅)
  − find lib test server daemon -name \*.hs -exec brittany --write-mode=inplace {} \;
  [5.9]

  [5.92]
  + ormolu --mode inplace $(find lib server daemon test -name '*.hs')
• edit in aftok.cabal at line 38
  [5.237]

  [5.1]
  + Aftok.Currency.Bitcoin.Payments

  + Aftok.Currency.Bitcoin.Bip70
• edit in aftok.cabal at line 41
  [5.44]

  [5.238]
  + Aftok.Currency.Zcash.Types

  + Aftok.Currency.Zcash.Payments

  + Aftok.Currency.Zcash.Zip321
• edit in aftok.cabal at line 46
  [5.323]

  [5.238]
  + Aftok.Database.PostgreSQL.Json
• edit in aftok.cabal at line 48
  [5.292]

  [5.323]
  + Aftok.Database.PostgreSQL.Auctions

  + Aftok.Database.PostgreSQL.Billing

  + Aftok.Database.PostgreSQL.Events

  + Aftok.Database.PostgreSQL.Projects

  + Aftok.Database.PostgreSQL.Users
• edit in aftok.cabal at line 57
  [5.44]

  [5.1]
  + Aftok.Payments.Bitcoin

  + Aftok.Payments.Zcash

  + Aftok.Payments.Util
• edit in aftok.cabal at line 67
  [5.1607]

  [5.72]
  + , basement
• replacement in aftok.cabal at line 72
  [5.178]→[5.178:203](∅→∅)
  − , base64-bytestring
  [5.178]

  [5.3072]
  + , base64
• edit in aftok.cabal at line 93
  [5.179]

  [5.1]
  + , MonadRandom
• edit in aftok.cabal at line 102
  [5.479]

  [5.1511]
  + , scientific
• replacement in aftok.cabal at line 109
  [5.502]→[5.502:523](∅→∅)
  − , thyme
  [5.502]

  [5.1]
  + , thyme
• edit in aftok.cabal at line 113
  [5.731]

  [5.2887]
  + , uri-encode
• edit in daemon/AftokD/AftokM.hs at line 5
  [4.468]

  [4.468]
  + {-# LANGUAGE TupleSections #-}
• edit in daemon/AftokD/AftokM.hs at line 9
  [5.1643]

  [4.470]
  + import qualified Aftok.Billing as B
• edit in daemon/AftokD/AftokM.hs at line 15
  [4.564]→[4.564:578](∅→∅)
  − billable,
• edit in daemon/AftokD/AftokM.hs at line 17
  [4.612]→[4.612:622](∅→∅)
  − name,
• replacement in daemon/AftokD/AftokM.hs at line 22
  [4.740]→[4.740:780](∅→∅)
  − import Aftok.Currency.Bitcoin (satoshi)
  [4.740]

  [4.780]
  + import Aftok.Currency.Bitcoin (Satoshi, _Satoshi)

  + import qualified Aftok.Currency.Bitcoin.Payments as Bitcoin

  + import Aftok.Currency.Zcash (Zatoshi (..))
• replacement in daemon/AftokD/AftokM.hs at line 28
  [4.900]→[4.900:1012](∅→∅)
  − import Aftok.Payments.Types

  − ( PaymentKey (..),

  − paymentKey,

  − paymentRequestTotal,

  − subscription,

  − )
  [4.900]

  [4.1012]
  + import Aftok.Payments.Bitcoin (BillingOps (..), PaymentsConfig)

  + import qualified Aftok.Payments.Types as P

  + import qualified Aftok.Payments.Zcash as Zcash
• replacement in daemon/AftokD/AftokM.hs at line 42
  [4.1173]→[4.1173:1237](∅→∅)
  − import Bippy.Types (Satoshi)

  − import Control.Error.Util (maybeT)
  [4.1173]

  [4.1237]
  + import Control.Error.Util (exceptT, maybeT)
• replacement in daemon/AftokD/AftokM.hs at line 44
  [4.1257]→[4.1257:1267](∅→∅)
  − ( (^.),
  [4.1257]

  [4.1267]
  + ( (.~),

  + Iso',

  + (^.),

  + from,

  + iso,
• edit in daemon/AftokD/AftokM.hs at line 51
  [4.1305]

  [4.1305]
  + over,

  + set,
• replacement in daemon/AftokD/AftokM.hs at line 92
  [5.3207]→[5.3207:3297](∅→∅),[5.3297]→[4.1995:2033](∅→∅),[4.2033]→[5.3335:3383](∅→∅),[5.4254]→[5.3335:3383](∅→∅),[5.3335]→[5.3335:3383](∅→∅)
  − instance P.AsPaymentError AftokDErr where

  − _PaymentError = _PaymentErr . P._PaymentError

  − _Overdue = _PaymentErr . P._Overdue

  − _SigningError = _PaymentErr . P._SigningError
  [5.3207]

  [5.3383]
  + -- instance P.AsPaymentError AftokDErr where

  + -- _PaymentError = _PaymentErr . P._PaymentError

  + -- _Overdue = _PaymentErr . P._Overdue

  + -- _SigningError = _PaymentErr . P._SigningError
• replacement in daemon/AftokD/AftokM.hs at line 101
  [4.2121]→[4.2121:2156](∅→∅)
  − _pcfg :: !P.PaymentsConfig
  [4.2121]

  [4.2156]
  + _pcfg :: !PaymentsConfig
• replacement in daemon/AftokD/AftokM.hs at line 106
  [5.3519]→[5.3519:3564](∅→∅),[5.3564]→[4.2166:2267](∅→∅),[4.2267]→[5.3657:3681](∅→∅),[5.4370]→[5.3657:3681](∅→∅),[5.3657]→[5.3657:3681](∅→∅)
  − instance P.HasPaymentsConfig AftokMEnv where

  − networkMode = pcfg . P.networkMode

  − signingKey = pcfg . P.signingKey

  − pkiData = pcfg . P.pkiData

  − paymentsConfig = pcfg
  [5.3519]

  [5.3681]
  + -- instance P.HasPaymentsConfig AftokMEnv where

  + -- networkMode = pcfg . P.networkMode

  + -- signingKey = pcfg . P.signingKey

  + -- pkiData = pcfg . P.pkiData

  + -- paymentsConfig = pcfg
• replacement in daemon/AftokD/AftokM.hs at line 139
  [5.4543]→[5.4543:4593](∅→∅)
  − traverse_ createProjectPaymentRequests projects
  [5.4543]

  [5.4593]
  + traverse_ createProjectSubscriptionPaymentRequests projects
• replacement in daemon/AftokD/AftokM.hs at line 141
  [5.4594]→[5.4594:4687](∅→∅)
  − createProjectPaymentRequests :: ProjectId -> AftokM ()

  − createProjectPaymentRequests pid = do
  [5.4594]

  [5.4467]
  + createProjectSubscriptionPaymentRequests :: ProjectId -> AftokM ()

  + createProjectSubscriptionPaymentRequests pid = do
• replacement in daemon/AftokD/AftokM.hs at line 144
  [5.4500]→[5.4500:4569](∅→∅)
  − let ops = P.BillingOps memoGen (fmap Just . paymentURL) payloadGen
  [5.4500]

  [5.4569]
  + btcCfg <- asks _pcfg

  + let btcOps = BillingOps _memoGen (fmap Just . bip70PaymentURL) _payloadGen

  + zecCfg = Zcash.PaymentsConfig (Zatoshi 100)

  + pcfg' = P.PaymentsConfig btcOps btcCfg zecCfg
• edit in daemon/AftokD/AftokM.hs at line 149
  [5.4620]

  [4.2353]
  + subscriptions <- join <$> traverse (DB.findSubscriptions pid) subscribers
• replacement in daemon/AftokD/AftokM.hs at line 151
  [4.2367]→[5.4637:4766](∅→∅),[5.4637]→[5.4637:4766](∅→∅)
  − traverse (\uid -> P.createPaymentRequests ops now uid pid) $ subscribers

  − traverse_ sendPaymentRequestEmail (join requests)
  [4.2367]

  [5.4989]
  + fmap join

  + . exceptT (throwError . PaymentErr) pure

  + $ traverse (\s -> fmap (snd s,) <$> P.createSubscriptionPaymentRequests pcfg' now s) subscriptions

  + traverse_ sendPaymentRequestEmail requests
• replacement in daemon/AftokD/AftokM.hs at line 156
  [5.4990]→[5.4990:5084](∅→∅)
  − sendPaymentRequestEmail :: P.PaymentRequestId -> AftokM ()

  − sendPaymentRequestEmail reqId = do
  [5.4990]

  [5.5084]
  + _Compose :: Iso' (f (g a)) (Compose f g a)

  + _Compose = iso Compose getCompose

  +

  + -- | TODO: Currently will only send email for bip70 requests

  + sendPaymentRequestEmail :: (B.Subscription, (P.PaymentRequestId, P.SomePaymentRequestDetail)) -> AftokM ()

  + sendPaymentRequestEmail (sub, (_, P.SomePaymentRequest req)) = do
• replacement in daemon/AftokD/AftokM.hs at line 165
  [4.2423]→[4.2423:2563](∅→∅),[4.2563]→[5.5347:5501](∅→∅),[5.5044]→[5.5347:5501](∅→∅),[5.5347]→[5.5347:5501](∅→∅),[5.5501]→[4.2564:2632](∅→∅),[4.2632]→[5.5569:5614](∅→∅),[5.5118]→[5.5569:5614](∅→∅),[5.5569]→[5.5569:5614](∅→∅),[5.5614]→[4.2633:2829](∅→∅),[5.1179]→[5.5762:5805](∅→∅),[4.2829]→[5.5762:5805](∅→∅),[5.5323]→[5.5762:5805](∅→∅),[5.5762]→[5.5762:5805](∅→∅)
  − reqMay = do

  − preq <- DB.findPaymentRequestId reqId

  − preq' <- traverseOf P.subscription DB.findSubscriptionBillable preq

  − preq'' <- traverseOf (P.subscription . customer) DB.findUser preq'

  − traverseOf (P.subscription . billable . project) DB.findProject preq''

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

  − bip70URL <- paymentURL (req ^. paymentKey)

  − mail <- buildPaymentRequestEmail preqCfg req bip70URL

  − let mailer =

  − maybe

  − (SMTP.sendMailWithLogin _smtpHost)

  − (SMTP.sendMailWithLogin' _smtpHost)

  − _smtpPort

  − liftIO $ mailer _smtpUser _smtpPass mail
  [4.2423]

  [5.1180]
  + req' = over P.billable (\b -> Compose $ sub & B.billable .~ b) req

  + req'' <- enrichWithUser req'

  + req''' <- enrichWithProject req''

  + case req''' ^. P.nativeRequest of

  + P.Bip70Request nreq -> do

  + bip70URL <- bip70PaymentURL (nreq ^. Bitcoin.paymentRequestKey)

  + mail <- buildBip70PaymentRequestEmail preqCfg req''' bip70URL

  + let mailer =

  + maybe

  + (SMTP.sendMailWithLogin _smtpHost)

  + (SMTP.sendMailWithLogin' _smtpHost)

  + _smtpPort

  + liftIO $ mailer _smtpUser _smtpPass mail

  + P.Zip321Request _ -> pure ()
• replacement in daemon/AftokD/AftokM.hs at line 180
  [5.1181]→[4.2830:2858](∅→∅)
  − buildPaymentRequestEmail ::
  [5.1181]

  [4.2858]
  + enrichWithUser ::

  + P.PaymentRequest' (Compose (Subscription' UserId) (Billable' p u)) a ->

  + AftokM (P.PaymentRequest' (Compose (Subscription' User) (Billable' p u)) a)

  + enrichWithUser req = do

  + let sub = req ^. P.billable . from _Compose

  + sub' <-

  + maybeT (throwError $ DBErr DB.SubjectNotFound) pure $

  + traverseOf customer DB.findUser sub

  + pure (set P.billable (Compose sub') req)

  +

  + enrichWithProject ::

  + P.PaymentRequest' (Compose (Subscription' u) (Billable' ProjectId u')) a ->

  + AftokM (P.PaymentRequest' (Compose (Subscription' u) (Billable' Project u')) a)

  + enrichWithProject req = do

  + let sub = req ^. P.billable . from _Compose

  + sub' <-

  + maybeT (throwError $ DBErr DB.SubjectNotFound) pure $

  + traverseOf (B.billable . project) DB.findProject sub

  + pure (set P.billable (Compose sub') req)

  +

  + buildBip70PaymentRequestEmail ::
• replacement in daemon/AftokD/AftokM.hs at line 203
  [4.2927]→[4.2927:3006](∅→∅)
  − P.PaymentRequest' (Subscription' User (Billable' Project UserId Satoshi)) ->
  [4.2927]

  [4.3006]
  + P.PaymentRequest' (Compose (Subscription' User) (Billable' Project UserId)) Satoshi ->
• replacement in daemon/AftokD/AftokM.hs at line 206
  [5.1348]→[5.6092:6141](∅→∅),[4.3029]→[5.6092:6141](∅→∅),[5.5584]→[5.6092:6141](∅→∅),[5.6092]→[5.6092:6141](∅→∅)
  − buildPaymentRequestEmail cfg req paymentUrl = do
  [4.3029]

  [5.6141]
  + buildBip70PaymentRequestEmail cfg req paymentUrl = do
• replacement in daemon/AftokD/AftokM.hs at line 210
  [5.5635]→[5.5635:5653](∅→∅),[5.5653]→[4.3030:3099](∅→∅)
  − <$> req

  − ^. (subscription . billable . paymentRequestEmailTemplate)
  [5.5635]

  [5.6326]
  + <$> (req ^. P.billable . to getCompose . B.billable . paymentRequestEmailTemplate)
• replacement in daemon/AftokD/AftokM.hs at line 216
  [5.3346]→[5.3346:3410](∅→∅)
  − toEmail <- case req ^. (subscription . contactChannel) of
  [5.3346]

  [5.3410]
  + toEmail <- case req ^. (P.billable . to getCompose . contactChannel) of
• replacement in daemon/AftokD/AftokM.hs at line 220
  [5.6596]→[4.3131:3275](∅→∅)
  − pname = req ^. (subscription . billable . project . projectName)

  − total = req ^. (P.paymentRequest . to paymentRequestTotal)
  [5.6596]

  [4.3275]
  + pname = req ^. P.billable . to getCompose . B.billable . B.project . projectName

  + total = req ^. P.billable . to getCompose . B.billable . B.amount
• replacement in daemon/AftokD/AftokM.hs at line 227
  [4.3465]→[4.3465:3522](∅→∅)
  − ("amount_due", show $ total ^. satoshi),
  [4.3465]

  [4.3522]
  + ("amount_due", show $ total ^. _Satoshi),
• replacement in daemon/AftokD/AftokM.hs at line 236
  [5.7418]→[4.3786:3874](∅→∅),[4.3874]→[5.7531:7639](∅→∅),[5.6447]→[5.7531:7639](∅→∅),[5.7531]→[5.7531:7639](∅→∅)
  − memoGen ::

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

  − memoGen sub billingDate requestTime = do

  − req <- traverseOf (billable . project) DB.findProjectOrError sub
  [5.7418]

  [5.6448]
  + _memoGen ::

  + DB.MonadDB m =>

  + Billable Satoshi ->

  + C.Day ->

  + C.UTCTime ->

  + m (Maybe Text)

  + _memoGen bill billingDate requestTime = do

  + req <- traverseOf B.project DB.findProjectOrError bill
• replacement in daemon/AftokD/AftokM.hs at line 246
  [5.6494]→[5.6494:6557](∅→∅)
  − <$> (sub ^. (billable . paymentRequestMemoTemplate))
  [5.6494]

  [4.3875]
  + <$> (bill ^. paymentRequestMemoTemplate)
• replacement in daemon/AftokD/AftokM.hs at line 249
  [4.3914]→[4.3914:4043](∅→∅)
  − [ ("project_name", req ^. (billable . project . projectName)),

  − ("subscription", req ^. (billable . name)),
  [4.3914]

  [4.4043]
  + [ ("project_name", req ^. B.project . projectName),

  + ("subscription", req ^. B.name),
• replacement in daemon/AftokD/AftokM.hs at line 258
  [5.8127]→[5.8127:8197](∅→∅)
  − paymentURL :: PaymentKey -> AftokM URI

  − paymentURL (PaymentKey k) = do
  [5.8127]

  [5.8197]
  + bip70PaymentURL :: Bitcoin.PaymentKey -> AftokM URI

  + bip70PaymentURL (Bitcoin.PaymentKey k) = do
• replacement in daemon/AftokD/AftokM.hs at line 273
  [5.8505]→[4.4357:4371](∅→∅)
  − payloadGen ::
  [5.8505]

  [4.4371]
  + _payloadGen ::
• replacement in daemon/AftokD/AftokM.hs at line 275
  [4.4384]→[4.4384:4419](∅→∅)
  − Subscription' UserId Billable ->
  [4.4384]

  [4.4419]
  + Billable Satoshi ->
• replacement in daemon/AftokD/AftokM.hs at line 279
  [5.1018]→[5.8606:8638](∅→∅),[4.4468]→[5.8606:8638](∅→∅),[5.6922]→[5.8606:8638](∅→∅),[5.8606]→[5.8606:8638](∅→∅)
  − payloadGen _ _ _ = pure Nothing
  [4.4468]
  + _payloadGen _ _ _ = pure Nothing
• replacement in lib/Aftok/Auction.hs at line 6
  [4.5664]→[4.5664:5677](∅→∅)
  − ( satoshi,
  [4.5664]

  [4.5677]
  + ( _Satoshi,
• replacement in lib/Aftok/Auction.hs at line 72
  [4.6617]→[4.6617:6671](∅→∅)
  − btc bid = toRational $ bid ^. bidAmount . satoshi
  [4.6617]

  [4.6671]
  + btc bid = toRational $ bid ^. bidAmount . _Satoshi
• replacement in lib/Aftok/Auction.hs at line 88
  [4.7089]→[4.7089:7152](∅→∅)
  − let winFraction r = r % (bid ^. bidAmount . satoshi)
  [4.7089]

  [4.7152]
  + let winFraction r = r % (bid ^. bidAmount . _Satoshi)
• replacement in lib/Aftok/Auction.hs at line 114
  [4.7900]→[4.7900:7961](∅→∅)
  − let winFraction r = r % (bid ^. bidAmount . satoshi)
  [4.7900]

  [4.7961]
  + let winFraction r = r % (bid ^. bidAmount . _Satoshi)
• edit in lib/Aftok/Billing.hs at line 4
  [5.1016]→[4.8244:8276](∅→∅)
  − {-# LANGUAGE ExplicitForAll #-}
• edit in lib/Aftok/Billing.hs at line 9
  [4.8356]→[4.8356:8385](∅→∅)
  − import Bippy.Types (Satoshi)
• edit in lib/Aftok/Billing.hs at line 14
  [5.982]→[5.982:1039](∅→∅),[5.1039]→[4.8527:8528](∅→∅),[4.8528]→[5.188:212](∅→∅),[5.1039]→[5.188:212](∅→∅),[5.212]→[5.1040:1041](∅→∅),[5.1040]→[5.1040:1041](∅→∅)
  − newtype BillableId = BillableId UUID deriving (Show, Eq)

  −

  − makePrisms ''BillableId

  −
• replacement in lib/Aftok/Billing.hs at line 52
  [5.1085]→[4.8787:8808](∅→∅)
  − data Billable' p u c
  [5.1085]

  [4.8808]
  + -- | A potentially recurring billable amount.

  + data Billable' p u currency
• replacement in lib/Aftok/Billing.hs at line 58
  [4.8890]→[4.8890:8920](∅→∅)
  − _description :: Text,
  [4.8890]

  [4.8920]
  + _description :: Maybe Text,

  + _messageText :: Maybe Text,
• replacement in lib/Aftok/Billing.hs at line 61
  [4.8955]→[4.8955:8977](∅→∅)
  − _amount :: c,
  [4.8955]

  [4.8977]
  + _amount :: currency,
• replacement in lib/Aftok/Billing.hs at line 63
  [4.9007]→[4.9007:9064](∅→∅)
  − _requestExpiryPeriod :: Maybe C.NominalDiffTime,
  [4.9007]

  [4.9064]
  + _requestExpiryPeriod :: NominalDiffTime,
• replacement in lib/Aftok/Billing.hs at line 70
  [5.1730]→[5.1370:1421](∅→∅)
  − type Billable = Billable' ProjectId UserId Satoshi
  [5.1730]

  [5.1421]
  + type Billable amt = Billable' ProjectId UserId amt
• replacement in lib/Aftok/Billing.hs at line 72
  [5.1422]→[5.964:1029](∅→∅),[5.1730]→[5.964:1029](∅→∅)
  − newtype SubscriptionId = SubscriptionId UUID deriving (Show, Eq)
  [5.1422]

  [4.9176]
  + newtype BillableId = BillableId UUID deriving (Show, Eq)
• replacement in lib/Aftok/Billing.hs at line 74
  [4.9177]→[5.34:62](∅→∅),[5.1029]→[5.34:62](∅→∅)
  − makePrisms ''SubscriptionId
  [4.9177]

  [5.3662]
  + makePrisms ''BillableId
• edit in lib/Aftok/Billing.hs at line 79
  [5.1424]

  [4.9178]
  + -- | An association between a customer and a (potentially recurring) billable amount.

  + --

  + -- For one-time billing events, the end date should be the same as the start date.
• replacement in lib/Aftok/Billing.hs at line 87
  [4.9309]→[4.9309:9378](∅→∅)
  − _startTime :: C.UTCTime,

  − _endTime :: Maybe C.UTCTime
  [4.9309]

  [4.9378]
  + _startTime :: UTCTime,

  + _endTime :: Maybe UTCTime
• edit in lib/Aftok/Billing.hs at line 94
  [5.242]

  [5.1659]
  +

  + newtype SubscriptionId = SubscriptionId UUID deriving (Show, Eq)

  +

  + makePrisms ''SubscriptionId
• replacement in lib/Aftok/Billing.hs at line 109
  [5.457]→[5.243:308](∅→∅),[5.787]→[5.243:308](∅→∅)
  − billingSchedule :: forall u. Subscription' u Billable -> [T.Day]
  [5.457]

  [5.840]
  + billingSchedule :: forall u a. Subscription' u (Billable a) -> [T.Day]
• replacement in lib/Aftok/Config.hs at line 5
  [5.10875]→[4.9504:9592](∅→∅)
  − import Aftok.Currency.Bitcoin (NetworkMode)

  − import Aftok.Payments (PaymentsConfig (..))
  [5.10875]

  [4.9592]
  + import Aftok.Currency.Bitcoin (NetworkMode, Satoshi (..))

  + import qualified Aftok.Payments.Bitcoin as Bitcoin
• replacement in lib/Aftok/Config.hs at line 44
  [4.10453]→[4.10453:10495](∅→∅)
  − _exchangeRateServiceURI :: String
  [4.10453]

  [4.10495]
  + _exchangeRateServiceURI :: String,

  + _minPayment :: Satoshi
• edit in lib/Aftok/Config.hs at line 65
  [5.11989]

  [5.12593]
  + <*> (Satoshi <$> C.lookupDefault 100 cfg "minPayment")
• replacement in lib/Aftok/Config.hs at line 76
  [5.12867]→[5.12867:12922](∅→∅)
  − toPaymentsConfig :: BillingConfig -> IO PaymentsConfig
  [5.12867]

  [5.12922]
  + toPaymentsConfig :: BillingConfig -> IO Bitcoin.PaymentsConfig
• replacement in lib/Aftok/Config.hs at line 91
  [5.13405]→[5.4189:4248](∅→∅)
  − pure $ PaymentsConfig (c ^. networkMode) privKey pkiData
  [5.13405]
  + pure $ Bitcoin.PaymentsConfig (c ^. networkMode) privKey pkiData (_minPayment c)
• file addition: Bitcoin (d--r------)
  [5.4250]
• file addition: Bip70.hs (----------)
  [0.6659]
  + {-# LANGUAGE TemplateHaskell #-}

  +

  + module Aftok.Currency.Bitcoin.Bip70

  + ( module Bippy.Proto,

  + )

  + where

  +

  + import Bippy.Proto
• file addition: Payments.hs (----------)
  [0.6659]
  + {-# LANGUAGE TemplateHaskell #-}

  +

  + module Aftok.Currency.Bitcoin.Payments

  + ( PaymentKey (..),

  + _PaymentKey,

  + Payment (..),

  + PaymentRequest (..),

  + amount,

  + txid,

  + address,

  + bip70Payment,

  + paymentKey,

  + bip70Request,

  + paymentRequestKey,

  + )

  + where

  +

  + import qualified Bippy.Proto as B

  + import Bippy.Types (Satoshi)

  + import Control.Lens (makeLenses, makePrisms)

  + import Haskoin.Address (Address (..))

  +

  + -- A unique identifier for a payment request, suitable

  + -- for URL embedding.

  + newtype PaymentKey = PaymentKey Text deriving (Eq)

  +

  + makePrisms ''PaymentKey

  +

  + data PaymentRequest

  + = PaymentRequest

  + { _paymentRequestKey :: PaymentKey,

  + _bip70Request :: B.PaymentRequest

  + }

  +

  + makeLenses ''PaymentRequest

  +

  + data Payment

  + = Payment

  + { _amount :: Maybe Satoshi,

  + _txid :: Maybe Text,

  + _address :: Maybe Address,

  + _paymentKey :: PaymentKey,

  + _bip70Payment :: B.Payment

  + }

  +

  + makeLenses ''Payment
• replacement in lib/Aftok/Currency/Bitcoin.hs at line 5
  [5.4406]→[5.4406:4442](∅→∅)
  − module Aftok.Currency.Bitcoin where
  [5.4406]

  [5.4442]
  + module Aftok.Currency.Bitcoin

  + ( Satoshi (..),

  + _Satoshi,

  + ssub,

  + NetworkMode (..),

  + renderNetworkMode,

  + parseNetworkMode,

  + getNetwork,

  + )

  + where
• replacement in lib/Aftok/Currency/Bitcoin.hs at line 21
  [5.4646]→[5.4646:4730](∅→∅)
  − satoshi :: Lens' Satoshi Word64

  − satoshi inj (Satoshi value) = Satoshi <$> inj value
  [5.4646]

  [5.4730]
  + _Satoshi :: Lens' Satoshi Word64

  + _Satoshi inj (Satoshi value) = Satoshi <$> inj value
• edit in lib/Aftok/Currency/Bitcoin.hs at line 27
  [4.11041]→[5.4858:5009](∅→∅),[5.12575]→[5.4858:5009](∅→∅),[5.4858]→[5.4858:5009](∅→∅)
  −

  − data NetworkId

  − = BTC

  − | BCH

  − deriving (Eq, Show, Ord)

  −

  − renderNetworkId :: NetworkId -> Text

  − renderNetworkId = \case

  − BTC -> "btc"

  − BCH -> "bch"
• edit in lib/Aftok/Currency/Bitcoin.hs at line 28
  [5.5010]→[5.5010:5115](∅→∅),[5.5115]→[4.11042:11057](∅→∅),[4.11057]→[5.5130:5131](∅→∅),[5.12595]→[5.5130:5131](∅→∅),[5.5130]→[5.5130:5131](∅→∅)
  − parseNetworkId :: Text -> Maybe NetworkId

  − parseNetworkId = \case

  − "btc" -> Just BTC

  − "bch" -> Just BCH

  − _ -> Nothing

  −
• edit in lib/Aftok/Currency/Bitcoin.hs at line 31
  [5.5174]

  [5.5174]
  +

  + renderNetworkMode :: NetworkMode -> Text

  + renderNetworkMode = \case

  + LiveMode -> "live"

  + TestMode -> "test"
• replacement in lib/Aftok/Currency/Bitcoin.hs at line 47
  [5.5421]→[5.5421:5668](∅→∅),[5.5668]→[4.11097:11117](∅→∅),[4.11117]→[5.5688:5712](∅→∅),[5.12675]→[5.5688:5712](∅→∅),[5.5688]→[5.5688:5712](∅→∅),[5.5712]→[4.11118:11138](∅→∅),[4.11138]→[5.5732:5756](∅→∅),[5.12700]→[5.5732:5756](∅→∅),[5.5732]→[5.5732:5756](∅→∅),[5.5756]→[4.11139:11154](∅→∅)
  − toNetwork :: NetworkMode -> NetworkId -> Network

  − toNetwork LiveMode = \case

  − BTC -> btc

  − BCH -> bch

  − toNetwork TestMode = \case

  − BTC -> btcTest

  − BCH -> bchTest

  −

  − toNetworkId :: Network -> Maybe NetworkId

  − toNetworkId n = case getNetworkName n of

  − "btc" -> Just BTC

  − "btcTest" -> Just BTC

  − "bch" -> Just BCH

  − "bchTest" -> Just BCH

  − _ -> Nothing
  [5.5421]
  + getNetwork :: NetworkMode -> Network

  + getNetwork = \case

  + LiveMode -> btc

  + TestMode -> btcTest
• file addition: Zcash (d--r------)
  [5.4250]
• file addition: Payments.hs (----------)
  [0.8302]
  + {-# LANGUAGE TemplateHaskell #-}

  +

  + module Aftok.Currency.Zcash.Payments where

  +

  + import Aftok.Currency.Zcash.Types (Zatoshi)

  + import Control.Lens (makeLenses, makePrisms)

  +

  + newtype TxId = TxId Text

  +

  + makePrisms ''TxId

  +

  + data Payment

  + = Payment

  + { _amount :: Zatoshi,

  + _txid :: TxId

  + }

  +

  + makeLenses ''Payment
• file addition: Types.hs (----------)
  [0.8302]
  + {-# LANGUAGE DerivingVia #-}

  + {-# LANGUAGE GeneralizedNewtypeDeriving #-}

  + {-# LANGUAGE StandaloneDeriving #-}

  + {-# LANGUAGE TemplateHaskell #-}

  +

  + module Aftok.Currency.Zcash.Types where

  +

  + import Control.Lens (makePrisms)

  +

  + coin :: Word64

  + coin = 100000000

  +

  + maxMoney :: Word64

  + maxMoney = 21000000 * coin

  +

  + newtype IVK = IVK {ivkText :: Text}

  + deriving (Eq, Ord, Show)

  +

  + makePrisms ''IVK

  +

  + newtype Address = Address {zaddrText :: Text}

  + deriving (Eq, Ord, Show)

  +

  + makePrisms ''Address

  +

  + newtype Zatoshi = Zatoshi Word64

  + deriving stock (Eq, Ord, Show)

  +

  + makePrisms ''Zatoshi

  +

  + class ToZatoshi a where

  + toZatoshi :: a -> Maybe Zatoshi

  +

  + instance ToZatoshi Word64 where

  + toZatoshi amt =

  + if amt > maxMoney then Nothing else Just (Zatoshi amt)

  +

  + instance Semigroup Zatoshi where

  + (Zatoshi a) <> (Zatoshi b) = Zatoshi (a + b)

  +

  + data ZAddrType

  + = Sprout

  + | Sapling

  +

  + decodeAddrType :: Text -> Maybe ZAddrType

  + decodeAddrType = \case

  + "sprout" -> Just Sprout

  + "sapling" -> Just Sapling

  + _ -> Nothing

  +

  + newtype Memo = Memo ByteString
• file addition: Zip321.hs (----------)
  [0.8302]
  + {-# LANGUAGE TemplateHaskell #-}

  +

  + module Aftok.Currency.Zcash.Zip321 where

  +

  + import Aftok.Currency.Zcash.Types

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

  + import Data.Attoparsec.Text

  + ( Parser,

  + char,

  + choice,

  + decimal,

  + option,

  + parseOnly,

  + scientific,

  + sepBy1,

  + string,

  + takeText,

  + takeTill,

  + takeWhile1,

  + )

  + import Data.ByteString.Base64.URL (decodeBase64, encodeBase64Unpadded)

  + import Data.Char (isAlpha, isAscii, isDigit)

  + import Data.List.NonEmpty (zip)

  + import qualified Data.Map.Strict as M

  + import Data.Scientific (toBoundedInteger)

  + import Data.Text (any, intercalate, pack, unpack)

  + import Network.URI.Encode (decodeText, encodeTextWith)

  + import Text.Printf (printf)

  + import Prelude hiding (any, intercalate, zip)

  +

  + data PaymentItem

  + = PaymentItem

  + { _address :: Address,

  + _amount :: Zatoshi,

  + _memo :: Maybe Memo,

  + _message :: Maybe Text,

  + _label :: Maybe Text,

  + _other :: [(Text, Text)] -- TODO: param name restrictions

  + }

  +

  + makeLenses ''PaymentItem

  +

  + data PaymentRequest

  + = PaymentRequest

  + { _items :: NonEmpty PaymentItem

  + }

  +

  + makeLenses ''PaymentRequest

  +

  + -- The set of ASCII characters that are excepted from percent-encoding according

  + -- to the definition of ZIP 321.

  + --

  + -- unreserved = ALPHA / DIGIT / "-" / "." / "_" / "~"

  + -- allowed-delims = "!" / "$" / "'" / "(" / ")" / "*" / "+" / "," / ";"

  + -- qchar = unreserved / pct-encoded / allowed-delims / ":" / "@"

  + qchar :: Char -> Bool

  + qchar c =

  + (isAscii c && isAlpha c)

  + || isDigit c

  + || any (== c) "-._!$'()*+,;:@"

  +

  + paramIndex :: Maybe Int -> Text

  + paramIndex = maybe "" (\i -> pack (printf ".%d" i)) . find (> 0)

  +

  + addrParam :: Maybe Int -> Address -> Text

  + addrParam i (Address t) = strParam "address" i t

  +

  + amountParam :: Maybe Int -> Zatoshi -> Text

  + amountParam i (Zatoshi value) =

  + "amount" <> paramIndex i <> "=" <> valueText

  + where

  + coins = value `div` coin

  + zats = value `mod` coin

  + valueText =

  + pack $

  + if zats == 0

  + then printf "%d" coins

  + else printf "%d.%0.8d" coins zats

  +

  + strParam :: Text -> Maybe Int -> Text -> Text

  + strParam l i value =

  + l <> paramIndex i <> "=" <> encodeTextWith qchar value

  +

  + memoParam :: Maybe Int -> Memo -> Text

  + memoParam i (Memo bytes) = "memo" <> paramIndex i <> "=" <> encodeBase64Unpadded bytes

  +

  + itemPartial :: Maybe Int -> PaymentItem -> [Text]

  + itemPartial i item =

  + catMaybes

  + [ Just $ amountParam i (item ^. amount),

  + memoParam i <$> (item ^. memo),

  + strParam "message" i <$> (item ^. message),

  + strParam "label" i <$> (item ^. label)

  + ]

  +

  + itemsParams :: NonEmpty PaymentItem -> NonEmpty Text

  + itemsParams xs =

  + intercalate "&" . toList . itemParams <$> zip (Just <$> fromList [1 ..]) xs

  + where

  + itemParams (i, item) =

  + addrParam i (item ^. address) : itemPartial i item

  +

  + toURI :: PaymentRequest -> Text

  + toURI req =

  + case req ^. items of

  + i :| [] ->

  + "zcash:" <> zaddrText (i ^. address) <> "?"

  + <> intercalate "&" (itemPartial Nothing i)

  + xs ->

  + "zcash:?" <> intercalate "&" (toList $ itemsParams xs)

  +

  + addrElem :: Char -> Bool

  + addrElem c = isDigit c || (isAscii c && isAlpha c)

  +

  + data Zip321Param

  + = AddrParam Address

  + | AmountParam Zatoshi

  + | MemoParam Memo

  + | LabelParam Text

  + | MessageParam Text

  + | OtherParam Text Text

  +

  + makePrisms ''Zip321Param

  +

  + type IndexedParam = (Int, Zip321Param)

  +

  + zip321Parser :: Parser PaymentRequest

  + zip321Parser = do

  + void $ string "zcash:"

  + addr0 <- toAddress <$> takeTill (== '?')

  + params' <- sepBy1 zip321Param (char '&')

  + let params = second (: []) <$> (toList addr0 <> params')

  + grouped = M.fromListWith (<>) params

  + groups <- maybe (fail "Parameter list was empty.") pure (nonEmpty $ M.toAscList grouped)

  + either (fail . unpack) (pure . PaymentRequest) $ traverse (toPaymentItem . snd) groups

  + where

  + toAddress addr =

  + if addr == ""

  + then Nothing

  + else Just (0, AddrParam $ Address addr)

  + zip321Param =

  + choice

  + [ parseAddrParam,

  + parseAmountParam,

  + parseMemoParam,

  + parseLabelParam,

  + parseMessageParam,

  + parseOtherParam

  + ]

  + toPaymentItem :: [Zip321Param] -> Either Text PaymentItem

  + toPaymentItem = error "Not yet implemented." --PaymentItem <$> note "Payment address is required"

  +

  + indexedParam :: Text -> Parser Zip321Param -> Parser IndexedParam

  + indexedParam name valuep = do

  + void $ string name

  + idx <- option 0 (char '.' *> decimal)

  + (,) <$> pure idx <*> (char '=' *> valuep)

  +

  + parseAddrParam :: Parser IndexedParam

  + parseAddrParam = indexedParam "address" (AddrParam . Address <$> takeWhile1 addrElem)

  +

  + parseAmountParam :: Parser IndexedParam

  + parseAmountParam = indexedParam "amount" $ do

  + s <- scientific

  + let zats = s * fromIntegral coin

  + maybe

  + (fail "Amount is out of bounds")

  + (pure . AmountParam . Zatoshi)

  + (toBoundedInteger zats)

  +

  + parseMemoParam :: Parser IndexedParam

  + parseMemoParam = indexedParam "memo" $ do

  + t <- takeText

  + either

  + (\e -> fail . unpack $ "Base64 decoding of memo value failed: " <> e)

  + (pure . MemoParam . Memo)

  + (decodeBase64 $ encodeUtf8 t)

  +

  + parseLabelParam :: Parser IndexedParam

  + parseLabelParam = indexedParam "label" (LabelParam . decodeText <$> takeText)

  +

  + parseMessageParam :: Parser IndexedParam

  + parseMessageParam = indexedParam "message" (MessageParam . decodeText <$> takeText)

  +

  + parseOtherParam :: Parser IndexedParam

  + parseOtherParam = do

  + pname <- takeWhile1 paramNameChar

  + idx <- option 0 (char '.' *> decimal)

  + void (char '=')

  + value <- decodeText <$> takeText

  + pure (idx, OtherParam pname value)

  + where

  + paramNameChar c = isDigit c || (isAscii c && isAlpha c) || c == '+' || c == '-'

  +

  + parseURI :: Text -> Either String PaymentRequest

  + parseURI = parseOnly zip321Parser
• replacement in lib/Aftok/Currency/Zcash.hs at line 4
  [5.494]→[4.11190:11218](∅→∅)
  − ( ZAddr (..),

  − _ZAddr,
  [5.494]

  [4.11218]
  + ( Z.Address (..),

  + Z._Address,

  + Z.IVK (..),

  + Z._IVK,
• replacement in lib/Aftok/Currency/Zcash.hs at line 11
  [4.11290]→[4.11290:11323](∅→∅)
  − Zatoshi,

  − ToZatoshi (..),
  [4.11290]

  [4.11323]
  + Z.Zatoshi (..),

  + Z._Zatoshi,

  + Z.ToZatoshi (..),
• edit in lib/Aftok/Currency/Zcash.hs at line 16
  [4.11367]

  [4.11367]
  + getUserDiversifiedAddress,
• edit in lib/Aftok/Currency/Zcash.hs at line 20
  [5.591]

  [4.11378]
  + import Aftok.Currency.Zcash.Types as Z

  + import Aftok.Types (UserId)
• edit in lib/Aftok/Currency/Zcash.hs at line 23
  [4.11411]→[4.11411:11444](∅→∅)
  − import Control.Lens (makePrisms)
• edit in lib/Aftok/Currency/Zcash.hs at line 44
  [5.781]→[5.781:860](∅→∅),[5.860]→[5.1491:1492](∅→∅),[5.1491]→[5.1491:1492](∅→∅),[5.1492]→[4.11928:11970](∅→∅),[4.11970]→[5.1536:1563](∅→∅),[5.1536]→[5.1536:1563](∅→∅),[5.1563]→[4.11971:11972](∅→∅),[4.11972]→[5.1563:1582](∅→∅),[5.1563]→[5.1563:1582](∅→∅),[5.1582]→[5.861:922](∅→∅),[5.922]→[4.11973:11974](∅→∅),[4.11974]→[5.922:1002](∅→∅),[5.922]→[5.922:1002](∅→∅),[5.1002]→[5.1582:1583](∅→∅),[5.1582]→[5.1582:1583](∅→∅),[5.1583]→[5.1003:1113](∅→∅),[5.1113]→[5.1583:1622](∅→∅),[5.1583]→[5.1583:1622](∅→∅)
  − coin :: Word64

  − coin = 100000000

  −

  − maxMoney :: Word64

  − maxMoney = 21000000 * coin

  −

  − newtype ZAddr = ZAddr {zaddrText :: Text}

  − deriving (Eq, Ord, Show)

  −

  − makePrisms ''ZAddr

  −

  − newtype Zatoshi = Zatoshi Word64

  − deriving (Eq, Ord, Show)

  −

  − makePrisms ''Zatoshi

  −

  − class ToZatoshi a where

  − toZatoshi :: a -> Maybe Zatoshi

  −

  − instance ToZatoshi Word64 where

  − toZatoshi amt =

  − if amt > maxMoney then Nothing else Just (Zatoshi amt)

  −

  − data ZAddrType

  − = Sprout

  − | Sapling

  −
• replacement in lib/Aftok/Currency/Zcash.hs at line 100
  [4.12783]→[4.12783:12822](∅→∅)
  − vzrAddrType :: Maybe ZAddrType
  [4.12783]

  [4.12822]
  + vzrAddrType :: Maybe Z.ZAddrType
• edit in lib/Aftok/Currency/Zcash.hs at line 114
  [4.13035]→[5.2053:2054](∅→∅),[5.2053]→[5.2053:2054](∅→∅),[5.2054]→[5.2661:2726](∅→∅),[5.2726]→[5.2342:2411](∅→∅),[5.2342]→[5.2342:2411](∅→∅)
  −

  − decodeAddrType :: Text -> Maybe ZAddrType

  − decodeAddrType = \case

  − "sprout" -> Just Sprout

  − "sapling" -> Just Sapling

  − _ -> Nothing
• replacement in lib/Aftok/Currency/Zcash.hs at line 115
  [5.2412]→[5.2727:2781](∅→∅)
  − parseAddrType :: A.Object -> Parser (Maybe ZAddrType)
  [5.2412]

  [5.2781]
  + parseAddrType :: A.Object -> Parser (Maybe Z.ZAddrType)
• replacement in lib/Aftok/Currency/Zcash.hs at line 118
  [5.2832]→[5.2832:2875](∅→∅)
  − let typeMay = decodeAddrType <$> typeStr
  [5.2832]

  [5.2875]
  + let typeMay = Z.decodeAddrType <$> typeStr
• replacement in lib/Aftok/Currency/Zcash.hs at line 131
  [5.2834]→[5.3223:3327](∅→∅)
  − rpcValidateZAddr :: Manager -> ZcashdConfig -> Text -> IO (Either (RPCError ZValidateAddressErr) ZAddr)
  [5.2834]

  [5.3327]
  + rpcValidateZAddr :: Manager -> ZcashdConfig -> Text -> IO (Either (RPCError ZValidateAddressErr) Z.Address)
• replacement in lib/Aftok/Currency/Zcash.hs at line 138
  [4.13213]→[4.13213:13266](∅→∅),[4.13266]→[5.3601:3644](∅→∅),[5.3601]→[5.3601:3644](∅→∅)
  − Just Sprout -> Left (RPCError SproutAddress)

  − Just Sapling -> Right (ZAddr addr)
  [4.13213]

  [4.13267]
  + Just Z.Sprout -> Left (RPCError SproutAddress)

  + Just Z.Sapling -> Right (Z.Address addr)
• replacement in lib/Aftok/Currency/Zcash.hs at line 146
  [4.13361]→[4.13361:13424](∅→∅)
  − { addressType :: ZAddrType

  − -- , address :: ZAddr
  [4.13361]

  [4.13424]
  + { addressType :: Z.ZAddrType

  + -- , address :: Z.Address
• replacement in lib/Aftok/Currency/Zcash.hs at line 155
  [5.4045]→[4.13433:13469](∅→∅)
  − -- <*> (ZAddr <$> v .: "address")
  [5.4045]

  [5.4085]
  + -- <*> (Z.Address <$> v .: "address")
• replacement in lib/Aftok/Currency/Zcash.hs at line 178
  [5.4828]→[5.4828:4901](∅→∅)
  − Sprout -> Left . RPCError $ SproutViewingKey

  − Sapling -> Right ()
  [5.4828]
  + Z.Sprout -> Left . RPCError $ SproutViewingKey

  + Z.Sapling -> Right ()

  +

  + getUserDiversifiedAddress :: UserId -> IVK -> Address

  + getUserDiversifiedAddress = error "Not Yet Implemented."
• edit in lib/Aftok/Currency.hs at line 1
  [5.5808]

  [5.5809]
  + {-# LANGUAGE TemplateHaskell #-}

  + {-# LANGUAGE TypeApplications #-}

  +
• edit in lib/Aftok/Currency.hs at line 5
  [5.5837]

  [5.5837]
  +

  + import qualified Aftok.Currency.Zcash as Zcash

  + import qualified Bippy.Types as Bitcoin

  + import Control.Lens (view)

  + import qualified Haskoin.Address as Bitcoin
• replacement in lib/Aftok/Currency.hs at line 11
  [5.5838]→[4.13722:13781](∅→∅)
  − import Data.Aeson (Value)

  − import Data.Aeson.Types (Parser)
  [5.5838]

  [5.5917]
  + data Currency a c where

  + BTC :: Currency Bitcoin.Address Bitcoin.Satoshi

  + ZEC :: Currency Zcash.Address Zcash.Zatoshi

  +

  + data Currency' c = forall a. Currency' (Currency a c)
• replacement in lib/Aftok/Currency.hs at line 17
  [5.5918]→[4.13782:13882](∅→∅)
  − data Network a

  − = Network

  − { addressFromJSON :: Parser a,

  − addressToJSON :: a -> Value
  [5.5918]

  [4.13882]
  + data Amount

  + = forall a c.

  + Amount

  + { currency :: !(Currency a c),

  + value :: !c
• edit in lib/Aftok/Currency.hs at line 23
  [4.13890]
  +

  + scaleCurrency :: Currency a c -> c -> Rational -> Maybe c

  + scaleCurrency c amount factor = case c of

  + BTC -> (\(Bitcoin.Satoshi amt) -> Just $ Bitcoin.Satoshi ((round $ toRational amt * factor) :: Word64)) amount

  + ZEC -> (\amt -> Zcash.toZatoshi ((round $ toRational (view Zcash._Zatoshi amt) * factor) :: Word64)) amount
• file addition: Auctions.hs (----------)
  [5.6049]
  + {-# LANGUAGE GADTs #-}

  + {-# LANGUAGE GeneralizedNewtypeDeriving #-}

  + {-# LANGUAGE LambdaCase #-}

  + {-# LANGUAGE QuasiQuotes #-}

  +

  + module Aftok.Database.PostgreSQL.Auctions

  + ( createAuction,

  + findAuction,

  + createBid,

  + findBids,

  + )

  + where

  +

  + import Aftok.Auction

  + ( Auction (..),

  + AuctionId (..),

  + Bid (..),

  + BidId (..),

  + _AuctionId,

  + auctionEnd,

  + bidAmount,

  + bidSeconds,

  + bidTime,

  + bidUser,

  + initiator,

  + projectId,

  + raiseAmount,

  + )

  + -- import Aftok.Currency ( Amount(..) )

  +

  + -- import qualified Aftok.Currency.Bitcoin as Bitcoin

  + import Aftok.Currency.Bitcoin (_Satoshi)

  + -- import qualified Aftok.Currency.Zcash as Zcash

  +

  + import Aftok.Database ()

  + import Aftok.Database.PostgreSQL.Types

  + ( DBM,

  + btcAmountParser,

  + idParser,

  + pinsert,

  + pquery,

  + utcParser,

  + )

  + import Aftok.Types

  + ( ProjectId (..),

  + UserId (..),

  + _ProjectId,

  + _UserId,

  + )

  + import Control.Lens

  + import Data.Hourglass (Seconds (..))

  + import qualified Data.Thyme.Time as C

  + import Database.PostgreSQL.Simple (Only (..))

  + import Database.PostgreSQL.Simple.FromField ()

  + import Database.PostgreSQL.Simple.FromRow (RowParser, field)

  + import Database.PostgreSQL.Simple.SqlQQ (sql)

  + import Safe (headMay)

  + import Prelude hiding (null)

  +

  + auctionParser :: RowParser Auction

  + auctionParser =

  + Auction

  + <$> idParser ProjectId

  + <*> idParser UserId

  + <*> utcParser

  + <*> btcAmountParser

  + <*> utcParser

  + <*> utcParser

  +

  + bidParser :: RowParser Bid

  + bidParser =

  + Bid <$> idParser UserId <*> (Seconds <$> field) <*> btcAmountParser <*> utcParser

  +

  + createAuction :: Auction -> DBM AuctionId

  + createAuction auc =

  + pinsert

  + AuctionId

  + [sql| INSERT INTO auctions (project_id, initiator_id, raise_amount, end_time)

  + VALUES (?, ?, ?, ?) RETURNING id |]

  + ( auc ^. (projectId . _ProjectId),

  + auc ^. (initiator . _UserId),

  + auc ^. (raiseAmount . _Satoshi),

  + auc ^. (auctionEnd . to C.fromThyme)

  + )

  +

  + findAuction :: AuctionId -> DBM (Maybe Auction)

  + findAuction aucId =

  + headMay

  + <$> pquery

  + auctionParser

  + [sql| SELECT project_id, initiator_id, created_at, raise_amount, start_time, end_time

  + FROM auctions

  + WHERE id = ? |]

  + (Only (aucId ^. _AuctionId))

  +

  + createBid :: AuctionId -> Bid -> DBM BidId

  + createBid (AuctionId aucId) bid =

  + pinsert

  + BidId

  + [sql| INSERT INTO bids (auction_id, bidder_id, bid_seconds, bid_amount, bid_time)

  + VALUES (?, ?, ?, ?, ?) RETURNING id |]

  + ( aucId,

  + bid ^. (bidUser . _UserId),

  + case bid ^. bidSeconds of

  + (Seconds i) -> i,

  + bid ^. (bidAmount . _Satoshi),

  + bid ^. (bidTime . to C.fromThyme)

  + )

  +

  + findBids :: AuctionId -> DBM [(BidId, Bid)]

  + findBids aucId =

  + pquery

  + ((,) <$> idParser BidId <*> bidParser)

  + [sql| SELECT id, bidder_id, bid_seconds, bid_amount, bid_time FROM bids WHERE auction_id = ? |]

  + (Only (aucId ^. _AuctionId))
• file addition: Billing.hs (----------)
  [5.6049]
  + {-# LANGUAGE QuasiQuotes #-}

  + {-# LANGUAGE TypeApplications #-}

  +

  + module Aftok.Database.PostgreSQL.Billing

  + ( createBillable,

  + findBillable,

  + findBillables,

  + createSubscription,

  + findSubscription,

  + findSubscriptions,

  + findSubscribers,

  + storePaymentRequest,

  + findPaymentRequestByKey,

  + findPaymentRequestById,

  + findSubscriptionPaymentRequests,

  + findSubscriptionUnpaidRequests,

  + createPayment,

  + findPayments,

  + )

  + where

  +

  + import Aftok.Billing

  + ( Billable,

  + Billable' (..),

  + BillableId (..),

  + ContactChannel (..),

  + Recurrence (..),

  + Subscription,

  + Subscription' (..),

  + SubscriptionId (..),

  + _BillableId,

  + _SubscriptionId,

  + amount,

  + description,

  + gracePeriod,

  + name,

  + paymentRequestEmailTemplate,

  + paymentRequestMemoTemplate,

  + project,

  + recurrence,

  + recurrenceCount,

  + recurrenceName,

  + )

  + import Aftok.Currency (Amount (..), Currency (..))

  + import Aftok.Currency.Bitcoin (Satoshi)

  + import qualified Aftok.Currency.Bitcoin as Bitcoin

  + import qualified Aftok.Currency.Bitcoin.Payments as Bitcoin

  + import Aftok.Currency.Zcash (Zatoshi)

  + import Aftok.Database.PostgreSQL.Json

  + ( nativeRequestJSON,

  + parseBip70PaymentRequestJSON,

  + parseBitcoinPaymentJSON,

  + parseZcashPaymentJSON,

  + parseZip321PaymentRequestJSON,

  + paymentJSON,

  + )

  + import Aftok.Database.PostgreSQL.Types

  + ( DBM,

  + currencyAmountParser,

  + currencyType,

  + currencyValue,

  + idParser,

  + nominalDiffTimeParser,

  + nullField,

  + pinsert,

  + pquery,

  + )

  + import Aftok.Payments.Types

  + ( NativePayment (..),

  + NativeRequest (..),

  + Payment,

  + Payment' (Payment),

  + PaymentId (..),

  + PaymentRequest,

  + PaymentRequest' (..),

  + PaymentRequestId (..),

  + PaymentRequestId,

  + SomePaymentRequest (..),

  + SomePaymentRequestDetail,

  + _PaymentRequestId,

  + billingDate,

  + bip70Request,

  + createdAt,

  + nativeRequest,

  + paymentDate,

  + paymentRequest,

  + )

  + import Aftok.TimeLog

  + ( EventId (..),

  + _EventId,

  + )

  + import Aftok.Types

  + ( Email (..),

  + ProjectId (..),

  + UserId (..),

  + _ProjectId,

  + _UserId,

  + )

  + import Control.Lens ((.~), (^.), (^?), _Just, to, view)

  + import Data.Aeson (encode)

  + import Data.Aeson.Types (parseEither)

  + import qualified Data.Thyme.Clock as C

  + import qualified Data.Thyme.Time as C

  + import Database.PostgreSQL.Simple (Only (..), ResultError (Incompatible))

  + import Database.PostgreSQL.Simple.FromField (FieldParser, returnError, typename)

  + import Database.PostgreSQL.Simple.FromRow (RowParser, field, fieldWith)

  + import Database.PostgreSQL.Simple.SqlQQ (sql)

  + import Safe (headMay)

  + import Prelude hiding (null)

  +

  + billableParser :: RowParser (Billable Amount)

  + billableParser =

  + Billable

  + <$> idParser ProjectId

  + <*> idParser UserId

  + <*> field

  + <*> field

  + <*> field

  + <*> recurrenceParser

  + <*> currencyAmountParser

  + <*> field

  + <*> fieldWith nominalDiffTimeParser

  + <*> field

  + <*> field

  +

  + recurrenceParser :: RowParser Recurrence

  + recurrenceParser = join $ fieldWith recurrenceParser'

  +

  + recurrenceParser' :: FieldParser (RowParser Recurrence)

  + recurrenceParser' f v = do

  + tn <- typename f

  + if tn /= "recurrence_t"

  + then returnError Incompatible f "column was not of type recurrence_t"

  + else maybe empty (pure . parser . decodeUtf8) v

  + where

  + parser :: Text -> RowParser Recurrence

  + parser = \case

  + "annually" -> nullField *> pure Annually

  + "monthly" -> Monthly <$> field

  + --"semimonthly" = nullField *> pure SemiMonthly

  + "weekly" -> Weekly <$> field

  + "onetime" -> nullField *> pure OneTime

  + _ -> empty

  +

  + subscriptionParser :: RowParser Subscription

  + subscriptionParser =

  + Subscription

  + <$> idParser UserId

  + <*> idParser BillableId

  + <*> (EmailChannel . Email <$> field)

  + <*> (C.toThyme <$> field)

  + <*> ((fmap C.toThyme) <$> field)

  +

  + bip70RequestParser :: RowParser (NativeRequest Satoshi)

  + bip70RequestParser =

  + Bip70Request <$> ((either (const empty) pure . parseEither parseBip70PaymentRequestJSON) =<< field)

  +

  + zip321RequestParser :: RowParser (NativeRequest Zatoshi)

  + zip321RequestParser =

  + Zip321Request <$> ((either (const empty) pure . parseEither parseZip321PaymentRequestJSON) =<< field)

  +

  + paymentRequestDetailParser :: RowParser SomePaymentRequestDetail

  + paymentRequestDetailParser = do

  + billable <- billableParser

  + ctime :: C.UTCTime <- C.toThyme <$> field

  + billDay :: C.Day <- C.toThyme <$> field

  + case billable ^. amount of

  + (Amount BTC sats) -> do

  + nativeReq <- bip70RequestParser

  + pure . SomePaymentRequest $ PaymentRequest (billable & amount .~ sats) ctime billDay nativeReq

  + (Amount ZEC zats) -> do

  + nativeReq <- zip321RequestParser

  + pure . SomePaymentRequest $ PaymentRequest (billable & amount .~ zats) ctime billDay nativeReq

  +

  + paymentParser :: Bitcoin.NetworkMode -> PaymentRequestId -> Currency a c -> RowParser (Payment c)

  + paymentParser nmode prid ccy = do

  + d :: C.UTCTime <- C.toThyme <$> field

  + case ccy of

  + BTC -> Payment (Const prid) d <$> bitcoinPaymentParser nmode

  + ZEC -> Payment (Const prid) d <$> zcashPaymentParser

  +

  + bitcoinPaymentParser :: Bitcoin.NetworkMode -> RowParser (NativePayment Satoshi)

  + bitcoinPaymentParser nmode = do

  + pvalue <- field

  + either

  + (const empty)

  + (pure . BitcoinPayment)

  + (parseEither (parseBitcoinPaymentJSON nmode) pvalue)

  +

  + zcashPaymentParser :: RowParser (NativePayment Zatoshi)

  + zcashPaymentParser = do

  + pvalue <- field

  + either

  + (const empty)

  + (pure . ZcashPayment)

  + (parseEither parseZcashPaymentJSON pvalue)

  +

  + createBillable :: EventId -> UserId -> Billable Amount -> DBM BillableId

  + createBillable eventId _ b = do

  + pinsert

  + BillableId

  + [sql| INSERT INTO billables

  + ( project_id, event_id, name, description

  + , recurrence_type, recurrence_count

  + , billing_currency, billing_amount

  + , grace_period_days

  + , payment_request_email_template

  + , payment_request_memo_template)

  + VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?) RETURNING id |]

  + ( b ^. (project . _ProjectId),

  + eventId ^. _EventId,

  + b ^. name,

  + b ^. description,

  + b ^. (recurrence . to recurrenceName),

  + b ^. (recurrence . to recurrenceCount),

  + b ^. (amount . to currencyType),

  + b ^. (amount . to currencyValue),

  + b ^. (gracePeriod),

  + b ^. (paymentRequestEmailTemplate),

  + b ^. (paymentRequestMemoTemplate)

  + )

  +

  + findBillable :: BillableId -> DBM (Maybe (Billable Amount))

  + findBillable bid =

  + headMay

  + <$> pquery

  + billableParser

  + [sql| SELECT b.project_id, e.created_by,

  + b.name, b.description, b.message,

  + b.recurrence_type, b.recurrence_count,

  + b.billing_currency, b.billing_amount,

  + b.grace_period_days, b.request_expiry_seconds,

  + b.payment_request_email_template, b.payment_request_memo_template

  + FROM billables b JOIN aftok_events e ON e.id = b.event_id

  + WHERE b.id = ? |]

  + (Only (bid ^. _BillableId))

  +

  + findBillables :: ProjectId -> DBM [(BillableId, Billable Amount)]

  + findBillables pid =

  + pquery

  + ((,) <$> idParser BillableId <*> billableParser)

  + [sql| SELECT b.id, b.project_id, e.created_by,

  + b.name, b.description, b.message,

  + b.recurrence_type, b.recurrence_count,

  + b.billing_currency, b.billing_amount,

  + b.grace_period_days, b.request_expiry_seconds,

  + b.payment_request_email_template, b.payment_request_memo_template

  + FROM billables b JOIN aftok_events e ON e.id = b.event_id

  + WHERE b.project_id = ? |]

  + (Only (pid ^. _ProjectId))

  +

  + createSubscription :: EventId -> UserId -> BillableId -> C.Day -> DBM SubscriptionId

  + createSubscription eventId uid bid start_date =

  + pinsert

  + SubscriptionId

  + [sql| INSERT INTO subscriptions

  + (user_id, billable_id, event_id, start_date)

  + VALUES (?, ?, ?, ?) RETURNING id |]

  + ( view _UserId uid,

  + view _BillableId bid,

  + view _EventId eventId,

  + C.fromThyme start_date

  + )

  +

  + findSubscription :: SubscriptionId -> DBM (Maybe Subscription)

  + findSubscription sid =

  + headMay

  + <$> pquery

  + subscriptionParser

  + [sql| SELECT id, billable_id, contact_email, start_date, end_date

  + FROM subscriptions s

  + WHERE s.id = ? |]

  + (Only (sid ^. _SubscriptionId))

  +

  + findSubscriptions :: ProjectId -> UserId -> DBM [(SubscriptionId, Subscription)]

  + findSubscriptions pid uid =

  + pquery

  + ((,) <$> idParser SubscriptionId <*> subscriptionParser)

  + [sql| SELECT s.id, user_id, billable_id, contact_email, start_date, end_date

  + FROM subscriptions s

  + JOIN billables b ON b.id = s.billable_id

  + WHERE s.user_id = ?

  + AND b.project_id = ? |]

  + (uid ^. _UserId, pid ^. _ProjectId)

  +

  + findSubscribers :: ProjectId -> DBM [UserId]

  + findSubscribers pid =

  + pquery

  + (idParser UserId)

  + [sql| SELECT s.user_id

  + FROM subscripions s

  + JOIN billables b ON s.billable_id = b.id

  + WHERE b.project_id = ? |]

  + (Only (pid ^. _ProjectId))

  +

  + storePaymentRequest ::

  + EventId ->

  + Maybe SubscriptionId ->

  + PaymentRequest c ->

  + DBM PaymentRequestId

  + storePaymentRequest eid sid req =

  + pinsert

  + PaymentRequestId

  + [sql| INSERT INTO payment_requests

  + (subscription_id, event_id, request_json, url_key, request_time, billing_date)

  + VALUES (?, ?, ?, ?, ?, ?) RETURNING id |]

  + ( (^. _SubscriptionId) <$> sid,

  + eid ^. _EventId,

  + req ^. nativeRequest . to nativeRequestJSON,

  + req ^? nativeRequest . to bip70Request . _Just . Bitcoin.paymentRequestKey . Bitcoin._PaymentKey,

  + req ^. createdAt . to C.fromThyme,

  + req ^. billingDate . to C.fromThyme

  + )

  +

  + findPaymentRequestByKey :: Bitcoin.PaymentKey -> DBM (Maybe (PaymentRequestId, SomePaymentRequestDetail))

  + findPaymentRequestByKey (Bitcoin.PaymentKey k) =

  + headMay

  + <$> pquery

  + ((,) <$> idParser PaymentRequestId <*> paymentRequestDetailParser)

  + [sql|

  + SELECT r.id,

  + b.project_id, e.created_by, b.name, b.description, b.recurrence_type,

  + b.recurrence_count, b.billing_currency, b.billing_amount, b.grace_period_days,

  + b.payment_request_email_template, b.payment_request_memo_template

  + r.request_time, r.billing_date, r.request_json,

  + FROM payment_requests r

  + JOIN billables b on b.id = s.billable_id

  + JOIN aftok_events e on e.id = b.event_id

  + WHERE r.url_key = ?

  + |]

  + (Only k)

  +

  + findPaymentRequestById :: PaymentRequestId -> DBM (Maybe SomePaymentRequestDetail)

  + findPaymentRequestById (PaymentRequestId prid) =

  + headMay

  + <$> pquery

  + paymentRequestDetailParser

  + [sql|

  + SELECT

  + b.project_id, e.created_by, b.name, b.description, b.recurrence_type,

  + b.recurrence_count, b.billing_currency, b.billing_amount, b.grace_period_days,

  + b.payment_request_email_template, b.payment_request_memo_template

  + r.request_time, r.billing_date, r.request_json,

  + FROM payment_requests r

  + JOIN billables b on b.id = s.billable_id

  + JOIN aftok_events e on e.id = b.event_id

  + WHERE r.id = ?

  + |]

  + (Only prid)

  +

  + findSubscriptionPaymentRequests :: SubscriptionId -> DBM [(PaymentRequestId, SomePaymentRequestDetail)]

  + findSubscriptionPaymentRequests sid =

  + pquery

  + ((,) <$> idParser PaymentRequestId <*> paymentRequestDetailParser)

  + [sql|

  + SELECT r.id,

  + b.project_id, e.created_by, b.name, b.description, b.recurrence_type,

  + b.recurrence_count, b.billing_currency, b.billing_amount, b.grace_period_days,

  + b.payment_request_email_template, b.payment_request_memo_template

  + r.request_time, r.billing_date, r.request_json,

  + FROM payment_requests r

  + JOIN billables b on b.id = s.billable_id

  + JOIN aftok_events e on e.id = b.event_id

  + WHERE subscription_id = ?

  + |]

  + (Only (sid ^. _SubscriptionId))

  +

  + findSubscriptionUnpaidRequests :: SubscriptionId -> DBM [(PaymentRequestId, SomePaymentRequestDetail)]

  + findSubscriptionUnpaidRequests sid =

  + pquery

  + ((,) <$> idParser PaymentRequestId <*> paymentRequestDetailParser)

  + [sql| SELECT r.id,

  + b.project_id, e.created_by, b.name, b.description, b.recurrence_type,

  + b.recurrence_count, b.billing_currency, b.billing_amount, b.grace_period_days,

  + b.payment_request_email_template, b.payment_request_memo_template

  + r.request_time, r.billing_date, r.request_json,

  + FROM payment_requests r

  + JOIN subscriptions s on s.id = r.subscription_id

  + JOIN billables b on b.id = s.billable_id

  + JOIN aftok_events e on e.id = b.event_id

  + WHERE subscription_id = ?

  + AND r.id NOT IN (SELECT payment_request_id FROM payments)

  + |]

  + (Only (sid ^. _SubscriptionId))

  +

  + createPayment :: EventId -> Payment c -> DBM PaymentId

  + createPayment eventId p = do

  + nmode <- asks fst

  + pinsert

  + PaymentId

  + [sql| INSERT INTO payments

  + (payment_request_id, event_id, payment_data, payment_date)

  + VALUES (?, ?, ?, ?) RETURNING id |]

  + ( p ^. (paymentRequest . to getConst . _PaymentRequestId),

  + eventId ^. _EventId,

  + p ^. (to (paymentJSON nmode) . to encode),

  + p ^. (paymentDate . to C.fromThyme)

  + )

  +

  + findPayments :: Currency a c -> PaymentRequestId -> DBM [(PaymentId, Payment c)]

  + findPayments ccy rid = do

  + nmode <- asks fst

  + pquery

  + ((,) <$> idParser PaymentId <*> paymentParser nmode rid ccy)

  + [sql| SELECT id, payment_request_id, payment_date, payment_data

  + FROM payments

  + WHERE payment_request_id = ? |]

  + (Only (rid ^. _PaymentRequestId))
• file addition: Events.hs (----------)
  [5.6049]
  + {-# LANGUAGE GADTs #-}

  + {-# LANGUAGE GeneralizedNewtypeDeriving #-}

  + {-# LANGUAGE LambdaCase #-}

  + {-# LANGUAGE QuasiQuotes #-}

  +

  + module Aftok.Database.PostgreSQL.Events

  + ( storeEvent,

  + storeEvent',

  + createEvent,

  + findEvent,

  + findEvents,

  + amendEvent,

  + readWorkIndex,

  + )

  + where

  +

  + import Aftok.Database

  + ( DBError (EventStorageFailed),

  + DBOp

  + ( CreateBillable,

  + CreatePayment,

  + CreateSubscription,

  + StorePaymentRequest

  + ),

  + KeyedLogEntry,

  + )

  + import Aftok.Database.PostgreSQL.Json

  + ( nativeRequestJSON,

  + paymentJSON,

  + )

  + import Aftok.Database.PostgreSQL.Types

  + ( DBM,

  + creditToName,

  + creditToParser,

  + idParser,

  + pinsert,

  + pquery,

  + utcParser,

  + )

  + import Aftok.Interval

  + import Aftok.Json

  + ( billableJSON,

  + createSubscriptionJSON,

  + )

  + import Aftok.Payments.Types

  + import Aftok.TimeLog

  + import Aftok.Types

  + import Control.Lens ((^.), _Just, preview)

  + import Control.Monad.Trans.Except (throwE)

  + import Data.Aeson

  + ( Value,

  + )

  + import Data.Thyme.Clock as C

  + import Data.Thyme.Time

  + import Database.PostgreSQL.Simple

  + import Database.PostgreSQL.Simple.FromField

  + import Database.PostgreSQL.Simple.FromRow

  + import Database.PostgreSQL.Simple.SqlQQ

  + ( sql,

  + )

  + import Safe (headMay)

  + import Prelude hiding (null)

  +

  + eventTypeParser :: FieldParser (C.UTCTime -> LogEvent)

  + eventTypeParser f v = do

  + tn <- typename f

  + if tn /= "event_t"

  + then returnError Incompatible f "column was not of type event_t"

  + else

  + maybe

  + (returnError UnexpectedNull f "event type may not be null")

  + ( maybe (returnError Incompatible f "unrecognized event type value") pure

  + . nameEvent

  + . decodeUtf8

  + )

  + v

  +

  + logEntryParser :: RowParser LogEntry

  + logEntryParser =

  + LogEntry

  + <$> creditToParser

  + <*> (fieldWith eventTypeParser <*> utcParser)

  + <*> field

  +

  + keyedLogEntryParser :: RowParser KeyedLogEntry

  + keyedLogEntryParser =

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

  +

  + storeEvent :: DBOp a -> Maybe (DBM EventId)

  + storeEvent = \case

  + (CreateBillable uid b) ->

  + Just $ storeEventJSON (Just uid) "create_billable" (billableJSON b)

  + (CreateSubscription uid bid t) ->

  + Just $

  + storeEventJSON

  + (Just uid)

  + "create_subscription"

  + (createSubscriptionJSON uid bid t)

  + (StorePaymentRequest req) ->

  + Just $

  + storeEventJSON Nothing "create_payment_request" (nativeRequestJSON (req ^. nativeRequest))

  + (CreatePayment p) ->

  + Just $ do

  + nmode <- asks fst

  + storeEventJSON Nothing "create_payment" (paymentJSON nmode p)

  + _ -> Nothing

  +

  + storeEvent' :: DBOp a -> DBM EventId

  + storeEvent' = maybe (lift $ throwE EventStorageFailed) id . storeEvent

  +

  + type EventType = Text

  +

  + storeEventJSON :: Maybe UserId -> EventType -> Value -> DBM EventId

  + storeEventJSON uid etype v = do

  + timestamp <- liftIO C.getCurrentTime

  + pinsert

  + EventId

  + [sql| INSERT INTO aftok_events

  + (event_time, created_by, event_type, event_json)

  + VALUES (?, ?, ?, ?) RETURNING id |]

  + (fromThyme timestamp, preview (_Just . _UserId) uid, etype, v)

  +

  + createEvent :: ProjectId -> UserId -> LogEntry -> DBM EventId

  + createEvent (ProjectId pid) (UserId uid) (LogEntry c e m) = case c of

  + CreditToAccount aid' -> do

  + pinsert

  + EventId

  + [sql| INSERT INTO work_events

  + ( project_id, user_id, credit_to_type, credit_to_account,

  + , event_type, event_time, event_metadata )

  + VALUES (?, ?, ?, ?, ?, ?, ?)

  + RETURNING id |]

  + ( pid,

  + uid,

  + creditToName c,

  + aid' ^. _AccountId,

  + eventName e,

  + fromThyme $ e ^. eventTime,

  + m

  + )

  + CreditToProject pid' ->

  + pinsert

  + EventId

  + [sql| INSERT INTO work_events

  + ( project_id, user_id, credit_to_type, credit_to_project_id

  + , event_type, event_time, event_metadata )

  + VALUES (?, ?, ?, ?, ?, ?, ?)

  + RETURNING id |]

  + ( pid,

  + uid,

  + creditToName c,

  + pid' ^. _ProjectId,

  + eventName e,

  + fromThyme $ e ^. eventTime,

  + m

  + )

  + CreditToUser uid' ->

  + pinsert

  + EventId

  + [sql| INSERT INTO work_events

  + ( project_id, user_id, credit_to_type, credit_to_user_id

  + , event_type, event_time, event_metadata)

  + VALUES (?, ?, ?, ?, ?, ?, ?)

  + RETURNING id |]

  + ( pid,

  + uid,

  + creditToName c,

  + uid' ^. _UserId,

  + eventName e,

  + fromThyme $ e ^. eventTime,

  + m

  + )

  +

  + findEvent :: EventId -> DBM (Maybe KeyedLogEntry)

  + findEvent (EventId eid) = do

  + headMay

  + <$> pquery

  + keyedLogEntryParser

  + [sql| SELECT project_id, user_id,

  + credit_to_type, credit_to_account, credit_to_user_id, credit_to_project_id,

  + event_type, event_time, event_metadata FROM work_events

  + WHERE id = ? |]

  + (Only eid)

  +

  + findEvents :: ProjectId -> UserId -> RangeQuery -> Word32 -> DBM [LogEntry]

  + findEvents (ProjectId pid) (UserId uid) rquery limit = do

  + case rquery of

  + (Before e) ->

  + pquery

  + logEntryParser

  + [sql| SELECT credit_to_type,

  + credit_to_account, credit_to_user_id, credit_to_project_id,

  + event_type, event_time,

  + event_metadata

  + FROM work_events

  + WHERE project_id = ? AND user_id = ? AND event_time <= ?

  + ORDER BY event_time DESC

  + LIMIT ?

  + |]

  + (pid, uid, fromThyme e, limit)

  + (During s e) ->

  + pquery

  + logEntryParser

  + [sql| SELECT credit_to_type,

  + credit_to_account, credit_to_user_id, credit_to_project_id,

  + event_type, event_time, event_metadata

  + FROM work_events

  + WHERE project_id = ? AND user_id = ?

  + AND event_time >= ? AND event_time <= ?

  + ORDER BY event_time DESC

  + LIMIT ?

  + |]

  + (pid, uid, fromThyme s, fromThyme e, limit)

  + (After s) ->

  + pquery

  + logEntryParser

  + [sql| SELECT credit_to_type,

  + credit_to_account, credit_to_user_id, credit_to_project_id,

  + event_type, event_time, event_metadata

  + FROM work_events

  + WHERE project_id = ? AND user_id = ? AND event_time >= ?

  + ORDER BY event_time DESC

  + LIMIT ?

  + |]

  + (pid, uid, fromThyme s, limit)

  + (Always) ->

  + pquery

  + logEntryParser

  + [sql| SELECT credit_to_type,

  + credit_to_account, credit_to_user_id, credit_to_project_id,

  + event_type, event_time, event_metadata

  + FROM work_events

  + WHERE project_id = ? AND user_id = ?

  + ORDER BY event_time DESC

  + LIMIT ?

  + |]

  + (pid, uid, limit)

  +

  + amendEvent :: EventId -> EventAmendment -> DBM AmendmentId

  + amendEvent (EventId eid) = \case

  + (TimeChange mt t) ->

  + pinsert

  + AmendmentId

  + [sql| INSERT INTO event_time_amendments

  + (event_id, amended_at, event_time)

  + VALUES (?, ?, ?) RETURNING id |]

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

  + (CreditToChange mt c@(CreditToAccount acctId)) ->

  + pinsert

  + AmendmentId

  + [sql| INSERT INTO event_credit_to_amendments

  + (event_id, amended_at, credit_to_type, credit_to_account)

  + VALUES (?, ?, ?, ?) RETURNING id |]

  + (eid, fromThyme $ mt ^. _ModTime, creditToName c, acctId ^. _AccountId)

  + (CreditToChange mt c@(CreditToProject pid)) ->

  + pinsert

  + AmendmentId

  + [sql| INSERT INTO event_credit_to_amendments

  + (event_id, amended_at, credit_to_type, credit_to_project_id)

  + VALUES (?, ?, ?, ?) RETURNING id |]

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

  + (CreditToChange mt c@(CreditToUser uid)) ->

  + pinsert

  + AmendmentId

  + [sql| INSERT INTO event_credit_to_amendments

  + (event_id, amended_at, credit_to_type, credit_to_user_id)

  + VALUES (?, ?, ?, ?) RETURNING id |]

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

  + (MetadataChange mt v) ->

  + pinsert

  + AmendmentId

  + [sql| INSERT INTO event_metadata_amendments

  + (event_id, amended_at, event_metadata)

  + VALUES (?, ?, ?) RETURNING id |]

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

  +

  + readWorkIndex :: ProjectId -> DBM WorkIndex

  + readWorkIndex (ProjectId pid) = do

  + logEntries <-

  + pquery

  + logEntryParser

  + [sql| SELECT credit_to_type,

  + credit_to_account, credit_to_user_id, credit_to_project_id,

  + event_type, event_time, event_metadata

  + FROM work_events

  + WHERE project_id = ? |]

  + (Only pid)

  + pure $ workIndex logEntries
• file addition: Json.hs (----------)
  [5.6049]
  + {-# LANGUAGE TypeApplications #-}

  +

  + module Aftok.Database.PostgreSQL.Json where

  +

  + import Aftok.Currency.Bitcoin (NetworkMode, Satoshi (..), _Satoshi, getNetwork)

  + import qualified Aftok.Currency.Bitcoin.Payments as Bitcoin

  + import Aftok.Currency.Zcash (Zatoshi (..), _Zatoshi)

  + import qualified Aftok.Currency.Zcash.Payments as Zcash

  + import qualified Aftok.Currency.Zcash.Zip321 as Zip321

  + import Aftok.Json (idValue, obj, parseBtcAddr, v1)

  + import Aftok.Payments.Types

  + ( NativePayment (..),

  + NativeRequest (..),

  + Payment,

  + _PaymentRequestId,

  + nativePayment,

  + paymentDate,

  + paymentRequest,

  + )

  + -- import qualified Bippy.Proto as BP

  + import Control.Lens ((^.), (^?), _Just, review, to, view)

  + import Data.Aeson

  + import Data.Aeson.Types (Parser)

  + import qualified Data.ByteString.Base64 as B64

  + import Data.ProtocolBuffers (Decode, Encode, decodeMessage, encodeMessage)

  + import Data.Serialize.Get (runGet)

  + import Data.Serialize.Put (runPut)

  + import Data.Text (unpack)

  + -- import Data.Thyme.Calendar (showGregorian)

  + import Haskoin.Address (addrToText)

  +

  + protoBase64 :: Encode a => a -> Text

  + protoBase64 = B64.encodeBase64 . runPut . encodeMessage

  +

  + fromBase64Proto :: Decode a => Text -> Either Text a

  + fromBase64Proto t = (first toText . runGet decodeMessage) <=< B64.decodeBase64 $ encodeUtf8 t

  +

  + bip70PaymentRequestJSON :: Bitcoin.PaymentRequest -> Value

  + bip70PaymentRequestJSON r =

  + v1 . obj $

  + [ "bip70_request"

  + .= object

  + [ "payment_key" .= (r ^. Bitcoin.paymentRequestKey . Bitcoin._PaymentKey),

  + "payment_request_protobuf_64" .= (r ^. Bitcoin.bip70Request . to protoBase64)

  + ]

  + ]

  +

  + parseBip70PaymentRequestJSON :: Value -> Parser Bitcoin.PaymentRequest

  + parseBip70PaymentRequestJSON = \case

  + Object wrapper -> do

  + o <- wrapper .: "bip70_request"

  + Bitcoin.PaymentRequest

  + <$> (Bitcoin.PaymentKey <$> o .: "paymentKey")

  + <*> ( either (fail . toString) pure . fromBase64Proto =<< (o .: "payment_request_protobuf_64")

  + )

  + nonobject ->

  + fail $ "Value " <> show nonobject <> " is not a JSON object."

  +

  + zip321PaymentRequestJSON :: Zip321.PaymentRequest -> Value

  + zip321PaymentRequestJSON r =

  + v1 . obj $

  + ["zip321_request" .= (toJSON . Zip321.toURI $ r)]

  +

  + parseZip321PaymentRequestJSON :: Value -> Parser Zip321.PaymentRequest

  + parseZip321PaymentRequestJSON = \case

  + Object o ->

  + either fail pure . Zip321.parseURI =<< (o .: "zip321_request")

  + nonobject ->

  + fail $ "Value " <> show nonobject <> " is not a JSON object."

  +

  + nativeRequestJSON :: NativeRequest c -> Value

  + nativeRequestJSON = \case

  + Bip70Request r -> bip70PaymentRequestJSON r

  + Zip321Request r -> zip321PaymentRequestJSON r

  +

  + bitcoinPaymentJSON :: NetworkMode -> Bitcoin.Payment -> Value

  + bitcoinPaymentJSON nmode bp =

  + object

  + [ "amount" .= (bp ^? Bitcoin.amount . _Just . _Satoshi),

  + "txid" .= (bp ^. Bitcoin.txid),

  + "address" .= addrText,

  + "payment_key" .= (bp ^. Bitcoin.paymentKey . Bitcoin._PaymentKey),

  + "payment_protobuf_64" .= (bp ^. Bitcoin.bip70Payment . to protoBase64)

  + ]

  + where

  + addrText = addrToText (getNetwork nmode) <$> (bp ^. Bitcoin.address)

  +

  + parseBitcoinPaymentJSON :: NetworkMode -> Value -> Parser Bitcoin.Payment

  + parseBitcoinPaymentJSON nmode = \case

  + Object o ->

  + Bitcoin.Payment

  + <$> (fmap Satoshi <$> o .:? "amount")

  + <*> (o .:? "txid")

  + <*> (traverse (parseBtcAddr nmode) =<< o .:? "address")

  + <*> (Bitcoin.PaymentKey <$> o .: "paymentKey")

  + <*> ( either (fail . unpack) pure . fromBase64Proto =<< (o .: "payment_protobuf_64")

  + )

  + nonobject ->

  + fail $ "Value " <> show nonobject <> " is not a JSON object."

  +

  + zcashPaymentJSON :: Zcash.Payment -> Value

  + zcashPaymentJSON zp =

  + v1 . obj $

  + [ "amount" .= (zp ^. Zcash.amount . _Zatoshi),

  + "txid" .= (zp ^. Zcash.txid . Zcash._TxId)

  + ]

  +

  + parseZcashPaymentJSON :: Value -> Parser Zcash.Payment

  + parseZcashPaymentJSON = \case

  + (Object o) ->

  + Zcash.Payment

  + <$> (Zatoshi <$> o .: "amount")

  + <*> (review Zcash._TxId <$> o .: "txid")

  + val ->

  + fail $ "Value " <> show val <> " is not a JSON object."

  +

  + paymentJSON :: NetworkMode -> Payment c -> Value

  + paymentJSON nmode p =

  + v1 . obj $

  + [ "payment_request_id" .= idValue (paymentRequest . to getConst . _PaymentRequestId) p,

  + "payment_date" .= view paymentDate p,

  + "payment_value" .= nativePaymentValue

  + ]

  + where

  + nativePaymentValue :: Value

  + nativePaymentValue = case view nativePayment p of

  + BitcoinPayment bp -> bitcoinPaymentJSON nmode bp

  + ZcashPayment bp -> zcashPaymentJSON bp
• file addition: Projects.hs (----------)
  [5.6049]
  + {-# LANGUAGE QuasiQuotes #-}

  +

  + module Aftok.Database.PostgreSQL.Projects

  + ( createProject,

  + listProjects,

  + findProject,

  + findUserProjects,

  + addUserToProject,

  + createInvitation,

  + findInvitation,

  + acceptInvitation,

  + )

  + where

  +

  + import Aftok.Database

  + ( InvitedUID,

  + InvitingUID,

  + )

  + import Aftok.Database.PostgreSQL.Types

  + ( DBM,

  + SerDepFunction (..),

  + idParser,

  + pexec,

  + pinsert,

  + pquery,

  + ptransact,

  + utcParser,

  + )

  + import Aftok.Project

  + ( Invitation (..),

  + InvitationCode (..),

  + Project (..),

  + depf,

  + inceptionDate,

  + initiator,

  + projectName,

  + randomInvCode,

  + renderInvCode,

  + )

  + import Aftok.Types

  + ( Email (..),

  + ProjectId (..),

  + UserId (..),

  + _ProjectId,

  + _UserId,

  + )

  + import Control.Lens

  + import Data.Aeson (toJSON)

  + import qualified Data.Thyme.Time as C

  + import Database.PostgreSQL.Simple (Only (..))

  + import Database.PostgreSQL.Simple.FromField (fromJSONField)

  + import Database.PostgreSQL.Simple.FromRow (RowParser, field, fieldWith)

  + import Database.PostgreSQL.Simple.SqlQQ (sql)

  + import Safe (headMay)

  + import Prelude hiding (null)

  +

  + projectParser :: RowParser Project

  + projectParser =

  + Project

  + <$> field

  + <*> utcParser

  + <*> idParser UserId

  + <*> (unSerDepFunction <$> fieldWith fromJSONField)

  +

  + invitationParser :: RowParser Invitation

  + invitationParser =

  + Invitation

  + <$> idParser ProjectId

  + <*> idParser UserId

  + <*> fmap Email field

  + <*> utcParser

  + <*> fmap (fmap C.toThyme) field

  +

  + createProject :: Project -> DBM ProjectId

  + createProject p =

  + pinsert

  + ProjectId

  + [sql| INSERT INTO projects (project_name, inception_date, initiator_id, depreciation_fn)

  + VALUES (?, ?, ?, ?) RETURNING id |]

  + ( p ^. projectName,

  + p ^. (inceptionDate . to C.fromThyme),

  + p ^. (initiator . _UserId),

  + toJSON $ p ^. depf . to SerDepFunction

  + )

  +

  + listProjects :: DBM [ProjectId]

  + listProjects =

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

  +

  + findProject :: ProjectId -> DBM (Maybe Project)

  + findProject (ProjectId pid) =

  + headMay

  + <$> pquery

  + projectParser

  + [sql| SELECT project_name, inception_date, initiator_id, depreciation_fn FROM projects WHERE id = ? |]

  + (Only pid)

  +

  + findUserProjects :: UserId -> DBM [(ProjectId, Project)]

  + 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

  + FROM projects p LEFT OUTER JOIN project_companions pc ON pc.project_id = p.id

  + WHERE pc.user_id = ?

  + OR p.initiator_id = ?

  + ORDER BY p.inception_date, p.id |]

  + (uid, uid)

  +

  + addUserToProject :: ProjectId -> InvitingUID -> InvitedUID -> DBM ()

  + addUserToProject pid current new =

  + void $

  + pexec

  + [sql| INSERT INTO project_companions (project_id, user_id, invited_by) VALUES (?, ?, ?) |]

  + (pid ^. _ProjectId, new ^. _UserId, current ^. _UserId)

  +

  + createInvitation :: ProjectId -> InvitingUID -> Email -> C.UTCTime -> DBM InvitationCode

  + createInvitation (ProjectId pid) (UserId uid) (Email e) t = do

  + invCode <- liftIO randomInvCode

  + void $

  + pexec

  + [sql| INSERT INTO invitations (project_id, invitor_id, invitee_email, invitation_key, invitation_time)

  + VALUES (?, ?, ?, ?, ?) |]

  + (pid, uid, e, renderInvCode invCode, C.fromThyme t)

  + pure invCode

  +

  + findInvitation :: InvitationCode -> DBM (Maybe Invitation)

  + findInvitation ic =

  + headMay

  + <$> pquery

  + invitationParser

  + [sql| SELECT project_id, invitor_id, invitee_email, invitation_time, acceptance_time

  + FROM invitations WHERE invitation_key = ? |]

  + (Only $ renderInvCode ic)

  +

  + acceptInvitation :: UserId -> InvitationCode -> C.UTCTime -> DBM ()

  + acceptInvitation (UserId uid) ic t = ptransact $ do

  + void $

  + pexec

  + [sql| UPDATE invitations SET acceptance_time = ? WHERE invitation_key = ? |]

  + (C.fromThyme t, renderInvCode ic)

  + void $

  + pexec

  + [sql| INSERT INTO project_companions (project_id, user_id, invited_by, joined_at)

  + SELECT i.project_id, ?, i.invitor_id, ?

  + FROM invitations i

  + WHERE i.invitation_key = ? |]

  + (uid, C.fromThyme t, renderInvCode ic)
• replacement in lib/Aftok/Database/PostgreSQL/Types.hs at line 1
  [5.6073]→[5.6074:6119](∅→∅)
  − module Aftok.Database.PostgreSQL.Types where
  [5.6073]

  [5.6119]
  + {-# LANGUAGE GeneralizedNewtypeDeriving #-}

  +

  + module Aftok.Database.PostgreSQL.Types

  + ( DBM,

  + SerDepFunction (..),

  + pexec,

  + pinsert,

  + pquery,

  + ptransact,

  + askNetworkMode,

  + idParser,

  + utcParser,

  + nullField,

  + nominalDiffTimeParser,

  + creditToParser,

  + creditToName,

  + bitcoinAddressParser,

  + zcashAddressParser,

  + zcashIvkParser,

  + currencyAmountParser,

  + btcAmountParser,

  + zecAmountParser,

  + currencyType,

  + currencyValue,

  + )

  + where
• edit in lib/Aftok/Database/PostgreSQL/Types.hs at line 28
  [5.6120]

  [4.13894]
  + import Aftok.Currency (Amount (..), Currency (..))

  + import Aftok.Currency.Bitcoin (Satoshi (..), _Satoshi)

  + import qualified Aftok.Currency.Bitcoin as Bitcoin

  + import Aftok.Currency.Zcash (Zatoshi (..), _Zatoshi)

  + import qualified Aftok.Currency.Zcash as Zcash

  + import Aftok.Database (DBError)
• replacement in lib/Aftok/Database/PostgreSQL/Types.hs at line 38
  [4.13967]→[4.13967:14009](∅→∅)
  − import Aftok.Types (DepreciationFunction)
  [4.13967]

  [4.14009]
  + import Aftok.Types

  + ( AccountId (..),

  + CreditTo (..),

  + DepreciationFunction,

  + ProjectId (..),

  + UserId (..),

  + )

  + import Control.Lens ((^.))
• edit in lib/Aftok/Database/PostgreSQL/Types.hs at line 49
  [4.14063]

  [4.14063]
  + )

  + import qualified Data.List as L

  + import qualified Data.Text as T

  + import Data.Thyme.Clock as C

  + import Data.Thyme.Time as C

  + import Data.UUID (UUID)

  + import Database.PostgreSQL.Simple

  + ( Connection,

  + Query,

  + ResultError (Incompatible),

  + ToRow,

  + execute,

  + fromOnly,

  + query,

  + queryWith,

  + withTransaction,

  + )

  + import Database.PostgreSQL.Simple.FromField

  + ( FieldParser,

  + ResultError (ConversionFailed),

  + fromField,

  + returnError,

  + typename,
• edit in lib/Aftok/Database/PostgreSQL/Types.hs at line 73
  [4.14067]

  [5.6367]
  + import Database.PostgreSQL.Simple.FromRow (RowParser, field, fieldWith)

  + import Database.PostgreSQL.Simple.Types (Null)

  + import qualified Haskoin.Address as Bitcoin

  + import qualified Haskoin.Constants as Bitcoin
• edit in lib/Aftok/Database/PostgreSQL/Types.hs at line 85
  [5.6630]
  +

  + type DBM a = ReaderT (Bitcoin.NetworkMode, Connection) (ExceptT DBError IO) a

  +

  + pexec :: (ToRow d) => Query -> d -> DBM Int64

  + pexec q d = do

  + conn <- asks snd

  + lift . lift $ execute conn q d

  +

  + pinsert :: (ToRow d) => (UUID -> r) -> Query -> d -> DBM r

  + pinsert f q d = do

  + conn <- asks snd

  + ids <- lift . lift $ query conn q d

  + pure . f . fromOnly $ L.head ids

  +

  + pquery :: (ToRow d) => RowParser r -> Query -> d -> DBM [r]

  + pquery p q d = do

  + conn <- asks snd

  + lift . lift $ queryWith p conn q d

  +

  + ptransact :: DBM a -> DBM a

  + ptransact rt = do

  + env <- ask

  + lift . ExceptT $ withTransaction (snd env) (runExceptT $ runReaderT rt env)

  +

  + askNetworkMode :: DBM Bitcoin.NetworkMode

  + askNetworkMode = asks fst

  +

  + idParser :: (UUID -> a) -> RowParser a

  + idParser f = f <$> field

  +

  + utcParser :: RowParser C.UTCTime

  + utcParser = C.toThyme <$> field

  +

  + nullField :: RowParser Null

  + nullField = field

  +

  + nominalDiffTimeParser :: FieldParser NominalDiffTime

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

  +

  + creditToName :: CreditTo -> Text

  + creditToName (CreditToAccount _) = "credit_to_account"

  + creditToName (CreditToUser _) = "credit_to_user"

  + creditToName (CreditToProject _) = "credit_to_project"

  +

  + creditToParser :: RowParser CreditTo

  + creditToParser = join $ fieldWith creditToParser'

  +

  + creditToParser' :: FieldParser (RowParser CreditTo)

  + creditToParser' f v = do

  + tn <- typename f

  + if tn /= "credit_to_t"

  + then returnError Incompatible f "column was not of type credit_to_t"

  + else maybe empty (pure . parser . decodeUtf8) v

  + where

  + parser :: Text -> RowParser CreditTo

  + parser = \case

  + "credit_to_account" ->

  + CreditToAccount <$> (idParser AccountId <* nullField <* nullField)

  + "credit_to_user" ->

  + CreditToUser <$> (nullField *> idParser UserId <* nullField)

  + "credit_to_project" ->

  + CreditToProject

  + <$> (nullField *> nullField *> idParser ProjectId)

  + _ -> empty

  +

  + bitcoinAddressParser :: Bitcoin.NetworkMode -> RowParser Bitcoin.Address

  + bitcoinAddressParser nmode =

  + fieldWith $ addrFieldParser (Bitcoin.getNetwork nmode)

  + where

  + addrFieldParser :: Bitcoin.Network -> FieldParser Bitcoin.Address

  + addrFieldParser n f v = do

  + fieldValue <- fromField f v

  + let addrMay = Bitcoin.textToAddr n fieldValue

  + let err =

  + returnError

  + ConversionFailed

  + f

  + ( "could not deserialize value "

  + <> T.unpack fieldValue

  + <> " to a valid BTC address for network "

  + <> show n

  + )

  + maybe err pure addrMay

  +

  + btcAmountParser :: RowParser Satoshi

  + btcAmountParser = (Satoshi . fromInteger) <$> field

  +

  + zecAmountParser :: RowParser Zatoshi

  + zecAmountParser = (Zatoshi . fromInteger) <$> field

  +

  + currencyAmountParser :: RowParser Amount

  + currencyAmountParser = join $ fieldWith currencyAmountParser'

  +

  + currencyAmountParser' :: FieldParser (RowParser Amount)

  + currencyAmountParser' f v = do

  + tn <- typename f

  + if tn /= "currency_t"

  + then returnError Incompatible f "column was not of type currency_t"

  + else maybe empty (pure . parser . decodeUtf8) v

  + where

  + parser :: Text -> RowParser Amount

  + parser = \case

  + "ZEC" -> Amount ZEC <$> zecAmountParser

  + "BTC" -> Amount BTC <$> btcAmountParser

  + _ -> empty

  +

  + -- TODO: address validation here?

  + zcashAddressParser :: RowParser Zcash.Address

  + zcashAddressParser = Zcash.Address <$> field

  +

  + -- TODO: ivk validation here?

  + zcashIvkParser :: RowParser Zcash.IVK

  + zcashIvkParser = Zcash.IVK <$> field

  +

  + currencyType :: Amount -> Text

  + currencyType = \case

  + Amount BTC _ -> "BTC"

  + Amount ZEC _ -> "ZEC"

  +

  + currencyValue :: Amount -> Word64

  + currencyValue = \case

  + Amount BTC sats -> sats ^. _Satoshi

  + Amount ZEC zats -> zats ^. _Zatoshi
• file addition: Users.hs (----------)
  [5.6049]
  + {-# LANGUAGE GADTs #-}

  + {-# LANGUAGE GeneralizedNewtypeDeriving #-}

  + {-# LANGUAGE LambdaCase #-}

  + {-# LANGUAGE QuasiQuotes #-}

  +

  + module Aftok.Database.PostgreSQL.Users

  + ( createUser,

  + findUser,

  + findUserByName,

  + findUserPaymentAddress,

  + findAccountPaymentAddress,

  + findAccountZcashIVK,

  + )

  + where

  +

  + import Aftok.Currency (Currency (..))

  + import qualified Aftok.Currency.Zcash as Zcash

  + import Aftok.Database ()

  + import Aftok.Database.PostgreSQL.Types

  + ( DBM,

  + askNetworkMode,

  + bitcoinAddressParser,

  + idParser,

  + pinsert,

  + pquery,

  + zcashAddressParser,

  + zcashIvkParser,

  + )

  + import Aftok.Types

  + import Control.Lens

  + import Database.PostgreSQL.Simple

  + import Database.PostgreSQL.Simple.FromRow

  + import Database.PostgreSQL.Simple.SqlQQ

  + ( sql,

  + )

  + import Safe (headMay)

  + import Prelude hiding (null)

  +

  + userParser :: RowParser User

  + userParser = do

  + uname <- UserName <$> field

  + remail <- fmap (RecoverByEmail . Email) <$> field

  + rzaddr <- fmap (RecoverByZAddr . Zcash.Address) <$> field

  + User uname <$> maybe empty pure (remail <|> rzaddr)

  +

  + createUser :: User -> DBM UserId

  + createUser user' = do

  + pinsert

  + UserId

  + [sql| INSERT INTO users (handle, recovery_email, recovery_zaddr)

  + VALUES (?, ?, ?) RETURNING id |]

  + ( user' ^. (username . _UserName),

  + user' ^? userAccountRecovery . _RecoverByEmail . _Email,

  + user' ^? userAccountRecovery . _RecoverByZAddr . Zcash._Address

  + )

  +

  + findUser :: UserId -> DBM (Maybe User)

  + findUser (UserId uid) = do

  + headMay

  + <$> pquery

  + userParser

  + [sql| SELECT handle, recovery_email, recovery_zaddr FROM users WHERE id = ? |]

  + (Only uid)

  +

  + findUserByName :: UserName -> DBM (Maybe (UserId, User))

  + findUserByName (UserName h) = do

  + headMay

  + <$> pquery

  + ((,) <$> idParser UserId <*> userParser)

  + [sql| SELECT id, handle, recovery_email, recovery_zaddr FROM users WHERE handle = ? |]

  + (Only h)

  +

  + findUserPaymentAddress :: UserId -> Currency a c -> DBM (Maybe a)

  + findUserPaymentAddress uid = \case

  + BTC -> do

  + mode <- askNetworkMode

  + headMay

  + <$> pquery

  + (bitcoinAddressParser mode)

  + [sql| SELECT btc_addr FROM cryptocurrency_accounts

  + WHERE user_id = ?

  + AND currency = 'BTC'

  + AND is_primary = true |]

  + (Only $ view _UserId uid)

  + ZEC -> do

  + headMay

  + <$> pquery

  + (zcashAddressParser)

  + [sql| SELECT zcash_addr FROM cryptocurrency_accounts

  + WHERE user_id = ?

  + AND currency = 'ZEC'

  + AND is_primary = true |]

  + (Only $ view _UserId uid)

  +

  + findAccountPaymentAddress :: AccountId -> Currency a c -> DBM (Maybe a)

  + findAccountPaymentAddress aid = \case

  + BTC -> do

  + mode <- askNetworkMode

  + headMay

  + <$> pquery

  + (bitcoinAddressParser mode)

  + [sql| SELECT btc_addr FROM cryptocurrency_accounts

  + WHERE id = ?

  + AND btc_addr IS NOT NULL |]

  + (Only $ view _AccountId aid)

  + ZEC -> do

  + headMay

  + <$> pquery

  + (zcashAddressParser)

  + [sql| SELECT zcash_addr FROM cryptocurrency_accounts

  + WHERE id = ?

  + AND zcash_addr IS NOT NULL |]

  + (Only $ view _AccountId aid)

  +

  + -- TODO: rework this for the case where someone wants to

  + -- use new diversified addresses for each purchase?

  +

  + findAccountZcashIVK :: AccountId -> DBM (Maybe Zcash.IVK)

  + findAccountZcashIVK aid =

  + headMay

  + <$> pquery

  + (zcashIvkParser)

  + [sql| SELECT zcash_ivk FROM cryptocurrency_accounts

  + WHERE id = ?

  + AND zcash_ivk IS NOT NULL |]

  + (Only $ view _AccountId aid)
• replacement in lib/Aftok/Database/PostgreSQL.hs at line 12
  [5.623]→[4.14264:14415](∅→∅)
  − import qualified Aftok.Auction as A

  − import qualified Aftok.Billing as B

  − import Aftok.Currency.Bitcoin

  − import Aftok.Currency.Zcash (ZAddr (..), _ZAddr)
  [5.623]

  [4.14415]
  + import qualified Aftok.Currency.Bitcoin as Bitcoin
• replacement in lib/Aftok/Database/PostgreSQL.hs at line 14
  [4.14437]→[4.14437:14794](∅→∅)
  − 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
  [4.14437]

  [4.14794]
  + import qualified Aftok.Database.PostgreSQL.Auctions as Q

  + import qualified Aftok.Database.PostgreSQL.Billing as Q

  + import qualified Aftok.Database.PostgreSQL.Events as Q

  + import qualified Aftok.Database.PostgreSQL.Projects as Q

  + import qualified Aftok.Database.PostgreSQL.Users as Q
• edit in lib/Aftok/Database/PostgreSQL.hs at line 24
  [4.14905]→[4.14905:15252](∅→∅)
  − 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)
• edit in lib/Aftok/Database/PostgreSQL.hs at line 25
  [4.15286]→[4.15286:15608](∅→∅)
  − 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)
• replacement in lib/Aftok/Database/PostgreSQL.hs at line 27
  [5.1124]→[5.7077:7158](∅→∅)
  − newtype QDBM a = QDBM (ReaderT (NetworkMode, Connection) (ExceptT DBError IO) a)
  [5.1012]

  [5.264]
  + newtype QDBM a = QDBM (ReaderT (Bitcoin.NetworkMode, Connection) (ExceptT DBError IO) a)
• replacement in lib/Aftok/Database/PostgreSQL.hs at line 39
  [5.343]→[5.7159:7230](∅→∅)
  − runQDBM :: NetworkMode -> Connection -> QDBM a -> ExceptT DBError IO a
  [5.343]

  [5.7230]
  + runQDBM :: Bitcoin.NetworkMode -> Connection -> QDBM a -> ExceptT DBError IO a
• edit in lib/Aftok/Database/PostgreSQL.hs at line 41
  [5.224]→[5.1215:1216](∅→∅),[5.240]→[5.1215:1216](∅→∅),[5.7323]→[5.1215:1216](∅→∅),[5.15670]→[5.1215:1216](∅→∅),[5.1215]→[5.1215:1216](∅→∅),[5.1216]→[5.1472:1536](∅→∅),[5.1536]→[5.1461:1462](∅→∅),[5.1932]→[5.1461:1462](∅→∅),[5.1461]→[5.1461:1462](∅→∅),[5.1462]→[5.7324:7497](∅→∅),[5.7497]→[4.15638:15774](∅→∅),[4.15774]→[5.15795:15819](∅→∅),[5.15795]→[5.15795:15819](∅→∅),[5.15819]→[5.7630:7631](∅→∅),[5.7630]→[5.7630:7631](∅→∅),[5.7631]→[5.1370:1463](∅→∅),[5.1463]→[5.7718:7761](∅→∅),[5.7718]→[5.7718:7761](∅→∅),[5.7761]→[4.15775:15843](∅→∅),[4.15843]→[5.7829:7935](∅→∅),[5.15890]→[5.7829:7935](∅→∅),[5.7829]→[5.7829:7935](∅→∅),[5.7935]→[5.382:412](∅→∅),[5.412]→[5.58323:58363](∅→∅),[5.58363]→[4.15844:16087](∅→∅),[5.186]→[5.2131:2156](∅→∅),[5.564]→[5.2131:2156](∅→∅),[5.1307]→[5.2131:2156](∅→∅),[5.16035]→[5.2131:2156](∅→∅),[4.16087]→[5.2131:2156](∅→∅),[5.2131]→[5.2131:2156](∅→∅),[5.2156]→[5.1545:1546](∅→∅),[5.2363]→[5.1545:1546](∅→∅),[5.1545]→[5.1545:1546](∅→∅),[5.1546]→[5.2157:2234](∅→∅),[5.62]→[5.57:58](∅→∅),[5.568]→[5.57:58](∅→∅),[5.2234]→[5.57:58](∅→∅),[5.51]→[5.57:58](∅→∅),[5.58]→[5.2235:2298](∅→∅),[5.2298]→[5.66:114](∅→∅),[5.1910]→[5.66:114](∅→∅),[5.1832]→[5.114:213](∅→∅),[5.114]→[5.114:213](∅→∅),[5.213]→[5.1833:1923](∅→∅),[5.1923]→[4.16088:16328](∅→∅),[5.8188]→[5.2299:2353](∅→∅),[5.16250]→[5.2299:2353](∅→∅),[4.16328]→[5.2299:2353](∅→∅),[5.2025]→[5.2299:2353](∅→∅),[5.2353]→[5.16251:16312](∅→∅),[5.892]→[5.271:272](∅→∅),[5.1910]→[5.271:272](∅→∅),[5.2025]→[5.271:272](∅→∅),[5.2417]→[5.271:272](∅→∅),[5.16312]→[5.271:272](∅→∅),[5.271]→[5.271:272](∅→∅),[5.272]→[5.8189:8326](∅→∅),[5.8326]→[5.293:294](∅→∅),[5.293]→[5.293:294](∅→∅),[5.294]→[4.16329:16421](∅→∅),[4.16421]→[5.4201:4400](∅→∅),[5.16405]→[5.4201:4400](∅→∅),[5.4400]→[4.16422:16873](∅→∅),[5.1735]→[5.1409:1410](∅→∅),[5.2618]→[5.1409:1410](∅→∅),[5.4775]→[5.1409:1410](∅→∅),[4.16873]→[5.1409:1410](∅→∅),[5.17038]→[5.1409:1410](∅→∅),[5.1409]→[5.1409:1410](∅→∅),[5.1410]→[5.8868:8965](∅→∅),[5.8965]→[5.17039:17142](∅→∅),[5.424]→[5.2597:2598](∅→∅),[5.17142]→[5.2597:2598](∅→∅),[5.2597]→[5.2597:2598](∅→∅),[5.2598]→[4.16874:16959](∅→∅),[4.16959]→[5.9084:9109](∅→∅),[5.17228]→[5.9084:9109](∅→∅),[5.9084]→[5.9084:9109](∅→∅),[5.9109]→[5.17229:17303](∅→∅),[5.9171]→[5.2021:2022](∅→∅),[5.17303]→[5.2021:2022](∅→∅),[5.121]→[5.2021:2022](∅→∅),[5.2022]→[5.2619:2656](∅→∅),[5.2656]→[5.2023:2039](∅→∅),[5.652]→[5.2023:2039](∅→∅),[5.2039]→[5.17304:17439](∅→∅),[5.724]→[5.2729:2730](∅→∅),[5.2178]→[5.2729:2730](∅→∅),[5.2864]→[5.2729:2730](∅→∅),[5.2873]→[5.2729:2730](∅→∅),[5.17439]→[5.2729:2730](∅→∅),[5.2729]→[5.2729:2730](∅→∅),[5.2730]→[5.2874:2903](∅→∅),[5.2903]→[5.2040:2052](∅→∅),[5.752]→[5.2040:2052](∅→∅),[5.2052]→[5.17440:17520](∅→∅),[5.878]→[5.2828:2829](∅→∅),[5.2209]→[5.2828:2829](∅→∅),[5.2963]→[5.2828:2829](∅→∅),[5.3036]→[5.2828:2829](∅→∅),[5.17520]→[5.2828:2829](∅→∅),[5.2828]→[5.2828:2829](∅→∅),[5.2829]→[5.1542:1584](∅→∅),[5.1584]→[5.17521:17557](∅→∅),[5.9273]→[5.17521:17557](∅→∅),[5.17557]→[4.16960:17122](∅→∅),[5.1115]→[5.3061:3062](∅→∅),[5.1749]→[5.3061:3062](∅→∅),[4.17122]→[5.3061:3062](∅→∅),[5.17659]→[5.3061:3062](∅→∅),[5.3061]→[5.3061:3062](∅→∅),[5.3062]→[5.3037:3074](∅→∅),[5.3074]→[5.2208:2224](∅→∅),[5.1151]→[5.2208:2224](∅→∅),[5.2224]→[5.17660:17783](∅→∅),[5.460]→[5.313:314](∅→∅),[5.1244]→[5.313:314](∅→∅),[5.3209]→[5.313:314](∅→∅),[5.9417]→[5.313:314](∅→∅),[5.17783]→[5.313:314](∅→∅),[5.313]→[5.313:314](∅→∅),[5.314]→[5.3210:3253](∅→∅),[5.3253]→[5.2279:2298](∅→∅),[5.2317]→[5.2279:2298](∅→∅),[5.2298]→[5.17784:17927](∅→∅),[5.17927]→[5.3458:3459](∅→∅),[5.1361]→[5.3458:3459](∅→∅),[5.3459]→[5.3216:3255](∅→∅),[5.3255]→[5.3499:3516](∅→∅),[5.3499]→[5.3499:3516](∅→∅),[5.3516]→[5.17928:18161](∅→∅),[5.14078]→[5.3516:3624](∅→∅),[5.18161]→[5.3516:3624](∅→∅),[5.3516]→[5.3516:3624](∅→∅),[5.3624]→[5.2238:2308](∅→∅),[5.2308]→[4.17123:17164](∅→∅),[4.17164]→[5.2350:2408](∅→∅),[5.2350]→[5.2350:2408](∅→∅),[5.2408]→[4.17165:17293](∅→∅),[4.17293]→[5.3941:3989](∅→∅),[5.3941]→[5.3941:3989](∅→∅),[5.3989]→[5.1421:1442](∅→∅),[5.1442]→[5.18162:18233](∅→∅),[5.18233]→[5.3870:3913](∅→∅),[5.3913]→[5.18233:18296](∅→∅),[5.18233]→[5.18233:18296](∅→∅),[5.18296]→[5.2247:2297](∅→∅),[5.4146]→[5.2247:2297](∅→∅),[5.2297]→[5.1443:1466](∅→∅),[5.1466]→[5.18297:18451](∅→∅),[5.18451]→[4.17294:17348](∅→∅),[5.461]→[5.2528:2564](∅→∅),[4.17348]→[5.2528:2564](∅→∅),[5.18511]→[5.2528:2564](∅→∅),[5.2528]→[5.2528:2564](∅→∅),[5.2564]→[5.1467:1483](∅→∅),[5.1483]→[5.18512:18672](∅→∅),[5.285]→[5.293:294](∅→∅),[5.1361]→[5.293:294](∅→∅),[5.2726]→[5.293:294](∅→∅),[5.3748]→[5.293:294](∅→∅),[5.4146]→[5.293:294](∅→∅),[5.18672]→[5.293:294](∅→∅),[5.293]→[5.293:294](∅→∅),[5.294]→[5.2349:2396](∅→∅),[5.2396]→[5.505:527](∅→∅),[5.1410]→[5.505:527](∅→∅),[5.527]→[5.9494:9513](∅→∅),[5.9513]→[5.2532:2565](∅→∅),[5.1439]→[5.2532:2565](∅→∅),[5.1465]→[5.620:621](∅→∅),[5.2565]→[5.620:621](∅→∅),[5.620]→[5.620:621](∅→∅),[5.621]→[5.2397:2457](∅→∅),[5.2457]→[5.528:554](∅→∅),[5.1527]→[5.528:554](∅→∅),[5.554]→[5.9514:9533](∅→∅),[5.9533]→[4.17349:17387](∅→∅),[5.2605]→[5.1579:1614](∅→∅),[4.17387]→[5.1579:1614](∅→∅),[5.1579]→[5.1579:1614](∅→∅),[5.1614]→[5.1257:1258](∅→∅),[5.1257]→[5.1257:1258](∅→∅),[5.1258]→[5.1615:1676](∅→∅),[5.1676]→[5.555:580](∅→∅),[5.580]→[5.9534:9553](∅→∅),[5.9553]→[5.2620:2726](∅→∅),[5.2620]→[5.2620:2726](∅→∅),[5.2726]→[5.9554:9645](∅→∅)
  −

  − idParser :: (UUID -> a) -> RowParser a

  − idParser f = f <$> field

  −

  − networkIdParser :: FieldParser NetworkId

  − networkIdParser f b = do

  − networkName <- fromField f b

  − case networkName of

  − Just "btc" -> pure BTC

  − Just "bch" -> pure BCH

  − Just other ->

  − returnError

  − ConversionFailed

  − f

  − ("Network identifier " <> other <> " is not supported.")

  − Nothing -> pure BTC

  −

  − btcAddressParser :: NetworkMode -> RowParser (NetworkId, Address)

  − btcAddressParser mode = do

  − networkId <- fieldWith (networkIdParser)

  − address <- fieldWith $ addrFieldParser (toNetwork mode networkId)

  − pure (networkId, address)

  −

  − addrFieldParser :: Network -> FieldParser Address

  − addrFieldParser n f v = do

  − fieldValue <- fromField f v

  − let addrMay = textToAddr n fieldValue

  − let err =

  − returnError

  − ConversionFailed

  − f

  − ( "could not deserialize value "

  − <> T.unpack fieldValue

  − <> " to a valid BTC address for network "

  − <> show n

  − )

  − maybe err pure addrMay

  −

  − btcParser :: RowParser Satoshi

  − btcParser = (Satoshi . fromInteger) <$> field

  −

  − utcParser :: RowParser C.UTCTime

  − utcParser = toThyme <$> field

  −

  − nullField :: RowParser Null

  − nullField = field

  −

  − eventTypeParser :: FieldParser (C.UTCTime -> LogEvent)

  − eventTypeParser f v = do

  − tn <- typename f

  − if tn /= "event_t"

  − then returnError Incompatible f "column was not of type event_t"

  − else

  − maybe

  − (returnError UnexpectedNull f "event type may not be null")

  − ( maybe (returnError Incompatible f "unrecognized event type value") pure

  − . nameEvent

  − . decodeUtf8

  − )

  − v

  −

  − nominalDiffTimeParser :: FieldParser NominalDiffTime

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

  −

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

  − creditToParser mode = join $ fieldWith (creditToParser' mode)

  −

  − creditToParser' ::

  − NetworkMode -> FieldParser (RowParser (CreditTo (NetworkId, Address)))

  − creditToParser' mode f v = do

  − tn <- typename f

  − if tn /= "credit_to_t"

  − then returnError Incompatible f "column was not of type credit_to_t"

  − else maybe empty (pure . parser . decodeUtf8) v

  − 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

  −

  − logEntryParser :: NetworkMode -> RowParser (LogEntry (NetworkId, Address))

  − logEntryParser mode =

  − LogEntry

  − <$> creditToParser mode

  − <*> (fieldWith eventTypeParser <*> utcParser)

  − <*> field

  −

  − qdbLogEntryParser ::

  − NetworkMode -> RowParser (KeyedLogEntry (NetworkId, Address))

  − qdbLogEntryParser mode =

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

  −

  − auctionParser :: RowParser A.Auction

  − auctionParser =

  − A.Auction

  − <$> idParser ProjectId

  − <*> idParser UserId

  − <*> utcParser

  − <*> btcParser

  − <*> utcParser

  − <*> utcParser

  −

  − bidParser :: RowParser A.Bid

  − bidParser =

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

  −

  − userParser :: RowParser User

  − userParser =

  − User

  − <$> (UserName <$> field)

  − <*> ( (maybe empty pure =<< fmap (RecoverByEmail . Email) <$> field)

  − <|> (maybe empty pure =<< fmap (RecoverByZAddr . ZAddr) <$> field)

  − )

  −

  − projectParser :: RowParser P.Project

  − projectParser =

  − P.Project

  − <$> field

  − <*> utcParser

  − <*> idParser UserId

  − <*> (unSerDepFunction <$> fieldWith fromJSONField)

  −

  − invitationParser :: RowParser P.Invitation

  − invitationParser =

  − P.Invitation

  − <$> idParser ProjectId

  − <*> idParser UserId

  − <*> fmap Email field

  − <*> utcParser

  − <*> fmap (fmap toThyme) field

  −

  − billableParser :: RowParser B.Billable

  − billableParser =

  − B.Billable

  − <$> idParser ProjectId

  − <*> idParser UserId

  − <*> field

  − <*> field

  − <*> recurrenceParser

  − <*> btcParser

  − <*> field

  − <*> fieldWith (optionalField nominalDiffTimeParser)

  − <*> field

  − <*> field

  −

  − recurrenceParser :: RowParser B.Recurrence

  − recurrenceParser =

  − let prec :: Text -> RowParser B.Recurrence

  − prec = \case

  − "annually" -> nullField *> pure B.Annually

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

  − --"semimonthly" = nullField *> pure B.SemiMonthly

  − "weekly" -> B.Weekly <$> field

  − "onetime" -> nullField *> pure B.OneTime

  − _ -> empty

  − in field >>= prec

  −

  − subscriptionParser :: RowParser B.Subscription

  − subscriptionParser =

  − B.Subscription

  − <$> idParser UserId

  − <*> idParser B.BillableId

  − <*> (B.EmailChannel . Email <$> field)

  − <*> (toThyme <$> field)

  − <*> ((fmap toThyme) <$> field)

  −

  − paymentRequestParser :: RowParser PaymentRequest

  − paymentRequestParser =

  − PaymentRequest

  − <$> fmap B.SubscriptionId field

  − <*> ((either (const empty) pure . runGet decodeMessage) =<< field)

  − <*> fmap PaymentKey field

  − <*> fmap toThyme field

  − <*> fmap toThyme field

  −

  − paymentParser :: RowParser Payment

  − paymentParser =

  − Payment

  − <$> (PaymentRequestId <$> field)

  − <*> (field >>= (either (const empty) pure . runGet decodeMessage))

  − <*> (toThyme <$> field)

  − <*> field

  −

  − pexec :: (ToRow d) => Query -> d -> QDBM Int64

  − pexec q d = QDBM $ do

  − conn <- asks snd

  − lift . lift $ execute conn q d

  −

  − pinsert :: (ToRow d) => (UUID -> r) -> Query -> d -> QDBM r

  − pinsert f q d = QDBM $ do

  − conn <- asks snd

  − ids <- lift . lift $ query conn q d

  − pure . f . fromOnly $ L.head ids

  −

  − pquery :: (ToRow d) => RowParser r -> Query -> d -> QDBM [r]

  − pquery p q d = QDBM $ do

  − conn <- asks snd

  − lift . lift $ queryWith p conn q d

  −

  − transactQDBM :: QDBM a -> QDBM a

  − transactQDBM (QDBM rt) = QDBM $ do

  − env <- ask

  − lift . ExceptT $ withTransaction (snd env) (runExceptT $ runReaderT rt env)
• edit in lib/Aftok/Database/PostgreSQL.hs at line 42
  [5.1362]→[5.3749:3794](∅→∅),[5.3794]→[5.1377:1413](∅→∅),[5.1413]→[5.462:532](∅→∅),[5.532]→[4.17388:17672](∅→∅),[4.17672]→[5.747:847](∅→∅),[5.249]→[5.747:847](∅→∅),[5.351]→[5.4029:4052](∅→∅),[5.506]→[5.4029:4052](∅→∅),[5.4029]→[5.4029:4052](∅→∅),[5.4052]→[5.507:531](∅→∅),[5.531]→[5.848:917](∅→∅),[5.917]→[5.594:661](∅→∅),[5.594]→[5.594:661](∅→∅),[5.661]→[5.18937:18959](∅→∅),[5.18959]→[5.9664:9758](∅→∅),[5.9664]→[5.9664:9758](∅→∅),[5.9758]→[5.14269:14315](∅→∅),[5.14269]→[5.14269:14315](∅→∅),[5.14315]→[5.918:981](∅→∅),[5.806]→[5.918:981](∅→∅),[5.981]→[5.9759:9828](∅→∅),[5.854]→[5.425:426](∅→∅),[5.981]→[5.425:426](∅→∅),[5.1986]→[5.425:426](∅→∅),[5.3302]→[5.425:426](∅→∅),[5.4052]→[5.425:426](∅→∅),[5.9828]→[5.425:426](∅→∅),[5.425]→[5.425:426](∅→∅)
  − storeEvent :: DBOp a -> Maybe (QDBM EventId)

  − storeEvent (CreateBillable uid b) =

  − Just $ storeEventJSON (Just uid) "create_billable" (billableJSON b)

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

  − storeEvent (CreatePayment req) =

  − Just $ storeEventJSON Nothing "create_payment" (paymentJSON req)

  − storeEvent _ = Nothing

  −

  − type EventType = Text

  −

  − storeEventJSON :: Maybe UserId -> EventType -> Value -> QDBM EventId

  − storeEventJSON uid t v = do

  − timestamp <- liftIO C.getCurrentTime

  − pinsert

  − EventId

  − [sql| INSERT INTO aftok_events

  − (event_time, created_by, event_type, event_json)

  − VALUES (?, ?, ?, ?) RETURNING id |]

  − (fromThyme timestamp, preview (_Just . _UserId) uid, t, v)

  −

  − askNetworkMode :: QDBM NetworkMode

  − askNetworkMode = QDBM $ asks fst

  −
• replacement in lib/Aftok/Database/PostgreSQL.hs at line 43
  [5.4296]→[5.18960:19202](∅→∅),[5.19202]→[5.4:94](∅→∅),[5.94]→[5.10067:10167](∅→∅),[5.14449]→[5.10067:10167](∅→∅),[5.10167]→[5.14551:14581](∅→∅),[5.14551]→[5.14551:14581](∅→∅),[5.14581]→[4.17673:17852](∅→∅),[4.17852]→[5.19349:19357](∅→∅),[5.19349]→[5.19349:19357](∅→∅),[5.19357]→[4.17853:17941](∅→∅),[5.10399]→[5.14644:14718](∅→∅),[4.17941]→[5.14644:14718](∅→∅),[5.19438]→[5.14644:14718](∅→∅),[5.14644]→[5.14644:14718](∅→∅),[5.14718]→[5.10400:10500](∅→∅),[5.10500]→[5.14820:14850](∅→∅),[5.14820]→[5.14820:14850](∅→∅),[5.14850]→[4.17942:18180](∅→∅),[4.18180]→[5.10662:10816](∅→∅),[5.19648]→[5.10662:10816](∅→∅),[5.10662]→[5.10662:10816](∅→∅),[5.10816]→[5.15069:15099](∅→∅),[5.15069]→[5.15069:15099](∅→∅),[5.15099]→[4.18181:18331](∅→∅),[4.18331]→[5.10817:10880](∅→∅),[5.3406]→[5.10817:10880](∅→∅),[5.10880]→[4.18332:18428](∅→∅),[4.18428]→[5.565:694](∅→∅),[5.10964]→[5.565:694](∅→∅),[5.694]→[5.11057:11130](∅→∅),[5.11057]→[5.11057:11130](∅→∅),[5.11130]→[5.15347:15373](∅→∅),[5.15347]→[5.15347:15373](∅→∅),[5.15373]→[4.18429:18446](∅→∅),[4.18446]→[5.2262:2329](∅→∅),[5.1084]→[5.2262:2329](∅→∅),[5.2329]→[5.11190:11215](∅→∅),[5.11190]→[5.11190:11215](∅→∅),[5.11215]→[5.2330:2347](∅→∅),[5.2347]→[4.18447:18545](∅→∅),[4.18545]→[5.730:830](∅→∅),[5.730]→[5.730:830](∅→∅),[5.830]→[5.11362:11474](∅→∅),[5.19984]→[5.11362:11474](∅→∅),[5.11362]→[5.11362:11474](∅→∅),[5.11474]→[5.2373:2522](∅→∅),[5.2522]→[4.18546:18685](∅→∅),[4.18685]→[5.866:966](∅→∅),[5.866]→[5.866:966](∅→∅),[5.966]→[5.11624:11766](∅→∅),[5.20166]→[5.11624:11766](∅→∅),[5.11624]→[5.11624:11766](∅→∅),[5.11766]→[5.2587:2719](∅→∅),[5.2719]→[4.18686:18835](∅→∅),[4.18835]→[5.7432:7617](∅→∅),[5.1002]→[5.7432:7617](∅→∅),[5.7617]→[5.2794:2935](∅→∅),[5.2935]→[4.18836:18971](∅→∅),[4.18971]→[5.3058:3399](∅→∅),[5.3058]→[5.3058:3399](∅→∅),[5.3399]→[4.18972:19122](∅→∅),[4.19122]→[5.12081:12126](∅→∅),[5.20508]→[5.12081:12126](∅→∅),[5.12081]→[5.12081:12126](∅→∅),[5.12126]→[5.16476:16519](∅→∅),[5.16476]→[5.16476:16519](∅→∅),[5.16519]→[4.19123:19174](∅→∅),[4.19174]→[5.12127:12213](∅→∅),[5.2904]→[5.12127:12213](∅→∅),[5.4576]→[5.6673:6685](∅→∅),[5.12213]→[5.6673:6685](∅→∅),[5.6673]→[5.6673:6685](∅→∅),[5.6685]→[5.12214:12292](∅→∅),[5.12292]→[5.20559:20593](∅→∅),[5.20593]→[5.12318:12371](∅→∅),[5.12318]→[5.12318:12371](∅→∅),[5.12371]→[5.124:215](∅→∅),[5.215]→[5.16675:16725](∅→∅),[5.12444]→[5.16675:16725](∅→∅),[5.16675]→[5.16675:16725](∅→∅),[5.16725]→[4.19175:19319](∅→∅),[4.19319]→[5.20706:20716](∅→∅),[5.58431]→[5.20706:20716](∅→∅),[5.20706]→[5.20706:20716](∅→∅),[5.20716]→[4.19320:19434](∅→∅),[4.19434]→[5.12612:12687](∅→∅),[5.20821]→[5.12612:12687](∅→∅),[5.12612]→[5.12612:12687](∅→∅),[5.12687]→[5.16883:16933](∅→∅),[5.16883]→[5.16883:16933](∅→∅),[5.16933]→[4.19435:19623](∅→∅),[4.19623]→[5.12847:12919](∅→∅),[5.20999]→[5.12847:12919](∅→∅),[5.12847]→[5.12847:12919](∅→∅),[5.12919]→[5.17088:17138](∅→∅),[5.17088]→[5.17088:17138](∅→∅),[5.17138]→[4.19624:19830](∅→∅),[4.19830]→[5.12990:13039](∅→∅),[5.21199]→[5.12990:13039](∅→∅),[5.12990]→[5.12990:13039](∅→∅),[5.13039]→[5.17261:17304](∅→∅),[5.17261]→[5.17261:17304](∅→∅),[5.17304]→[4.19831:19872](∅→∅),[4.19872]→[5.13040:13084](∅→∅),[5.4862]→[5.13040:13084](∅→∅),[5.13084]→[4.19873:19988](∅→∅),[4.19988]→[5.1136:1232](∅→∅),[5.1136]→[5.1136:1232](∅→∅),[5.1232]→[5.13247:13330](∅→∅),[5.13247]→[5.13247:13330](∅→∅),[5.13330]→[5.17523:17557](∅→∅),[5.17523]→[5.17523:17557](∅→∅),[5.17557]→[4.19989:20006](∅→∅),[4.20006]→[5.8047:8077](∅→∅),[5.8047]→[5.8047:8077](∅→∅),[5.8077]→[4.20007:20144](∅→∅),[5.13435]→[5.17664:17710](∅→∅),[4.20144]→[5.17664:17710](∅→∅),[5.21452]→[5.17664:17710](∅→∅),[5.17664]→[5.17664:17710](∅→∅),[5.17710]→[4.20145:20479](∅→∅),[4.20479]→[5.13602:13626](∅→∅),[5.21761]→[5.13602:13626](∅→∅),[5.13602]→[5.13602:13626](∅→∅),[5.13626]→[5.17863:17889](∅→∅),[5.17863]→[5.17863:17889](∅→∅),[5.17889]→[4.20480:20670](∅→∅),[5.13731]→[5.17996:18045](∅→∅),[4.20670]→[5.17996:18045](∅→∅),[5.21943]→[5.17996:18045](∅→∅),[5.17996]→[5.17996:18045](∅→∅),[5.18045]→[4.20671:21079](∅→∅),[4.21079]→[5.13783:13814](∅→∅),[5.705]→[5.13783:13814](∅→∅),[5.58467]→[5.22326:22347](∅→∅),[5.14063]→[5.22326:22347](∅→∅),[5.22347]→[5.1750:1819](∅→∅),[5.1819]→[5.4:47](∅→∅),[5.47]→[4.21080:21244](∅→∅),[5.1944]→[5.9510:9516](∅→∅),[4.21244]→[5.9510:9516](∅→∅),[5.22421]→[5.9510:9516](∅→∅),[5.9510]→[5.9510:9516](∅→∅),[5.1369]→[5.14220:14256](∅→∅),[5.14256]→[4.21245:21389](∅→∅),[4.21389]→[5.14321:14363](∅→∅),[5.3219]→[5.14321:14363](∅→∅),[5.14363]→[4.21390:21570](∅→∅),[4.21570]→[5.2215:2265](∅→∅),[5.2215]→[5.2215:2265](∅→∅),[5.2265]→[5.14363:14388](∅→∅),[5.14363]→[5.14363:14388](∅→∅),[5.14388]→[4.21571:21735](∅→∅),[4.21735]→[5.14456:14528](∅→∅),[5.9826]→[5.14456:14528](∅→∅),[5.4993]→[5.9905:9941](∅→∅),[5.14528]→[5.9905:9941](∅→∅),[5.9905]→[5.9905:9941](∅→∅),[5.9941]→[4.21736:21864](∅→∅),[5.14651]→[5.18674:18710](∅→∅),[4.21864]→[5.18674:18710](∅→∅),[5.18674]→[5.18674:18710](∅→∅),[5.18710]→[4.21865:21923](∅→∅),[4.21923]→[5.10145:10160](∅→∅),[5.10145]→[5.10145:10160](∅→∅),[5.10160]→[4.21924:22092](∅→∅),[5.14779]→[5.18840:18895](∅→∅),[4.22092]→[5.18840:18895](∅→∅),[5.22692]→[5.18840:18895](∅→∅),[5.18840]→[5.18840:18895](∅→∅),[5.18895]→[4.22093:22127](∅→∅),[4.22127]→[5.5024:5088](∅→∅),[5.3742]→[5.5024:5088](∅→∅),[5.5088]→[4.22128:22377](∅→∅),[4.22377]→[5.14897:14976](∅→∅),[5.14897]→[5.14897:14976](∅→∅),[5.14976]→[5.19179:19219](∅→∅),[5.19179]→[5.19179:19219](∅→∅),[5.19219]→[4.22378:22567](∅→∅),[5.15090]→[5.19337:19383](∅→∅),[4.22567]→[5.19337:19383](∅→∅),[5.22862]→[5.19337:19383](∅→∅),[5.19337]→[5.19337:19383](∅→∅),[5.19383]→[4.22568:22728](∅→∅),[4.22728]→[5.19385:19407](∅→∅),[5.19385]→[5.19385:19407](∅→∅),[5.19407]→[5.23011:23077](∅→∅),[5.23077]→[4.22729:22818](∅→∅),[4.22818]→[5.15307:15388](∅→∅),[5.23161]→[5.15307:15388](∅→∅),[5.15307]→[5.15307:15388](∅→∅),[5.15388]→[5.19653:19689](∅→∅),[5.19653]→[5.19653:19689](∅→∅),[5.19689]→[4.22819:23289](∅→∅),[5.4013]→[5.15643:15762](∅→∅),[4.23289]→[5.15643:15762](∅→∅),[5.23571]→[5.15643:15762](∅→∅),[5.15643]→[5.15643:15762](∅→∅),[5.15762]→[5.4014:4091](∅→∅),[5.4091]→[4.23290:23527](∅→∅),[4.23527]→[5.15833:15871](∅→∅),[5.1043]→[5.15833:15871](∅→∅),[5.900]→[5.11916:11949](∅→∅),[5.5293]→[5.11916:11949](∅→∅),[5.15871]→[5.11916:11949](∅→∅),[5.11916]→[5.11916:11949](∅→∅),[5.11949]→[5.23795:23822](∅→∅),[5.23822]→[5.15895:16025](∅→∅),[5.15895]→[5.15895:16025](∅→∅),[5.16025]→[5.20437:20526](∅→∅),[5.20437]→[5.20437:20526](∅→∅),[5.20526]→[5.16026:16069](∅→∅),[5.16069]→[5.20570:20634](∅→∅),[5.20570]→[5.20570:20634](∅→∅),[5.20634]→[4.23528:23883](∅→∅),[5.3044]→[5.12451:12457](∅→∅),[5.5564]→[5.12451:12457](∅→∅),[5.20720]→[5.12451:12457](∅→∅),[4.23883]→[5.12451:12457](∅→∅),[5.12451]→[5.12451:12457](∅→∅),[5.12457]→[4.23884:24028](∅→∅),[5.23953]→[5.16211:16267](∅→∅),[4.24028]→[5.16211:16267](∅→∅),[5.16211]→[5.16211:16267](∅→∅),[5.16267]→[5.20884:21023](∅→∅),[5.20884]→[5.20884:21023](∅→∅),[5.21023]→[5.16268:16336](∅→∅),[5.16336]→[5.21092:21120](∅→∅),[5.21092]→[5.21092:21120](∅→∅),[5.21120]→[4.24029:24232](∅→∅),[5.24148]→[5.16500:16611](∅→∅),[4.24232]→[5.16500:16611](∅→∅),[5.16500]→[5.16500:16611](∅→∅),[5.16611]→[5.21401:21484](∅→∅),[5.21401]→[5.21401:21484](∅→∅),[5.21484]→[5.16612:16680](∅→∅),[5.16680]→[5.21553:21589](∅→∅),[5.21553]→[5.21553:21589](∅→∅),[5.21589]→[4.24233:24264](∅→∅),[4.24264]→[5.16713:16770](∅→∅),[5.3943]→[5.16713:16770](∅→∅),[5.566]→[5.576:609](∅→∅),[5.1286]→[5.576:609](∅→∅),[5.5675]→[5.576:609](∅→∅),[5.16770]→[5.576:609](∅→∅),[5.576]→[5.576:609](∅→∅),[5.609]→[5.24179:24210](∅→∅),[5.24210]→[5.16798:16889](∅→∅),[5.16798]→[5.16798:16889](∅→∅),[5.16889]→[5.21744:21790](∅→∅),[5.21744]→[5.21744:21790](∅→∅),[5.21790]→[4.24265:24375](∅→∅),[5.1354]→[5.647:653](∅→∅),[4.24375]→[5.647:653](∅→∅),[5.647]→[5.647:653](∅→∅),[5.653]→[4.24376:24530](∅→∅),[5.3982]→[5.16985:17016](∅→∅),[5.24400]→[5.16985:17016](∅→∅),[4.24530]→[5.16985:17016](∅→∅),[5.16985]→[5.16985:17016](∅→∅),[5.17016]→[5.21920:21948](∅→∅),[5.21920]→[5.21920:21948](∅→∅),[5.21948]→[4.24531:24761](∅→∅),[5.4062]→[5.17151:17263](∅→∅),[5.24607]→[5.17151:17263](∅→∅),[4.24761]→[5.17151:17263](∅→∅),[5.17151]→[5.17151:17263](∅→∅),[5.17263]→[5.22200:22234](∅→∅),[5.22200]→[5.22200:22234](∅→∅),[5.22234]→[4.24762:24802](∅→∅),[4.24802]→[5.17305:17349](∅→∅),[5.6109]→[5.17305:17349](∅→∅),[5.954]→[5.863:896](∅→∅),[5.1028]→[5.863:896](∅→∅),[5.6157]→[5.863:896](∅→∅),[5.17349]→[5.863:896](∅→∅),[5.863]→[5.863:896](∅→∅),[5.896]→[5.24647:24678](∅→∅),[5.24678]→[5.17377:17505](∅→∅),[5.17377]→[5.17377:17505](∅→∅),[5.17505]→[5.22393:22445](∅→∅),[5.22393]→[5.22393:22445](∅→∅),[5.22445]→[4.24803:25073](∅→∅),[5.3568]→[5.1180:1186](∅→∅),[4.25073]→[5.1180:1186](∅→∅),[5.1180]→[5.1180:1186](∅→∅),[5.1186]→[4.25074:25301](∅→∅),[4.25301]→[5.17674:17730](∅→∅),[5.17674]→[5.17674:17730](∅→∅),[5.17730]→[5.22674:22741](∅→∅),[5.22674]→[5.22674:22741](∅→∅),[5.22741]→[4.25302:25511](∅→∅),[4.25511]→[5.17813:17843](∅→∅),[5.17813]→[5.17813:17843](∅→∅),[5.17843]→[5.22955:22979](∅→∅),[5.22955]→[5.22955:22979](∅→∅),[5.22979]→[4.25512:25727](∅→∅),[4.25727]→[5.18000:18030](∅→∅),[5.18000]→[5.18000:18030](∅→∅),[5.18030]→[5.23183:23220](∅→∅),[5.23183]→[5.23183:23220](∅→∅),[5.23220]→[4.25728:25766](∅→∅),[4.25766]→[5.716:750](∅→∅),[5.4073]→[5.716:750](∅→∅),[5.750]→[5.765:846](∅→∅),[5.846]→[5.25012:25025](∅→∅),[5.25025]→[4.25767:25928](∅→∅),[4.25928]→[5.25196:25241](∅→∅),[5.25196]→[5.25196:25241](∅→∅),[5.25241]→[5.18079:18176](∅→∅),[5.18079]→[5.18079:18176](∅→∅),[5.18176]→[5.4063:4151](∅→∅),[5.4151]→[5.18247:18336](∅→∅),[5.18247]→[5.18247:18336](∅→∅),[5.18336]→[5.23531:23694](∅→∅),[5.23531]→[5.23531:23694](∅→∅),[5.23694]→[5.18337:18487](∅→∅),[5.18487]→[5.23847:23900](∅→∅),[5.23847]→[5.23847:23900](∅→∅),[5.23900]→[5.18488:18526](∅→∅),[5.18526]→[5.23939:24012](∅→∅),[5.23939]→[5.23939:24012](∅→∅),[5.24012]→[5.25242:25284](∅→∅),[5.1642]→[5.18527:18562](∅→∅),[5.1001]→[5.48:81](∅→∅),[5.1596]→[5.48:81](∅→∅),[5.4112]→[5.48:81](∅→∅),[5.6248]→[5.48:81](∅→∅),[5.18562]→[5.48:81](∅→∅),[5.48]→[5.48:81](∅→∅),[5.81]→[5.25285:25309](∅→∅),[5.25309]→[5.18583:18699](∅→∅),[5.18583]→[5.18583:18699](∅→∅),[5.18699]→[5.24152:24201](∅→∅),[5.24152]→[5.24152:24201](∅→∅),[5.24201]→[4.25929:26116](∅→∅),[5.394]→[5.339:345](∅→∅),[5.4351]→[5.339:345](∅→∅),[4.26116]→[5.339:345](∅→∅),[5.339]→[5.339:345](∅→∅),[5.345]→[4.26117:26273](∅→∅),[4.26273]→[5.18822:18844](∅→∅),[5.18822]→[5.18822:18844](∅→∅),[5.18844]→[5.24349:24389](∅→∅),[5.24349]→[5.24349:24389](∅→∅),[5.24389]→[4.26274:26312](∅→∅),[4.26312]→[5.6249:6294](∅→∅),[5.1045]→[5.6249:6294](∅→∅),[5.6294]→[5.3944:3945](∅→∅),[5.13039]→[5.3944:3945](∅→∅),[5.4454]→[5.3944:3945](∅→∅),[5.3945]→[5.13040:13152](∅→∅),[5.13152]→[5.3945:3946](∅→∅),[5.3945]→[5.3945:3946](∅→∅),[5.3946]→[5.13153:13185](∅→∅),[5.13185]→[5.24390:24424](∅→∅)
  − pgEval (CreateEvent (ProjectId pid) (UserId uid) (LogEntry c e m)) = case c of

  − CreditToCurrency (nid, addr) -> do

  − mode <- askNetworkMode

  − let network = toNetwork mode nid

  − pinsert

  − EventId

  − [sql| INSERT INTO work_events

  − ( project_id, user_id, credit_to_type, credit_to_network, credit_to_address

  − , event_type, event_time, event_metadata )

  − VALUES (?, ?, ?, ?, ?, ?, ?)

  − RETURNING id |]

  − ( pid,

  − uid,

  − creditToName c,

  − renderNetworkId nid,

  − addrToText network addr,

  − eventName e,

  − fromThyme $ e ^. eventTime,

  − m

  − )

  − CreditToProject pid' ->

  − pinsert

  − EventId

  − [sql| INSERT INTO work_events

  − ( project_id, user_id, credit_to_type, credit_to_project_id

  − , event_type, event_time, event_metadata )

  − VALUES (?, ?, ?, ?, ?, ?, ?)

  − RETURNING id |]

  − ( pid,

  − uid,

  − creditToName c,

  − pid' ^. _ProjectId,

  − eventName e,

  − fromThyme $ e ^. eventTime,

  − m

  − )

  − CreditToUser uid' ->

  − pinsert

  − EventId

  − [sql| INSERT INTO work_events

  − (project_id, user_id, credit_to_type, credit_to_user_id, event_type, event_time, event_metadata)

  − VALUES (?, ?, ?, ?, ?, ?, ?)

  − RETURNING id |]

  − ( pid,

  − uid,

  − creditToName c,

  − uid' ^. _UserId,

  − eventName e,

  − fromThyme $ e ^. eventTime,

  − m

  − )

  − pgEval (FindEvent (EventId eid)) = do

  − mode <- askNetworkMode

  − headMay

  − <$> pquery

  − (qdbLogEntryParser mode)

  − [sql| SELECT project_id, user_id,

  − credit_to_type,

  − credit_to_network, credit_to_address, credit_to_user_id, credit_to_project_id,

  − event_type, event_time, event_metadata FROM work_events

  − WHERE id = ? |]

  − (Only eid)

  − pgEval (FindEvents (ProjectId pid) (UserId uid) rquery limit) = do

  − mode <- askNetworkMode

  − case rquery of

  − (Before e) ->

  − pquery

  − (logEntryParser mode)

  − [sql| SELECT credit_to_type,

  − credit_to_network, credit_to_address, credit_to_user_id, credit_to_project_id,

  − event_type, event_time,

  − event_metadata

  − FROM work_events

  − WHERE project_id = ? AND user_id = ? AND event_time <= ?

  − ORDER BY event_time DESC

  − LIMIT ?

  − |]

  − (pid, uid, fromThyme e, limit)

  − (During s e) ->

  − pquery

  − (logEntryParser mode)

  − [sql| SELECT credit_to_type,

  − credit_to_network, credit_to_address, credit_to_user_id, credit_to_project_id,

  − event_type, event_time, event_metadata

  − FROM work_events

  − WHERE project_id = ? AND user_id = ?

  − AND event_time >= ? AND event_time <= ?

  − ORDER BY event_time DESC

  − LIMIT ?

  − |]

  − (pid, uid, fromThyme s, fromThyme e, limit)

  − (After s) ->

  − pquery

  − (logEntryParser mode)

  − [sql| SELECT credit_to_type,

  − credit_to_network, credit_to_address, credit_to_user_id, credit_to_project_id,

  − event_type, event_time, event_metadata

  − FROM work_events

  − WHERE project_id = ? AND user_id = ? AND event_time >= ?

  − ORDER BY event_time DESC

  − LIMIT ?

  − |]

  − (pid, uid, fromThyme s, limit)

  − (Always) ->

  − pquery

  − (logEntryParser mode)

  − [sql| SELECT credit_to_type,

  − credit_to_network, credit_to_address, credit_to_user_id, credit_to_project_id,

  − event_type, event_time,

  − event_metadata

  − FROM work_events

  − WHERE project_id = ? AND user_id = ?

  − ORDER BY event_time DESC

  − LIMIT ?

  − |]

  − (pid, uid, limit)

  − pgEval (AmendEvent (EventId eid) (TimeChange mt t)) =

  − pinsert

  − AmendmentId

  − [sql| INSERT INTO event_time_amendments

  − (event_id, amended_at, event_time)

  − VALUES (?, ?, ?) RETURNING id |]

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

  − pgEval (AmendEvent (EventId eid) (CreditToChange mt c)) = do

  − mode <- askNetworkMode

  − case c of

  − CreditToCurrency (nid, addr) -> do

  − let network = toNetwork mode nid

  − pinsert

  − AmendmentId

  − [sql| INSERT INTO event_credit_to_amendments

  − (event_id, amended_at, credit_to_type, credit_to_network, credit_to_address)

  − VALUES (?, ?, ?, ?) RETURNING id |]

  − ( eid,

  − fromThyme $ mt ^. _ModTime,

  − creditToName c,

  − renderNetworkId nid,

  − addrToText network addr

  − )

  − CreditToProject pid ->

  − pinsert

  − AmendmentId

  − [sql| INSERT INTO event_credit_to_amendments

  − (event_id, amended_at, credit_to_type, credit_to_project_id)

  − VALUES (?, ?, ?, ?) RETURNING id |]

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

  − CreditToUser uid ->

  − pinsert

  − AmendmentId

  − [sql| INSERT INTO event_credit_to_amendments

  − (event_id, amended_at, credit_to_type, credit_to_user_id)

  − VALUES (?, ?, ?, ?) RETURNING id |]

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

  − pgEval (AmendEvent (EventId eid) (MetadataChange mt v)) =

  − pinsert

  − AmendmentId

  − [sql| INSERT INTO event_metadata_amendments

  − (event_id, amended_at, event_metadata)

  − VALUES (?, ?, ?) RETURNING id |]

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

  − pgEval (ReadWorkIndex (ProjectId pid)) = do

  − mode <- askNetworkMode

  − logEntries <-

  − pquery

  − (logEntryParser mode)

  − [sql| SELECT credit_to_type,

  − credit_to_network, credit_to_address, credit_to_user_id, credit_to_project_id,

  − event_type, event_time, event_metadata

  − FROM work_events

  − WHERE project_id = ? |]

  − (Only pid)

  − pure $ workIndex logEntries

  − pgEval (CreateAuction auc) =

  − pinsert

  − A.AuctionId

  − [sql| INSERT INTO auctions (project_id, initiator_id, raise_amount, end_time)

  − VALUES (?, ?, ?, ?) RETURNING id |]

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

  − FROM auctions

  − WHERE id = ? |]

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

  − VALUES (?, ?, ?, ?, ?) RETURNING id |]

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

  − pgEval (CreateUser user') = do

  − pinsert

  − UserId

  − [sql| INSERT INTO users (handle, recovery_email, recovery_zaddr)

  − VALUES (?, ?, ?) RETURNING id |]

  − ( user' ^. (username . _UserName),

  − user' ^? userAccountRecovery . _RecoverByEmail . _Email,

  − user' ^? userAccountRecovery . _RecoverByZAddr . _ZAddr

  − )

  − pgEval (FindUser (UserId uid)) = do

  − headMay

  − <$> pquery

  − userParser

  − [sql| SELECT handle, recovery_email, recovery_zaddr FROM users WHERE id = ? |]

  − (Only uid)

  − pgEval (FindUserByName (UserName h)) = do

  − headMay

  − <$> pquery

  − ((,) <$> idParser UserId <*> userParser)

  − [sql| SELECT id, handle, recovery_email, recovery_zaddr FROM users WHERE handle = ? |]

  − (Only h)

  − pgEval (FindUserPaymentAddress (UserId uid)) = do

  − mode <- askNetworkMode

  − headMay

  − <$> pquery

  − (btcAddressParser mode)

  − [sql| SELECT default_payment_network, default_payment_addr FROM users WHERE id = ? |]

  − (Only uid)

  − pgEval (CreateInvitation (ProjectId pid) (UserId uid) (Email e) t) = do

  − invCode <- liftIO P.randomInvCode

  − void $

  − pexec

  − [sql| INSERT INTO invitations (project_id, invitor_id, invitee_email, invitation_key, invitation_time)

  − VALUES (?, ?, ?, ?, ?) |]

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

  − pure invCode

  − pgEval (FindInvitation ic) =

  − headMay

  − <$> pquery

  − invitationParser

  − [sql| SELECT project_id, invitor_id, invitee_email, invitation_time, acceptance_time

  − FROM invitations WHERE invitation_key = ? |]

  − (Only $ P.renderInvCode ic)

  − pgEval (AcceptInvitation (UserId uid) ic t) = transactQDBM $ do

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

  − SELECT i.project_id, ?, i.invitor_id, ?

  − FROM invitations i

  − WHERE i.invitation_key = ? |]

  − (uid, fromThyme t, P.renderInvCode ic)

  − pgEval (CreateProject p) =

  − pinsert

  − ProjectId

  − [sql| INSERT INTO projects (project_name, inception_date, initiator_id, depreciation_fn)

  − VALUES (?, ?, ?, ?) RETURNING id |]

  − ( p ^. P.projectName,

  − p ^. (P.inceptionDate . to fromThyme),

  − p ^. (P.initiator . _UserId),

  − toJSON $ p ^. P.depf . to SerDepFunction

  − )

  − pgEval ListProjects =

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

  − pgEval (FindSubscribers pid) =

  − pquery

  − (idParser UserId)

  − [sql| SELECT s.user_id

  − FROM subscripions s

  − JOIN billables b ON s.billable_id = b.id

  − WHERE b.project_id = ? |]

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

  − FROM projects p LEFT OUTER JOIN project_companions pc ON pc.project_id = p.id

  − WHERE pc.user_id = ?

  − OR p.initiator_id = ?

  − ORDER BY p.inception_date, p.id |]

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

  − pgEval dbop@(CreateBillable _ b) = do

  − eventId <- requireEventId dbop

  − pinsert

  − B.BillableId

  − [sql| INSERT INTO billables

  − ( project_id, event_id, name, description

  − , recurrence_type, recurrence_count

  − , billing_amount, grace_period_days

  − , payment_request_email_template

  − , payment_request_memo_template)

  − VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?) RETURNING id |]

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

  − )

  − pgEval (FindBillable bid) =

  − headMay

  − <$> pquery

  − billableParser

  − [sql| SELECT b.project_id, e.created_by, b.name, b.description,

  − b.recurrence_type, b.recurrence_count,

  − b.billing_amount, b.grace_period_days,

  − b.payment_request_email_template, b.payment_request_memo_template

  − FROM billables b JOIN aftok_events e ON e.id = b.event_id

  − WHERE b.id = ? |]

  − (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,

  − b.recurrence_type, b.recurrence_count,

  − b.billing_amount, b.grace_period_days

  − b.payment_request_email_template, b.payment_request_memo_template

  − FROM billables b JOIN aftok_events e ON e.id = b.event_id

  − WHERE b.project_id = ? |]

  − (Only (pid ^. _ProjectId))

  − pgEval dbop@(CreateSubscription uid bid start_date) = do

  − eventId <- requireEventId dbop

  − pinsert

  − B.SubscriptionId

  − [sql| INSERT INTO subscriptions

  − (user_id, billable_id, event_id, start_date)

  − VALUES (?, ?, ?, ?) RETURNING id |]

  − ( view _UserId uid,

  − view B._BillableId bid,

  − view _EventId eventId,

  − fromThyme start_date

  − )

  − pgEval (FindSubscription sid) =

  − headMay

  − <$> pquery

  − subscriptionParser

  − [sql| SELECT id, billable_id, contact_email, start_date, end_date

  − FROM subscriptions s

  − WHERE s.id = ? |]

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

  − FROM subscriptions s

  − JOIN billables b ON b.id = s.billable_id

  − WHERE s.user_id = ?

  − AND b.project_id = ? |]

  − (uid ^. _UserId, pid ^. _ProjectId)

  − pgEval dbop@(CreatePaymentRequest req) = do

  − eventId <- requireEventId dbop

  − pinsert

  − PaymentRequestId

  − [sql| INSERT INTO payment_requests

  − (subscription_id, event_id, request_data, url_key, request_time, billing_date)

  − VALUES (?, ?, ?, ?, ?, ?) RETURNING id |]

  − ( req ^. (subscription . B._SubscriptionId),

  − eventId ^. _EventId,

  − req ^. (paymentRequest . to (runPut . encodeMessage)),

  − req ^. (paymentKey . _PaymentKey),

  − req ^. (paymentRequestTime . to fromThyme),

  − req ^. (billingDate . to fromThyme)

  − )

  − pgEval (FindPaymentRequest (PaymentKey k)) =

  − headMay

  − <$> pquery

  − ((,) <$> idParser PaymentRequestId <*> paymentRequestParser)

  − [sql| SELECT id, subscription_id, request_data, url_key, request_time, billing_date

  − FROM payment_requests

  − WHERE url_key = ?

  − AND id NOT IN (SELECT payment_request_id FROM payments) |]

  − (Only k)

  − pgEval (FindPaymentRequestId (PaymentRequestId prid)) =

  − headMay

  − <$> pquery

  − paymentRequestParser

  − [sql| SELECT subscription_id, request_data, url_key, request_time, billing_date

  − FROM payment_requests

  − WHERE id = ? |]

  − (Only prid)

  − pgEval (FindPaymentRequests sid) =

  − pquery

  − ((,) <$> idParser PaymentRequestId <*> paymentRequestParser)

  − [sql| SELECT id, subscription_id, request_data, url_key, request_time, billing_date

  − FROM payment_requests

  − WHERE subscription_id = ? |]

  − (Only (sid ^. B._SubscriptionId))

  − pgEval (FindUnpaidRequests sid) =

  − let rowp :: RowParser (PaymentKey, PaymentRequest, B.Subscription, B.Billable)

  − rowp =

  − (,,,)

  − <$> (PaymentKey <$> field)

  − <*> paymentRequestParser

  − <*> subscriptionParser

  − <*> billableParser

  − in pquery

  − rowp

  − [sql| SELECT r.url_key,

  − r.subscription_id, r.request_data, r.url_key, r.request_time, r.billing_date,

  − s.user_id, s.billable_id, s.contact_email, s.start_date, s.end_date,

  − b.project_id, e.created_by, b.name, b.description, b.recurrence_type,

  − b.recurrence_count, b.billing_amount, b.grace_period_days,

  − b.payment_request_email_template, b.payment_request_memo_template

  − FROM payment_requests r

  − JOIN subscriptions s on s.id = r.subscription_id

  − JOIN billables b on b.id = s.billable_id

  − JOIN aftok_events e on e.id = b.event_id

  − WHERE subscription_id = ?

  − AND r.id NOT IN (SELECT payment_request_id FROM payments) |]

  − (Only (sid ^. B._SubscriptionId))

  − pgEval dbop@(CreatePayment p) = do

  − eventId <- requireEventId dbop

  − pinsert

  − PaymentId

  − [sql| INSERT INTO payments

  − (payment_request_id, event_id, payment_data, payment_date, exchange_rates)

  − VALUES (?, ?, ?, ?, ?) RETURNING id |]

  − ( p ^. (request . _PaymentRequestId),

  − eventId ^. _EventId,

  − p ^. (payment . to (runPut . encodeMessage)),

  − p ^. (paymentDate . to fromThyme),

  − p ^. exchangeRates

  − )

  − pgEval (FindPayments rid) =

  − pquery

  − ((,) <$> idParser PaymentId <*> paymentParser)

  − [sql| SELECT id, payment_request_id, payment_data, payment_date

  − FROM payments

  − WHERE payment_request_id = ? |]

  − (Only (rid ^. _PaymentRequestId))

  − pgEval (RaiseDBError err _) = raiseError err

  −

  − requireEventId :: DBOp a -> QDBM EventId

  − requireEventId = maybe (raiseError EventStorageFailed) id . storeEvent

  −

  − raiseError :: DBError -> QDBM a

  − raiseError = QDBM . lift . throwE
  [5.4296]
  + pgEval =

  + QDBM . \case

  + (CreateEvent pid uid lentry) -> Q.createEvent pid uid lentry

  + (FindEvent eid) -> Q.findEvent eid

  + (FindEvents pid uid rquery limit) -> Q.findEvents pid uid rquery limit

  + (AmendEvent eid amendment) -> Q.amendEvent eid amendment

  + (ReadWorkIndex pid) -> Q.readWorkIndex pid

  + (CreateAuction auc) -> Q.createAuction auc

  + (FindAuction aucId) -> Q.findAuction aucId

  + (CreateBid aucId bid) -> Q.createBid aucId bid

  + (FindBids aucId) -> Q.findBids aucId

  + (CreateUser user') -> Q.createUser user'

  + (FindUser uid) -> Q.findUser uid

  + (FindUserByName n) -> Q.findUserByName n

  + (FindUserPaymentAddress uid currency) -> Q.findUserPaymentAddress uid currency

  + (FindAccountPaymentAddress aid currency) -> Q.findAccountPaymentAddress aid currency

  + (FindAccountZcashIVK aid) -> Q.findAccountZcashIVK aid

  + (CreateProject p) -> Q.createProject p

  + ListProjects -> Q.listProjects

  + (FindProject pid) -> Q.findProject pid

  + (FindUserProjects uid) -> Q.findUserProjects uid

  + (AddUserToProject pid current new) -> Q.addUserToProject pid current new

  + (CreateInvitation pid uid e t) -> Q.createInvitation pid uid e t

  + (FindInvitation ic) -> Q.findInvitation ic

  + (AcceptInvitation uid ic t) -> Q.acceptInvitation uid ic t

  + dbop@(CreateBillable uid b) -> do

  + eventId <- Q.storeEvent' dbop

  + Q.createBillable eventId uid b

  + (FindBillable bid) -> Q.findBillable bid

  + (FindBillables pid) -> Q.findBillables pid

  + dbop@(CreateSubscription uid bid start_date) -> do

  + eventId <- Q.storeEvent' dbop

  + Q.createSubscription eventId uid bid start_date

  + (FindSubscription sid) -> Q.findSubscription sid

  + (FindSubscriptions uid pid) -> Q.findSubscriptions uid pid

  + (FindSubscribers pid) -> Q.findSubscribers pid

  + dbop@(StorePaymentRequest req) -> do

  + eventId <- Q.storeEvent' dbop

  + Q.storePaymentRequest eventId Nothing req

  + (FindPaymentRequestByKey k) -> Q.findPaymentRequestByKey k

  + (FindPaymentRequestById prid) -> Q.findPaymentRequestById prid

  + (FindSubscriptionPaymentRequests sid) -> Q.findSubscriptionPaymentRequests sid

  + (FindSubscriptionUnpaidRequests sid) -> Q.findSubscriptionUnpaidRequests sid

  + dbop@(CreatePayment p) -> do

  + eventId <- Q.storeEvent' dbop

  + Q.createPayment eventId p

  + (FindPayments ccy rid) -> Q.findPayments ccy rid

  + (RaiseDBError err _) -> lift . throwE $ err
• replacement in lib/Aftok/Database.hs at line 11
  [5.4986]→[4.26469:26495](∅→∅)
  − import Aftok.Auction as A
  [5.4986]

  [4.26495]
  + import qualified Aftok.Auction as A
• replacement in lib/Aftok/Database.hs at line 13
  [4.26521]→[4.26521:26585](∅→∅)
  − import Aftok.Currency.Bitcoin (NetworkId)

  − import Aftok.Interval
  [4.26521]

  [4.26585]
  + import Aftok.Currency (Amount, Currency)

  + import Aftok.Currency.Bitcoin.Payments (PaymentKey)

  + import qualified Aftok.Currency.Zcash as Zcash

  + import Aftok.Interval (RangeQuery)
• edit in lib/Aftok/Database.hs at line 18
  [4.26613]

  [4.26613]
  + ( Payment,

  + PaymentId,

  + PaymentRequest,

  + PaymentRequestId,

  + SomePaymentRequestDetail,

  + )
• edit in lib/Aftok/Database.hs at line 26
  [4.26660]

  [4.26660]
  + ( AmendmentId,

  + EventAmendment,

  + EventId,

  + LogEntry,

  + WorkIndex,

  + )
• replacement in lib/Aftok/Database.hs at line 33
  [4.26679]→[4.26679:26697](∅→∅)
  − import Aftok.Util
  [4.26679]

  [4.26697]
  + ( AccountId,

  + Email,

  + ProjectId,

  + User,

  + UserId,

  + UserName,

  + )

  + import Aftok.Util (Program, fc, fromMaybeT)
• replacement in lib/Aftok/Database.hs at line 47
  [4.26779]→[4.26779:26803](∅→∅)
  − import Data.AffineSpace
  [4.26779]

  [4.26803]
  + import Data.AffineSpace ((.-.))
• edit in lib/Aftok/Database.hs at line 52
  [4.26873]→[4.26873:26906](∅→∅)
  − import Haskoin.Address (Address)
• replacement in lib/Aftok/Database.hs at line 54
  [5.5920]→[4.26929:26984](∅→∅)
  − type KeyedLogEntry a = (ProjectId, UserId, LogEntry a)
  [5.5920]

  [5.18985]
  + type KeyedLogEntry = (ProjectId, UserId, LogEntry)
• edit in lib/Aftok/Database.hs at line 60
  [5.19102]→[5.19102:19137](∅→∅),[5.19164]→[5.6137:6138](∅→∅),[5.6137]→[5.6137:6138](∅→∅)
  − type BTCNet = (NetworkId, Address)

  −
• replacement in lib/Aftok/Database.hs at line 64
  [4.27125]→[5.2555:2615](∅→∅),[5.2555]→[5.2555:2615](∅→∅)
  − FindUserPaymentAddress :: UserId -> DBOp (Maybe (BTCNet))
  [4.27125]

  [4.27126]
  + FindUserPaymentAddress :: UserId -> Currency a c -> DBOp (Maybe a)

  + FindAccountPaymentAddress :: AccountId -> Currency a c -> DBOp (Maybe a)

  + FindAccountZcashIVK :: AccountId -> DBOp (Maybe Zcash.IVK)
• edit in lib/Aftok/Database.hs at line 70
  [4.27257]→[4.27257:27305](∅→∅)
  − FindSubscribers :: ProjectId -> DBOp [UserId]
• replacement in lib/Aftok/Database.hs at line 75
  [5.2513]→[4.27369:28077](∅→∅)
  − 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)]
  [5.2513]

  [5.3285]
  + CreateEvent :: ProjectId -> UserId -> LogEntry -> DBOp EventId

  + AmendEvent :: EventId -> EventAmendment -> DBOp AmendmentId

  + FindEvent :: EventId -> DBOp (Maybe KeyedLogEntry)

  + FindEvents :: ProjectId -> UserId -> RangeQuery -> Word32 -> DBOp [LogEntry]

  + ReadWorkIndex :: ProjectId -> DBOp WorkIndex

  + CreateAuction :: A.Auction -> DBOp A.AuctionId

  + FindAuction :: A.AuctionId -> DBOp (Maybe A.Auction)

  + CreateBid :: A.AuctionId -> A.Bid -> DBOp A.BidId

  + FindBids :: A.AuctionId -> DBOp [(A.BidId, A.Bid)]

  + CreateBillable :: UserId -> Billable Amount -> DBOp BillableId

  + FindBillable :: BillableId -> DBOp (Maybe (Billable Amount))

  + FindBillables :: ProjectId -> DBOp [(BillableId, Billable Amount)]
• replacement in lib/Aftok/Database.hs at line 89
  [4.28144]→[4.28144:28710](∅→∅)
  − 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.28144]

  [4.28710]
  + FindSubscriptions :: ProjectId -> UserId -> DBOp [(SubscriptionId, Subscription)]

  + FindSubscribers :: ProjectId -> DBOp [UserId]

  + StorePaymentRequest :: PaymentRequest c -> DBOp PaymentRequestId

  + FindPaymentRequestByKey :: PaymentKey -> DBOp (Maybe (PaymentRequestId, SomePaymentRequestDetail))

  + FindPaymentRequestById :: PaymentRequestId -> DBOp (Maybe SomePaymentRequestDetail)

  + FindSubscriptionPaymentRequests :: SubscriptionId -> DBOp [(PaymentRequestId, SomePaymentRequestDetail)]

  + FindSubscriptionUnpaidRequests :: SubscriptionId -> DBOp [(PaymentRequestId, SomePaymentRequestDetail)]

  + CreatePayment :: Payment c -> DBOp PaymentId

  + FindPayments :: Currency a c -> PaymentRequestId -> DBOp [(PaymentId, Payment c)]
• edit in lib/Aftok/Database.hs at line 125
  [5.5275]

  [5.6782]
  + instance MonadDB m => MonadDB (ExceptT e m) where

  + liftdb = lift . liftdb

  +
• replacement in lib/Aftok/Database.hs at line 145
  [5.2786]→[5.2786:2921](∅→∅)
  − findUserPaymentAddress :: (MonadDB m) => UserId -> MaybeT m (BTCNet)

  − findUserPaymentAddress = MaybeT . liftdb . FindUserPaymentAddress
  [5.2786]

  [5.7626]
  + findUserPaymentAddress :: (MonadDB m) => UserId -> Currency a c -> MaybeT m a

  + findUserPaymentAddress uid n = MaybeT . liftdb $ FindUserPaymentAddress uid n

  +

  + findAccountPaymentAddress :: (MonadDB m) => AccountId -> Currency a c -> MaybeT m a

  + findAccountPaymentAddress uid n = MaybeT . liftdb $ FindAccountPaymentAddress uid n
• replacement in lib/Aftok/Database.hs at line 230
  [4.29572]→[4.29572:29641](∅→∅)
  − (MonadDB m) => ProjectId -> UserId -> LogEntry BTCNet -> m EventId
  [4.29572]

  [5.819]
  + (MonadDB m) => ProjectId -> UserId -> LogEntry -> m EventId
• replacement in lib/Aftok/Database.hs at line 234
  [4.29656]→[4.29656:29733](∅→∅)
  − (MonadDB m) => UserId -> EventId -> EventAmendment BTCNet -> m AmendmentId
  [4.29656]

  [5.8764]
  + (MonadDB m) => UserId -> EventId -> EventAmendment -> m AmendmentId
• replacement in lib/Aftok/Database.hs at line 245
  [5.1147]→[5.20042:20114](∅→∅)
  − findEvent :: (MonadDB m) => EventId -> m (Maybe (KeyedLogEntry BTCNet))
  [5.1147]

  [5.8744]
  + findEvent :: (MonadDB m) => EventId -> m (Maybe KeyedLogEntry)
• replacement in lib/Aftok/Database.hs at line 254
  [4.29988]→[4.29988:30010](∅→∅)
  − m [LogEntry BTCNet]
  [4.29988]

  [5.3664]
  + m [LogEntry]
• replacement in lib/Aftok/Database.hs at line 257
  [5.1304]→[5.20201:20277](∅→∅)
  − readWorkIndex :: (MonadDB m) => ProjectId -> UserId -> m (WorkIndex BTCNet)
  [5.8233]

  [5.9265]
  + readWorkIndex :: (MonadDB m) => ProjectId -> UserId -> m WorkIndex
• replacement in lib/Aftok/Database.hs at line 262
  [5.834]→[5.8968:9036](∅→∅)
  − createBillable :: (MonadDB m) => UserId -> Billable -> m BillableId
  [5.834]

  [5.1570]
  + createBillable :: (MonadDB m) => UserId -> Billable Amount -> m BillableId
• replacement in lib/Aftok/Database.hs at line 266
  [5.4547]→[5.5462:5525](∅→∅)
  − findBillable :: (MonadDB m) => BillableId -> MaybeT m Billable
  [5.4547]

  [5.5525]
  + findBillable :: (MonadDB m) => BillableId -> MaybeT m (Billable Amount)
• replacement in lib/Aftok/Database.hs at line 270
  [4.30032]→[4.30032:30107](∅→∅),[5.29467]→[5.5666:5729](∅→∅),[4.30107]→[5.5666:5729](∅→∅),[5.5666]→[5.5666:5729](∅→∅)
  − (MonadDB m) => UserId -> ProjectId -> m [(SubscriptionId, Subscription)]

  − findSubscriptions uid pid = liftdb $ FindSubscriptions uid pid
  [4.30032]

  [5.5729]
  + (MonadDB m) => ProjectId -> UserId -> m [(SubscriptionId, Subscription)]

  + findSubscriptions pid uid = liftdb $ FindSubscriptions pid uid
• replacement in lib/Aftok/Database.hs at line 274
  [4.30136]→[4.30136:30212](∅→∅)
  − (MonadDB m) => SubscriptionId -> MaybeT m (Subscription' UserId Billable)
  [4.30136]

  [5.5825]
  + (MonadDB m) => SubscriptionId -> MaybeT m (Subscription' UserId (Billable Amount))
• replacement in lib/Aftok/Database.hs at line 279
  [5.4655]→[4.30213:30310](∅→∅),[5.29670]→[5.6032:6083](∅→∅),[4.30310]→[5.6032:6083](∅→∅),[5.6032]→[5.6032:6083](∅→∅)
  − findPaymentRequests ::

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

  − findPaymentRequests = liftdb . FindPaymentRequests
  [5.4655]

  [5.1594]
  + storePaymentRequest ::

  + (MonadDB m) => PaymentRequest c -> m PaymentRequestId

  + storePaymentRequest = liftdb . StorePaymentRequest

  +

  + findPaymentRequestByKey ::

  + (MonadDB m) => PaymentKey -> MaybeT m (PaymentRequestId, SomePaymentRequestDetail)

  + findPaymentRequestByKey = MaybeT . liftdb . FindPaymentRequestByKey
• replacement in lib/Aftok/Database.hs at line 287
  [5.1595]→[4.30311:30408](∅→∅),[5.29768]→[5.25813:25871](∅→∅),[4.30408]→[5.25813:25871](∅→∅),[5.25813]→[5.25813:25871](∅→∅)
  − findPaymentRequest ::

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

  − findPaymentRequest = MaybeT . liftdb . FindPaymentRequest
  [5.1595]

  [5.25871]
  + findPaymentRequestById ::

  + (MonadDB m) => PaymentRequestId -> MaybeT m SomePaymentRequestDetail

  + findPaymentRequestById = MaybeT . liftdb . FindPaymentRequestById
• replacement in lib/Aftok/Database.hs at line 291
  [5.25872]→[4.30409:30494](∅→∅),[5.29854]→[5.25955:26017](∅→∅),[4.30494]→[5.25955:26017](∅→∅),[5.25955]→[5.25955:26017](∅→∅)
  − findPaymentRequestId ::

  − (MonadDB m) => PaymentRequestId -> MaybeT m PaymentRequest

  − findPaymentRequestId = MaybeT . liftdb . FindPaymentRequestId
  [5.25872]

  [5.1117]
  + findSubscriptionPaymentRequests ::

  + (MonadDB m) => SubscriptionId -> m [(PaymentRequestId, SomePaymentRequestDetail)]

  + findSubscriptionPaymentRequests = liftdb . FindSubscriptionPaymentRequests
• replacement in lib/Aftok/Database.hs at line 297
  [5.2213]→[5.2213:2332](∅→∅)
  − findUnpaidRequests :: (MonadDB m) => SubscriptionId -> m [BillDetail]

  − findUnpaidRequests = liftdb . FindUnpaidRequests
  [5.2213]

  [5.2332]
  + findSubscriptionUnpaidRequests :: (MonadDB m) => SubscriptionId -> m [(PaymentRequestId, SomePaymentRequestDetail)]

  + findSubscriptionUnpaidRequests = liftdb . FindSubscriptionUnpaidRequests
• replacement in lib/Aftok/Database.hs at line 300
  [5.2333]→[5.26018:26165](∅→∅)
  − findPayment :: (MonadDB m) => PaymentRequestId -> MaybeT m Payment

  − findPayment prid = MaybeT $ (fmap snd . headMay) <$> liftdb (FindPayments prid)
  [5.2333]

  [5.4910]
  + findPayment :: (MonadDB m) => Currency a c -> PaymentRequestId -> MaybeT m (Payment c)

  + findPayment currency prid = MaybeT $ (fmap snd . headMay) <$> liftdb (FindPayments currency prid)
• replacement in lib/Aftok/Database.hs at line 305
  [5.1306]→[5.9596:9651](∅→∅)
  − createAuction :: (MonadDB m) => Auction -> m AuctionId
  [5.1306]

  [5.671]
  + createAuction :: (MonadDB m) => A.Auction -> m A.AuctionId
• replacement in lib/Aftok/Database.hs at line 309
  [5.767]→[5.26166:26236](∅→∅)
  − findAuction :: (MonadDB m) => AuctionId -> UserId -> MaybeT m Auction
  [5.767]

  [5.841]
  + findAuction :: (MonadDB m) => A.AuctionId -> UserId -> MaybeT m A.Auction
• replacement in lib/Aftok/Database.hs at line 317
  [5.293]→[5.9755:9819](∅→∅)
  − findAuction' :: (MonadDB m) => AuctionId -> UserId -> m Auction
  [5.293]

  [5.864]
  + findAuction' :: (MonadDB m) => A.AuctionId -> UserId -> m A.Auction
• replacement in lib/Aftok/Database.hs at line 328
  [5.22]→[5.9906:9972](∅→∅)
  − createBid :: (MonadDB m) => AuctionId -> UserId -> Bid -> m BidId
  [5.22]

  [5.888]
  + createBid :: (MonadDB m) => A.AuctionId -> UserId -> A.Bid -> m A.BidId
• replacement in lib/Aftok/Database.hs at line 333
  [5.30228]→[5.30228:30278](∅→∅)
  − if view bidTime bid > view auctionEnd auc
  [5.30228]

  [5.30278]
  + if view A.bidTime bid > view A.auctionEnd auc
• replacement in lib/Aftok/Json.hs at line 11
  [5.273]→[4.31576:31602](∅→∅)
  − import Aftok.Auction as A
  [5.273]

  [4.31602]
  + import qualified Aftok.Auction as A
• edit in lib/Aftok/Json.hs at line 13
  [4.31638]

  [4.31638]
  + import Aftok.Currency (Amount (..), Currency (..))
• edit in lib/Aftok/Json.hs at line 15
  [4.31668]

  [4.31668]
  + import Aftok.Currency.Zcash (_Zatoshi)
• replacement in lib/Aftok/Json.hs at line 17
  [4.31690]→[4.31690:31738](∅→∅)
  − import Aftok.Payments

  − import Aftok.Project as P
  [4.31690]

  [4.31738]
  + import Aftok.Payments.Types

  + ( PaymentId,

  + _PaymentId,

  + )

  + import qualified Aftok.Project as P
• edit in lib/Aftok/Json.hs at line 24
  [4.31778]→[4.31778:31811](∅→∅)
  − import Aftok.Util (traverseKeys)
• edit in lib/Aftok/Json.hs at line 26
  [4.31851]→[4.31851:31867](∅→∅)
  − fromMaybeM,
• edit in lib/Aftok/Json.hs at line 32
  [4.32038]→[4.32038:32085](∅→∅)
  − import qualified Data.ByteString.Base64 as B64
• edit in lib/Aftok/Json.hs at line 37
  [4.32238]→[4.32238:32317](∅→∅)
  − import Data.ProtocolBuffers (encodeMessage)

  − import Data.Serialize.Put (runPut)
• edit in lib/Aftok/Json.hs at line 45
  [4.32553]→[4.32553:32587](∅→∅)
  − addrFromJSON,

  − addrToJSON,
• replacement in lib/Aftok/Json.hs at line 142
  [5.1694]→[5.5266:5298](∅→∅),[5.486]→[5.5266:5298](∅→∅)
  − projectJSON :: Project -> Value
  [5.1694]

  [4.33657]
  + projectJSON :: P.Project -> Value
• replacement in lib/Aftok/Json.hs at line 146
  [4.33688]→[4.33688:33782](∅→∅)
  − [ "projectName" .= (p ^. projectName),

  − "inceptionDate" .= (p ^. inceptionDate),
  [4.33688]

  [4.33782]
  + [ "projectName" .= (p ^. P.projectName),

  + "inceptionDate" .= (p ^. P.inceptionDate),
• replacement in lib/Aftok/Json.hs at line 151
  [5.26516]→[5.26516:26564](∅→∅)
  − qdbProjectJSON :: (ProjectId, Project) -> Value
  [5.26516]

  [5.4498]
  + qdbProjectJSON :: (ProjectId, P.Project) -> Value
• replacement in lib/Aftok/Json.hs at line 154
  [5.539]→[5.366:402](∅→∅),[5.402]→[5.1898:1944](∅→∅)
  − auctionIdJSON :: AuctionId -> Value

  − auctionIdJSON = idJSON "auctionId" _AuctionId
  [5.539]

  [5.481]
  + auctionIdJSON :: A.AuctionId -> Value

  + auctionIdJSON = idJSON "auctionId" A._AuctionId
• replacement in lib/Aftok/Json.hs at line 157
  [5.482]→[5.539:571](∅→∅),[5.539]→[5.539:571](∅→∅)
  − auctionJSON :: Auction -> Value
  [5.482]

  [4.33843]
  + auctionJSON :: A.Auction -> Value
• replacement in lib/Aftok/Json.hs at line 163
  [4.33993]→[4.33993:34049](∅→∅)
  − "raiseAmount" .= (x ^. (raiseAmount . satoshi))
  [4.33993]

  [4.34049]
  + "raiseAmount" .= (x ^. (A.raiseAmount . _Satoshi))
• replacement in lib/Aftok/Json.hs at line 166
  [5.484]→[5.484:512](∅→∅),[5.512]→[5.33824:33878](∅→∅)
  − bidIdJSON :: BidId -> Value

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

  [5.21865]
  + bidIdJSON :: A.BidId -> Value

  + bidIdJSON pid = v1 $ obj ["bidId" .= (pid ^. A._BidId)]
• replacement in lib/Aftok/Json.hs at line 173
  [5.2561]→[5.21885:21955](∅→∅),[5.21955]→[4.34058:34256](∅→∅),[5.34058]→[5.22152:22188](∅→∅),[4.34256]→[5.22152:22188](∅→∅),[5.22152]→[5.22152:22188](∅→∅)
  − creditToJSON :: NetworkMode -> CreditTo (NetworkId, Address) -> Value

  − creditToJSON nmode (CreditToCurrency (netId, addr)) =

  − v2 $

  − obj

  − [ "creditToAddress" .= addrToJSON (toNetwork nmode netId) addr,

  − "creditToNetwork" .= renderNetworkId netId

  − ]

  − creditToJSON _ (CreditToUser uid) =
  [5.2561]

  [5.34059]
  + creditToJSON :: CreditTo -> Value

  + creditToJSON (CreditToAccount accountId) =

  + v2 $ obj ["creditToAccount" .= idValue _AccountId accountId]

  + creditToJSON (CreditToUser uid) =
• replacement in lib/Aftok/Json.hs at line 178
  [5.34110]→[5.22244:22283](∅→∅),[5.22244]→[5.22244:22283](∅→∅)
  − creditToJSON _ (CreditToProject pid) =
  [5.34110]

  [5.34111]
  + creditToJSON (CreditToProject pid) =
• replacement in lib/Aftok/Json.hs at line 181
  [5.22338]→[5.22338:22551](∅→∅)
  − parseCreditTo :: NetworkMode -> Value -> Parser (CreditTo (NetworkId, Address))

  − parseCreditTo nmode = unversion "CreditTo" $ \case

  − (Version 1 0) -> parseCreditToV1 nmode

  − (Version 2 0) -> parseCreditToV2 nmode
  [5.22338]

  [4.34257]
  + parseCreditTo :: Value -> Parser CreditTo

  + parseCreditTo = unversion "CreditTo" $ \case

  + (Version 2 0) -> parseCreditToV2
• replacement in lib/Aftok/Json.hs at line 187
  [4.34315]→[4.34315:34426](∅→∅)
  − NetworkMode -> NetworkId -> Text -> Parser (CreditTo (NetworkId, Address))

  − parseBtcAddr nmode net addrText =
  [4.34315]

  [4.34426]
  + NetworkMode -> Text -> Parser Address

  + parseBtcAddr nmode addrText =
• replacement in lib/Aftok/Json.hs at line 190
  [4.34434]→[4.34434:34659](∅→∅)
  − ( fail

  − . T.unpack

  − $ "Address "

  − <> addrText

  − <> " cannot be parsed as a BTC network address."

  − )

  − (pure . CreditToCurrency . (net,))

  − (textToAddr (toNetwork nmode net) addrText)
  [4.34434]

  [5.22927]
  + (fail . T.unpack $ "Address " <> addrText <> " cannot be parsed as a BTC network address.")

  + pure

  + (textToAddr (getNetwork nmode) addrText)
• replacement in lib/Aftok/Json.hs at line 194
  [5.22928]→[4.34660:34745](∅→∅),[5.34549]→[5.23017:23091](∅→∅),[4.34745]→[5.23017:23091](∅→∅),[5.23017]→[5.23017:23091](∅→∅),[5.23091]→[4.34746:34831](∅→∅),[5.34635]→[5.23174:23200](∅→∅),[4.34831]→[5.23174:23200](∅→∅),[5.23174]→[5.23174:23200](∅→∅),[5.23200]→[4.34832:35208](∅→∅)
  − parseCreditToV1 ::

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

  − parseCreditToV1 nmode x = do

  − parseBtcAddr nmode BTC =<< x .: "btcAddr"

  −

  − parseCreditToV2 ::

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

  − parseCreditToV2 nmode o =

  − 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
  [5.22928]

  [4.35208]
  + parseCreditToV2 :: Object -> Parser CreditTo

  + parseCreditToV2 o =

  + let parseCreditToAcct = do

  + fmap CreditToAccount . parseId _AccountId =<< o .: "creditToAccount"
• replacement in lib/Aftok/Json.hs at line 204
  [4.35502]→[4.35502:35526](∅→∅)
  − in parseCreditToAddr
  [4.35502]

  [4.35526]
  + in parseCreditToAcct
• replacement in lib/Aftok/Json.hs at line 213
  [5.581]→[5.35378:35478](∅→∅)
  − payoutsJSON :: NetworkMode -> Payouts (NetworkId, Address) -> Value

  − payoutsJSON nmode (Payouts m) =
  [5.581]

  [4.35611]
  + payoutsJSON :: FractionalPayouts -> Value

  + payoutsJSON (Payouts m) =
• replacement in lib/Aftok/Json.hs at line 216
  [4.35618]→[4.35618:35691](∅→∅)
  − let payoutsRec :: (CreditTo (NetworkId, Address), Rational) -> Value
  [4.35618]

  [4.35691]
  + let payoutsRec :: (CreditTo, Rational) -> Value
• replacement in lib/Aftok/Json.hs at line 218
  [4.35719]→[4.35719:35793](∅→∅)
  − object ["creditTo" .= creditToJSON nmode c, "payoutRatio" .= r]
  [4.35719]

  [4.35793]
  + object ["creditTo" .= creditToJSON c, "payoutRatio" .= r, "payoutPercentage" .= (fromRational @Double r * 100)]
• replacement in lib/Aftok/Json.hs at line 221
  [5.24498]→[4.35853:35986](∅→∅)
  − parsePayoutsJSON ::

  − NetworkMode -> Value -> Parser (Payouts (NetworkId, Address))

  − parsePayoutsJSON nmode = unversion "Payouts" $ p
  [5.24498]

  [4.35986]
  + parsePayoutsJSON :: Value -> Parser FractionalPayouts

  + parsePayoutsJSON = unversion "Payouts" $ p
• replacement in lib/Aftok/Json.hs at line 224
  [4.35994]→[4.35994:36196](∅→∅)
  − p :: Version -> Object -> Parser (Payouts (NetworkId, Address))

  − p (Version 1 _) val =

  − Payouts

  − <$> join

  − (traverseKeys (parseBtcAddr nmode BTC) <$> parseJSON (Object val))
  [4.35994]

  [4.36196]
  + p :: Version -> Object -> Parser FractionalPayouts
• replacement in lib/Aftok/Json.hs at line 228
  [5.35970]→[5.35970:36034](∅→∅)
  − <$> (parseCreditToV2 nmode =<< (x .: "creditTo"))
  [5.35970]

  [5.36034]
  + <$> (parseCreditToV2 =<< (x .: "creditTo"))
• replacement in lib/Aftok/Json.hs at line 239
  [5.24820]→[5.24820:24892](∅→∅),[5.24892]→[4.36413:36452](∅→∅)
  − workIndexJSON :: NetworkMode -> WorkIndex (NetworkId, Address) -> Value

  − workIndexJSON nmode (WorkIndex widx) =
  [5.24820]

  [4.36452]
  + workIndexJSON :: WorkIndex -> Value

  + workIndexJSON (WorkIndex widx) =
• replacement in lib/Aftok/Json.hs at line 244
  [4.36522]→[4.36522:36597](∅→∅)
  − widxRec :: (CreditTo (NetworkId, Address), NonEmpty Interval) -> Value
  [4.36522]

  [4.36597]
  + widxRec :: (CreditTo, NonEmpty Interval) -> Value
• replacement in lib/Aftok/Json.hs at line 247
  [4.36631]→[4.36631:36677](∅→∅)
  − [ "creditTo" .= creditToJSON nmode c,
  [4.36631]

  [4.36677]
  + [ "creditTo" .= creditToJSON c,
• replacement in lib/Aftok/Json.hs at line 258
  [5.255]→[5.25082:25152](∅→∅),[5.25152]→[5.4850:4909](∅→∅)
  − logEntryJSON :: NetworkMode -> LogEntry (NetworkId, Address) -> Value

  − logEntryJSON nmode le = v2 $ obj (logEntryFields nmode le)
  [5.255]

  [5.4909]
  + logEntryJSON :: LogEntry -> Value

  + logEntryJSON le = v2 $ obj (logEntryFields le)
• replacement in lib/Aftok/Json.hs at line 261
  [5.4910]→[5.4910:5024](∅→∅),[5.5024]→[4.36743:36783](∅→∅)
  − logEntryFields :: NetworkMode -> LogEntry (NetworkId, Address) -> [Pair]

  − logEntryFields nmode (LogEntry c ev m) =

  − [ "creditTo" .= creditToJSON nmode c,
  [5.4910]

  [4.36783]
  + logEntryFields :: LogEntry -> [Pair]

  + logEntryFields (LogEntry c ev m) =

  + [ "creditTo" .= creditToJSON c,
• edit in lib/Aftok/Json.hs at line 271
  [5.26624]

  [5.26624]
  + amountJSON :: Amount -> Value

  + amountJSON (Amount currency value) = case currency of

  + BTC -> object ["satoshi" .= (value ^. _Satoshi)]

  + ZEC -> object ["zatoshi" .= (value ^. _Zatoshi)]

  +
• replacement in lib/Aftok/Json.hs at line 279
  [5.1569]→[5.1569:1605](∅→∅)
  − billableJSON :: B.Billable -> Value
  [5.1569]

  [5.2524]
  + billableJSON :: B.Billable Amount -> Value
• replacement in lib/Aftok/Json.hs at line 282
  [5.2562]→[5.2562:2612](∅→∅)
  − billableKV :: (KeyValue kv) => B.Billable -> [kv]
  [5.2562]

  [5.2612]
  + billableKV :: (KeyValue kv) => B.Billable Amount -> [kv]
• replacement in lib/Aftok/Json.hs at line 287
  [4.36965]→[4.36965:37067](∅→∅)
  − "recurrence" .= recurrenceJSON' (b ^. B.recurrence),

  − "amount" .= (b ^. (B.amount . satoshi)),
  [4.36965]

  [4.37067]
  + "recurrence" .= (b ^. B.recurrence . to recurrenceJSON'),

  + "amount" .= (b ^. (B.amount . to amountJSON)),
• replacement in lib/Aftok/Json.hs at line 290
  [4.37110]→[4.37110:37191](∅→∅)
  − "requestExpiryPeriod" .= (Clock.toSeconds' <$> (b ^. B.requestExpiryPeriod))
  [4.37110]

  [5.2993]
  + "requestExpiryPeriod" .= (b ^. B.requestExpiryPeriod . to Clock.toSeconds')
• replacement in lib/Aftok/Json.hs at line 293
  [5.26717]→[5.26717:26772](∅→∅)
  − qdbBillableJSON :: (B.BillableId, B.Billable) -> Value
  [5.26717]

  [5.4603]
  + qdbBillableJSON :: (B.BillableId, B.Billable Amount) -> Value
• replacement in lib/Aftok/Json.hs at line 327
  [5.3562]→[5.630:676](∅→∅),[5.26949]→[5.630:676](∅→∅),[5.630]→[5.630:676](∅→∅),[5.676]→[5.3563:3694](∅→∅),[5.3694]→[4.37770:38065](∅→∅),[5.770]→[5.4007:4011](∅→∅),[4.38065]→[5.4007:4011](∅→∅),[5.4007]→[5.4007:4011](∅→∅),[5.4011]→[4.38066:38167](∅→∅),[5.2890]→[5.4011:4053](∅→∅),[5.3342]→[5.4011:4053](∅→∅),[5.37661]→[5.4011:4053](∅→∅),[4.38167]→[5.4011:4053](∅→∅),[5.4011]→[5.4011:4053](∅→∅),[5.4053]→[5.37662:37737](∅→∅),[5.4131]→[5.975:976](∅→∅),[5.37737]→[5.975:976](∅→∅),[5.975]→[5.975:976](∅→∅),[5.976]→[5.4132:4171](∅→∅),[5.4171]→[4.38168:38380](∅→∅)
  − paymentRequestJSON :: PaymentRequest -> Value

  − paymentRequestJSON = v1 . obj . paymentRequestKV

  −

  − paymentRequestKV :: (KeyValue kv) => PaymentRequest -> [kv]

  − paymentRequestKV r =

  − [ "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

  − ]

  − where

  − prBytes =

  − paymentRequest . to (T.decodeUtf8 . B64.encode . runPut . encodeMessage)

  −

  − billDetailsJSON :: [BillDetail] -> Value

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

  −

  − billDetailJSON :: BillDetail -> Object

  − billDetailJSON r =

  − obj $

  − concat

  − [ ["payment_request_id" .= view (_1 . _PaymentKey) r],

  − paymentRequestKV $ view _2 r,

  − subscriptionKV $ view _3 r,

  − billableKV $ view _4 r

  − ]
  [5.26949]

  [5.26950]
  + -- paymentRequestDetailsJSON :: [PaymentRequestDetail Amount] -> Value

  + -- paymentRequestDetailsJSON r = v1 $ obj ["payment_requests" .= fmap paymentRequestDetailJSON r]

  + --

  + -- paymentRequestDetailJSON :: PaymentRequestDetail Amount -> Object

  + -- paymentRequestDetailJSON r = obj $ concat

  + -- [ ["payment_request_id" .= view () r]

  + -- , paymentRequestKV $ view _2 r

  + -- , subscriptionKV $ view _3 r

  + -- , billableKV $ view _4 r

  + -- ]
• edit in lib/Aftok/Json.hs at line 341
  [5.4378]→[5.976:1008](∅→∅),[5.976]→[5.976:1008](∅→∅),[5.1008]→[4.38381:38691](∅→∅),[5.3110]→[5.2430:2431](∅→∅),[5.3428]→[5.2430:2431](∅→∅),[5.38203]→[5.2430:2431](∅→∅),[4.38691]→[5.2430:2431](∅→∅),[5.2430]→[5.2430:2431](∅→∅)
  − paymentJSON :: Payment -> Value

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

  −
• edit in lib/Aftok/Json.hs at line 354
  [4.38876]→[4.38876:38893](∅→∅)
  − NetworkMode ->
• replacement in lib/Aftok/Json.hs at line 356
  [4.38917]→[4.38917:39025](∅→∅)
  − Parser (EventAmendment (NetworkId, Address))

  − parseEventAmendment nmode t = unversion "EventAmendment" $ p
  [4.38917]

  [4.39025]
  + Parser EventAmendment

  + parseEventAmendment t = unversion "EventAmendment" $ p
• replacement in lib/Aftok/Json.hs at line 359
  [4.39033]→[4.39033:39137](∅→∅)
  − p (Version 1 _) = parseEventAmendmentV1 nmode t

  − p (Version 2 0) = parseEventAmendmentV2 nmode t
  [4.39033]

  [4.39137]
  + p (Version 2 0) = parseEventAmendmentV2 t
• edit in lib/Aftok/Json.hs at line 362
  [5.1957]→[4.39182:39296](∅→∅),[4.39296]→[5.25818:25852](∅→∅),[5.25818]→[5.25818:25852](∅→∅),[5.25852]→[4.39297:39697](∅→∅),[5.1362]→[5.2512:2513](∅→∅),[5.4328]→[5.2512:2513](∅→∅),[5.38771]→[5.2512:2513](∅→∅),[4.39697]→[5.2512:2513](∅→∅),[5.2512]→[5.2512:2513](∅→∅)
  − parseEventAmendmentV1 ::

  − NetworkMode ->

  − ModTime ->

  − Object ->

  − Parser (EventAmendment (NetworkId, Address))

  − parseEventAmendmentV1 nmode t o =

  − 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

  −
• edit in lib/Aftok/Json.hs at line 363
  [4.39723]→[4.39723:39740](∅→∅)
  − NetworkMode ->
• replacement in lib/Aftok/Json.hs at line 365
  [4.39765]→[4.39765:39812](∅→∅),[4.39812]→[5.26197:26231](∅→∅),[5.26197]→[5.26197:26231](∅→∅),[5.26231]→[4.39813:39882](∅→∅)
  − Parser (EventAmendment (NetworkId, Address))

  − parseEventAmendmentV2 nmode t o =

  − let parseA :: Text -> Parser (EventAmendment (NetworkId, Address))
  [4.39765]

  [4.39882]
  + Parser EventAmendment

  + parseEventAmendmentV2 t o =

  + let parseA :: Text -> Parser EventAmendment
• replacement in lib/Aftok/Json.hs at line 369
  [4.39944]→[4.39944:40021](∅→∅)
  − parseA "creditToChange" = CreditToChange t <$> parseCreditToV2 nmode o
  [4.39944]

  [4.40021]
  + parseA "creditToChange" = CreditToChange t <$> parseCreditToV2 o
• edit in lib/Aftok/Json.hs at line 376
  [4.40235]→[4.40235:40252](∅→∅)
  − NetworkMode ->
• replacement in lib/Aftok/Json.hs at line 379
  [4.40302]→[4.40302:40407](∅→∅)
  − Parser (UTCTime -> (LogEntry (NetworkId, Address)))

  − parseLogEntry nmode uid f = unversion "LogEntry" p
  [4.40302]

  [4.40407]
  + Parser (UTCTime -> LogEntry)

  + parseLogEntry uid f = unversion "LogEntry" p
• replacement in lib/Aftok/Json.hs at line 383
  [4.40442]→[4.40442:40580](∅→∅)
  − creditTo' <-

  − o .:? "creditTo"

  − >>= maybe

  − (pure $ CreditToUser uid)

  − (parseCreditToV2 nmode)
  [4.40442]

  [4.40580]
  + creditTo' <- o .:? "creditTo" >>= maybe (pure $ CreditToUser uid) (parseCreditToV2)
• file addition: Bitcoin.hs (----------)
  [5.10523]
  + {-# LANGUAGE DeriveTraversable #-}

  + {-# LANGUAGE TemplateHaskell #-}

  + {-# LANGUAGE TupleSections #-}

  +

  + module Aftok.Payments.Bitcoin where

  +

  + import Aftok.Billing

  + ( Billable,

  + amount,

  + project,

  + requestExpiryPeriod,

  + )

  + import Aftok.Currency (Currency (BTC))

  + import Aftok.Currency.Bitcoin

  + ( NetworkMode,

  + _Satoshi,

  + getNetwork,

  + )

  + import Aftok.Currency.Bitcoin.Payments (PaymentKey (..), PaymentRequest (..))

  + import Aftok.Database (MonadDB)

  + import Aftok.Payments.Types

  + ( NativeRequest (Bip70Request),

  + PaymentOps (..),

  + PaymentRequestError,

  + )

  + import Aftok.Payments.Util (MinPayout (..), getPayouts, getProjectPayoutFractions)

  + import qualified Bippy as B

  + import qualified Bippy.Proto as P

  + import Bippy.Types

  + ( Expiry (Expiry),

  + Output (Output),

  + PKIData,

  + Satoshi (Satoshi),

  + expiryTime,

  + getExpires,

  + getPaymentDetails,

  + )

  + import Control.Lens

  + ( (^.),

  + makeLenses,

  + )

  + import Control.Monad.Except (throwError)

  + import Control.Monad.Trans.Except (except, withExceptT)

  + 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 qualified Data.Text as T

  + import Data.Thyme.Clock as C

  + import Data.Thyme.Time as C

  + import Haskoin.Address (Address (..), encodeBase58Check)

  + import Haskoin.Script (ScriptOutput (..))

  + import Network.URI (URI)

  +

  + data BillingOps (m :: * -> *)

  + = BillingOps

  + { -- | generator for user memo

  + memoGen ::

  + Billable Satoshi -> -- template for the bill

  + C.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 ::

  + Billable Satoshi -> -- template for the bill

  + C.Day -> -- billing date

  + C.UTCTime -> -- payment request generation time

  + m (Maybe ByteString)

  + }

  +

  + data PaymentsConfig

  + = PaymentsConfig

  + { _networkMode :: !NetworkMode,

  + _signingKey :: !RSA.PrivateKey,

  + _pkiData :: !PKIData,

  + _minPayment :: !Satoshi

  + }

  +

  + makeLenses ''PaymentsConfig

  +

  + data PaymentError

  + = RequestError !PaymentRequestError

  + | SigningError !RSA.Error

  + | IllegalAddress !Address

  +

  + {- Check whether the specified payment request has expired (whether wallet software

  + - will still consider the payment request valid)

  + -}

  + isExpired :: C.UTCTime -> P.PaymentRequest -> Bool

  + isExpired now req =

  + let check = any ((now >) . C.toThyme . expiryTime)

  + in -- using error here is reasonable since it would indicate

  + -- a serialization problem

  + either (error . T.pack) (check . getExpires) $

  + getPaymentDetails req

  +

  + paymentOps ::

  + ( MonadRandom m,

  + MonadDB m

  + ) =>

  + BillingOps m ->

  + PaymentsConfig ->

  + PaymentOps Satoshi (ExceptT PaymentError m)

  + paymentOps ops cfg =

  + PaymentOps

  + { newPaymentRequest = (((fmap Bip70Request) .) .) . bip70PaymentRequest ops cfg

  + }

  +

  + bip70PaymentRequest ::

  + ( MonadRandom m,

  + MonadDB m

  + ) =>

  + BillingOps m ->

  + PaymentsConfig ->

  + -- | bill denominated in satoshi

  + Billable Satoshi ->

  + -- | billing base date

  + C.Day ->

  + -- | time at which the bill is being issued

  + UTCTime ->

  + ExceptT PaymentError m PaymentRequest

  + bip70PaymentRequest ops cfg billable billingDay billingTime = do

  + let billTotal = billable ^. amount

  + payoutTime = C.mkUTCTime billingDay (fromInteger 0)

  + payoutFractions <- lift $ getProjectPayoutFractions payoutTime (billable ^. project)

  + payouts <- withExceptT RequestError $ getPayouts payoutTime BTC (MinPayout $ cfg ^. minPayment) billTotal payoutFractions

  + outputs <- except $ traverse toOutput (assocs payouts)

  + pkey <- PaymentKey . encodeBase58Check <$> lift (getRandomBytes 32)

  + memo <- lift $ memoGen ops billable billingDay billingTime

  + uri <- lift $ uriGen ops pkey

  + payload <- lift $ payloadGen ops billable billingDay billingTime

  + let expiry = Expiry . C.fromThyme $ billingTime .+^ (billable ^. requestExpiryPeriod)

  + let details =

  + B.createPaymentDetails

  + (getNetwork (cfg ^. networkMode))

  + outputs

  + (C.fromThyme billingTime)

  + (Just expiry)

  + memo

  + uri

  + payload

  + resp <- lift $ B.createPaymentRequest (cfg ^. signingKey) (cfg ^. pkiData) details

  + either (throwError . SigningError) (pure . PaymentRequest pkey) resp

  +

  + toOutput :: (Address, Satoshi) -> Either PaymentError Output

  + toOutput (addr, amt) = case addr of

  + (PubKeyAddress a) -> Right (Output amt (PayPKHash a))

  + other -> Left $ IllegalAddress other

  +

  + outputAmount :: Satoshi -> Rational -> Satoshi

  + outputAmount i r = Satoshi . round $ toRational (i ^. _Satoshi) * r
• replacement in lib/Aftok/Payments/Types.hs at line 11
  [4.41454]→[4.41454:41492](∅→∅)
  − Subscription,

  − SubscriptionId,
  [4.41454]

  [4.41492]
  + Billable',

  + BillableId,

  + requestExpiryPeriod,
• replacement in lib/Aftok/Payments/Types.hs at line 15
  [4.41496]→[4.41496:41626](∅→∅)
  − import qualified Bippy.Proto as P

  − import Bippy.Types

  − ( Satoshi (..),

  − expiryTime,

  − getExpires,

  − getPaymentDetails,

  − )
  [4.41496]

  [4.41626]
  + import Aftok.Currency (Currency (..), Currency' (..))

  + import Aftok.Currency.Bitcoin (Satoshi)

  + import qualified Aftok.Currency.Bitcoin.Payments as B

  + import Aftok.Currency.Zcash (Zatoshi)

  + import qualified Aftok.Currency.Zcash.Payments as Z

  + import qualified Aftok.Currency.Zcash.Zip321 as Z

  + import Aftok.Types (ProjectId, UserId)
• replacement in lib/Aftok/Payments/Types.hs at line 23
  [4.41646]→[4.41646:41662](∅→∅)
  − ( makeLenses,
  [4.41646]

  [4.41662]
  + ( (^.),

  + makeLenses,
• edit in lib/Aftok/Payments/Types.hs at line 26
  [4.41678]→[4.41678:41688](∅→∅)
  − view,
• replacement in lib/Aftok/Payments/Types.hs at line 27
  [4.41692]→[4.41692:41750](∅→∅)
  − import Data.Aeson (Value)

  − import qualified Data.Text as T
  [4.41692]

  [4.41750]
  + import Data.AffineSpace ((.+^))
• edit in lib/Aftok/Payments/Types.hs at line 31
  [4.41824]→[4.41824:41874](∅→∅)
  − import Haskoin.Address.Base58 (decodeBase58Check)
• replacement in lib/Aftok/Payments/Types.hs at line 40
  [5.1243]→[5.28314:28393](∅→∅),[5.28393]→[5.1243:1294](∅→∅),[5.1243]→[5.1243:1294](∅→∅)
  − -- A unique identifier for the payment request, suitable

  − -- for URL embedding.

  − newtype PaymentKey = PaymentKey Text deriving (Eq)
  [5.1243]

  [4.41947]
  + data NativeRequest currency where

  + Bip70Request :: B.PaymentRequest -> NativeRequest Satoshi

  + Zip321Request :: Z.PaymentRequest -> NativeRequest Zatoshi

  +

  + bip70Request :: NativeRequest currency -> Maybe B.PaymentRequest

  + bip70Request = \case

  + Bip70Request r -> Just r

  + _ -> Nothing

  +

  + zip321Request :: NativeRequest currency -> Maybe Z.PaymentRequest

  + zip321Request = \case

  + Zip321Request r -> Just r

  + _ -> Nothing

  +

  + data NativePayment currency where

  + BitcoinPayment :: B.Payment -> NativePayment Satoshi

  + ZcashPayment :: Z.Payment -> NativePayment Zatoshi
• replacement in lib/Aftok/Payments/Types.hs at line 58
  [4.41948]→[5.1294:1318](∅→∅),[5.1294]→[5.1294:1318](∅→∅)
  − makePrisms ''PaymentKey
  [4.41948]

  [5.11036]
  + data PaymentOps currency m

  + = PaymentOps

  + { newPaymentRequest ::

  + Billable currency -> -- billing information

  + C.Day -> -- payout date (billing date)

  + C.UTCTime -> -- timestamp of payment request creation

  + m (NativeRequest currency)

  + }
• replacement in lib/Aftok/Payments/Types.hs at line 67
  [5.11037]→[4.41949:41972](∅→∅)
  − data PaymentRequest' s
  [5.11037]

  [4.41972]
  + data PaymentRequest' (billable :: * -> *) currency
• replacement in lib/Aftok/Payments/Types.hs at line 69
  [4.41991]→[4.41991:42171](∅→∅)
  − { _subscription :: s,

  − _paymentRequest :: P.PaymentRequest,

  − _paymentKey :: PaymentKey,

  − _paymentRequestTime :: C.UTCTime,

  − _billingDate :: C.Day
  [4.41991]

  [4.42171]
  + { _billable :: billable currency,

  + _createdAt :: C.UTCTime,

  + _billingDate :: C.Day,

  + _nativeRequest :: NativeRequest currency
• edit in lib/Aftok/Payments/Types.hs at line 74
  [4.42179]→[4.42179:42223](∅→∅)
  − deriving (Functor, Foldable, Traversable)
• edit in lib/Aftok/Payments/Types.hs at line 76
  [5.11220]

  [5.11220]
  +

  + type PaymentRequest currency = PaymentRequest' (Const BillableId) currency
• replacement in lib/Aftok/Payments/Types.hs at line 79
  [5.11221]→[5.11221:11274](∅→∅)
  − type PaymentRequest = PaymentRequest' SubscriptionId
  [5.11221]

  [5.11274]
  + type PaymentRequestDetail currency = PaymentRequest' (Billable' ProjectId UserId) currency
• replacement in lib/Aftok/Payments/Types.hs at line 81
  [5.11275]→[4.42225:42241](∅→∅)
  − data Payment' r
  [5.11275]

  [4.42241]
  + data SomePaymentRequest (b :: * -> *) = forall c. SomePaymentRequest (PaymentRequest' b c)

  +

  + type SomePaymentRequestDetail = SomePaymentRequest (Billable' ProjectId UserId)

  +

  + paymentRequestCurrency :: PaymentRequest' b c -> Currency' c

  + paymentRequestCurrency pr = case _nativeRequest pr of

  + Bip70Request _ -> Currency' BTC

  + Zip321Request _ -> Currency' ZEC

  +

  + isExpired :: forall c. UTCTime -> PaymentRequestDetail c -> Bool

  + isExpired now req =

  + let expiresAt = (req ^. createdAt) .+^ (req ^. (billable . requestExpiryPeriod))

  + in now >= expiresAt

  +

  + data Payment' (paymentRequest :: * -> *) currency
• replacement in lib/Aftok/Payments/Types.hs at line 97
  [4.42253]→[4.42253:42307](∅→∅)
  − { _request :: r,

  − _payment :: P.Payment,
  [4.42253]

  [4.42307]
  + { _paymentRequest :: paymentRequest currency,
• replacement in lib/Aftok/Payments/Types.hs at line 99
  [4.42342]→[4.42342:42380](∅→∅)
  − _exchangeRates :: Maybe Value
  [4.42342]

  [4.42380]
  + _nativePayment :: NativePayment currency
• edit in lib/Aftok/Payments/Types.hs at line 101
  [4.42388]→[4.42388:42432](∅→∅)
  − deriving (Functor, Foldable, Traversable)
• replacement in lib/Aftok/Payments/Types.hs at line 104
  [5.11410]→[5.11410:11451](∅→∅)
  − type Payment = Payment' PaymentRequestId
  [5.11410]

  [5.11451]
  + data PaymentRequestError

  + = AmountInvalid

  + | NoRecipients
• replacement in lib/Aftok/Payments/Types.hs at line 108
  [5.11452]→[5.1319:1390](∅→∅)
  − type BillDetail = (PaymentKey, PaymentRequest, Subscription, Billable)
  [5.11452]

  [5.4642]
  + type Payment currency = Payment' (Const PaymentRequestId) currency
• replacement in lib/Aftok/Payments/Types.hs at line 110
  [5.4643]→[5.6960:7098](∅→∅),[5.11452]→[5.6960:7098](∅→∅),[5.7098]→[4.42434:42496](∅→∅),[5.4706]→[5.2489:2509](∅→∅),[5.41047]→[5.2489:2509](∅→∅),[4.42496]→[5.2489:2509](∅→∅),[5.7149]→[5.2489:2509](∅→∅),[5.2509]→[5.3729:3782](∅→∅),[5.3782]→[4.42497:42699](∅→∅),[5.3880]→[5.2571:2572](∅→∅),[5.4793]→[5.2571:2572](∅→∅),[5.41250]→[5.2571:2572](∅→∅),[4.42699]→[5.2571:2572](∅→∅),[5.7377]→[5.2571:2572](∅→∅),[5.2572]→[5.1391:1441](∅→∅),[5.1441]→[5.41251:41338](∅→∅),[5.27198]→[5.28394:28498](∅→∅),[5.41338]→[5.28394:28498](∅→∅),[5.1513]→[5.28394:28498](∅→∅)
  − {- Check whether the specified payment request has expired (whether wallet software

  − - will still consider the payment request valid)

  − -}

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

  − isExpired now req =

  − let check = any ((now >) . C.toThyme . expiryTime)

  − in -- using error here is reasonable since it would indicate

  − -- a serialization problem

  − either (error . T.pack) (check . getExpires) $

  − getPaymentDetails (view paymentRequest req)

  −

  − parsePaymentKey :: ByteString -> Maybe PaymentKey

  − parsePaymentKey bs =

  − (PaymentKey . decodeUtf8) <$> decodeBase58Check (decodeUtf8 bs)

  −

  − paymentRequestTotal :: P.PaymentRequest -> Satoshi

  − paymentRequestTotal _ = error "Not yet implemented"
  [5.4643]
  + type PaymentDetail currency = Payment' (PaymentRequest' (Billable' ProjectId UserId)) currency
• file addition: Util.hs (----------)
  [5.10523]
  + {-# LANGUAGE TupleSections #-}

  +

  + module Aftok.Payments.Util where

  +

  + import Aftok.Currency (Currency, scaleCurrency)

  + import Aftok.Database

  + ( DBOp

  + ( FindProject,

  + ReadWorkIndex

  + ),

  + MonadDB,

  + findAccountPaymentAddress,

  + findUserPaymentAddress,

  + liftdb,

  + raiseSubjectNotFound,

  + )

  + import Aftok.Payments.Types (PaymentRequestError (..))

  + import Aftok.Project (depf)

  + import qualified Aftok.TimeLog as TL

  + import Aftok.Types (ProjectId)

  + import Control.Error.Util (note)

  + import Control.Lens ((^.))

  + import Control.Monad.Trans.Except (except)

  + import Data.Map.Strict (assocs, fromListWith)

  + import Data.Thyme.Clock as C

  +

  + getProjectPayoutFractions ::

  + (MonadDB m) =>

  + C.UTCTime ->

  + ProjectId ->

  + m TL.FractionalPayouts

  + getProjectPayoutFractions ptime pid = do

  + project' <-

  + let projectOp = FindProject pid

  + in maybe (raiseSubjectNotFound projectOp) pure =<< liftdb projectOp

  + widx <- liftdb $ ReadWorkIndex pid

  + pure $ TL.payouts (TL.toDepF $ project' ^. depf) ptime widx

  +

  + newtype MinPayout c = MinPayout c

  +

  + getPayouts ::

  + (MonadDB m, Ord a, Semigroup c, Ord c) =>

  + -- | time used in computation of payouts when `creditTo` is another project

  + C.UTCTime ->

  + -- | the currency with which the payment will be made

  + Currency a c ->

  + -- | the minimum payout amount, below which values are disregarded (avoids dust)

  + MinPayout c ->

  + -- | the amount to pay in total

  + c ->

  + -- | the fractions of the total payout to pay to each recipient

  + TL.FractionalPayouts ->

  + ExceptT PaymentRequestError m (Map a c)

  + getPayouts t currency mp@(MinPayout minAmt) amt payouts =

  + if amt <= minAmt

  + then pure mempty

  + else do

  + -- Multiply the total by each payout fraction. This may fail, so traverse.

  + let scaled frac = note AmountInvalid $ scaleCurrency currency amt frac

  + payoutFractions <- except $ traverse scaled (payouts ^. TL._Payouts)

  + fromListWith (<>) . join <$> traverse (uncurry (getPayoutAmounts t currency mp)) (assocs payoutFractions)

  +

  + getPayoutAmounts ::

  + (MonadDB m, Ord a, Semigroup c, Ord c) =>

  + -- | time used in computation of payouts when `creditTo` is another project

  + C.UTCTime ->

  + -- | the network on which the payment will be made

  + Currency a c ->

  + -- | the minimum payout amount, below which amounts will be disregarded (avoids dust)

  + MinPayout c ->

  + -- | the recipient of the payment

  + TL.CreditTo ->

  + -- | the amount to pay to the recipient

  + c ->

  + ExceptT PaymentRequestError m [(a, c)]

  + getPayoutAmounts t network mp creditTo amt = case creditTo of

  + (TL.CreditToAccount aid) ->

  + fmap (,amt) . maybeToList <$> (lift . runMaybeT $ findAccountPaymentAddress aid network)

  + (TL.CreditToUser uid) ->

  + fmap (,amt) . maybeToList <$> (lift . runMaybeT $ findUserPaymentAddress uid network)

  + (TL.CreditToProject pid) -> do

  + payouts <- lift $ getProjectPayoutFractions t pid

  + assocs <$> getPayouts t network mp amt payouts
• file addition: Zcash.hs (----------)
  [5.10523]
  + {-# LANGUAGE TemplateHaskell #-}

  +

  + module Aftok.Payments.Zcash where

  +

  + import Aftok.Billing

  + ( Billable,

  + amount,

  + messageText,

  + project,

  + )

  + import Aftok.Currency (Currency (ZEC))

  + import Aftok.Currency.Zcash (Address, Zatoshi)

  + import Aftok.Currency.Zcash.Zip321 (PaymentItem (..), PaymentRequest (..))

  + import Aftok.Database (MonadDB)

  + import qualified Aftok.Payments.Types as PT

  + import Aftok.Payments.Util (MinPayout (..), getPayouts, getProjectPayoutFractions)

  + import Control.Error.Safe (tryJust)

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

  + import Data.Map.Strict (assocs)

  + import Data.Thyme.Clock as C

  + import Data.Thyme.Time as C

  +

  + data PaymentsConfig

  + = PaymentsConfig

  + { _minAmt :: Zatoshi

  + }

  +

  + makeLenses ''PaymentsConfig

  +

  + paymentOps ::

  + (MonadDB m) =>

  + PaymentsConfig ->

  + PT.PaymentOps Zatoshi (ExceptT PT.PaymentRequestError m)

  + paymentOps cfg =

  + PT.PaymentOps

  + { PT.newPaymentRequest = ((fmap PT.Zip321Request .) .) . zip321PaymentRequest cfg

  + }

  +

  + zip321PaymentRequest ::

  + (MonadDB m) =>

  + PaymentsConfig ->

  + -- | billing information

  + Billable Zatoshi ->

  + -- | payout date (billing date)

  + C.Day ->

  + -- | timestamp for payment request creation

  + C.UTCTime ->

  + ExceptT PT.PaymentRequestError m PaymentRequest

  + zip321PaymentRequest cfg billable billingDay _ = do

  + let payoutTime = C.mkUTCTime billingDay (fromInteger 0)

  + billTotal = billable ^. amount

  + payoutFractions <- lift $ getProjectPayoutFractions payoutTime (billable ^. project)

  + payouts <- getPayouts payoutTime ZEC (MinPayout $ cfg ^. minAmt) billTotal payoutFractions

  + PaymentRequest <$> (tryJust PT.NoRecipients $ nonEmpty (toPaymentItem <$> assocs payouts))

  + where

  + toPaymentItem :: (Address, Zatoshi) -> PaymentItem

  + toPaymentItem (a, z) =

  + PaymentItem

  + { _address = a,

  + _label = Nothing,

  + _message = billable ^. messageText,

  + _amount = z,

  + _memo = Nothing, -- Just . Memo $ toASCIIBytes (reqid ^. PT._PaymentRequestId),

  + _other = []

  + }
• replacement in lib/Aftok/Payments.hs at line 12
  [4.42852]→[4.42852:42947](∅→∅)
  − import Aftok.Currency.Bitcoin

  − ( NetworkId (..),

  − NetworkMode,

  − satoshi,

  − toNetwork,
  [4.42852]

  [4.42947]
  + ( Billable,

  + BillableId,

  + Subscription,

  + Subscription',

  + SubscriptionId,

  + amount,
• edit in lib/Aftok/Payments.hs at line 19
  [4.42951]

  [4.42951]
  + import qualified Aftok.Billing as B

  + import Aftok.Currency (Amount (..), Currency (..), Currency' (..))
• edit in lib/Aftok/Payments.hs at line 22
  [4.42973]

  [4.42973]
  + ( DBOp

  + ( FindBillable,

  + FindSubscription

  + ),

  + MonadDB,

  + OpForbiddenReason (UserNotSubscriber),

  + findBillable,

  + findPayment,

  + findSubscriptionPaymentRequests,

  + findSubscriptionUnpaidRequests,

  + liftdb,

  + raiseOpForbidden,

  + raiseSubjectNotFound,

  + storePaymentRequest,

  + )

  + import qualified Aftok.Payments.Bitcoin as BTC
• replacement in lib/Aftok/Payments.hs at line 39
  [4.43001]→[4.43001:43066](∅→∅)
  − import Aftok.Project (depf)

  − import qualified Aftok.TimeLog as TL
  [4.43001]

  [4.43066]
  + ( NativeRequest (..),

  + Payment,

  + PaymentOps (..),

  + PaymentRequest,

  + PaymentRequest' (..),

  + PaymentRequestDetail,

  + PaymentRequestId,

  + SomePaymentRequest (..),

  + SomePaymentRequestDetail,

  + billingDate,

  + isExpired,

  + paymentRequestCurrency,

  + )

  + import qualified Aftok.Payments.Types as PT

  + import qualified Aftok.Payments.Zcash as Zcash
• replacement in lib/Aftok/Payments.hs at line 55
  [4.43085]→[4.43085:43112](∅→∅)
  − ( ProjectId,

  − UserId,
  [4.43085]

  [4.43112]
  + ( UserId,
• edit in lib/Aftok/Payments.hs at line 57
  [4.43116]→[4.43116:43213](∅→∅)
  − import qualified Bippy as B

  − import qualified Bippy.Proto as P

  − import qualified Bippy.Types as BT
• replacement in lib/Aftok/Payments.hs at line 59
  [4.43268]→[4.43268:43278](∅→∅)
  − ( (%~),
  [4.43268]

  [4.43278]
  + ( (.~),
• edit in lib/Aftok/Payments.hs at line 61
  [4.43288]→[4.43288:43304](∅→∅)
  − makeClassy,
• edit in lib/Aftok/Payments.hs at line 62
  [4.43326]

  [4.43326]
  + makeLenses,
• edit in lib/Aftok/Payments.hs at line 65
  [4.43354]→[4.43354:43364](∅→∅)
  − view,
• edit in lib/Aftok/Payments.hs at line 66
  [4.43368]→[4.43368:43394](∅→∅)
  − import Control.Lens.Tuple
• replacement in lib/Aftok/Payments.hs at line 67
  [4.43422]→[4.43422:43454](∅→∅)
  − ( MonadError,

  − throwError,
  [4.43422]

  [4.43454]
  + ( throwError,

  + withExceptT,
• replacement in lib/Aftok/Payments.hs at line 70
  [4.43458]→[4.43458:43674](∅→∅)
  − import qualified Crypto.PubKey.RSA.Types as RSA

  − ( Error (..),

  − PrivateKey,

  − )

  − import Crypto.Random.Types

  − ( MonadRandom,

  − getRandomBytes,

  − )

  − import Data.AffineSpace ((.+^))

  − import Data.Map.Strict (assocs)
  [4.43458]

  [4.43674]
  + import qualified Crypto.Random.Types as CR
• replacement in lib/Aftok/Payments.hs at line 73
  [4.43731]→[4.43731:43880](∅→∅)
  − import Haskoin.Address (Address (..))

  − import Haskoin.Address.Base58 (encodeBase58Check)

  − import Haskoin.Script (ScriptOutput (..))

  − import Network.URI
  [4.43731]

  [5.3882]
  + import Network.URI ()
• replacement in lib/Aftok/Payments.hs at line 75
  [5.3883]→[4.43881:43901](∅→∅)
  − data PaymentsConfig
  [5.3883]

  [4.43901]
  + data PaymentsConfig m
• replacement in lib/Aftok/Payments.hs at line 77
  [4.43920]→[4.43920:44030](∅→∅)
  − { _networkMode :: !NetworkMode,

  − _signingKey :: !RSA.PrivateKey,

  − _pkiData :: !BT.PKIData
  [4.43920]

  [4.44030]
  + { _bitcoinBillingOps :: !(BTC.BillingOps m),

  + _bitcoinPaymentsConfig :: !BTC.PaymentsConfig,

  + _zcashPaymentsConfig :: !Zcash.PaymentsConfig
• replacement in lib/Aftok/Payments.hs at line 82
  [5.12583]→[5.28779:28807](∅→∅)
  − makeClassy ''PaymentsConfig
  [5.12460]

  [5.7759]
  + makeLenses ''PaymentsConfig
• replacement in lib/Aftok/Payments.hs at line 84
  [5.7760]→[4.44039:44757](∅→∅),[4.44757]→[5.8106:8107](∅→∅),[5.8106]→[5.8106:8107](∅→∅),[5.8107]→[5.4081:4107](∅→∅)
  − 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)

  − }

  −

  − data PaymentRequestStatus
  [5.7760]

  [4.44758]
  + data PaymentRequestStatus c
• replacement in lib/Aftok/Payments.hs at line 86
  [4.44815]→[4.44815:44833](∅→∅)
  − Paid !Payment
  [4.44815]

  [4.44833]
  + Paid !(Payment c)
• replacement in lib/Aftok/Payments.hs at line 88
  [4.44897]→[4.44897:44924](∅→∅)
  − Unpaid !PaymentRequest
  [4.44897]

  [4.44924]
  + forall b. Unpaid !(PaymentRequest' b c)
• replacement in lib/Aftok/Payments.hs at line 90
  [4.44987]→[4.44987:45015](∅→∅)
  − Expired !PaymentRequest
  [4.44987]

  [5.12610]
  + forall b. Expired !(PaymentRequest' b c)
• replacement in lib/Aftok/Payments.hs at line 93
  [5.8406]→[5.29725:29781](∅→∅),[5.29781]→[5.27776:27804](∅→∅)
  − = Overdue !SubscriptionId

  − | SigningError !RSA.Error

  − | IllegalAddress !Address
  [5.8406]

  [4.45016]
  + = RequestError PT.PaymentRequestError

  + | Overdue !PaymentRequestId

  + | BTCPaymentError !BTC.PaymentError

  + | BillableIdMismatch !BillableId !BillableId
• edit in lib/Aftok/Payments.hs at line 99
  [5.8492]→[5.4108:4109](∅→∅),[5.4109]→[5.29782:29955](∅→∅),[5.29955]→[4.45018:45432](∅→∅),[5.7632]→[5.9049:9095](∅→∅),[4.45432]→[5.9049:9095](∅→∅),[5.13305]→[5.9049:9095](∅→∅),[5.9095]→[5.13366:13414](∅→∅),[5.13366]→[5.13366:13414](∅→∅),[5.13414]→[5.2838:2916](∅→∅)
  −

  − {--

  − - Find all the subscriptions for the specified customer, and

  − - determine which if any are up for renewal. Create a payment

  − - request for each such subscription.

  − --}

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

  − createPaymentRequests ops now custId pid = do

  − subscriptions <- findSubscriptions custId pid

  − join <$> traverse (createSubscriptionPaymentRequests ops now) subscriptions
• replacement in lib/Aftok/Payments.hs at line 101
  [4.45470]→[4.45470:45616](∅→∅)
  − ( MonadRandom m,

  − MonadReader r m,

  − HasPaymentsConfig r,

  − MonadError e m,

  − AsPaymentError e,

  − MonadDB m

  − ) =>

  − BillingOps m ->
  [4.45470]

  [4.45616]
  + forall m.

  + (MonadDB m, CR.MonadRandom m) =>

  + PaymentsConfig m ->
• replacement in lib/Aftok/Payments.hs at line 106
  [4.45667]→[4.45667:45690](∅→∅),[4.45690]→[5.2917:2975](∅→∅),[5.9458]→[5.2917:2975](∅→∅),[5.2975]→[5.7785:7802](∅→∅),[5.7802]→[4.45691:45808](∅→∅),[5.7919]→[5.9653:9698](∅→∅),[5.30120]→[5.9653:9698](∅→∅),[4.45808]→[5.9653:9698](∅→∅),[5.9653]→[5.9653:9698](∅→∅)
  − m [PaymentRequestId]

  − createSubscriptionPaymentRequests ops now (sid, sub) = do

  − billableSub <-

  − maybeT (raiseSubjectNotFound . FindBillable $ sub ^. billable) pure $

  − traverseOf billable findBillable sub

  − paymentRequests <- findPaymentRequests sid
  [4.45667]

  [4.45809]
  + ExceptT PaymentError m [(PaymentRequestId, SomePaymentRequestDetail)]

  + createSubscriptionPaymentRequests cfg now (sid, sub) = do

  + -- fill in the billable for the subscription

  + sub' <-

  + lift . maybeT (raiseSubjectNotFound . FindBillable $ billableId) pure $

  + traverseOf B.billable findBillable sub

  + -- get previous payment requests & augment with billable information

  + paymentRequests <- lift $ findSubscriptionPaymentRequests sid

  + -- find dates for which no bill has yet been issued
• replacement in lib/Aftok/Payments.hs at line 116
  [4.45828]→[5.7941:8011](∅→∅),[5.7941]→[5.7941:8011](∅→∅),[5.8011]→[4.45829:45905](∅→∅),[5.8083]→[5.2976:3048](∅→∅),[4.45905]→[5.2976:3048](∅→∅),[5.9870]→[5.2976:3048](∅→∅)
  − findUnbilledDates now (view billable billableSub) paymentRequests

  − $ takeWhile (< view _utctDay now)

  − $ billingSchedule billableSub

  − traverse (createPaymentRequest ops now sid billableSub) billableDates
  [4.45828]

  [5.9949]
  + findUnbilledDates now paymentRequests

  + . takeWhile (< now ^. _utctDay)

  + $ B.billingSchedule sub'

  + traverse (createPaymentRequest' sub') billableDates

  + where

  + billableId = sub ^. B.billable

  + -- create a payment request for the specified unbilled date

  + createPaymentRequest' ::

  + Subscription' UserId (Billable Amount) ->

  + T.Day ->

  + ExceptT PaymentError m (PaymentRequestId, SomePaymentRequestDetail)

  + createPaymentRequest' sub' day =

  + let bill = sub' ^. B.billable

  + in case bill ^. amount of

  + Amount BTC sats -> withExceptT BTCPaymentError $ do

  + let ops = BTC.paymentOps (cfg ^. bitcoinBillingOps) (cfg ^. bitcoinPaymentsConfig)

  + bill' = bill & amount .~ sats

  + second SomePaymentRequest <$> createPaymentRequest ops now billableId bill' day

  + Amount ZEC zats -> withExceptT RequestError $ do

  + let ops = Zcash.paymentOps (cfg ^. zcashPaymentsConfig)

  + bill' = bill & amount .~ zats

  + second SomePaymentRequest <$> createPaymentRequest ops now billableId bill' day
• replacement in lib/Aftok/Payments.hs at line 140
  [4.45930]→[4.45930:46076](∅→∅)
  − ( MonadRandom m,

  − MonadReader r m,

  − HasPaymentsConfig r,

  − MonadError e m,

  − AsPaymentError e,

  − MonadDB m

  − ) =>

  − BillingOps m ->
  [4.45930]

  [4.46076]
  + (MonadDB m) =>

  + PaymentOps currency m ->
• replacement in lib/Aftok/Payments.hs at line 143
  [4.46091]→[4.46091:46146](∅→∅)
  − SubscriptionId ->

  − Subscription' UserId Billable ->
  [4.46091]

  [4.46146]
  + BillableId ->

  + Billable currency ->
• replacement in lib/Aftok/Payments.hs at line 146
  [4.46157]→[4.46157:46178](∅→∅),[4.46178]→[5.3049:3096](∅→∅),[5.10233]→[5.3049:3096](∅→∅),[5.3096]→[4.46179:46192](∅→∅),[5.8240]→[5.946:1016](∅→∅),[4.46192]→[5.946:1016](∅→∅),[5.13427]→[5.946:1016](∅→∅),[5.1016]→[4.46193:46316](∅→∅),[4.46316]→[5.3260:3301](∅→∅),[5.3260]→[5.3260:3301](∅→∅),[5.3301]→[5.10377:10455](∅→∅),[5.10377]→[5.10377:10455](∅→∅),[5.10455]→[4.46317:46461](∅→∅),[4.46461]→[5.3302:3373](∅→∅),[5.10604]→[5.3302:3373](∅→∅)
  − m PaymentRequestId

  − createPaymentRequest ops now sid sub bday = do

  − cfg <- ask

  − -- TODO: maybe make pkey a function of subscription, billable, bday

  − pkey <- PaymentKey . encodeBase58Check <$> getRandomBytes 32

  − memo <- memoGen ops sub bday now

  − uri <- uriGen ops pkey

  − payload <- payloadGen ops sub bday now

  − details <- createPaymentDetails bday now memo uri payload (sub ^. billable)

  − reqErr <- B.createPaymentRequest (cfg ^. signingKey) (cfg ^. pkiData) details

  − req <- either (throwError . review _SigningError) pure reqErr

  − liftdb $ CreatePaymentRequest (PaymentRequest sid req pkey now bday)
  [4.46157]

  [5.4339]
  + m (PaymentRequestId, PaymentRequestDetail currency)

  + createPaymentRequest ops now billId bill bday = do

  + nativeReq <- newPaymentRequest ops bill bday now

  + let req =

  + PaymentRequest

  + { _billable = (Const billId),

  + _createdAt = now,

  + _billingDate = bday,

  + _nativeRequest = nativeReq

  + }

  + reqId <- storePaymentRequest req

  + pure (reqId, req & PT.billable .~ bill)
• replacement in lib/Aftok/Payments.hs at line 164
  [4.46483]→[4.46483:46534](∅→∅)
  − (MonadDB m, MonadError e m, AsPaymentError e) =>
  [4.46483]

  [4.46534]
  + (MonadDB m) =>
• edit in lib/Aftok/Payments.hs at line 167
  [4.46624]→[4.46624:46638](∅→∅)
  − Billable ->
• replacement in lib/Aftok/Payments.hs at line 168
  [4.46683]→[4.46683:46725](∅→∅)
  − [(PaymentRequestId, PaymentRequest)] ->
  [4.46683]

  [4.46725]
  + [(PaymentRequestId, PT.SomePaymentRequestDetail)] ->
• replacement in lib/Aftok/Payments.hs at line 172
  [4.46847]→[4.46847:46859](∅→∅),[4.46859]→[5.8632:8686](∅→∅),[5.8632]→[5.8632:8686](∅→∅),[5.8686]→[5.11373:11421](∅→∅),[5.11373]→[5.11373:11421](∅→∅),[5.11421]→[4.46860:47250](∅→∅),[5.9008]→[5.4542:4595](∅→∅),[4.47250]→[5.4542:4595](∅→∅),[5.11842]→[5.4542:4595](∅→∅),[5.4595]→[5.11896:11973](∅→∅),[5.11896]→[5.11896:11973](∅→∅)
  − m [T.Day]

  − findUnbilledDates now b (px@(p : ps)) (dx@(d : ds)) =

  − case compare (view (_2 . billingDate) p) d of

  − 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

  − GT -> fmap (d :) $ findUnbilledDates now b px ds

  − LT -> findUnbilledDates now b ps dx

  − findUnbilledDates _ _ _ ds = pure ds
  [4.46847]

  [5.610]
  + ExceptT PaymentError m [T.Day]

  + findUnbilledDates now (px@((reqId, SomePaymentRequest req) : ps)) (dx@(d : ds)) =

  + let rec = findUnbilledDates now

  + gracePeriod = req ^. PT.billable . B.gracePeriod

  + in case compare (req ^. billingDate) d of

  + EQ ->

  + lift (getRequestStatus now reqId req) >>= \case

  + Expired r ->

  + if (now ^. _utctDay) > addDays gracePeriod (r ^. billingDate)

  + then throwError (review _Overdue reqId)

  + else fmap (d :) $ rec px dx -- d will be rebilled

  + _ ->

  + rec ps ds -- if paid or unpaid, nothing to do, keep looking

  + GT ->

  + fmap (d :) $ rec px ds

  + LT ->

  + rec ps dx

  + findUnbilledDates _ _ ds = pure ds
• edit in lib/Aftok/Payments.hs at line 195
  [4.47271]

  [4.47271]
  + forall c m.
• edit in lib/Aftok/Payments.hs at line 199
  [4.47370]

  [4.47370]
  + PaymentRequestId ->
• replacement in lib/Aftok/Payments.hs at line 201
  [4.47417]→[4.47417:47482](∅→∅),[5.9236]→[5.4629:4665](∅→∅),[4.47482]→[5.4629:4665](∅→∅),[5.12397]→[5.4629:4665](∅→∅),[5.4665]→[5.5137:5206](∅→∅),[5.5206]→[4.47483:47543](∅→∅)
  − (PaymentRequestId, PaymentRequest) ->

  − m PaymentRequestStatus

  − getRequestStatus now (reqid, req) =

  − let ifUnpaid = (if isExpired now req then Expired else Unpaid) req

  − in maybe ifUnpaid Paid <$> runMaybeT (findPayment reqid)
  [4.47417]

  [5.13890]
  + PaymentRequestDetail c ->

  + m (PaymentRequestStatus c)

  + getRequestStatus now reqid req =

  + let ifUnpaid = if isExpired now req then Expired req else Unpaid req

  + findPayment' = case paymentRequestCurrency req of

  + (Currency' BTC) -> findPayment BTC reqid

  + (Currency' ZEC) -> findPayment ZEC reqid

  + in maybe ifUnpaid Paid <$> runMaybeT findPayment'
• edit in lib/Aftok/Payments.hs at line 210
  [5.13891]→[5.12574:12639](∅→∅),[5.12639]→[4.47544:47985](∅→∅),[5.28354]→[5.13150:13342](∅→∅),[4.47985]→[5.13150:13342](∅→∅),[5.14318]→[5.13150:13342](∅→∅),[5.13342]→[5.9334:9444](∅→∅),[5.9444]→[5.14551:14564](∅→∅),[5.13434]→[5.14551:14564](∅→∅),[5.14551]→[5.14551:14564](∅→∅),[5.14564]→[4.47986:48223](∅→∅),[5.9824]→[5.14659:14660](∅→∅),[5.13627]→[5.14659:14660](∅→∅),[4.48223]→[5.14659:14660](∅→∅),[5.14659]→[5.14659:14660](∅→∅),[5.14660]→[4.48224:48364](∅→∅),[5.28537]→[5.14736:14769](∅→∅),[4.48364]→[5.14736:14769](∅→∅),[5.14736]→[5.14736:14769](∅→∅),[5.14769]→[5.4860:4874](∅→∅),[5.4874]→[5.14784:14820](∅→∅),[5.14784]→[5.14784:14820](∅→∅),[5.14820]→[4.48365:48438](∅→∅),[4.48438]→[5.14894:14994](∅→∅),[5.14894]→[5.14894:14994](∅→∅),[5.14994]→[4.48439:48598](∅→∅),[5.28697]→[5.4875:4906](∅→∅),[4.48598]→[5.4875:4906](∅→∅),[5.15089]→[5.4875:4906](∅→∅),[5.4906]→[5.28698:28772](∅→∅),[5.28772]→[5.15174:15253](∅→∅),[5.15174]→[5.15174:15253](∅→∅),[5.15253]→[4.48599:48667](∅→∅),[4.48667]→[5.15322:15323](∅→∅),[5.15322]→[5.15322:15323](∅→∅),[5.15323]→[4.48668:48821](∅→∅),[4.48821]→[5.28926:28998](∅→∅),[5.28926]→[5.28926:28998](∅→∅),[5.4965]→[5.15471:15513](∅→∅),[5.28998]→[5.15471:15513](∅→∅),[5.15471]→[5.15471:15513](∅→∅),[5.6086]→[5.28999:29096](∅→∅),[5.29097]→[5.30317:30397](∅→∅),[5.6086]→[5.30317:30397](∅→∅),[5.30397]→[5.3031:3073](∅→∅),[5.3073]→[5.29155:29228](∅→∅),[5.29155]→[5.29155:29228](∅→∅),[5.29228]→[4.48822:48877](∅→∅),[4.48877]→[5.15734:15858](∅→∅),[5.6288]→[5.15734:15858](∅→∅),[5.855]→[5.855:856](∅→∅),[5.856]→[5.15859:15982](∅→∅),[5.15982]→[5.5207:5208](∅→∅)
  − {- Create the PaymentDetails section of the payment request.

  − -}

  − 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

  − createPaymentDetails payoutDate billingTime memo uri payload b = do

  − payouts <- getProjectPayouts payoutTime (b ^. project)

  − outputs <- createPayoutsOutputs payoutTime (b ^. amount) payouts

  − let expiry =

  − (BT.Expiry . T.fromThyme . (billingTime .+^))

  − <$> (b ^. requestExpiryPeriod)

  − cfg <- ask

  − pure $

  − B.createPaymentDetails

  − (toNetwork (cfg ^. networkMode) BTC)

  − outputs

  − (T.fromThyme billingTime)

  − expiry

  − memo

  − uri

  − payload

  − where

  − payoutTime = T.mkUTCTime payoutDate (fromInteger 0)

  −

  − getProjectPayouts ::

  − (MonadDB m, MonadError e m, AsPaymentError e) =>

  − C.UTCTime ->

  − ProjectId ->

  − m (TL.Payouts (NetworkId, Address))

  − getProjectPayouts ptime pid = do

  − project' <-

  − let projectOp = FindProject pid

  − in maybe (raiseSubjectNotFound projectOp) pure =<< liftdb projectOp

  − widx <- liftdb $ ReadWorkIndex pid

  − pure $ TL.payouts (TL.toDepF $ project' ^. depf) ptime widx

  −

  − createPayoutsOutputs ::

  − (MonadDB m, MonadError e m, AsPaymentError e) =>

  − C.UTCTime ->

  − BT.Satoshi ->

  − TL.Payouts (NetworkId, Address) ->

  − m [BT.Output]

  − createPayoutsOutputs t amt p =

  − let payoutFractions :: [(TL.CreditTo (NetworkId, Address), BT.Satoshi)]

  − payoutFractions = (_2 %~ outputAmount amt) <$> assocs (p ^. TL._Payouts)

  − in join <$> traverse (uncurry (createOutputs t)) payoutFractions

  −

  − createOutputs ::

  − (MonadDB m, MonadError e m, AsPaymentError e) =>

  − C.UTCTime ->

  − TL.CreditTo (NetworkId, Address) ->

  − BT.Satoshi ->

  − m [BT.Output]

  − createOutputs _ (TL.CreditToCurrency (BTC, (PubKeyAddress addr))) amt =

  − pure $ [BT.Output amt (PayPKHash addr)]

  − createOutputs _ (TL.CreditToCurrency (_, other)) _ =

  − throwError $ review _IllegalAddress other

  − createOutputs _ (TL.CreditToUser uid) amt = (fmap maybeToList) . runMaybeT $ do

  − (_, addr) <- findUserPaymentAddress uid

  − case addr of

  − PubKeyAddress a -> pure $ BT.Output amt (PayPKHash a)

  − other -> throwError $ review _IllegalAddress other

  − createOutputs t (TL.CreditToProject pid) amt = do

  − payouts <- getProjectPayouts t pid

  − createPayoutsOutputs t amt payouts

  −

  − outputAmount :: BT.Satoshi -> Rational -> BT.Satoshi

  − outputAmount i r = BT.Satoshi . round $ toRational (i ^. satoshi) * r

  −
• replacement in lib/Aftok/Payments.hs at line 211
  [4.48901]→[4.48901:48974](∅→∅),[5.9987]→[5.5302:5367](∅→∅),[4.48974]→[5.5302:5367](∅→∅),[5.5302]→[5.5302:5367](∅→∅),[5.5367]→[5.9988:10076](∅→∅),[5.10076]→[4.48975:49165](∅→∅)
  − (MonadDB m) => UserId -> SubscriptionId -> C.UTCTime -> m [BillDetail]

  − findPayableRequests uid sid now = do

  − requests <- liftdb findOp

  − join

  − <$> (traverse checkAccess $ filter (not . isExpired now . view _2) requests)

  − where

  − findOp = FindUnpaidRequests sid

  − checkAccess d =

  − if view (_3 . customer) d == uid

  − then pure [d]

  − else raiseOpForbidden uid (UserNotSubscriber sid) findOp
  [4.48901]
  + (MonadDB m) => UserId -> SubscriptionId -> m [(PaymentRequestId, PT.SomePaymentRequestDetail)]

  + findPayableRequests uid sid = do

  + subMay <- liftdb (FindSubscription sid)

  + when (maybe True (\s -> s ^. B.customer /= uid) subMay) $

  + void (raiseOpForbidden uid (UserNotSubscriber sid) (FindSubscription sid))

  + findSubscriptionUnpaidRequests sid
• replacement in lib/Aftok/Project.hs at line 37
  [5.1850]→[5.1850:1903](∅→∅)
  − parseInvCode :: Text -> Either String InvitationCode
  [5.1850]

  [5.1903]
  + parseInvCode :: Text -> Either Text InvitationCode
• replacement in lib/Aftok/Project.hs at line 39
  [5.1923]→[5.1923:1961](∅→∅)
  − code <- B64.decode . encodeUtf8 $ t
  [5.1923]

  [5.3938]
  + code <- B64.decodeBase64 . encodeUtf8 $ t
• replacement in lib/Aftok/Project.hs at line 45
  [5.2117]→[5.2117:2180](∅→∅)
  − renderInvCode (InvitationCode bs) = decodeUtf8 $ B64.encode bs
  [5.2117]

  [5.2180]
  + renderInvCode (InvitationCode bs) = B64.encodeBase64 bs
• replacement in lib/Aftok/TimeLog.hs at line 10
  [4.50487]→[4.50487:50510](∅→∅)
  − _CreditToCurrency,
  [4.50487]

  [4.50510]
  + _CreditToAccount,
• edit in lib/Aftok/TimeLog.hs at line 13
  [4.50551]→[4.50551:50569](∅→∅)
  − creditToName,
• edit in lib/Aftok/TimeLog.hs at line 31
  [4.50893]

  [4.50893]
  + FractionalPayouts,
• replacement in lib/Aftok/TimeLog.hs at line 100
  [5.1627]→[5.1627:1661](∅→∅),[5.1661]→[4.52170:52202](∅→∅)
  − eventName (StartWork _) = "start"

  − eventName (StopWork _) = "stop"
  [5.1627]

  [5.431]
  + eventName = \case

  + (StartWork _) -> "start"

  + (StopWork _) -> "stop"
• replacement in lib/Aftok/TimeLog.hs at line 105
  [5.31604]→[5.31604:31639](∅→∅),[5.31639]→[4.52203:52258](∅→∅)
  − nameEvent "start" = Just StartWork

  − nameEvent "stop" = Just StopWork

  − nameEvent _ = Nothing
  [5.31604]

  [5.5441]
  + nameEvent = \case

  + "start" -> Just StartWork

  + "stop" -> Just StopWork

  + _ -> Nothing
• replacement in lib/Aftok/TimeLog.hs at line 110
  [5.5442]→[4.52259:52275](∅→∅)
  − data LogEntry a
  [5.5442]

  [4.52275]
  + data LogEntry
• replacement in lib/Aftok/TimeLog.hs at line 112
  [4.52288]→[4.52288:52324](∅→∅)
  − { _creditTo :: !(CreditTo a),
  [4.52288]

  [4.52324]
  + { _creditTo :: !CreditTo,
• replacement in lib/Aftok/TimeLog.hs at line 120
  [5.214]→[5.31762:31803](∅→∅)
  − instance Ord a => Ord (LogEntry a) where
  [5.214]

  [5.4775]
  + instance Ord LogEntry where
• replacement in lib/Aftok/TimeLog.hs at line 133
  [5.5813]→[5.31804:31826](∅→∅)
  − data EventAmendment a
  [5.5813]

  [5.31826]
  + data EventAmendment
• replacement in lib/Aftok/TimeLog.hs at line 135
  [5.31861]→[5.31861:31903](∅→∅)
  − | CreditToChange !ModTime !(CreditTo a)
  [5.31861]

  [5.31903]
  + | CreditToChange !ModTime !CreditTo
• replacement in lib/Aftok/TimeLog.hs at line 142
  [5.5971]→[5.31941:31997](∅→∅)
  − newtype Payouts a = Payouts (Map (CreditTo a) Rational)
  [5.5971]

  [4.52471]
  + newtype Payouts a = Payouts (Map CreditTo a)
• replacement in lib/Aftok/TimeLog.hs at line 146
  [5.6043]→[5.31998:32089](∅→∅)
  − newtype WorkIndex a = WorkIndex (Map (CreditTo a) (NonEmpty Interval)) deriving (Show, Eq)
  [5.6043]

  [4.52473]
  + type FractionalPayouts = Payouts Rational

  +

  + newtype WorkIndex = WorkIndex (Map CreditTo (NonEmpty Interval)) deriving (Show, Eq)
• replacement in lib/Aftok/TimeLog.hs at line 165
  [4.52814]→[4.52814:52851](∅→∅),[4.52851]→[5.32090:32156](∅→∅),[5.1766]→[5.32090:32156](∅→∅)
  − -- - work allocated to each address.

  − payouts :: Ord a => DepF -> C.UTCTime -> WorkIndex a -> Payouts a
  [4.52814]

  [5.4834]
  + -- - work allocated to each unique CreditTo.

  + payouts :: DepF -> C.UTCTime -> WorkIndex -> FractionalPayouts
• replacement in lib/Aftok/TimeLog.hs at line 174
  [5.1582]→[4.52978:53058](∅→∅)
  − workIndex :: forall a f. (Ord a, Foldable f) => f (LogEntry a) -> (WorkIndex a)
  [5.1582]

  [5.4957]
  + workIndex :: Foldable f => f LogEntry -> WorkIndex
• replacement in lib/Aftok/TimeLog.hs at line 179
  [4.53138]→[4.53138:53162](∅→∅)
  − (CreditTo a) ->
  [4.53138]

  [4.53162]
  + CreditTo ->
• replacement in lib/Aftok/TimeLog.hs at line 181
  [4.53200]→[4.53200:53293](∅→∅)
  − Map (CreditTo a) (NonEmpty Interval) ->

  − Map (CreditTo a) (NonEmpty Interval)
  [4.53200]

  [5.4981]
  + Map CreditTo (NonEmpty Interval) ->

  + Map CreditTo (NonEmpty Interval)
• replacement in lib/Aftok/TimeLog.hs at line 192
  [4.53573]→[5.32226:32288](∅→∅),[5.2114]→[5.32226:32288](∅→∅)
  − type RawIndex a = Map (CreditTo a) [Either LogEvent Interval]
  [4.53573]

  [5.2169]
  + type RawIndex = Map CreditTo [Either LogEvent Interval]
• replacement in lib/Aftok/TimeLog.hs at line 194
  [5.2170]→[5.32289:32357](∅→∅)
  − appendLogEntry :: (Ord a) => RawIndex a -> LogEntry a -> RawIndex a
  [5.2170]

  [5.5030]
  + appendLogEntry :: RawIndex -> LogEntry -> RawIndex
• edit in lib/Aftok/Types.hs at line 1
  [5.805]→[4.54482:54513](∅→∅)
  − {-# LANGUAGE DeriveFunctor #-}
• replacement in lib/Aftok/Types.hs at line 5
  [5.32940]→[4.54547:54583](∅→∅)
  − import Aftok.Currency.Zcash (ZAddr)
  [5.32940]

  [4.54583]
  + import qualified Aftok.Currency.Zcash.Types as Zcash
• edit in lib/Aftok/Types.hs at line 11
  [4.54659]→[4.54659:54689](∅→∅)
  − import Data.Functor (Functor)
• replacement in lib/Aftok/Types.hs at line 29
  [5.33159]→[5.3947:3970](∅→∅)
  − data AccountRecovery z
  [5.33159]

  [5.3238]
  + data RecoverBy z
• replacement in lib/Aftok/Types.hs at line 33
  [5.3992]→[5.3288:3317](∅→∅),[4.54816]→[5.3288:3317](∅→∅),[5.3288]→[5.3288:3317](∅→∅)
  − makePrisms ''AccountRecovery
  [4.54816]

  [4.54817]
  + makePrisms ''RecoverBy
• replacement in lib/Aftok/Types.hs at line 38
  [4.54869]→[4.54869:54926](∅→∅)
  − _userAccountRecovery :: !(AccountRecovery ZAddr)
  [4.54869]

  [4.54926]
  + _userAccountRecovery :: !(RecoverBy Zcash.Address)
• replacement in lib/Aftok/Types.hs at line 47
  [5.33373]→[5.33373:33389](∅→∅)
  − data CreditTo a
  [5.33373]

  [4.54937]
  + -- Identifier for a cryptocurrency account. An account

  + -- is a mapping from cryptocurrency network to address;

  + -- this abstraction permits users to accept payment

  + -- in multiple currencies, or to direct payments in a

  + -- fashion that can change over time.

  + newtype AccountId = AccountId UUID deriving (Show, Eq, Ord)

  +

  + makePrisms ''AccountId

  +

  + data CreditTo
• replacement in lib/Aftok/Types.hs at line 58
  [4.54999]→[4.54999:55023](∅→∅)
  − CreditToCurrency !a
  [4.54999]

  [4.55023]
  + CreditToAccount !AccountId
• replacement in lib/Aftok/Types.hs at line 63
  [4.55214]→[5.33660:33696](∅→∅),[5.33660]→[5.33660:33696](∅→∅)
  − deriving (Show, Eq, Ord, Functor)
  [4.55214]

  [4.55215]
  + deriving (Show, Eq, Ord)
• edit in lib/Aftok/Types.hs at line 67
  [5.1037]→[5.33719:33807](∅→∅),[5.33807]→[4.55217:55321](∅→∅),[5.43434]→[5.33914:33915](∅→∅),[4.55321]→[5.33914:33915](∅→∅),[5.33914]→[5.33914:33915](∅→∅)
  − creditToName :: CreditTo a -> Text

  − creditToName (CreditToCurrency _) = "credit_via_net"

  − creditToName (CreditToUser _) = "credit_to_user"

  − creditToName (CreditToProject _) = "credit_to_project"

  −
• edit in lib/Aftok/Util/Http.hs at line 6
  [4.55436]

  [5.4010]
  + import Data.Text (unpack)
• replacement in lib/Aftok/Util/Http.hs at line 18
  [5.5561]→[5.775:822](∅→∅),[4.55489]→[5.775:822](∅→∅),[5.775]→[5.775:822](∅→∅)
  − decoded <- either fail pure $ B64.decode b64
  [4.55489]

  [5.822]
  + decoded <- either (fail . unpack) pure $ B64.decodeBase64 b64
• file addition: 2020-11-25_04-22-24_zcash-support.txt (----------)
  [132.1]
  + Description: (Describe migration here.)

  + Created: 2020-11-25 04:24:09.873312342 UTC

  + Depends: 2020-06-06_03-53-54_add-payment-networks 2017-09-24_22-06-01_billing-templates 2017-06-08_04-37-31_event-metadata-ids 2016-12-31_03-45-17_create-payments 2016-10-14_02-49-36_event-amendments 2016-10-14_02-14-09_create_invitations 2016-10-14_02-11-24_project_companions_invitations 2016-10-13_05-36-55_user-event-log

  + Apply: |

  + CREATE TYPE currency_t AS ENUM ('ZEC', 'BTC');

  +

  + ALTER TABLE work_events ALTER COLUMN credit_to_type DROP DEFAULT;

  + ALTER TABLE work_events ALTER COLUMN credit_to_type TYPE VARCHAR(255);

  + ALTER TABLE event_credit_to_amendments ALTER COLUMN credit_to_type TYPE VARCHAR(255);

  +

  + UPDATE work_events SET credit_to_type = 'credit_to_account' WHERE credit_to_type = 'credit_to_address';

  + UPDATE event_credit_to_amendments SET credit_to_type = 'credit_to_account' WHERE credit_to_type = 'credit_to_address';

  +

  + DROP TYPE IF EXISTS credit_to_t;

  + CREATE TYPE credit_to_t AS ENUM ('credit_to_account', 'credit_to_user', 'credit_to_project');

  +

  + ALTER TABLE work_events ALTER COLUMN credit_to_type TYPE credit_to_t USING (credit_to_type::credit_to_t);

  + ALTER TABLE event_credit_to_amendments ALTER COLUMN credit_to_type TYPE credit_to_t USING (credit_to_type::credit_to_t);

  +

  + CREATE TABLE IF NOT EXISTS cryptocurrency_accounts (

  + id uuid primary key default uuid_generate_v4(),

  + user_id uuid references users(id) not null,

  + currency currency_t not null,

  + is_primary bool,

  + zcash_ivk text,

  + zcash_addr text,

  + btc_addr text,

  + UNIQUE (user_id, currency, is_primary),

  + CHECK ((currency = 'BTC' AND btc_addr IS NOT NULL) OR (currency = 'ZEC' AND zcash_ivk IS NOT NULL))

  + );

  +

  + INSERT INTO cryptocurrency_accounts

  + (user_id, currency, btc_addr, is_primary)

  + SELECT DISTINCT id, 'BTC'::currency_t, default_payment_addr, true FROM users

  + WHERE default_payment_addr IS NOT NULL;

  +

  + INSERT INTO cryptocurrency_accounts

  + (user_id, currency, btc_addr)

  + SELECT DISTINCT user_id, 'BTC'::currency_t, credit_to_address FROM work_events

  + WHERE credit_to_address IS NOT NULL;

  +

  + ALTER TABLE work_events ADD COLUMN credit_to_account uuid REFERENCES cryptocurrency_accounts(id);

  + UPDATE work_events

  + SET credit_to_account = ca.id, credit_to_type = 'credit_to_account'

  + FROM cryptocurrency_accounts ca

  + WHERE ca.user_id = work_events.user_id

  + AND credit_to_address = ca.btc_addr;

  + ALTER TABLE work_events DROP COLUMN credit_to_address;

  +

  + ALTER TABLE event_credit_to_amendments ADD COLUMN credit_to_account uuid REFERENCES cryptocurrency_accounts(id);

  + UPDATE event_credit_to_amendments

  + SET credit_to_account = ca.id, credit_to_type = 'credit_to_account'

  + FROM cryptocurrency_accounts ca

  + JOIN work_events w

  + ON ca.user_id = w.user_id

  + WHERE w.id = event_credit_to_amendments.event_id

  + AND event_credit_to_amendments.credit_to_address = ca.btc_addr;

  + ALTER TABLE event_credit_to_amendments DROP COLUMN credit_to_address;

  +

  + ALTER TABLE billables ADD COLUMN billing_currency currency_t NOT NULL;

  + ALTER TABLE billables ADD COLUMN message text;

  + ALTER TABLE billables ADD COLUMN request_expiry_seconds integer NOT NULL DEFAULT 259200;

  + ALTER TABLE billables ALTER COLUMN billing_amount TYPE bigint;

  +

  + ALTER TABLE payment_requests ALTER COLUMN subscription_id DROP NOT NULL;

  + ALTER TABLE payment_requests ALTER COLUMN url_key DROP NOT NULL;

  + ALTER TABLE payment_requests ADD COLUMN request_json json NOT NULL;

  + ALTER TABLE payment_requests DROP COLUMN request_data;

  +

  + ALTER TABLE payments ADD COLUMN payment_json json NOT NULL;

  + ALTER TABLE payments DROP COLUMN payment_data;
• file addition: check_zaddr.sh (---r------)
  [5.1220]
  + #!/bin/bash

  +

  + if [ -f ".env" ]; then

  + source .env

  + fi

  +

  + if [ -z "${AFTOK_HOST}" ]; then

  + AFTOK_HOST="aftok.com"

  + fi

  +

  + read -p "Zcash Address: " ZADDR

  +

  + curl --verbose \

  + ${ALLOW_INSECURE} \

  + "https://$AFTOK_HOST/api/validate_zaddr?zaddr=${ZADDR}"
• replacement in scripts/create_project.sh at line 35
  [5.104]→[5.239:341](∅→∅)
  − curl --verbose --insecure --user $USER \

  − --request POST --header "Content-Type: application/json" \
  [5.104]

  [5.446]
  + curl --verbose \

  + ${ALLOW_INSECURE} \

  + --user $USER \

  + --header "Content-Type: application/json" \
• file addition: create_project_billable.sh (---r------)
  [5.1220]
  + #!/bin/bash

  +

  + if [ -f ".env" ]; then

  + source .env

  + fi

  +

  + if [ -z "${AFTOK_HOST}" ]; then

  + AFTOK_HOST="aftok.com"

  + fi

  +

  + if [ -z "${USER}" ]; then

  + read -p "Username: " USER

  + echo

  + fi

  +

  + if [ -z "${PID}" ]; then

  + read -p "Project UUID: " PID

  + echo

  + fi

  +

  + read -p "Billable Name: " BNAME

  + read -p "Description: " BDESC

  +

  + while [ -z "${RECUR}" ]

  + do

  + read -p "Recurrence Period [A|M|W|O] ((A)nnual, (M)onthly, (W)eekly, (O)ne-time): " RECUR

  + case $RECUR in

  + "A")

  + RECUR="annually"

  + read -p "Recur every ? years: " RECUR_COUNT

  + ;;

  + "M")

  + RECUR="monthly"

  + read -p "Recur every ? months: " RECUR_COUNT

  + ;;

  + "W")

  + RECUR="weekly"

  + read -p "Recur every ? weeks: " RECUR_COUNT

  + ;;

  + "O")

  + RECUR="one-time"

  + ;;

  + *)

  + echo "$RECUR is not a supported recurrence. Please choose \"A\" \"M\", \"W\" or \"O\""

  + RECUR=""

  + ;;

  + esac

  + done

  +

  + while [ -z "${CURRENCY}" ]

  + do

  + read -p "Currency [BTC|ZEC]: " CURRENCY

  + case $CURRENCY in

  + "BTC")

  + read -p "Bill Total (in Satoshis): " AMOUNT

  + break

  + ;;

  + "ZEC")

  + read -p "Bill Total (in Zatoshis): " AMOUNT

  + break

  + ;;

  + *)

  + echo "$CURRENCY is not a supported currency. Please choose \"BTC\" or \"ZEC\""

  + CURRENCY=""

  + ;;

  + esac

  + done

  +

  + read -p "Grace Period (days): " GRACE_PERIOD

  + read -p "Request Expiry Period (seconds): " REQUEST_EXPIRY

  +

  + BODY=$(cat <<END_BODY

  + {

  + "schemaVersion": "1.0",

  + "name": "$BNAME",

  + "description": "$BDESC",

  + "message": "Thank you for your patronage.",

  + "recurrence": { "$RECUR": $RECUR_COUNT },

  + "currency": "$CURRENCY",

  + "amount": $AMOUNT,

  + "gracePeriod": $GRACE_PERIOD,

  + "requestExpiryPeriod": $REQUEST_EXPIRY

  + }

  + END_BODY

  + )

  +

  + curl --verbose \

  + ${ALLOW_INSECURE} \

  + --user $USER \

  + --header "Content-Type: application/json" \

  + --data "$BODY" \

  + "https://$AFTOK_HOST/api/projects/${PID}/billables"

  +
• edit in scripts/create_user.sh at line 15
  [5.1975]→[5.1975:2008](∅→∅)
  − read -p "BTC Address: " BTC_ADDR
• replacement in scripts/create_user.sh at line 16
  [5.2009]→[5.418:618](∅→∅)
  − curl --verbose --insecure \

  − --request POST --header 'Content-Type: application/json' \

  − --data "{\"username\":\"$USER\", \"password\":\"$PASS\", \"email\":\"$EMAIL\", \"btcAddr\":\"$BTC_ADDR\"}" \
  [5.2009]

  [5.730]
  + curl --verbose \

  + ${ALLOW_INSECURE} \

  + --header 'Content-Type: application/json' \

  + --data "{\"username\":\"$USER\", \"password\":\"$PASS\", \"recoveryType\": \"email\", \"recoveryEmail\": \"$EMAIL\", \"captchaToken\":\"FAKE\"}" \
• file move: latest_events.sh (---r------) → get_project.sh (---r------)
  [5.1220]

  [5.2]
• replacement in scripts/get_project.sh at line 21
  [5.252]→[5.252:311](∅→∅),[5.311]→[5.4104:4180](∅→∅)
  − curl --verbose --insecure --user $USER \

  − --request GET \

  − "https://$AFTOK_HOST/api/projects/$PID/events?after=2020-01-01T00:00:00Z"
  [5.252]
  + curl \

  + ${ALLOW_INSECURE} \

  + --user $USER \

  + "https://$AFTOK_HOST/api/projects/${PID}"
• replacement in scripts/invite.sh at line 24
  [5.108]→[5.685:745](∅→∅)
  − curl --verbose --insecure --user $USER \

  − --request POST \
  [5.108]

  [5.2]
  + curl --verbose \

  + ${ALLOW_INSECURE} \

  + --user $USER \

  + --header "Content-Type: application/json" \
• file move: list_events.sh (---r------) → list_project_billables.sh (---r------)
  [5.1220]

  [5.4182]
• replacement in scripts/list_project_billables.sh at line 21
  [5.4432]→[5.4432:4567](∅→∅)
  − curl --verbose --insecure --user $USER \

  − --request GET \

  − "https://$AFTOK_HOST/api/projects/$PID/events?after=2020-01-01T00:00:00Z"
  [5.4432]
  + curl --verbose \

  + ${ALLOW_INSECURE} \

  + --user $USER \

  + "https://$AFTOK_HOST/api/projects/$PID/billables"
• file move: list_intervals.sh (---r------) → list_project_intervals.sh (---r------)
  [5.1220]

  [5.14257]
• replacement in scripts/list_project_intervals.sh at line 21
  [5.14507]→[3.2:32](∅→∅),[3.32]→[5.14548:14566](∅→∅),[5.14548]→[5.14548:14566](∅→∅)
  − curl --verbose --user $USER \

  − --request GET \
  [5.14507]

  [3.33]
  + curl --verbose \

  + ${ALLOW_INSECURE} \

  + --user $USER \
• file addition: list_project_payouts.sh (---r------)
  [5.1220]
  + #!/bin/bash

  +

  + if [ -f ".env" ]; then

  + source .env

  + fi

  +

  + if [ -z "${AFTOK_HOST}" ]; then

  + AFTOK_HOST="aftok.com"

  + fi

  +

  + if [ -z "${USER}" ]; then

  + read -p "Username: " USER

  + echo

  + fi

  +

  + if [ -z "${PID}" ]; then

  + read -p "Project UUID: " PID

  + echo

  + fi

  +

  + curl --verbose \

  + ${ALLOW_INSECURE} \

  + --user $USER \

  + "https://$AFTOK_HOST/api/projects/$PID/payouts"
• replacement in scripts/list_projects.sh at line 16
  [5.71]→[5.7807:7838](∅→∅)
  − curl --insecure --user $USER \
  [5.71]

  [5.959]
  + curl \

  + ${ALLOW_INSECURE} \

  + --user $USER \
• file move: log.sh (---r------) → list_user_events.sh (---r------)
  [5.1220]

  [5.176]
• replacement in scripts/list_user_events.sh at line 24
  [5.90]→[5.90:137](∅→∅)
  − after=$(date -Iseconds --date='1 month ago')
  [5.90]

  [5.947]
  + after=$(date -Iseconds --date='4 years ago')
• edit in scripts/list_user_events.sh at line 26
  [5.950]

  [5.283]
  +

  + echo "Retrieving your log entries for project ${PID} after ${after}..."
• replacement in scripts/list_user_events.sh at line 29
  [5.284]→[5.913:972](∅→∅),[5.972]→[5.1061:1129](∅→∅)
  − curl --verbose --insecure --user $USER \

  − --request GET \

  − "https://$AFTOK_HOST/api/projects/$PID/logEntries?after=${after}"
  [5.284]
  + curl --verbose \

  + ${ALLOW_INSECURE} \

  + --user $USER \

  + "https://$AFTOK_HOST/api/user/projects/$PID/events?after=${after}&limit=100"
• file addition: list_user_intervals.sh (---r------)
  [5.1220]
  + #!/bin/bash

  +

  + if [ -f ".env" ]; then

  + source .env

  + fi

  +

  + if [ -z "${AFTOK_HOST}" ]; then

  + AFTOK_HOST="aftok.com"

  + fi

  +

  + if [ -z "${USER}" ]; then

  + read -p "Username: " USER

  + echo

  + fi

  +

  + if [ -z "${PID}" ]; then

  + read -p "Project UUID: " PID

  + echo

  + fi

  +

  + curl --verbose \

  + ${ALLOW_INSECURE} \

  + --user $USER \

  + "https://$AFTOK_HOST/api/user/projects/$PID/workIndex?limit=100&before=$(date -Iseconds)"
• replacement in scripts/log_end.sh at line 21
  [5.562]→[5.1104:1164](∅→∅)
  − curl --verbose --insecure --user $USER \

  − --request POST \
  [5.562]

  [5.1164]
  + curl --verbose \

  + ${ALLOW_INSECURE} \

  + --user $USER \

  + --header "Content-Type: application/json" \
• replacement in scripts/log_start.sh at line 21
  [5.803]→[5.1278:1338](∅→∅)
  − curl --verbose --insecure --user $USER \

  − --request POST \
  [5.803]

  [5.1338]
  + curl --verbose \

  + ${ALLOW_INSECURE} \

  + --user $USER \
• replacement in scripts/login-xhr.sh at line 22
  [2.268]→[2.268:287](∅→∅)
  − --request POST \
  [2.268]

  [2.287]
  + ${ALLOW_INSECURE} \

  + --header "Content-Type: application/json" \
• replacement in scripts/login.sh at line 16
  [5.309908]→[2.429:459](∅→∅)
  − curl --verbose --user $USER \
  [5.309908]

  [5.309982]
  + curl --verbose \

  + ${ALLOW_INSECURE} \

  + --user $USER \
• file addition: logout.sh (---r------)
  [5.1220]
  + #!/bin/bash

  +

  + if [ -f ".env" ]; then

  + source .env

  + fi

  +

  + if [ -z "${AFTOK_HOST}" ]; then

  + AFTOK_HOST="aftok.com"

  + fi

  +

  + curl --verbose \

  + ${ALLOW_INSECURE} \

  + "https://$AFTOK_HOST/api/logout"
• edit in server/Aftok/Snaplet/Billing.hs at line 11
  [4.60150]

  [4.60150]
  + import Aftok.Currency (Amount (..), Currency (..))

  + import Aftok.Currency.Bitcoin (Satoshi (..))

  + import Aftok.Currency.Zcash (Zatoshi (..))
• edit in server/Aftok/Snaplet/Billing.hs at line 24
  [4.60328]→[4.60328:60362](∅→∅)
  − import Bippy.Types (Satoshi (..))
• replacement in server/Aftok/Snaplet/Billing.hs at line 31
  [5.34476]→[5.34476:34547](∅→∅)
  − parseCreateBillable :: UserId -> ProjectId -> Value -> Parser Billable
  [5.33908]

  [4.60524]
  + parseCreateBillable :: UserId -> ProjectId -> Value -> Parser (Billable Amount)
• edit in server/Aftok/Snaplet/Billing.hs at line 34
  [4.60585]

  [4.60585]
  + amountParser = \case

  + "ZEC" -> pure (Amount ZEC . Zatoshi)

  + "BTC" -> pure (Amount BTC . Satoshi)

  + c -> fail ("Currency " <> c <> " not recognized.")
• replacement in server/Aftok/Snaplet/Billing.hs at line 42
  [4.60666]→[4.60666:60737](∅→∅)
  − <*> o

  − .: "name"

  − <*> o

  − .: "description"
  [4.60666]

  [4.60737]
  + <*> (o .: "name")

  + <*> (o .: "description")

  + <*> (o .: "message")
• replacement in server/Aftok/Snaplet/Billing.hs at line 46
  [4.60790]→[4.60790:61038](∅→∅)
  − <*> (Satoshi <$> o .: "amount")

  − <*> o

  − .: "gracePeriod"

  − <*> (fmap toThyme <$> o .: "requestExpiryPeriod")

  − <*> o

  − .:? "paymentRequestEmailTemplate"

  − <*> o

  − .:? "paymentRequestMemoTemplate"
  [4.60790]

  [4.61038]
  + <*> ((o .: "currency" >>= amountParser) <*> o .: "amount")

  + <*> (o .: "gracePeriod")

  + <*> (toThyme <$> o .: "requestExpiryPeriod")

  + <*> (o .:? "paymentRequestEmailTemplate")

  + <*> (o .:? "paymentRequestMemoTemplate")
• replacement in server/Aftok/Snaplet/Billing.hs at line 63
  [5.35393]→[5.35393:35459](∅→∅)
  − billableListHandler :: S.Handler App App [(BillableId, Billable)]
  [5.35393]

  [5.35459]
  + billableListHandler :: S.Handler App App [(BillableId, Billable Amount)]
• replacement in server/Aftok/Snaplet/Payments.hs at line 5
  [4.61305]→[4.61305:61363](∅→∅)
  − getPaymentRequestHandler,

  − paymentResponseHandler,
  [4.61305]

  [5.49536]
  + getBip70PaymentRequestHandler,

  + bip70PaymentResponseHandler,
• replacement in server/Aftok/Snaplet/Payments.hs at line 11
  [4.61385]→[4.61385:61411](∅→∅)
  − import Aftok.Config as AC
  [4.61385]

  [4.61411]
  + import qualified Aftok.Config as AC

  + import qualified Aftok.Currency.Bitcoin.Payments as Bitcoin
• edit in server/Aftok/Snaplet/Payments.hs at line 15
  [4.61455]

  [4.61455]
  + import Aftok.Payments.Types

  + ( NativePayment (..),

  + Payment' (..),

  + PaymentId,

  + nativeRequest,

  + )
• edit in server/Aftok/Snaplet/Payments.hs at line 24
  [4.61533]→[4.61533:61598](∅→∅)
  − import qualified Bippy.Proto as P

  − import Control.Exception (try)
• replacement in server/Aftok/Snaplet/Payments.hs at line 25
  [4.61618]→[4.61618:61690](∅→∅)
  − ( (.~),

  − (^.),

  − _1,

  − _2,

  − _Left,

  − _Right,

  − preview,
  [4.61618]

  [4.61690]
  + ( (^.),
• edit in server/Aftok/Snaplet/Payments.hs at line 31
  [4.61832]→[4.61832:61873](∅→∅)
  − import qualified Data.Text.Encoding as T
• replacement in server/Aftok/Snaplet/Payments.hs at line 32
  [4.61902]→[4.61902:62197](∅→∅)
  − 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)
  [4.61902]

  [4.62197]
  + -- import Network.HTTP.Client

  + -- ( defaultManagerSettings,

  + -- managerResponseTimeout,

  + -- responseTimeoutMicro,

  + -- )

  + -- import Network.HTTP.Client.OpenSSL

  + -- import Network.Wreq

  + -- ( defaults,

  + -- manager,

  + -- )

  + -- import OpenSSL.Session (context)
• replacement in server/Aftok/Snaplet/Payments.hs at line 44
  [4.62214]→[4.62214:62249](∅→∅)
  − ( logError,

  − readRequestBody,
  [4.62214]

  [4.62249]
  + ( readRequestBody,
• replacement in server/Aftok/Snaplet/Payments.hs at line 48
  [5.9959]→[5.6097:6158](∅→∅)
  − listPayableRequestsHandler :: S.Handler App App [BillDetail]
  [5.9959]

  [5.6158]
  + listPayableRequestsHandler :: S.Handler App App [(PaymentRequestId, SomePaymentRequestDetail)]
• replacement in server/Aftok/Snaplet/Payments.hs at line 52
  [5.6264]→[5.6264:6344](∅→∅),[5.6344]→[5.17650:17651](∅→∅),[5.17650]→[5.17650:17651](∅→∅),[5.17651]→[5.6345:6408](∅→∅),[5.6408]→[5.3884:3970](∅→∅)
  − now <- liftIO $ C.getCurrentTime

  − snapEval $ findPayableRequests uid sid now

  −

  − getPaymentRequestHandler :: S.Handler App App P.PaymentRequest

  − getPaymentRequestHandler =

  − view (_2 . paymentRequest) <$> getPaymentRequestHandler'
  [5.6264]

  [5.3970]
  + snapEval $ findPayableRequests uid sid
• replacement in server/Aftok/Snaplet/Payments.hs at line 54
  [5.3971]→[5.36180:36254](∅→∅),[5.36254]→[5.1850:1882](∅→∅),[5.1850]→[5.1850:1882](∅→∅)
  − paymentResponseHandler :: AC.BillingConfig -> S.Handler App App PaymentId

  − paymentResponseHandler cfg = do
  [5.3971]

  [5.4053]
  + bip70PaymentResponseHandler :: AC.BillingConfig -> S.Handler App App PaymentId

  + bip70PaymentResponseHandler _ = do
• replacement in server/Aftok/Snaplet/Payments.hs at line 57
  [5.4091]→[4.62279:62315](∅→∅)
  − preq <- getPaymentRequestHandler'
  [5.4091]

  [4.62315]
  + (prid, preq) <- getBip70PaymentRequestHandler
• replacement in server/Aftok/Snaplet/Payments.hs at line 61
  [4.62418]→[4.62418:62429](∅→∅)
  − pure
  [4.62418]

  [4.62429]
  + (pure . Bitcoin.Payment Nothing Nothing Nothing (preq ^. Bitcoin.paymentRequestKey))
• replacement in server/Aftok/Snaplet/Payments.hs at line 64
  [5.51816]→[4.62475:62753](∅→∅),[4.62753]→[5.52091:52116](∅→∅),[5.2064]→[5.52091:52116](∅→∅),[5.52116]→[4.62754:62870](∅→∅),[5.52228]→[5.5270:5344](∅→∅),[4.62870]→[5.5270:5344](∅→∅),[5.5270]→[5.5270:5344](∅→∅),[5.5344]→[4.62871:63013](∅→∅)
  − let opts =

  − defaults

  − & manager

  − .~ Left (opensslManagerSettings context)

  − & manager

  − .~ Left

  − ( defaultManagerSettings

  − { managerResponseTimeout = responseTimeoutMicro 10000

  − }

  − )

  − exchResp <-

  − liftIO

  − . try @HttpException

  − $ asValue

  − =<< (withOpenSSL $ getWith opts (cfg ^. exchangeRateServiceURI))

  − _ <- traverse (logError . T.encodeUtf8 . show) (preview _Left exchResp)

  − let newPayment =

  − Payment

  − (view _1 preq)

  − pmnt

  − now

  − (preview (_Right . responseBody) exchResp)
  [5.51816]

  [5.2347]
  + -- let opts =

  + -- defaults

  + -- & manager

  + -- .~ Left (opensslManagerSettings context)

  + -- & manager

  + -- .~ Left

  + -- ( defaultManagerSettings

  + -- { managerResponseTimeout = responseTimeoutMicro 10000

  + -- }

  + -- )

  + -- exchResp <-

  + -- liftIO

  + -- . try @HttpException

  + -- $ asValue

  + -- =<< (withOpenSSL $ getWith opts (cfg ^. exchangeRateServiceURI))

  + -- _ <- traverse (logError . T.encodeUtf8 . show) (preview _Left exchResp)

  + -- (preview (_Right . responseBody) exchResp)

  + let newPayment = Payment (Const prid) now (BitcoinPayment pmnt)
• replacement in server/Aftok/Snaplet/Payments.hs at line 84
  [5.4402]→[4.63014:63098](∅→∅),[5.52489]→[5.4484:4561](∅→∅),[4.63098]→[5.4484:4561](∅→∅),[5.4484]→[5.4484:4561](∅→∅),[5.4561]→[4.63099:63242](∅→∅)
  − getPaymentRequestHandler' ::

  − S.Handler App App (PaymentRequestId, PaymentRequest)

  − getPaymentRequestHandler' = do

  − pkBytes <- requireParam "paymentRequestKey"

  − pkey <-

  − maybe

  − (snapError 400 $ "parameter paymentRequestKey is formatted incorrectly.")

  − pure

  − (parsePaymentKey pkBytes)
  [5.4402]

  [5.36359]
  + getBip70PaymentRequestHandler :: S.Handler App App (PaymentRequestId, Bitcoin.PaymentRequest)

  + getBip70PaymentRequestHandler = do

  + (rid, SomePaymentRequest preq) <- getBip70PaymentRequestHandler'

  + case (preq ^. nativeRequest) of

  + Bip70Request bp -> pure (rid, bp)

  + _ -> snapError 400 $ "Not a BIP-70 bitcoin payment request."

  +

  + getBip70PaymentRequestHandler' ::

  + S.Handler App App (PaymentRequestId, SomePaymentRequestDetail)

  + getBip70PaymentRequestHandler' = do

  + pkey <- Bitcoin.PaymentKey . decodeUtf8 <$> requireParam "paymentRequestKey"
• replacement in server/Aftok/Snaplet/Payments.hs at line 98
  [4.63322]→[4.63322:63359](∅→∅)
  − <> (view _PaymentKey pkey)
  [4.63322]

  [5.52735]
  + <> (view Bitcoin._PaymentKey pkey)
• replacement in server/Aftok/Snaplet/Payments.hs at line 100
  [5.52741]→[5.36470:36521](∅→∅),[5.36470]→[5.36470:36521](∅→∅)
  − (mapMaybeT snapEval $ findPaymentRequest pkey)
  [5.52741]
  + (mapMaybeT snapEval $ findPaymentRequestByKey pkey)
• replacement in server/Aftok/Snaplet/Users.hs at line 16
  [5.3487]→[4.66018:66085](∅→∅)
  − import Aftok.Currency.Zcash (RPCError, ZAddr, ZValidateAddressErr)
  [5.3487]

  [4.66085]
  + import qualified Aftok.Currency.Zcash as Zcash

  + import Aftok.Currency.Zcash (RPCError, ZValidateAddressErr)
• replacement in server/Aftok/Snaplet/Users.hs at line 23
  [4.66256]→[4.66256:66298](∅→∅)
  − ( AccountRecovery (..),

  − Email (..),
  [4.66256]

  [4.66298]
  + ( Email (..),

  + RecoverBy (..),
• replacement in server/Aftok/Snaplet/Users.hs at line 60
  [4.67060]→[4.67060:67142](∅→∅)
  − { validateZAddr :: Text -> m (Either (RPCError ZValidateAddressErr) ZAddr),
  [4.67060]

  [4.67142]
  + { validateZAddr :: Text -> m (Either (RPCError ZValidateAddressErr) Zcash.Address),
• replacement in server/Aftok/Snaplet/Users.hs at line 67
  [4.67255]→[4.67255:67311](∅→∅)
  − _userAccountRecovery :: !(AccountRecovery Text)
  [4.67255]

  [4.67311]
  + _userAccountRecovery :: !(RecoverBy Text)
• replacement in server/Aftok/Snaplet/Users.hs at line 99
  [4.67701]→[4.67701:67775](∅→∅)
  − (\e -> fail $ "Invitation code was rejected as invalid: " <> e)
  [4.67701]

  [4.67775]
  + (\e -> fail $ "Invitation code was rejected as invalid: " <> toString e)
• edit in server/Aftok/Snaplet/Users.hs at line 108
  [5.5917]

  [5.5917]
  + deriving (Show)
• replacement in server/Aftok/Snaplet/Users.hs at line 122
  [5.4425]→[5.4510:4573](∅→∅)
  − checkZAddrHandler :: RegisterOps IO -> S.Handler App App ZAddr
  [5.4425]

  [5.4573]
  + checkZAddrHandler :: RegisterOps IO -> S.Handler App App Zcash.Address
• replacement in server/Aftok/Snaplet/Users.hs at line 132
  [5.4874]→[4.68208:68222](∅→∅),[4.68222]→[5.4889:4968](∅→∅),[5.4889]→[5.4889:4968](∅→∅)
  − Left _ ->

  − snapError 400 "The Z-Address provided for account recovery was invalid."
  [5.4874]

  [5.4968]
  + Left err ->

  + snapError 400 $ "The Z-Address provided for account recovery was invalid: " <> show err
• replacement in server/Aftok/Snaplet/Users.hs at line 180
  [5.9318]→[4.68845:68937](∅→∅),[4.68937]→[5.57272:57278](∅→∅),[5.57272]→[5.57272:57278](∅→∅)
  − ( \e ->

  − snapError 400 $ "Invitation code was rejected as invalid: " <> T.pack e

  − )
  [5.9318]

  [5.6824]
  + (\e -> snapError 400 $ "Invitation code was rejected as invalid: " <> e)
• edit in server/Aftok/Snaplet/WorkLog.hs at line 5
  [5.5756]→[4.70250:70336](∅→∅)
  − import Aftok.Currency.Bitcoin

  − ( NetworkId (..),

  − NetworkMode,

  − toNetwork,

  − )
• edit in server/Aftok/Snaplet/WorkLog.hs at line 26
  [4.70848]→[4.70848:70904](∅→∅)
  − import Haskoin.Address

  − ( Address,

  − textToAddr,

  − )
• replacement in server/Aftok/Snaplet/WorkLog.hs at line 31
  [4.70994]→[4.70994:71046](∅→∅)
  − S.Handler App App (EventId, KeyedLogEntry BTCNet)
  [4.70994]

  [5.10122]
  + S.Handler App App (EventId, KeyedLogEntry)
• edit in server/Aftok/Snaplet/WorkLog.hs at line 35
  [4.71096]→[4.71096:71122](∅→∅)
  − nmode <- getNetworkMode
• replacement in server/Aftok/Snaplet/WorkLog.hs at line 37
  [4.71162]→[4.71162:71253](∅→∅)
  − case A.eitherDecode requestBody

  − >>= A.parseEither (parseLogEntry nmode uid evCtr) of
  [4.71162]

  [4.71253]
  + case (A.eitherDecode requestBody >>= A.parseEither (parseLogEntry uid evCtr)) of
• edit in server/Aftok/Snaplet/WorkLog.hs at line 53
  [5.5708]→[5.570:571](∅→∅),[5.35680]→[5.570:571](∅→∅),[5.58697]→[5.570:571](∅→∅),[4.71607]→[5.570:571](∅→∅),[5.570]→[5.570:571](∅→∅),[5.571]→[5.18476:18550](∅→∅),[5.18550]→[5.643:672](∅→∅),[5.643]→[5.643:672](∅→∅),[5.672]→[4.71608:71657](∅→∅),[5.58751]→[5.35681:35743](∅→∅),[4.71657]→[5.35681:35743](∅→∅),[5.12656]→[5.35681:35743](∅→∅),[5.35743]→[4.71658:71692](∅→∅),[5.58788]→[5.4323:4361](∅→∅),[4.71692]→[5.4323:4361](∅→∅),[5.6005]→[5.4323:4361](∅→∅),[5.4361]→[4.71693:71732](∅→∅),[4.71732]→[5.59964:60023](∅→∅),[5.58830]→[5.59964:60023](∅→∅),[5.35805]→[5.10149:10164](∅→∅),[5.60023]→[5.10149:10164](∅→∅),[5.6216]→[5.10149:10164](∅→∅),[5.10164]→[4.71733:72008](∅→∅)
  −

  − logWorkBTCHandler :: (C.UTCTime -> LogEvent) -> S.Handler App App EventId

  − logWorkBTCHandler evCtr = do

  − uid <- requireUserId

  − pid <- requireProjectId

  − nmode <- getNetworkMode

  − let network = toNetwork nmode BTC

  − addrBytes <- getParam "btcAddr"

  − requestBody <- readRequestBody 4096

  − timestamp <- liftIO C.getCurrentTime

  − case fmap decodeUtf8 addrBytes >>= textToAddr network of

  − Nothing ->

  − 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 54
  [5.6348]→[5.14781:14852](∅→∅)
  − projectWorkIndex :: S.Handler App App (WorkIndex (NetworkId, Address))
  [5.6348]

  [5.14852]
  + projectWorkIndex :: S.Handler App App WorkIndex
• replacement in server/Aftok/Snaplet/WorkLog.hs at line 60
  [5.6632]→[5.4611:4675](∅→∅)
  − userEvents :: S.Handler App App [LogEntry (NetworkId, Address)]
  [5.6632]

  [5.4675]
  + userEvents :: S.Handler App App [LogEntry]
• replacement in server/Aftok/Snaplet/WorkLog.hs at line 73
  [5.8959]→[5.15051:15119](∅→∅),[5.5386]→[5.15051:15119](∅→∅)
  − userWorkIndex :: S.Handler App App (WorkIndex (NetworkId, Address))
  [5.8959]

  [5.15904]
  + userWorkIndex :: S.Handler App App WorkIndex
• replacement in server/Aftok/Snaplet/WorkLog.hs at line 76
  [5.15167]→[5.36080:36147](∅→∅),[5.5386]→[5.36080:36147](∅→∅)
  − payoutsHandler :: S.Handler App App (Payouts (NetworkId, Address))
  [5.15167]

  [5.10183]
  + payoutsHandler :: S.Handler App App FractionalPayouts
• edit in server/Aftok/Snaplet/WorkLog.hs at line 91
  [4.72435]→[4.72435:72461](∅→∅)
  − nmode <- getNetworkMode
• replacement in server/Aftok/Snaplet/WorkLog.hs at line 102
  [4.72732]→[4.72732:72800](∅→∅)
  − (A.parseEither (parseEventAmendment nmode modTime) requestJSON)
  [4.72732]

  [5.269]
  + (A.parseEither (parseEventAmendment modTime) requestJSON)
• replacement in server/Aftok/Snaplet/WorkLog.hs at line 104
  [5.270]→[4.72801:72896](∅→∅),[4.72896]→[5.16041:16089](∅→∅),[5.16041]→[5.16041:16089](∅→∅)
  − keyedLogEntryJSON ::

  − NetworkMode -> (EventId, KeyedLogEntry (NetworkId, Address)) -> A.Value

  − keyedLogEntryJSON nmode (eid, (pid, uid, ev)) =
  [5.270]

  [5.16089]
  + keyedLogEntryJSON :: (EventId, KeyedLogEntry) -> A.Value

  + keyedLogEntryJSON (eid, (pid, uid, ev)) =
• replacement in server/Aftok/Snaplet/WorkLog.hs at line 112
  [4.73047]→[4.73047:73080](∅→∅)
  − <> logEntryFields nmode ev
  [4.73047]
  + <> logEntryFields ev
• edit in server/Main.hs at line 6
  [4.75276]

  [4.75276]
  + import Aftok.Currency.Bitcoin.Payments (_bip70Request)
• replacement in server/Main.hs at line 85
  [4.77519]→[4.77519:77589](∅→∅)
  − serveJSON (workIndexJSON nmode) (method GET projectWorkIndex)
  [4.77519]

  [4.77589]
  + serveJSON workIndexJSON $ method GET projectWorkIndex
• replacement in server/Main.hs at line 87
  [4.77617]→[4.77617:77683](∅→∅)
  − serveJSON (payoutsJSON nmode) $ method GET payoutsHandler
  [4.77617]

  [4.77683]
  + serveJSON payoutsJSON $ method GET payoutsHandler
• replacement in server/Main.hs at line 89
  [4.77706]→[4.77706:77881](∅→∅)
  − serveJSON (keyedLogEntryJSON nmode) $ method POST (logWorkHandler f)

  − -- logWorkBTCRoute f =

  − -- serveJSON eventIdJSON $ method POST (logWorkBTCHandler f)
  [4.77706]

  [4.77881]
  + serveJSON keyedLogEntryJSON $ method POST (logWorkHandler f)
• replacement in server/Main.hs at line 92
  [4.77986]→[4.77986:78056](∅→∅)
  − serveJSON (fmap $ logEntryJSON nmode) $ method GET userEvents
  [4.77986]

  [4.78056]
  + serveJSON (fmap logEntryJSON) $ method GET userEvents
• replacement in server/Main.hs at line 94
  [4.78083]→[4.78083:78150](∅→∅)
  − serveJSON (workIndexJSON nmode) $ method GET userWorkIndex
  [4.78083]

  [4.78150]
  + serveJSON workIndexJSON $ method GET userWorkIndex
• replacement in server/Main.hs at line 105
  [4.78682]→[4.78682:78816](∅→∅)
  − payableRequestsRoute =

  − serveJSON billDetailsJSON $ method GET listPayableRequestsHandler

  − getPaymentRequestRoute =
  [4.78682]

  [4.78816]
  + -- payableRequestsRoute =

  + -- serveJSON billDetailsJSON $ method GET listPayableRequestsHandler

  + getBip70PaymentRequestRoute =
• replacement in server/Main.hs at line 111
  [4.78882]→[4.78882:78959](∅→∅)
  − =<< method GET getPaymentRequestHandler

  − submitPaymentRoute =
  [4.78882]

  [4.78959]
  + . _bip70Request

  + . snd

  + =<< method GET getBip70PaymentRequestHandler

  + submitBip70PaymentRoute =
• replacement in server/Main.hs at line 116
  [4.78993]→[4.78993:79063](∅→∅)
  − method POST (paymentResponseHandler $ cfg ^. billingConfig)
  [4.78993]

  [5.64887]
  + method POST (bip70PaymentResponseHandler $ cfg ^. billingConfig)
• replacement in server/Main.hs at line 119
  [4.79138]→[4.79138:80316](∅→∅)
  − ("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),
  [4.79138]

  [4.80316]
  + ("login", loginRoute), -- login.sh

  + ("login", xhrLoginRoute), -- login_xhr.sh

  + ("logout", logoutRoute), -- logout.sh

  + ("login/check", checkLoginRoute), -- login.sh

  + ("register", registerRoute), -- create_user.sh

  + ("validate_zaddr", checkZAddrRoute), -- check_zaddr.sh

  + ("accept_invitation", acceptInviteRoute),

  + ("user/projects/:projectId/logStart", logWorkRoute StartWork), -- log_start.sh

  + ("user/projects/:projectId/logEnd", logWorkRoute StopWork), -- log_end.sh

  + ("user/projects/:projectId/events", userEventsRoute), -- list_user_events.sh

  + ("user/projects/:projectId/workIndex", userWorkIndexRoute), -- list_user_intervals.sh

  + ("projects/:projectId/workIndex", projectWorkIndexRoute), -- list_project_intervals.sh

  + ("projects/:projectId/auctions", auctionCreateRoute), -- <|> auctionListRoute)

  + ("projects/:projectId/billables", billableCreateRoute <|> billableListRoute), -- create_billable.sh / list_project_billables.sh

  + ("projects/:projectId/payouts", projectPayoutsRoute), -- list_project_payouts.sh

  + ("projects/:projectId/invite", inviteRoute), -- invite.sh

  + ("projects/:projectId", projectRoute), -- get_project.sh

  + ("projects", projectCreateRoute <|> projectListRoute), -- create_project.sh, list_projects.sh
• replacement in server/Main.hs at line 140
  [4.80462]→[4.80462:80623](∅→∅)
  − ("subscriptions/:subscriptionId/payment_requests", payableRequestsRoute),

  − ("pay/:paymentRequestKey", getPaymentRequestRoute <|> submitPaymentRoute),
  [4.80462]

  [4.80623]
  + -- ("subscriptions/:subscriptionId/payment_requests", payableRequestsRoute),

  + ("pay/btc/:paymentRequestKey", getBip70PaymentRequestRoute <|> submitBip70PaymentRoute),
• edit in test/Aftok/TimeLogSpec.hs at line 11
  [5.1660]

  [4.82704]
  + import Aftok.Generators (genUUID)
• edit in test/Aftok/TimeLogSpec.hs at line 14
  [4.82762]

  [4.82762]
  + import Aftok.Types (UserId (..))
• edit in test/Aftok/TimeLogSpec.hs at line 21
  [4.82945]→[4.82945:83035](∅→∅)
  − import Haskoin.Address (Address)

  − import Haskoin.Util.Arbitrary.Address (arbitraryAddress)
• replacement in test/Aftok/TimeLogSpec.hs at line 46
  [5.2046]→[5.64926:64966](∅→∅)
  − genWorkIndex :: Gen (WorkIndex Address)
  [5.2046]

  [5.2852]
  + genWorkIndex :: Gen WorkIndex
• replacement in test/Aftok/TimeLogSpec.hs at line 48
  [5.2867]→[5.64967:65032](∅→∅)
  − let recordGen :: Gen (CreditTo Address, L.NonEmpty I.Interval)
  [5.2867]

  [5.65032]
  + let recordGen :: Gen (CreditTo, L.NonEmpty I.Interval)
• replacement in test/Aftok/TimeLogSpec.hs at line 50
  [5.65053]→[4.83297:83330](∅→∅)
  − addr <- arbitraryAddress
  [5.65053]

  [5.70220]
  + uid <- UserId <$> genUUID
• replacement in test/Aftok/TimeLogSpec.hs at line 52
  [5.70250]→[5.65088:65132](∅→∅)
  − pure (CreditToCurrency addr, ivals)
  [5.70250]

  [4.83331]
  + pure (CreditToUser uid, ivals)
• replacement in test/Aftok/TimeLogSpec.hs at line 59
  [5.65227]→[5.65227:65287](∅→∅)
  − testAddrs <- replicateM 3 (generate arbitraryAddress)
  [5.65227]

  [4.83382]
  + testUsers <- take 3 <$> sample' (UserId <$> genUUID)
• replacement in test/Aftok/TimeLogSpec.hs at line 72
  [4.83768]→[5.65329:65389](∅→∅),[5.418]→[5.65329:65389](∅→∅)
  − testIntervals :: [(CreditTo Address, I.Interval)]
  [4.83768]

  [5.1422]
  + testIntervals :: [(CreditTo, I.Interval)]
• replacement in test/Aftok/TimeLogSpec.hs at line 74
  [5.1451]→[4.83769:83799](∅→∅)
  − addr <- testAddrs
  [5.1451]

  [5.65390]
  + user <- testUsers
• replacement in test/Aftok/TimeLogSpec.hs at line 76
  [5.65436]→[5.65436:65503](∅→∅),[5.1453]→[5.65504:65551](∅→∅)
  − pure $ (CreditToCurrency addr, I.interval start' end')

  − testLogEntries :: [LogEntry Address]
  [5.65436]

  [5.1499]
  + pure $ (CreditToUser user, I.interval start' end')

  + testLogEntries :: [LogEntry]