Modularize & update to recent haskoin.

[?]

Mar 13, 2019, 5:24 PM

B6HWAPDPXIWH7CHK5VLMWLL6EQN6NOFZEFYO47BPUY2ZO4SL7VDAC

Dependencies

[2] UOG5H2TW Default work logging credit to logged-in user.
[3] IPG33FAW Add billing daemon
[4] 2MNO5FUY Upgrade LTS version
[5] JFOEOFGA stylish-haskell formatting.
[6] GKGVYBZG Added JSON serialization to TimeLog
[7] AL37SVTC Implement payments service endpoints.
[8] O5FVTOM6 Undo JSON silliness, enable a couple more routes.
[9] MGOF7IUF Update TASKS list to reflect completed projects.
[10] 5OI44E4E Add authentication to auction search.
[11] 3QVT6MA6 Add database support for event amend operations.
[12] 5W5M56VJ Move library code to 'lib'
[13] 75N3UJ4J More progression toward lenses.
[14] NAS4BFL4 Trivial stylish-haskell reformat.
[15] JUUMYIQE Add groupBy utility function for use in TimeLog.
[16] Y35QCWYW Minor improvement in WorkIndex type to eliminate duplicated information.
[17] 7XN3I3QJ Add 'loggedIntervals' endpoint.
[18] F2XLL7XW Remove Ord Bid & sort in favor of sortBy
[19] 7DBNV3GV Initial, stack-based impl of time log event reduction.
[20] EMVTF2IW WIP moving back to snap.
[21] V2VDN77H Enable postgres configuration via environment variable for Heroku.
[22] LHJ2HFXV Add property test for auction algorithm.
[23] 7VGYLTMU Clean up schema version handling.
[24] Y3LIJ5US Add handler for CreatePaymentRequest
[25] 64C6AWH6 Rename Ananke -> Quixotic, project reboot.
[26] I2KHGVD4 Require project permissions for access to most data.
[27] PBD7LZYQ Postgres & auth are beginning to function.
[28] WZUHEZSB Start of migration back toward snap.
[29] MB5SHULB Add route for accepting an invitation with an existing account
[30] 5DRIWGLU Improving TimeLog specs
[31] POX3UAMT Enabling logging of time to contributor/project accounts
[32] Q5X5RYQL stylish-haskell reformatting
[33] 4U7F3CPI THE GREAT RENAMING OF THINGS!
[34] BWN72T44 Don't accept work timestamp from an external source.
[35] 4FDQGIXN Make payment request retrieval key an opaque 32-bit hash.
[36] WZFQDWW4 Add retrieval/storage of current exchange rate data to payment recording.
[37] UILI6PIL The route-based logStart/logStop is nicer.
[38] M4KM76DG Merge branch 'stackify'
[39] TLQ72DSJ Lenses, sqlite-simple
[40] 4IQVQL4T Added client for payouts endpoint.
[41] P6NR2CGX Beginning of implementation of depreciation.
[42] N4NDAZYT Initial implementation of payouts.
[43] WFZDMVUX Rename ADB -> QDB
[44] 2XQD6KKK Add invitation logic and clean up DBProg error handling.
[45] KEP5WUFJ Convert project to stack-based build.
[46] XTBSG4C7 Adding serveJSON combinator to eliminate some boilerplate from handlers.
[47] 7HPY3QPF Fix linting errors. (yay hlint!)
[48] 2OIPAQCB Merge branch 'master' of github.com:nuttycom/ananke
[49] A6HKMINB Attempting to improve JSON handling.
[50] O722AOKE Add route to allow crediting of events to users/projects.
[51] EKI57EJR Add alternative implementation of auction winner determination.
[52] HBULCDN6 Add tests for auction winner determination algorithm.
[53] Z7KS5XHH Very WIP. Wow.
[54] HALRDT2F Added initial auction create route.
[55] HO2PFRAB Client login now handles response correctly.
[56] SCXG6TJW Make log reduction safer in presence of overlapping events.
[57] KNSI575V Cleanup of EventLog types.
[58] IZEVQF62 Work in progress replacing sqlite with postgres.
[59] NEDDHXUK Reformat via stylish-haskell
[60] ADMKQQGC Initial empty Snap project.
[61] 2G3GNDDU Event logging is now functioning in postgres.
[62] QMRKFEPG Refactor QDB to use a free monad algebra instead.
[63] OV5AKJHA Remove unused LogInterval type.
[64] SEWTRB6S Implement payment request creation functions.
[65] RN7EI6IN Update database layer to use CreditTo
[66] 2Y2QZFVF Switch to more modern cabal2nix-based workflow.
[67] QADKFHAR Adds CreatePayment handler implementation.
[68] ASF3UPJL Add auction creation and bid handlers
[69] FXJQACES Ensure that auction is not ended at the time of bid
[70] EW2XN7KU Update docker build, clean up migration for payments tables.
[71] 7KZP4RHZ Switch from Data.Time to Data.Thyme
[72] LAROLAYU WIP
[73] RPAJLHMT Change to use UUIDs instead of ints for primary keys.
[74] NTPC7KJE Trivial changes, feature scratchpad.
[75] EQXRXRZD Changed to use tasty instead of test-framework
[76] TNR3TEHK Switch to Postgres + snaplet arch compiles.
[77] EZQG2APB Update task list.
[78] DFOBMSAO Initial work on payments API
[79] KQQAITFH Upgrade snap dependency.
[80] Z3MK2PJ5 Add GET handler for retrieving auction data.
[81] WAIX6AGN Add event serialization for PaymentRequest & Payment
[82] WO2MINIF Auctions now compile!
[83] FD7SV5I6 Fix handling of event_t columns.
[84] NVOCQVAS Initial failing tests.
[85] GLFF5ZDK Factor winningBids for easier testing.
[86] ZITLSTYX Fix problems with SQL queries & depreciation function parsing.
[87] EKY7U7SK Finish conversion to stack.
[88] HMDM3B55 Implement core of payments/billing infrastructure.
[89] BXGLKYRX Added primitive user registration handler.
[90] 4QX5E5AC Initial compilation of payouts function succeeds.
[91] RSEB2NFG Replacing Snap with Scotty.
[92] SLL7262C Make depreciation functions more flexible.
[93] OBFPJS2G Project successfully builds and tests under nix.
[94] BROSTG5K Beginning of modularization of server.
[95] 73NDXDEZ Begin implementation of billing event persistence.
[96] VJPT6HDR Fix remaining type errors after addition of login handler.
[97] W35DDBFY Factor common JSON conversions up into client lib module.
[98] 5XFJNUAZ Start of addition of project infrastructure.
[99] LD4GLVSF More database stuff.
[100] GCVQD44V Create amends endpoint, switch to UUID primary keys
[101] ZP62WC47 Begin conversion to build with stack.
[102] BSIUHCGF Add payment response handler.
[103] NLZ3JXLO Fix formatting with stylish-haskell.
[104] O227CEAV Adds storage of original event JSON for some DBOp constructors.
[*] LEINLS3X Update deployment documentation.
[*] SOIAMXLW Build versioned docker images.
[*] UUR6SMCA Add start of specs for auctions.
[*] MJ6R42RC Utility methods for reading key & cert data.
[*] 6L5BK5EH Use generic SMTP rather than Sendmail-specific mail client.
[*] AXKKXBWN Initial attempt at writing down my ideas for a company based on trust.

Change contents

edit in Makefile at line 3

[107.321]

[107.321]

format:
find lib test server daemon -name \*.hs -exec brittany --write-mode=inplace {} \;
replacement in aftok.cabal at line 12

[5.426]→[5.221:244](∅→∅)

Cabal-version: >= 1.22

[5.426]

[5.449]

Cabal-version: >= 2.0
replacement in aftok.cabal at line 23

[5.117]→[5.139:203](∅→∅),[5.164]→[5.139:203](∅→∅)

exposed-modules: Aftok
Aftok.Auction

[5.117]

[5.118]

exposed-modules: Aftok.Auction
edit in aftok.cabal at line 26

[3.75]

[5.238]

Aftok.Currency
Aftok.Currency.Bitcoin
edit in aftok.cabal at line 30

[5.323]

[5.323]

Aftok.Database.PostgreSQL.Types
edit in aftok.cabal at line 37

[5.429]

[108.1]

Aftok.TimeLog.Serialization
edit in aftok.cabal at line 59

[5.46]

[5.292]

, from-sum
edit in aftok.cabal at line 166

[5.3169]

[5.180]

, haskoin-core
edit in aftok.cabal at line 219

[3.1055]

[3.1055]

, haskoin-core
replacement in daemon/AftokD/AftokM.hs at line 7

[3.1643]→[3.1643:1665](∅→∅)

import ClassyPrelude

[3.1643]

[3.1665]

import ClassyPrelude
replacement in daemon/AftokD/AftokM.hs at line 22

[3.2238]→[3.2238:2325](∅→∅)

import Network.Mail.Mime
import Network.Mail.SMTP as SMTP

[3.2238]

[3.2325]

import qualified Network.Mail.Mime as Mime
import qualified Network.Mail.SMTP as SMTP
replacement in daemon/AftokD/AftokM.hs at line 25

[3.2360]→[3.2360:2397](∅→∅)

import Text.StringTemplate

[3.2360]

[3.2397]

import Network.Haskoin.Address (Address)
import Text.StringTemplate (directoryGroup, newSTMP, getStringTemplate, setManyAttrib, render)
replacement in daemon/AftokD/AftokM.hs at line 31

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

import Aftok (User, UserId, userEmail, _Email)
import Aftok.Types (satoshi)

[3.2484]

[3.2571]

import Aftok.Types (User, UserId, ProjectId(..), userEmail, _Email)
import Aftok.Currency.Bitcoin (NetworkId, satoshi)
replacement in daemon/AftokD/AftokM.hs at line 39

[3.2991]→[3.2991:3060](∅→∅)

import Aftok.Project (Project, ProjectId(..), projectName)

[3.2991]

[3.3060]

import Aftok.Project (Project, projectName)
replacement in daemon/AftokD/AftokM.hs at line 53

[3.3384]→[3.3384:3412](∅→∅)

data AftokMEnv = AftokMEnv

[3.3384]

[3.3412]

data AftokMEnv = AftokMEnv
replacement in daemon/AftokD/AftokM.hs at line 61

[3.3564]→[3.3564:3593](∅→∅)

network = pcfg . P.network

[3.3564]

[3.3593]

networkMode = pcfg . P.networkMode
replacement in daemon/AftokD/AftokM.hs at line 76

[3.4039]→[3.4039:4126](∅→∅)

liftQDBM (QDBM r) =
AftokM . mapReaderT (withExceptT DBErr) . withReaderT _conn $ r

[3.4039]

[3.4126]

liftQDBM (QDBM r) = do
let f a = (a ^. dcfg . D.billingConfig . AC.networkMode, a ^. conn)
AftokM . mapReaderT (withExceptT DBErr) . withReaderT f $ r
replacement in daemon/AftokD/AftokM.hs at line 113

[3.5670]→[3.5670:5762](∅→∅)

let mailer = maybe (sendMailWithLogin _smtpHost) (sendMailWithLogin' _smtpHost) _smtpPort

[3.5670]

[3.5762]

let mailer = maybe (SMTP.sendMailWithLogin _smtpHost) (SMTP.sendMailWithLogin' _smtpHost) _smtpPort
replacement in daemon/AftokD/AftokM.hs at line 115

[3.5805]→[3.5805:5808](∅→∅)

[3.5805]

[3.5808]
replacement in daemon/AftokD/AftokM.hs at line 118

[3.5923]→[3.5923:6025](∅→∅)

-> P.PaymentRequest' (Subscription' User (Billable' Project UserId Satoshi))

[3.5923]

[3.6025]

-> P.PaymentRequest' (Subscription' (User (NetworkId, Address)) (Billable' Project UserId Satoshi))
replacement in daemon/AftokD/AftokM.hs at line 120

[3.6057]→[3.6057:6092](∅→∅)

-> m Mail

[3.6057]

[3.6092]

-> m Mime.Mail
replacement in daemon/AftokD/AftokM.hs at line 127

[3.6526]→[3.6526:6548](∅→∅)

Just template ->

[3.6526]

[3.6548]

Just template ->
replacement in daemon/AftokD/AftokM.hs at line 132

[3.6805]→[3.6805:6841](∅→∅)

setAttrs = setManyAttrib

[3.6805]

[3.6841]

setAttrs = setManyAttrib
replacement in daemon/AftokD/AftokM.hs at line 139

[3.7092]→[3.7092:7208](∅→∅)

fromAddr = Address Nothing ("billing@aftok.com")
toAddr = Address Nothing (toEmail ^. _Email)

[3.7092]

[3.7208]

fromAddr = Mime.Address Nothing ("billing@aftok.com")
toAddr = Mime.Address Nothing (toEmail ^. _Email)
replacement in daemon/AftokD/AftokM.hs at line 142

[3.7281]→[3.7281:7345](∅→∅)

body = plainTextPart . render $ setAttrs template

[3.7281]

[3.7345]

body = SMTP.plainTextPart . render $ setAttrs template
replacement in daemon/AftokD/AftokM.hs at line 145

[3.7418]→[3.7418:7500](∅→∅)

memoGen :: Subscription' UserId Billable
-> T.Day
-> C.UTCTime

[3.7418]

[3.7500]

memoGen :: Subscription' UserId Billable
-> T.Day
-> C.UTCTime
replacement in daemon/AftokD/AftokM.hs at line 152

[3.7728]→[3.7728:7760](∅→∅)

setAttrs = setManyAttrib

[3.7728]

[3.7760]

setAttrs = setManyAttrib
replacement in daemon/AftokD.hs at line 14

[3.9016]→[3.9016:9041](∅→∅)

import Aftok (Email(..))

[3.9016]

[3.9041]

import Aftok.Types (Email(..))
replacement in daemon/AftokD.hs at line 33

[3.9494]→[3.9494:9516](∅→∅)

loadConfig cfgFile =

[3.9494]

[3.9516]

loadConfig cfgFile =
replacement in daemon/AftokD.hs at line 37

[3.9614]→[3.9614:9639](∅→∅)

readConfig cfg = Config

[3.9614]

[3.9639]

readConfig cfg = Config
replacement in daemon/AftokD.hs at line 39

[3.9690]→[3.9690:9748](∅→∅)

<*> (AC.readBillingConfig $ C.subconfig "billing" cfg)

[3.9690]

[3.9748]

<*> (AC.readBillingConfig $ C.subconfig "billing" cfg)
file deletion: Quixotic.hs (----------)Aftok.hs (----------)Ananke.hs (----------)Quixotic.hs (----------)

[5.1]→[5.207:242](∅→∅),[5.242]→[5.2457:2457](∅→∅),[5.1]→[5.1924:1956](∅→∅),[5.1956]→[5.2457:2457](∅→∅),[5.4286]→[5.2849:2882](∅→∅),[5.2882]→[5.2457:2457](∅→∅),[5.4286]→[5.5517:5552](∅→∅),[5.5552]→[5.2457:2457](∅→∅)

{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TemplateHaskell #-}

module Aftok where

import ClassyPrelude

import Control.Lens (makeLenses, makePrisms)
import Data.Aeson
import Data.Aeson.Types
import Data.Data
import Data.UUID

import Network.Haskoin.Crypto (Address (..), base58ToAddr)

newtype BtcAddr = BtcAddr Address deriving (Show, Eq, Ord)
makePrisms ''BtcAddr

parseBtcAddr :: Text -> Maybe BtcAddr
parseBtcAddr addr = BtcAddr <$> (base58ToAddr . encodeUtf8) addr

instance FromJSON BtcAddr where
parseJSON v = do
t <- parseJSON v
maybe (fail $ show t <> " is not a valid BTC address") pure $ parseBtcAddr t

newtype Months = Months Integer
deriving (Eq, Show, Data, Typeable)

data DepreciationFunction = LinearDepreciation Months Months
deriving (Eq, Show, Data, Typeable)

newtype UserId = UserId UUID deriving (Show, Eq, Ord)
makePrisms ''UserId

newtype UserName = UserName Text deriving (Show, Eq)
makePrisms ''UserName

newtype Email = Email Text deriving (Show, Eq)
makePrisms ''Email

data User = User
{ _username :: !UserName
, _userAddress :: !(Maybe BtcAddr)
, _userEmail :: !Email
}
makeLenses ''User

-- | others tbd

instance ToJSON DepreciationFunction where
toJSON (LinearDepreciation (Months up) (Months dp)) =
object [ "type" .= ("LinearDepreciation" :: Text)
, "arguments" .= object [ "undep" .= up
, "dep" .= dp
]
]

instance FromJSON DepreciationFunction where
parseJSON (Object v) = do
t <- v .: "type" :: Parser Text
args <- v .: "arguments"
case unpack t of
"LinearDepreciation" ->
let undep = Months <$> (args .: "undep")
dep = Months <$> (args .: "dep")
in LinearDepreciation <$> undep <*> dep
x -> fail $ "No depreciation function recognized for type " <> x

parseJSON _ = mzero
replacement in lib/Aftok/Auction.hs at line 5

[5.5192]→[5.3:34](∅→∅)

import ClassyPrelude

[5.5192]

[5.34]

import ClassyPrelude hiding (rem)
replacement in lib/Aftok/Auction.hs at line 8

[5.52]→[5.64:96](∅→∅),[5.64]→[5.64:96](∅→∅)

import Data.Hourglass

[5.52]

[5.3]

import Data.Hourglass (Seconds(..))
import Data.Ratio ((%))
import Data.Traversable (for)
replacement in lib/Aftok/Auction.hs at line 15

[5.27]→[5.86:233](∅→∅)

import Aftok (UserId)
import Aftok.Project (ProjectId)
import Aftok.Types (Satoshi (..))

[5.27]

[5.5213]

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

[5.1706]→[5.42:66](∅→∅)

} deriving (Eq, Show)

[5.1706]

[5.258]

} deriving (Eq)
replacement in lib/Aftok/Auction.hs at line 52

[5.128]→[5.128:150](∅→∅)

deriving (Show, Eq)

[5.128]

[5.150]

deriving (Eq)
replacement in lib/Aftok/Auction.hs at line 56

[5.198]→[5.198:253](∅→∅)

foldl' (\s b -> s + (b^.bidAmount)) (Satoshi 0) bids

[5.198]

[5.253]

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

[5.125]→[5.125:170](∅→∅)

btc bid = toRational $ bid ^. bidAmount

[5.125]

[5.170]

btc bid = toRational $ bid ^. bidAmount . satoshi
replacement in lib/Aftok/Auction.hs at line 75

[5.538]→[5.163:281](∅→∅)

| total + (bid ^. bidAmount) < raiseAmount' =
bid : takeWinningBids (total + (bid ^. bidAmount)) xs

[5.538]

[5.652]

| total <> (bid ^. bidAmount) < raiseAmount' =
bid : takeWinningBids (total <> (bid ^. bidAmount)) xs
replacement in lib/Aftok/Auction.hs at line 80

[5.228]→[5.228:275](∅→∅),[5.275]→[5.282:459](∅→∅),[5.158]→[5.925:926](∅→∅),[5.459]→[5.925:926](∅→∅),[5.677]→[5.925:926](∅→∅),[5.925]→[5.925:926](∅→∅),[5.926]→[5.460:538](∅→∅),[5.538]→[5.1080:1081](∅→∅),[5.754]→[5.1080:1081](∅→∅),[5.999]→[5.1080:1081](∅→∅),[5.1080]→[5.1080:1081](∅→∅)

let remainder = raiseAmount' - total
winFraction = toRational remainder / toRational (bid ^. bidAmount)
remainderSeconds = Seconds . round $ winFraction * toRational (bid ^. bidSeconds)

in [bid & bidSeconds .~ remainderSeconds & bidAmount .~ remainder]

[5.228]

[5.1081]

let winFraction rem = rem % (bid ^. bidAmount . satoshi)
remainderSeconds (Satoshi rem) = Seconds . round $ winFraction rem * fromIntegral (bid ^. bidSeconds)
adjustBid rem = bid & bidSeconds .~ remainderSeconds rem & bidAmount .~ rem
in toList $ adjustBid <$> raiseAmount' `ssub` total
replacement in lib/Aftok/Auction.hs at line 89

[5.483]→[5.483:653](∅→∅)

in if submittedTotal >= raiseAmount'
then WinningBids $ takeWinningBids 0 $ sortBy bidOrder bids
else InsufficientBids (raiseAmount' - submittedTotal)

[5.483]

[5.653]

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

[5.502]→[5.502:551](∅→∅),[5.551]→[5.418:454](∅→∅)

x | x + (bid ^. bidAmount) < raiseAmount' ->
put (x + bid ^. bidAmount) >>

[5.502]

[5.588]

x | x <> (bid ^. bidAmount) < raiseAmount' ->
put (x <> bid ^. bidAmount) >>
replacement in lib/Aftok/Auction.hs at line 105

[5.763]→[5.763:1074](∅→∅)

let remainder = raiseAmount' - x
winFraction = toRational remainder / toRational (bid ^. bidAmount)
remainderSeconds = Seconds . round $ winFraction * toRational (bid ^. bidSeconds)
in put (x + remainder) >>
(pure . Just $ Commitment bid (remainderSeconds) remainder)

[5.763]

[5.1074]

let winFraction rem = rem % (bid ^. bidAmount . satoshi)
remainderSeconds (Satoshi rem) = Seconds . round $ winFraction rem * fromIntegral (bid ^. bidSeconds)
in for (raiseAmount' `ssub` x) $ \remainder ->
put (x <> remainder) *>
(pure $ Commitment bid (remainderSeconds remainder) remainder)
replacement in lib/Aftok/Billables.hs at line 17

[5.915]→[5.276:409](∅→∅)

import Aftok (UserId)
import Aftok.Project (ProjectId)
import Aftok.Types (Satoshi)

[5.915]

[5.981]

import Aftok.Types (UserId, ProjectId)
import Network.Bippy.Types (Satoshi)
replacement in lib/Aftok/Billables.hs at line 84

[5.694]→[3.10756:10761](∅→∅)

}

[5.694]

[5.1586]

}
replacement in lib/Aftok/Config.hs at line 9

[3.10966]→[3.10966:11019](∅→∅)

import qualified Data.Configurator.Types as CT

[3.10966]

[3.11019]

import qualified Data.Configurator.Types as C
replacement in lib/Aftok/Config.hs at line 12

[3.11125]→[3.11125:11258](∅→∅)

import Database.PostgreSQL.Simple (ConnectInfo(..))
import Filesystem.Path.CurrentOS (FilePath, fromText, encodeString)

[3.11125]

[3.11258]

import Database.PostgreSQL.Simple (ConnectInfo(..))
import Filesystem.Path.CurrentOS (FilePath, fromText, encodeString)
edit in lib/Aftok/Config.hs at line 19

[3.11421]

[3.11421]

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

[3.11686]→[3.11686:11728](∅→∅)

{ _network :: BT.Network

[3.11686]

[3.11728]

{ _networkMode :: NetworkMode
replacement in lib/Aftok/Config.hs at line 35

[3.11846]→[3.11846:11851](∅→∅)

}

[3.11846]

[3.11851]

}
replacement in lib/Aftok/Config.hs at line 38

[3.11879]→[3.11879:11924](∅→∅)

readSmtpConfig :: CT.Config -> IO SmtpConfig

[3.11879]

[3.11924]

readSmtpConfig :: C.Config -> IO SmtpConfig
replacement in lib/Aftok/Config.hs at line 45

[3.12142]→[3.12142:12193](∅→∅)

readBillingConfig :: CT.Config -> IO BillingConfig

[3.12142]

[3.12193]

readBillingConfig :: C.Config -> IO BillingConfig
replacement in lib/Aftok/Config.hs at line 47

[3.12217]→[3.12217:12280](∅→∅)

BillingConfig <$> (parseNetwork <$> C.require cfg "network")

[3.12217]

[3.12280]

BillingConfig <$> C.require cfg "networkMode"
edit in lib/Aftok/Config.hs at line 51

[3.12466]→[3.12466:12593](∅→∅)

where parseNetwork :: String -> BT.Network
parseNetwork "main" = BT.MainNet
parseNetwork _ = BT.TestNet
replacement in lib/Aftok/Config.hs at line 52

[3.12594]→[3.12594:12641](∅→∅)

readConnectInfo :: CT.Config -> IO ConnectInfo

[3.12594]

[3.12641]

readConnectInfo :: C.Config -> IO ConnectInfo
replacement in lib/Aftok/Config.hs at line 66

[3.13148]→[3.13148:13343](∅→∅)

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

[3.13148]

[3.13343]

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

[3.13405]→[3.13405:13460](∅→∅)

pure $ PaymentsConfig (c ^. network) privKey pkiData

[3.13405]

pure $ PaymentsConfig (c ^. networkMode) privKey pkiData
file addition: Currency (d--r------)

[5.679]
file addition: Bitcoin.hs (----------)

[0.4250]

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

module Aftok.Currency.Bitcoin where

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

satoshi :: Lens' Satoshi Word64
satoshi inj (Satoshi value) = Satoshi <$> inj value

ssub :: Satoshi -> Satoshi -> Maybe Satoshi
ssub (Satoshi a) (Satoshi b) | a > b = Just . Satoshi $ (a - b)
ssub _ _ = Nothing

data NetworkId
= BTC
| BCH
deriving (Eq, Show, Ord)

renderNetworkId :: NetworkId -> Text
renderNetworkId = \case
BTC -> "btc"
BCH -> "bch"

parseNetworkId :: Text -> Maybe NetworkId
parseNetworkId = \case
"btc" -> Just BTC
"bch" -> Just BCH
_ -> Nothing

data NetworkMode
= LiveMode
| TestMode

parseNetworkMode :: Text -> Maybe NetworkMode
parseNetworkMode = \case
"test" -> Just TestMode
"live" -> Just LiveMode
_ -> Nothing

instance C.Configured NetworkMode where
convert (C.String t) = parseNetworkMode t
convert _ = Nothing

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
file addition: Currency.hs (----------)

[5.679]

module Aftok.Currency where

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

data Network a = Network
{ addressFromJSON :: Parser a
, addressToJSON :: a -> Value
}
file addition: PostgreSQL (d--r------)

[5.988]
file addition: Types.hs (----------)

[0.6049]

module Aftok.Database.PostgreSQL.Types where

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

newtype SerDepFunction = SerDepFunction { unSerDepFunction :: DepreciationFunction }

instance FromJSON SerDepFunction where
parseJSON v = SerDepFunction <$> depfFromJSON v

instance ToJSON SerDepFunction where
toJSON (SerDepFunction depf) = depfToJSON depf
replacement in lib/Aftok/Database/PostgreSQL.hs at line 7

[5.623]→[5.938:969](∅→∅)

import ClassyPrelude

[5.623]

[5.969]

import ClassyPrelude hiding (null)
edit in lib/Aftok/Database/PostgreSQL.hs at line 27

[5.65]→[5.1828:1829](∅→∅),[5.1829]→[5.144:213](∅→∅)

import Network.Haskoin.Crypto (addrToBase58)
edit in lib/Aftok/Database/PostgreSQL.hs at line 28

[5.1012]→[5.1560:1583](∅→∅)

import Aftok
edit in lib/Aftok/Database/PostgreSQL.hs at line 30

[5.1722]

[5.1614]

import Aftok.Currency.Bitcoin
edit in lib/Aftok/Database/PostgreSQL.hs at line 32

[5.1646]

[5.1646]

import Aftok.Database.PostgreSQL.Types (SerDepFunction(..))
edit in lib/Aftok/Database/PostgreSQL.hs at line 42

[5.1738]

[5.1123]

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

[5.1124]→[3.13752:13818](∅→∅)

newtype QDBM a = QDBM (ReaderT Connection (ExceptT DBError IO) a)

[5.1124]

[5.264]

newtype QDBM a = QDBM (ReaderT (NetworkMode, Connection) (ExceptT DBError IO) a)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 58

[5.343]→[3.13866:13922](∅→∅),[3.13922]→[5.1984:2026](∅→∅),[5.1984]→[5.1984:2026](∅→∅)

runQDBM :: Connection -> QDBM a -> ExceptT DBError IO a
runQDBM conn (QDBM r) = runReaderT r conn

[5.343]

[5.1215]

runQDBM :: NetworkMode -> Connection -> QDBM a -> ExceptT DBError IO a
runQDBM mode conn (QDBM r) = runReaderT r (mode, conn)

null :: RowParser Null
null = field
replacement in lib/Aftok/Database/PostgreSQL.hs at line 67

[5.2104]→[5.1462:1499](∅→∅),[5.1462]→[5.1462:1499](∅→∅),[5.1499]→[5.1885:1952](∅→∅)

btcAddrParser :: FieldParser BtcAddr
btcAddrParser f v = do
addrMay <- parseBtcAddr <$> fromField f v

[5.1462]

[5.2035]

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

addressParser :: NetworkMode -> RowParser (NetworkId, Address)
addressParser mode = do
networkId <- fieldWith (networkIdParser)
address <- fieldWith $ addrFieldParser (toNetwork mode networkId)
pure (networkId, address)

addrFieldParser :: Network -> FieldParser Address
addrFieldParser n f v = do
addrMay <- stringToAddr n <$> fromField f v
replacement in lib/Aftok/Database/PostgreSQL.hs at line 102

[5.1923]→[5.1923:2025](∅→∅)

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

[5.1923]

[5.2299]

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

[5.272]→[5.206:293](∅→∅)

creditToParser :: RowParser CreditTo
creditToParser = join $ fieldWith creditToParser'

[5.272]

[5.293]

creditToParser :: NetworkMode -> RowParser (CreditTo (NetworkId, Address))
creditToParser mode = join $ fieldWith (creditToParser' mode)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 113

[5.294]→[5.294:346](∅→∅),[5.346]→[5.1326:1348](∅→∅),[5.371]→[5.2050:2093](∅→∅),[5.1348]→[5.2050:2093](∅→∅),[5.2050]→[5.2050:2093](∅→∅),[5.2093]→[3.13923:14031](∅→∅),[3.14031]→[5.1537:1742](∅→∅),[5.2201]→[5.1537:1742](∅→∅)

creditToParser' :: FieldParser (RowParser CreditTo)
creditToParser' f v =
let parser :: Text -> RowParser CreditTo
parser "credit_to_address" = CreditToAddress <$> (fieldWith btcAddrParser <* nullField <* nullField)
parser "credit_to_user" = CreditToUser <$> (nullField *> idParser UserId <* nullField)
parser "credit_to_project" = CreditToProject <$> (nullField *> nullField *> idParser P.ProjectId)

[5.294]

[5.2409]

creditToParser' :: NetworkMode -> FieldParser (RowParser (CreditTo (NetworkId, Address)))
creditToParser' mode f v =
let parser :: Text -> RowParser (CreditTo (NetworkId, Address))
parser "credit_to_address" =
CreditToCurrency <$> (addressParser mode <* nullField <* nullField)
parser "credit_to_user" =
CreditToUser <$> (nullField *> nullField *> idParser UserId <* nullField)
parser "credit_to_project" =
CreditToProject <$> (nullField *> nullField *> nullField *> idParser ProjectId)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 129

[5.1683]→[5.241:278](∅→∅),[5.224]→[5.241:278](∅→∅),[5.278]→[5.1911:1928](∅→∅),[5.1928]→[5.372:402](∅→∅)

logEntryParser :: RowParser LogEntry
logEntryParser =
LogEntry <$> creditToParser

[5.1410]

[5.2607]

logEntryParser :: NetworkMode -> RowParser (LogEntry (NetworkId, Address))
logEntryParser mode =
LogEntry <$> creditToParser mode
replacement in lib/Aftok/Database/PostgreSQL.hs at line 135

[5.2598]→[5.306:351](∅→∅),[5.351]→[5.1968:1988](∅→∅),[5.1988]→[5.1743:1775](∅→∅)

qdbLogEntryParser :: RowParser KeyedLogEntry
qdbLogEntryParser =
(,,) <$> idParser P.ProjectId

[5.2598]

[5.1775]

qdbLogEntryParser :: NetworkMode -> RowParser (KeyedLogEntry (NetworkId, Address))
qdbLogEntryParser mode =
(,,) <$> idParser ProjectId
replacement in lib/Aftok/Database/PostgreSQL.hs at line 139

[5.1802]→[5.95:121](∅→∅),[5.2020]→[5.95:121](∅→∅),[5.2707]→[5.95:121](∅→∅),[5.95]→[5.95:121](∅→∅)

<*> logEntryParser

[5.1802]

[5.2021]

<*> logEntryParser mode
replacement in lib/Aftok/Database/PostgreSQL.hs at line 143

[5.2039]→[5.1803:1840](∅→∅)

A.Auction <$> idParser P.ProjectId

[5.2039]

[5.1840]

A.Auction <$> idParser ProjectId
replacement in lib/Aftok/Database/PostgreSQL.hs at line 157

[5.2829]→[5.879:908](∅→∅),[5.908]→[5.2147:2160](∅→∅)

userParser :: RowParser User
userParser =

[5.2829]

[5.2964]

userParser :: NetworkMode -> RowParser BTCUser
userParser mode =
replacement in lib/Aftok/Database/PostgreSQL.hs at line 160

[5.2996]→[5.3132:3183](∅→∅),[5.958]→[5.3132:3183](∅→∅)

<*> fieldWith (optionalField btcAddrParser)

[5.2996]

[5.2210]

<*> ((null *> null *> pure Nothing) <|> fmap Just (addressParser mode))
replacement in lib/Aftok/Database/PostgreSQL.hs at line 168

[5.1934]→[5.3169:3209](∅→∅),[5.3070]→[5.3169:3209](∅→∅),[5.3169]→[5.3169:3209](∅→∅)

<*> fieldWith fromJSONField

[5.1934]

[5.313]

<*> (unSerDepFunction <$> fieldWith fromJSONField)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 172

[5.2298]→[5.1935:1975](∅→∅)

P.Invitation <$> idParser P.ProjectId

[5.2298]

[5.1975]

P.Invitation <$> idParser ProjectId
replacement in lib/Aftok/Database/PostgreSQL.hs at line 180

[5.3516]→[5.2011:2049](∅→∅)

B.Billable <$> idParser P.ProjectId

[5.3516]

[5.2049]

B.Billable <$> idParser ProjectId
replacement in lib/Aftok/Database/PostgreSQL.hs at line 226

[5.527]→[5.1425:1439](∅→∅),[5.1425]→[5.1425:1439](∅→∅)

conn <- ask

[5.527]

[5.2532]

conn <- asks snd
replacement in lib/Aftok/Database/PostgreSQL.hs at line 231

[5.412]→[5.3172:3186](∅→∅),[5.554]→[5.3172:3186](∅→∅),[5.1232]→[5.3172:3186](∅→∅),[5.1546]→[5.3172:3186](∅→∅),[5.3172]→[5.3172:3186](∅→∅)

conn <- ask

[5.554]

[5.2566]

conn <- asks snd
replacement in lib/Aftok/Database/PostgreSQL.hs at line 237

[5.580]→[5.2606:2620](∅→∅)

conn <- ask

[5.580]

[5.2620]

conn <- asks snd
replacement in lib/Aftok/Database/PostgreSQL.hs at line 242

[5.580]→[5.1320:1334](∅→∅),[5.1694]→[5.1320:1334](∅→∅),[5.2726]→[5.1320:1334](∅→∅),[5.1320]→[5.1320:1334](∅→∅),[5.1334]→[3.14079:14153](∅→∅)

conn <- ask
lift . ExceptT $ withTransaction conn (runExceptT $ runReaderT rt conn)

[5.2726]

[5.1361]

env <- ask
lift . ExceptT $ withTransaction (snd env) (runExceptT $ runReaderT rt env)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 265

[5.661]→[3.14154:14269](∅→∅)

pinsert EventId
[sql| INSERT INTO aftok_events
(event_time, created_by, event_type, event_json)

[5.661]

[3.14269]

pinsert EventId
[sql| INSERT INTO aftok_events
(event_time, created_by, event_type, event_json)
edit in lib/Aftok/Database/PostgreSQL.hs at line 270

[5.981]

[5.425]

askNetworkMode :: QDBM NetworkMode
askNetworkMode = QDBM $ asks fst
replacement in lib/Aftok/Database/PostgreSQL.hs at line 275

[5.4296]→[5.4296:4367](∅→∅)

pgEval (CreateEvent (P.ProjectId pid) (UserId uid) (LogEntry c e m)) =

[5.4296]

[5.4161]

pgEval (CreateEvent (ProjectId pid) (UserId uid) (LogEntry c e m)) =
replacement in lib/Aftok/Database/PostgreSQL.hs at line 277

[5.4173]→[5.4173:4201](∅→∅),[5.4201]→[3.14316:14378](∅→∅)

CreditToAddress addr ->
pinsert EventId
[sql| INSERT INTO work_events

[5.4173]

[3.14378]

CreditToCurrency (nid, addr) -> do
mode <- askNetworkMode
let network = toNetwork mode nid
pinsert EventId
[sql| INSERT INTO work_events
replacement in lib/Aftok/Database/PostgreSQL.hs at line 283

[3.14449]→[3.14449:14551](∅→∅)

, event_type, event_time, event_metadata )
VALUES (?, ?, ?, ?, ?, ?, ?)

[3.14449]

[3.14551]

, event_type, event_time, event_metadata )
VALUES (?, ?, ?, ?, ?, ?, ?)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 286

[3.14581]→[5.4430:4546](∅→∅),[5.4430]→[5.4430:4546](∅→∅)

( pid, uid, creditToName c, addr ^. _BtcAddr . to addrToBase58, eventName e, fromThyme $ e ^. eventTime, m)

[3.14581]

[5.762]

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

[5.4575]→[3.14582:14644](∅→∅)

pinsert EventId
[sql| INSERT INTO work_events

[5.4575]

[3.14644]

pinsert EventId
[sql| INSERT INTO work_events
replacement in lib/Aftok/Database/PostgreSQL.hs at line 299

[3.14718]→[3.14718:14820](∅→∅)

, event_type, event_time, event_metadata )
VALUES (?, ?, ?, ?, ?, ?, ?)

[3.14718]

[3.14820]

, event_type, event_time, event_metadata )
VALUES (?, ?, ?, ?, ?, ?, ?)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 302

[3.14850]→[5.4806:4908](∅→∅),[5.4806]→[5.4806:4908](∅→∅)

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

[3.14850]

[5.1807]

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

[5.4934]→[3.14851:15069](∅→∅)

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 (?, ?, ?, ?, ?, ?, ?)

[5.4934]

[3.15069]

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 (?, ?, ?, ?, ?, ?, ?)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 312

[5.3406]→[5.4368:4403](∅→∅),[5.4403]→[3.15100:15347](∅→∅)

pgEval (FindEvent (EventId eid)) =
headMay <$> pquery qdbLogEntryParser
[sql| SELECT project_id, user_id,
credit_to_type, credit_to_address, credit_to_user_id, credit_to_project_id,
event_type, event_time, event_metadata FROM work_events

[5.3406]

[3.15347]

pgEval (FindEvent (EventId eid)) = do
mode <- askNetworkMode
headMay <$> pquery (qdbLogEntryParser mode)
[sql| SELECT project_id, user_id,
credit_to_type, credit_to_address, credit_to_user_id, credit_to_project_id,
event_type, event_time, event_metadata FROM work_events
replacement in lib/Aftok/Database/PostgreSQL.hs at line 321

[5.1084]→[5.4404:4462](∅→∅),[5.4462]→[3.15374:15631](∅→∅)

pgEval (FindEvents (P.ProjectId pid) (UserId uid) ival) =
let q (Before e) = pquery logEntryParser
[sql| SELECT credit_to_type, credit_to_address, credit_to_user_id, credit_to_project_id,
event_type, event_time,
event_metadata
FROM work_events

[5.1084]

[3.15631]

pgEval (FindEvents (ProjectId pid) (UserId uid) ival) = do
mode <- askNetworkMode
let q (Before e) = pquery (logEntryParser mode)
[sql| SELECT credit_to_type, credit_to_address, credit_to_user_id, credit_to_project_id,
event_type, event_time,
event_metadata
FROM work_events
replacement in lib/Aftok/Database/PostgreSQL.hs at line 330

[5.5845]→[3.15706:15995](∅→∅)

q (During s e) = pquery logEntryParser
[sql| SELECT credit_to_type, 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 = ?

[5.5845]

[3.15995]

q (During s e) = pquery (logEntryParser mode)
[sql| SELECT credit_to_type, 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 = ?
replacement in lib/Aftok/Database/PostgreSQL.hs at line 337

[5.6117]→[3.16053:16287](∅→∅)

q (After s) = pquery logEntryParser
[sql| SELECT credit_to_type, credit_to_address, credit_to_user_id, credit_to_project_id,
event_type, event_time, event_metadata
FROM work_events

[5.6117]

[3.16287]

q (After s) = pquery (logEntryParser mode)
[sql| SELECT credit_to_type, credit_to_address, credit_to_user_id, credit_to_project_id,
event_type, event_time, event_metadata
FROM work_events
replacement in lib/Aftok/Database/PostgreSQL.hs at line 343

[5.6342]→[5.6342:6355](∅→∅)

in q ival

[5.6342]

[5.1951]

q ival
replacement in lib/Aftok/Database/PostgreSQL.hs at line 346

[5.4517]→[3.16362:16476](∅→∅)

pinsert AmendmentId
[sql| INSERT INTO event_time_amendments
(event_id, amended_at, event_time)

[5.4517]

[3.16476]

pinsert AmendmentId
[sql| INSERT INTO event_time_amendments
(event_id, amended_at, event_time)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 352

[5.2904]→[5.4518:4576](∅→∅)

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

[5.2904]

[5.6673]

pgEval (AmendEvent (EventId eid) (CreditToChange mt c)) = do
mode <- askNetworkMode
replacement in lib/Aftok/Database/PostgreSQL.hs at line 355

[5.6685]→[5.6685:6713](∅→∅),[5.6713]→[3.16520:16675](∅→∅)

CreditToAddress addr ->
pinsert AmendmentId
[sql| INSERT INTO event_credit_to_amendments
(event_id, amended_at, credit_to_type, credit_to_btc_addr)

[5.6685]

[3.16675]

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_btc_addr)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 361

[3.16725]→[5.6902:6998](∅→∅),[5.6902]→[5.6902:6998](∅→∅)

( eid, fromThyme $ mt ^. _ModTime, creditToName c, addr ^. _BtcAddr . to addrToBase58 )

[3.16725]

[5.1932]

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

[5.7026]→[3.16726:16883](∅→∅)

pinsert AmendmentId
[sql| INSERT INTO event_credit_to_amendments
(event_id, amended_at, credit_to_type, credit_to_project_id)

[5.7026]

[3.16883]

pinsert AmendmentId
[sql| INSERT INTO event_credit_to_amendments
(event_id, amended_at, credit_to_type, credit_to_project_id)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 368

[3.16933]→[5.7217:7298](∅→∅),[5.7217]→[5.7217:7298](∅→∅)

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

[3.16933]

[5.2208]

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

[5.7323]→[3.16934:17088](∅→∅)

pinsert AmendmentId
[sql| INSERT INTO event_credit_to_amendments
(event_id, amended_at, credit_to_type, credit_to_user_id)

[5.7323]

[3.17088]

pinsert AmendmentId
[sql| INSERT INTO event_credit_to_amendments
(event_id, amended_at, credit_to_type, credit_to_user_id)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 378

[5.4635]→[3.17139:17261](∅→∅)

pinsert AmendmentId
[sql| INSERT INTO event_metadata_amendments
(event_id, amended_at, event_metadata)

[5.4635]

[3.17261]

pinsert AmendmentId
[sql| INSERT INTO event_metadata_amendments
(event_id, amended_at, event_metadata)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 384

[5.4862]→[5.4636:4682](∅→∅),[5.4682]→[3.17305:17523](∅→∅)

pgEval (ReadWorkIndex (P.ProjectId pid)) = do
logEntries <- pquery logEntryParser
[sql| SELECT credit_to_type, credit_to_address, credit_to_user_id, credit_to_project_id,
event_type, event_time, event_metadata
FROM work_events

[5.4862]

[3.17523]

pgEval (ReadWorkIndex (ProjectId pid)) = do
mode <- askNetworkMode
logEntries <- pquery (logEntryParser mode)
[sql| SELECT credit_to_type, credit_to_address, credit_to_user_id, credit_to_project_id,
event_type, event_time, event_metadata
FROM work_events
replacement in lib/Aftok/Database/PostgreSQL.hs at line 395

[5.4712]→[3.17558:17664](∅→∅)

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

[5.4712]

[3.17664]

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

[3.17710]→[5.8247:8289](∅→∅),[5.8247]→[5.8247:8289](∅→∅)

( auc ^. (A.projectId . P._ProjectId)

[3.17710]

[5.8289]

( auc ^. (A.projectId . _ProjectId)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 405

[5.4742]→[3.17711:17863](∅→∅)

headMay <$> pquery auctionParser
[sql| SELECT project_id, initiator_id, created_at, raise_amount, start_time, end_time
FROM auctions

[5.4742]

[3.17863]

headMay <$> pquery auctionParser
[sql| SELECT project_id, initiator_id, created_at, raise_amount, start_time, end_time
FROM auctions
replacement in lib/Aftok/Database/PostgreSQL.hs at line 412

[5.4788]→[3.17890:17996](∅→∅)

pinsert A.BidId
[sql| INSERT INTO bids (auction_id, bidder_id, bid_seconds, bid_amount, bid_time)

[5.4788]

[3.17996]

pinsert A.BidId
[sql| INSERT INTO bids (auction_id, bidder_id, bid_seconds, bid_amount, bid_time)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 423

[5.2753]→[3.18046:18097](∅→∅)

pquery ((,) <$> idParser A.BidId <*> bidParser)

[5.2753]

[3.18097]

pquery ((,) <$> idParser A.BidId <*> bidParser)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 427

[5.705]→[5.4816:4844](∅→∅),[5.4844]→[5.9214:9327](∅→∅),[5.9214]→[5.9214:9327](∅→∅),[5.9327]→[3.18198:18307](∅→∅)

pgEval (CreateUser user') =
let addrMay :: Maybe ByteString
addrMay = user' ^? (userAddress . traverse . _BtcAddr . to addrToBase58)
in pinsert UserId
[sql| INSERT INTO users (handle, btc_addr, email) VALUES (?, ?, ?) RETURNING id |]

[5.705]

[5.9428]

pgEval (CreateUser user') = do
mode <- askNetworkMode
let nidMay = fst <$> _userAddress user'
addrMay :: Maybe Text
addrMay = do
network <- toNetwork mode <$> nidMay
address <- snd <$> _userAddress user'
pure $ addrToString network address
pinsert UserId
[sql| INSERT INTO users (handle, network, addr, email)
VALUES (?, ?, ?, ?) RETURNING id |]
edit in lib/Aftok/Database/PostgreSQL.hs at line 439

[5.9464]

[5.9464]

, renderNetworkId <$> nidMay
replacement in lib/Aftok/Database/PostgreSQL.hs at line 444

[5.1369]→[5.4845:4878](∅→∅),[5.4878]→[3.18308:18341](∅→∅)

pgEval (FindUser (UserId uid)) =
headMay <$> pquery userParser

[5.1369]

[3.18341]

pgEval (FindUser (UserId uid)) = do
mode <- askNetworkMode
headMay <$> pquery (userParser mode)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 450

[5.3219]→[5.4879:4918](∅→∅),[5.4918]→[3.18410:18473](∅→∅)

pgEval (FindUserByName (UserName h)) =
headMay <$> pquery ((,) <$> idParser UserId <*> userParser)

[5.3219]

[3.18473]

pgEval (FindUserByName (UserName h)) = do
mode <- askNetworkMode
headMay <$> pquery ((,) <$> idParser UserId <*> userParser mode)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 456

[5.9826]→[5.4919:4993](∅→∅)

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

[5.9826]

[5.9905]

pgEval (CreateInvitation (ProjectId pid) (UserId uid) (Email e) t) = do
replacement in lib/Aftok/Database/PostgreSQL.hs at line 458

[5.9941]→[3.18550:18674](∅→∅)

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

[5.9941]

[3.18674]

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

[5.5023]→[3.18711:18840](∅→∅)

headMay <$> pquery invitationParser
[sql| SELECT project_id, invitor_id, invitee_email, invitation_time, acceptance_time

[5.5023]

[3.18840]

headMay <$> pquery invitationParser
[sql| SELECT project_id, invitor_id, invitee_email, invitation_time, acceptance_time
replacement in lib/Aftok/Database/PostgreSQL.hs at line 471

[5.5088]→[3.18896:18912](∅→∅)

void $ pexec

[5.5088]

[3.18912]

void $ pexec
replacement in lib/Aftok/Database/PostgreSQL.hs at line 475

[3.18995]→[3.18995:19179](∅→∅)

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

[3.18995]

[3.19179]

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
replacement in lib/Aftok/Database/PostgreSQL.hs at line 483

[5.5116]→[3.19220:19337](∅→∅)

pinsert P.ProjectId
[sql| INSERT INTO projects (project_name, inception_date, initiator_id, depreciation_fn)

[5.5116]

[3.19337]

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

[3.19383]→[5.11027:11143](∅→∅),[5.11027]→[5.11027:11143](∅→∅)

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

[3.19383]

[3.19384]

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

[3.19407]→[3.19407:19439](∅→∅)

pquery (idParser P.ProjectId)

[3.19407]

[3.19439]

pquery (idParser ProjectId)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 499

[3.19542]→[3.19542:19653](∅→∅)

[sql| SELECT s.user_id
FROM subscripions s
JOIN billables b ON s.billable_id = b.id

[3.19542]

[3.19653]

[sql| SELECT s.user_id
FROM subscripions s
JOIN billables b ON s.billable_id = b.id
replacement in lib/Aftok/Database/PostgreSQL.hs at line 503

[3.19689]→[3.19689:19722](∅→∅)

(Only (pid ^. P._ProjectId))

[3.19689]

[5.4290]

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

[5.4291]→[5.5117:5158](∅→∅),[5.5158]→[3.19723:19759](∅→∅)

pgEval (FindProject (P.ProjectId pid)) =
headMay <$> pquery projectParser

[5.4291]

[3.19759]

pgEval (FindProject (ProjectId pid)) =
headMay <$> pquery projectParser
replacement in lib/Aftok/Database/PostgreSQL.hs at line 511

[5.5200]→[3.19867:20139](∅→∅)

pquery ((,) <$> idParser P.ProjectId <*> projectParser)
[sql| SELECT 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 = ?

[5.5200]

[3.20139]

pquery ((,) <$> idParser ProjectId <*> projectParser)
[sql| SELECT 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 = ?
replacement in lib/Aftok/Database/PostgreSQL.hs at line 519

[5.5252]→[3.20175:20184](∅→∅)

pexec

[5.5252]

[3.20184]

pexec
replacement in lib/Aftok/Database/PostgreSQL.hs at line 521

[3.20279]→[5.11810:11872](∅→∅),[5.11810]→[5.11810:11872](∅→∅)

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

[3.20279]

[5.1042]

(pid ^. _ProjectId, new ^. _UserId, current ^. _UserId)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 523

[5.1043]→[5.5253:5293](∅→∅)

pgEval dbop @ (CreateBillable _ b) = do

[5.1043]

[5.11916]

pgEval dbop@(CreateBillable _ b) = do
replacement in lib/Aftok/Database/PostgreSQL.hs at line 525

[5.11949]→[3.20280:20437](∅→∅)

pinsert B.BillableId
[sql| INSERT INTO billables
( project_id, event_id, name, description
, recurrence_type, recurrence_count

[5.11949]

[3.20437]

pinsert B.BillableId
[sql| INSERT INTO billables
( project_id, event_id, name, description
, recurrence_type, recurrence_count
replacement in lib/Aftok/Database/PostgreSQL.hs at line 531

[3.20526]→[3.20526:20570](∅→∅)

, payment_request_memo_template)

[3.20526]

[3.20570]

, payment_request_memo_template)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 533

[3.20634]→[5.5318:5356](∅→∅),[5.12171]→[5.5318:5356](∅→∅)

( b ^. (B.project . P._ProjectId)

[3.20634]

[5.12210]

( b ^. (B.project . _ProjectId)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 546

[5.3073]→[3.20721:20884](∅→∅)

headMay <$> pquery billableParser
[sql| SELECT b.project_id, e.created_by, b.name, b.description,
b.recurrence_type, b.recurrence_count,

[5.3073]

[3.20884]

headMay <$> pquery billableParser
[sql| SELECT b.project_id, e.created_by, b.name, b.description,
b.recurrence_type, b.recurrence_count,
replacement in lib/Aftok/Database/PostgreSQL.hs at line 551

[3.21023]→[3.21023:21092](∅→∅)

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

[3.21023]

[3.21092]

FROM billables b JOIN aftok_events e ON e.id = b.event_id
replacement in lib/Aftok/Database/PostgreSQL.hs at line 555

[3.21122]→[3.21122:21401](∅→∅)

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

[3.21122]

[3.21401]

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
replacement in lib/Aftok/Database/PostgreSQL.hs at line 561

[3.21484]→[3.21484:21553](∅→∅)

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

[3.21484]

[3.21553]

FROM billables b JOIN aftok_events e ON e.id = b.event_id
replacement in lib/Aftok/Database/PostgreSQL.hs at line 563

[3.21589]→[3.21589:21622](∅→∅)

(Only (pid ^. P._ProjectId))

[3.21589]

[5.3942]

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

[5.3943]→[5.1227:1286](∅→∅)

pgEval dbop @ (CreateSubscription uid bid start_date) = do

[5.3943]

[5.576]

pgEval dbop@(CreateSubscription uid bid start_date) = do
replacement in lib/Aftok/Database/PostgreSQL.hs at line 567

[5.609]→[3.21623:21744](∅→∅)

pinsert B.SubscriptionId
[sql| INSERT INTO subscriptions
(user_id, billable_id, event_id, start_date)

[5.609]

[3.21744]

pinsert B.SubscriptionId
[sql| INSERT INTO subscriptions
(user_id, billable_id, event_id, start_date)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 578

[5.1516]→[3.21791:21920](∅→∅)

headMay <$> pquery subscriptionParser
[sql| SELECT id, billable_id, start_date, end_date
FROM subscriptions s

[5.1516]

[3.21920]

headMay <$> pquery subscriptionParser
[sql| SELECT id, billable_id, start_date, end_date
FROM subscriptions s
replacement in lib/Aftok/Database/PostgreSQL.hs at line 585

[5.1554]→[3.21949:22200](∅→∅)

pquery ((,) <$> idParser B.SubscriptionId <*> subscriptionParser)
[sql| SELECT s.id, user_id, billable_id, start_date, end_date
FROM subscriptions s
JOIN billables b ON b.id = s.billable_id
WHERE s.user_id = ?

[5.1554]

[3.22200]

pquery ((,) <$> idParser B.SubscriptionId <*> subscriptionParser)
[sql| SELECT s.id, user_id, billable_id, start_date, end_date
FROM subscriptions s
JOIN billables b ON b.id = s.billable_id
WHERE s.user_id = ?
replacement in lib/Aftok/Database/PostgreSQL.hs at line 591

[3.22234]→[5.6065:6107](∅→∅),[5.6065]→[5.6065:6107](∅→∅)

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

[3.22234]

[5.811]

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

[5.6109]→[5.982:1028](∅→∅)

pgEval dbop @ (CreatePaymentRequest req) = do

[5.6109]

[5.863]

pgEval dbop@(CreatePaymentRequest req) = do
replacement in lib/Aftok/Database/PostgreSQL.hs at line 596

[5.896]→[3.22235:22393](∅→∅)

pinsert PaymentRequestId
[sql| INSERT INTO payment_requests
(subscription_id, event_id, request_data, url_key, request_time, billing_date)

[5.896]

[3.22393]

pinsert PaymentRequestId
[sql| INSERT INTO payment_requests
(subscription_id, event_id, request_data, url_key, request_time, billing_date)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 609

[5.730]→[3.22446:22674](∅→∅)

headMay <$> pquery ((,) <$> idParser PaymentRequestId <*> paymentRequestParser)
[sql| SELECT id, subscription_id, request_data, url_key, request_time, billing_date
FROM payment_requests
WHERE url_key = ?

[5.730]

[3.22674]

headMay <$> pquery ((,) <$> idParser PaymentRequestId <*> paymentRequestParser)
[sql| SELECT id, subscription_id, request_data, url_key, request_time, billing_date
FROM payment_requests
WHERE url_key = ?
replacement in lib/Aftok/Database/PostgreSQL.hs at line 618

[3.22841]→[3.22841:22955](∅→∅)

[sql| SELECT subscription_id, request_data, url_key, request_time, billing_date
FROM payment_requests

[3.22841]

[3.22955]

[sql| SELECT subscription_id, request_data, url_key, request_time, billing_date
FROM payment_requests
replacement in lib/Aftok/Database/PostgreSQL.hs at line 624

[5.1626]→[3.22994:23183](∅→∅)

pquery ((,) <$> idParser PaymentRequestId <*> paymentRequestParser)
[sql| SELECT id, subscription_id, request_data, url_key, request_time, billing_date
FROM payment_requests

[5.1626]

[3.23183]

pquery ((,) <$> idParser PaymentRequestId <*> paymentRequestParser)
[sql| SELECT id, subscription_id, request_data, url_key, request_time, billing_date
FROM payment_requests
replacement in lib/Aftok/Database/PostgreSQL.hs at line 636

[5.1010]→[3.23221:23531](∅→∅)

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.start_date, s.end_date,
b.project_id, e.created_by, b.name, b.description, b.recurrence_type,

[5.1010]

[3.23531]

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.start_date, s.end_date,
b.project_id, e.created_by, b.name, b.description, b.recurrence_type,
replacement in lib/Aftok/Database/PostgreSQL.hs at line 643

[3.23694]→[3.23694:23847](∅→∅)

FROM payment_requests r
JOIN subscriptions s on s.id = r.subscription_id
JOIN billables b on b.id = s.billable_id

[3.23694]

[3.23847]

FROM payment_requests r
JOIN subscriptions s on s.id = r.subscription_id
JOIN billables b on b.id = s.billable_id
replacement in lib/Aftok/Database/PostgreSQL.hs at line 647

[3.23900]→[3.23900:23939](∅→∅)

WHERE subscription_id = ?

[3.23900]

[3.23939]

WHERE subscription_id = ?
replacement in lib/Aftok/Database/PostgreSQL.hs at line 651

[5.1642]→[5.1559:1596](∅→∅)

pgEval dbop @ (CreatePayment p) = do

[5.1642]

[5.48]

pgEval dbop@(CreatePayment p) = do
replacement in lib/Aftok/Database/PostgreSQL.hs at line 653

[5.81]→[3.24013:24152](∅→∅)

pinsert PaymentId
[sql| INSERT INTO payments
(payment_request_id, event_id, payment_data, payment_date, exchange_rates)

[5.81]

[3.24152]

pinsert PaymentId
[sql| INSERT INTO payments
(payment_request_id, event_id, payment_data, payment_date, exchange_rates)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 665

[5.1655]→[3.24202:24349](∅→∅)

pquery ((,) <$> idParser PaymentId <*> paymentParser)
[sql| SELECT id, payment_request_id, payment_data, payment_date
FROM payments

[5.1655]

[3.24349]

pquery ((,) <$> idParser PaymentId <*> paymentParser)
[sql| SELECT id, payment_request_id, payment_data, payment_date
FROM payments
replacement in lib/Aftok/Database.hs at line 17

[5.6577]→[5.247:270](∅→∅)

import Aftok

[5.6577]

[5.1894]

import Aftok.Types
edit in lib/Aftok/Database.hs at line 20

[5.1990]

[5.301]

import Aftok.Currency.Bitcoin (NetworkId)
replacement in lib/Aftok/Database.hs at line 27

[5.5956]→[5.5956:6007](∅→∅),[5.6049]→[5.6049:6105](∅→∅)

type KeyedLogEntry = (ProjectId, UserId, LogEntry)
type InvitingUID = UserId
type InvitedUID = UserId

[5.5920]

[5.6137]

import Network.Haskoin.Address (Address)

type KeyedLogEntry a = (ProjectId, UserId, LogEntry a)
type InvitingUID = UserId
type InvitedUID = UserId

type BTCNet = (NetworkId, Address)
type BTCUser = User BTCNet
replacement in lib/Aftok/Database.hs at line 37

[5.6156]→[5.6156:6248](∅→∅),[5.6248]→[5.4648:4710](∅→∅)

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

[5.6156]

[5.6305]

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

[5.6535]→[5.6535:6857](∅→∅)

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

[5.6535]

[5.6857]

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

[5.7400]→[5.7057:7103](∅→∅)

createUser :: (MonadDB m) => User -> m UserId

[5.7400]

[5.7103]

createUser :: (MonadDB m) => BTCUser -> m UserId
replacement in lib/Aftok/Database.hs at line 114

[5.7466]→[3.24810:24861](∅→∅)

findUser :: (MonadDB m) => UserId -> MaybeT m User

[5.7466]

[3.24861]

findUser :: (MonadDB m) => UserId -> MaybeT m BTCUser
replacement in lib/Aftok/Database.hs at line 117

[5.5045]→[3.24900:24969](∅→∅)

findUserByName :: (MonadDB m) => UserName -> MaybeT m (UserId, User)

[5.5045]

[3.24969]

findUserByName :: (MonadDB m) => UserName -> MaybeT m (UserId, BTCUser)
replacement in lib/Aftok/Database.hs at line 192

[5.8566]→[5.8394:8469](∅→∅)

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

[5.8566]

[5.819]

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

[5.8692]→[5.8470:8552](∅→∅)

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

[5.8692]

[5.8764]

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

[5.1147]→[5.8681:8744](∅→∅)

findEvent :: (MonadDB m) => EventId -> m (Maybe KeyedLogEntry)

[5.1147]

[5.8744]

findEvent :: (MonadDB m) => EventId -> m (Maybe (KeyedLogEntry BTCNet))
replacement in lib/Aftok/Database.hs at line 206

[5.4025]→[5.8776:8854](∅→∅)

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

[5.4025]

[5.8854]

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

[5.1304]→[5.8900:8967](∅→∅)

readWorkIndex :: (MonadDB m) => ProjectId -> UserId -> m WorkIndex

[5.1304]

[5.9265]

readWorkIndex :: (MonadDB m) => ProjectId -> UserId -> m (WorkIndex BTCNet)
replacement in lib/Aftok/Database.hs at line 257

[3.26271]→[3.26271:26337](∅→∅)

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

[3.26271]

[3.26337]

_ <- lift $ checkProjectAuth (auc ^. A.projectId) uid findOp
edit in lib/Aftok/Json.hs at line 3

[5.1002]

[5.2335]

{-# LANGUAGE LambdaCase #-}
edit in lib/Aftok/Json.hs at line 6

[5.917]

[5.10049]

{-# LANGUAGE TupleSections #-}
replacement in lib/Aftok/Json.hs at line 11

[5.156]→[5.1490:1553](∅→∅)

import ClassyPrelude hiding (Day)

[5.156]

[5.1965]

import ClassyPrelude hiding (Day, fail, fromEitherM, UTCTime)
edit in lib/Aftok/Json.hs at line 13

[5.1966]

[5.950]

import Control.FromSum (fromMaybeM, fromEitherM)
edit in lib/Aftok/Json.hs at line 15

[5.1014]

[5.1014]

import Control.Monad.Fail (MonadFail(..))
replacement in lib/Aftok/Json.hs at line 29

[5.2136]→[5.3:58](∅→∅),[5.5025]→[5.3:58](∅→∅),[5.790]→[5.3:58](∅→∅)

import Data.Thyme.Clock as C

[5.2136]

[5.1554]

import Data.Thyme.Clock as Clock
replacement in lib/Aftok/Json.hs at line 33

[5.232]→[5.1271:1294](∅→∅)

import Aftok

[5.232]

[5.60]

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

import Aftok.Currency.Bitcoin
replacement in lib/Aftok/Json.hs at line 53

[5.485]→[5.4076:4182](∅→∅)

instance Show Version where
show Version{..} = intercalate "." $ fmap show [majorVersion, minorVersion]

[5.485]

[5.2225]

failT :: Text -> Parser a
failT = fail . T.unpack

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

[5.4310]→[5.1559:1582](∅→∅),[5.1582]→[5.4479:4827](∅→∅),[5.4479]→[5.4479:4827](∅→∅)

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

[5.4310]

[5.2414]

version :: MonadFail m => ByteString -> m Version
version = fromEitherM fail . PC.parseOnly versionParser

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

[5.4892]→[5.309:382](∅→∅),[5.382]→[5.4964:4995](∅→∅),[5.4964]→[5.4964:4995](∅→∅)

v <- either (fail . show) pure $ PC.parseOnly versionParser (C.pack s)
dataToExpQ (const Nothing) v

[5.4892]

[5.4330]

ver <- version $ C.pack s
dataToExpQ (const Nothing) ver
replacement in lib/Aftok/Json.hs at line 79

[5.574]→[5.574:651](∅→∅)

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

[5.574]

[5.186]

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

[5.803]→[5.51:129](∅→∅),[5.51]→[5.51:129](∅→∅)

vers <- either fail pure $ PC.parseOnly versionParser (encodeUtf8 verstr)

[5.803]

[5.804]

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

[5.1093]→[5.993:1089](∅→∅),[5.993]→[5.993:1089](∅→∅)

badVersion name ver = const . fail $ "Unrecognized " <> name <> " schema version: " <> show ver

[5.1093]

[5.5114]

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

[5.1659]→[5.1659:1699](∅→∅)

idValue l a = toJSON . tshow $ view l a

[5.1659]

[5.1699]

idValue l a = toJSON . U.toText $ view l a
edit in lib/Aftok/Json.hs at line 156

[5.1802]

[5.2560]

--
-- CreditTo
--
replacement in lib/Aftok/Json.hs at line 161

[5.2561]→[5.1090:1124](∅→∅),[5.1124]→[5.1803:1894](∅→∅),[5.1894]→[5.2065:2157](∅→∅),[5.2157]→[5.1989:2079](∅→∅),[5.1989]→[5.1989:2079](∅→∅)

creditToJSON :: CreditTo -> Value
creditToJSON (CreditToAddress addr) = v2 $ obj [ "creditToAddress" .= (addr ^. _BtcAddr) ]
creditToJSON (CreditToUser uid) = v2 $ obj [ "creditToUser" .= idValue _UserId uid ]
creditToJSON (CreditToProject pid) = v2 $ obj [ "creditToProject" .= projectIdJSON pid ]

[5.2561]

[5.580]

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) =
v2 $ obj [ "creditToUser" .= idValue _UserId uid ]
creditToJSON _ (CreditToProject pid) =
v2 $ obj [ "creditToProject" .= projectIdJSON pid ]

parseCreditTo :: NetworkMode -> Value -> Parser (CreditTo (NetworkId, Address))
parseCreditTo nmode = unversion "CreditTo" $ \case
(Version 1 0) -> parseCreditToV1 nmode
(Version 2 0) -> parseCreditToV2 nmode
ver -> badVersion "EventAmendment" ver

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

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

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

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

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

in parseCreditToAddr <|> parseCreditToUser <|> parseCreditToProject <|> notFound

--
-- Payouts
--
replacement in lib/Aftok/Json.hs at line 219

[5.581]→[5.1695:1727](∅→∅),[5.2561]→[5.1695:1727](∅→∅),[5.1727]→[5.3343:3488](∅→∅)

payoutsJSON :: Payouts -> Value
payoutsJSON (Payouts m) = v2 $
let payoutsRec :: (CreditTo, Rational) -> Value
payoutsRec (c, r) = object [ "creditTo" .= creditToJSON c

[5.581]

[5.3488]

payoutsJSON :: NetworkMode -> Payouts (NetworkId, Address)-> Value
payoutsJSON nmode (Payouts m) = v2 $
let payoutsRec :: (CreditTo (NetworkId, Address), Rational) -> Value
payoutsRec (c, r) = object [ "creditTo" .= creditToJSON nmode c
edit in lib/Aftok/Json.hs at line 226

[5.2139]

[5.1904]

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

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

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

[5.1905]→[5.3623:3815](∅→∅)

workIndexJSON :: WorkIndex -> Value
workIndexJSON (WorkIndex widx) = v2 $
let widxRec :: (CreditTo, NonEmpty Interval) -> Value
widxRec (c, l) = object [ "creditTo" .= creditToJSON c

[5.1905]

[5.3815]

--
-- WorkIndex
--

workIndexJSON :: NetworkMode -> WorkIndex (NetworkId, Address) -> Value
workIndexJSON nmode (WorkIndex widx) = v2 $
let widxRec :: (CreditTo (NetworkId, Address), NonEmpty Interval) -> Value
widxRec (c, l) = object [ "creditTo" .= creditToJSON nmode c
replacement in lib/Aftok/Json.hs at line 259

[5.255]→[5.1799:1833](∅→∅),[5.1799]→[5.1799:1833](∅→∅),[5.1833]→[5.1059:1097](∅→∅),[5.1097]→[5.2236:2274](∅→∅),[5.1665]→[5.2236:2274](∅→∅)

logEntryJSON :: LogEntry -> Value
logEntryJSON (LogEntry c ev m) = v2 $
obj [ "creditTo" .= creditToJSON c

[5.255]

[5.1531]

logEntryJSON :: NetworkMode -> LogEntry (NetworkId, Address) -> Value
logEntryJSON nmode (LogEntry c ev m) = v2 $
obj [ "creditTo" .= creditToJSON nmode c
replacement in lib/Aftok/Json.hs at line 283

[5.2916]→[5.2916:2993](∅→∅)

, "requestExpiryPeriod" .= (C.toSeconds' <$> (b ^. B.requestExpiryPeriod))

[5.2916]

[5.2993]

, "requestExpiryPeriod" .= (Clock.toSeconds' <$> (b ^. B.requestExpiryPeriod))
replacement in lib/Aftok/Json.hs at line 328

[5.4011]→[5.2794:2803](∅→∅)

where

[5.4011]

[5.2803]

where
replacement in lib/Aftok/Json.hs at line 353

[5.2430]→[5.3018:3027](∅→∅)

where

[5.2430]

[5.3027]

where
replacement in lib/Aftok/Json.hs at line 360

[3.27070]→[3.27070:27108](∅→∅)

parseUUID v = do
str <- parseJSON v

[3.27070]

[3.27108]

parseUUID val = do
str <- parseJSON val
replacement in lib/Aftok/Json.hs at line 365

[3.27264]→[3.27264:27305](∅→∅),[5.2031]→[5.2133:2134](∅→∅),[5.5724]→[5.2133:2134](∅→∅),[3.27305]→[5.2133:2134](∅→∅),[5.2133]→[5.2133:2134](∅→∅),[5.2134]→[5.2381:2423](∅→∅),[5.2423]→[5.1098:1145](∅→∅),[5.1145]→[5.2471:2596](∅→∅),[5.2471]→[5.2471:2596](∅→∅),[5.2596]→[5.1146:1191](∅→∅),[5.1191]→[5.5128:5201](∅→∅),[5.5201]→[5.2722:2768](∅→∅),[5.2722]→[5.2722:2768](∅→∅),[5.2768]→[5.1192:1241](∅→∅),[5.1241]→[5.5202:5277](∅→∅),[5.5277]→[5.2901:2902](∅→∅),[5.2901]→[5.2901:2902](∅→∅),[5.2902]→[5.1242:1271](∅→∅),[5.1271]→[3.27306:27381](∅→∅),[3.27381]→[5.3012:3013](∅→∅),[5.3012]→[5.3012:3013](∅→∅),[5.3013]→[5.1272:1304](∅→∅),[5.1304]→[3.27382:27466](∅→∅),[3.27466]→[5.3135:3350](∅→∅),[5.3135]→[5.3135:3350](∅→∅),[5.3350]→[5.5725:5769](∅→∅),[5.2134]→[5.5725:5769](∅→∅),[5.5769]→[5.3351:3443](∅→∅),[5.3443]→[5.1958:1980](∅→∅),[5.1980]→[5.5301:5347](∅→∅),[5.5301]→[5.5301:5347](∅→∅),[5.5347]→[5.1981:2143](∅→∅),[5.2143]→[5.5512:5633](∅→∅),[5.5512]→[5.5512:5633](∅→∅),[5.5633]→[5.2144:2145](∅→∅),[5.2145]→[5.1305:1327](∅→∅),[5.5638]→[5.1305:1327](∅→∅),[5.3539]→[5.1305:1327](∅→∅),[5.1327]→[5.3563:3752](∅→∅),[5.3563]→[5.3563:3752](∅→∅)

parseId p = fmap (review p) . parseUUID

parseCreditTo :: Value -> Parser CreditTo
parseCreditTo = unversion "CreditTo" $ p where
p (Version 1 0) = parseCreditToV1
p (Version 2 0) = parseCreditToV2
p ver = badVersion "EventAmendment" ver

parseCreditToV1 :: Object -> Parser CreditTo
parseCreditToV1 x = CreditToAddress <$> (parseJSON =<< (x .: "btcAddr"))

parseCreditToV2 :: Object -> Parser CreditTo
parseCreditToV2 o =
let parseCreditToAddr o' =
fmap CreditToAddress . parseJSON <$> O.lookup "creditToAddress" o'

parseCreditToUser o' =
fmap CreditToUser . parseId _UserId <$> O.lookup "creditToUser" o'

parseCreditToProject o' =
fmap CreditToProject . parseId _ProjectId <$> O.lookup "creditToProject" o'

notFound = fail $ "Value " <> show o <> " does not represent a CreditTo value."
parseV v = (parseCreditToAddr v <|> parseCreditToUser v <|> parseCreditToProject v)

in fromMaybe notFound $ parseV o

parsePayoutsJSON :: Value -> Parser Payouts
parsePayoutsJSON = unversion "Payouts" $ p where
p :: Version -> Object -> Parser Payouts
p (Version 1 _) v =
let parseKey :: String -> Parser CreditTo
parseKey k = maybe
(fail $ "Key " <> k <> " cannot be parsed as a valid BTC address.")
(pure . CreditToAddress)
(parseBtcAddr $ T.pack k)
in Payouts <$> join (traverseKeys parseKey <$> parseJSON (Object v))

p (Version 2 0) v =
let parsePayoutRecord x = (,) <$> (parseCreditToV2 =<< (x .: "creditTo")) <*> x .: "payoutRatio"
in Payouts . MS.fromList <$> (traverse parsePayoutRecord =<< parseJSON (Object v))

[3.27264]

[5.5639]

parseId p = fmap (review p) . parseUUID
replacement in lib/Aftok/Json.hs at line 367

[5.5640]→[5.2146:2158](∅→∅),[5.2158]→[5.5653:5684](∅→∅),[5.5653]→[5.5653:5684](∅→∅),[5.1744]→[5.5859:5925](∅→∅),[5.1774]→[5.5859:5925](∅→∅),[5.3791]→[5.5859:5925](∅→∅),[5.4400]→[5.5859:5925](∅→∅),[5.5684]→[5.5859:5925](∅→∅),[5.5859]→[5.5859:5925](∅→∅),[5.5925]→[5.3792:3941](∅→∅)

p ver x =
badVersion "Payouts" ver x

parseEventAmendment :: ModTime -> Value -> Parser EventAmendment
parseEventAmendment t = unversion "EventAmendment" $ p where
p (Version 1 _) = parseEventAmendmentV1 t
p (Version 2 0) = parseEventAmendmentV2 t

[5.5640]

[5.2159]

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

[5.1957]→[5.3984:4080](∅→∅),[5.4080]→[5.2063:2109](∅→∅),[5.2063]→[5.2063:2109](∅→∅)

parseEventAmendmentV1 :: ModTime -> Object -> Parser EventAmendment
parseEventAmendmentV1 t o =
let parseA :: Text -> Parser EventAmendment

[5.1957]

[5.4081]

parseEventAmendmentV1
:: NetworkMode
-> ModTime
-> Object
-> Parser (EventAmendment (NetworkId, Address))
parseEventAmendmentV1 nmode t o =
let parseA :: Text -> Parser (EventAmendment (NetworkId, Address))
replacement in lib/Aftok/Json.hs at line 385

[5.4151]→[5.4151:4222](∅→∅)

parseA "addrChange" = CreditToChange t <$> parseCreditToV1 o

[5.4151]

[5.4222]

parseA "addrChange" = CreditToChange t <$> parseCreditToV1 nmode o
replacement in lib/Aftok/Json.hs at line 387

[5.4292]→[5.4401:4481](∅→∅),[5.2314]→[5.4401:4481](∅→∅)

parseA tid = fail . show $ "Amendment type " <> tid <> " not recognized."

[5.4292]

[5.1328]

parseA tid = fail . unpack $ "Amendment type " <> tid <> " not recognized."
replacement in lib/Aftok/Json.hs at line 390

[5.2513]→[5.4329:4425](∅→∅),[5.4425]→[5.2619:2665](∅→∅),[5.2619]→[5.2619:2665](∅→∅)

parseEventAmendmentV2 :: ModTime -> Object -> Parser EventAmendment
parseEventAmendmentV2 t o =
let parseA :: Text -> Parser EventAmendment

[5.2513]

[5.4426]

parseEventAmendmentV2
:: NetworkMode
-> ModTime
-> Object
-> Parser (EventAmendment (NetworkId, Address))
parseEventAmendmentV2 nmode t o =
let parseA :: Text -> Parser (EventAmendment (NetworkId, Address))
replacement in lib/Aftok/Json.hs at line 398

[5.4496]→[5.4496:4567](∅→∅)

parseA "creditToChange" = CreditToChange t <$> parseCreditToV2 o

[5.4496]

[5.4567]

parseA "creditToChange" = CreditToChange t <$> parseCreditToV2 nmode o
replacement in lib/Aftok/Json.hs at line 400

[5.4637]→[5.4511:4591](∅→∅),[5.2870]→[5.4511:4591](∅→∅)

parseA tid = fail . show $ "Amendment type " <> tid <> " not recognized."

[5.4637]

[5.1363]

parseA tid = fail . unpack $ "Amendment type " <> tid <> " not recognized."
replacement in lib/Aftok/Json.hs at line 403

[5.3863]→[2.3:148](∅→∅)

parseLogEntry :: UserId -> (C.UTCTime -> LogEvent) -> Value -> Parser (C.UTCTime -> LogEntry)
parseLogEntry uid f = unversion "LogEntry" p where

[5.3863]

[5.4722]

parseLogEntry
:: NetworkMode
-> UserId
-> (UTCTime -> LogEvent)
-> Value
-> Parser (UTCTime -> (LogEntry (NetworkId, Address)))
parseLogEntry nmode uid f = unversion "LogEntry" p where
replacement in lib/Aftok/Json.hs at line 411

[5.4747]→[2.149:236](∅→∅)

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

[5.4747]

[5.4801]

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

[5.665]→[5.4838:4874](∅→∅)

p v o = badVersion "LogEntry" v o

[5.665]

[5.3226]

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

[3.27516]→[3.27516:27537](∅→∅)

parseRecurrence o =

[3.27516]

[3.27537]

parseRecurrence o =
replacement in lib/Aftok/Json.hs at line 425

[3.27939]→[3.27939:28028](∅→∅)

parseV v = parseAnnually v <|> parseMonthly v <|> parseWeekly v <|> parseOneTime v

[3.27939]

[3.28028]

parseV val = parseAnnually val
<|> parseMonthly val
<|> parseWeekly val
<|> parseOneTime val
replacement in lib/Aftok/Json.hs at line 433

[3.28162]→[3.28162:28237](∅→∅)

parseRecurrence' v = fail $ "Value " <> show v <> " is not a JSON object."

[3.28162]

parseRecurrence' val = fail $ "Value " <> show val <> " is not a JSON object."
replacement in lib/Aftok/Payments/Types.hs at line 21

[5.2235]→[5.1181:1241](∅→∅),[3.28313]→[5.1181:1241](∅→∅),[5.2433]→[5.1181:1241](∅→∅)

import Network.Haskoin.Crypto (decodeBase58Check)

[3.28313]

[5.10816]

import Network.Haskoin.Address.Base58 (decodeBase58Check)
replacement in lib/Aftok/Payments/Types.hs at line 70

[5.1441]→[5.1441:1513](∅→∅)

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

[5.1441]

[3.28394]

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

[5.3432]→[5.2430:2491](∅→∅)

import Network.Haskoin.Crypto (encodeBase58Check)

[5.3432]

[5.3432]

import Network.Haskoin.Address (Address(..))
import Network.Haskoin.Address.Base58 (encodeBase58Check)
replacement in lib/Aftok/Payments.hs at line 34

[5.5960]→[5.3494:3623](∅→∅)

import Aftok (BtcAddr (..), UserId, userAddress,
_BtcAddr)

[5.5960]

[5.2319]

import Aftok.Types (UserId, ProjectId, userAddress)
edit in lib/Aftok/Payments.hs at line 36

[5.2352]

[5.3624]

import Aftok.Currency.Bitcoin (NetworkId(..), NetworkMode, satoshi, toNetwork)
replacement in lib/Aftok/Payments.hs at line 39

[5.12334]→[5.3657:3716](∅→∅)

import Aftok.Project (ProjectId, depf)

[5.12334]

[5.3716]

import Aftok.Project (depf)
edit in lib/Aftok/Payments.hs at line 41

[5.3763]→[5.3763:3814](∅→∅)

import Aftok.Types (satoshi)
replacement in lib/Aftok/Payments.hs at line 43

[3.28681]→[3.28681:28778](∅→∅)

{ _network :: !BT.Network
, _signingKey :: !RSA.PrivateKey
, _pkiData :: !BT.PKIData

[3.28681]

[5.12579]

{ _networkMode :: !NetworkMode
, _signingKey :: !RSA.PrivateKey
, _pkiData :: !BT.PKIData
replacement in lib/Aftok/Payments.hs at line 56

[5.2657]→[3.29072:29164](∅→∅)

, uriGen :: PaymentKey -- ^ payment key to be included in the URL

[5.2657]

[3.29164]

, uriGen :: PaymentKey -- ^ payment key to be included in the URL
replacement in lib/Aftok/Payments.hs at line 62

[3.29427]→[3.29427:29467](∅→∅)

-> m (Maybe ByteString)

[3.29427]

[5.8102]

-> m (Maybe ByteString)
edit in lib/Aftok/Payments.hs at line 73

[3.29781]

[5.8460]

| IllegalAddress !Address
replacement in lib/Aftok/Payments.hs at line 128

[5.1016]→[5.3114:3193](∅→∅),[5.3114]→[5.3114:3193](∅→∅)

pkey <- PaymentKey . decodeUtf8 . encodeBase58Check <$> getRandomBytes 32

[5.1016]

[5.3193]

pkey <- PaymentKey . encodeBase58Check <$> getRandomBytes 32
replacement in lib/Aftok/Payments.hs at line 172

[5.12639]→[3.30227:30316](∅→∅),[5.4754]→[5.12728:13149](∅→∅),[3.30316]→[5.12728:13149](∅→∅),[5.12728]→[5.12728:13149](∅→∅),[5.13149]→[5.14275:14318](∅→∅),[5.14275]→[5.14275:14318](∅→∅)

createPaymentDetails :: (MonadRandom m, MonadReader r m, HasPaymentsConfig r, MonadDB m)
=> T.Day -- ^ payout date (billing date)
-> C.UTCTime -- ^ timestamp of payment request creation
-> Maybe Text -- ^ user memo
-> Maybe URI -- ^ payment response URL
-> Maybe ByteString -- ^ merchant payload
-> Billable -- ^ billing information
-> m P.PaymentDetails

[5.12639]

[5.13150]

createPaymentDetails
:: ( MonadRandom m
, MonadReader r m , HasPaymentsConfig r
, MonadError e m, AsPaymentError e
, MonadDB m
)
=> T.Day -- ^ payout date (billing date)
-> C.UTCTime -- ^ timestamp of payment request creation
-> Maybe Text -- ^ user memo
-> Maybe URI -- ^ payment response URL
-> Maybe ByteString -- ^ merchant payload
-> Billable -- ^ billing information
-> m P.PaymentDetails
replacement in lib/Aftok/Payments.hs at line 191

[5.4787]→[5.4787:4808](∅→∅)

(cfg ^. network)

[5.4787]

[5.4808]

(toNetwork (cfg ^. networkMode) BTC)
replacement in lib/Aftok/Payments.hs at line 199

[5.14661]→[5.14661:14736](∅→∅)

getProjectPayouts :: (MonadDB m) => C.UTCTime -> ProjectId -> m TL.Payouts

[5.14661]

[5.14736]

getProjectPayouts
:: (MonadDB m, MonadError e m, AsPaymentError e)
=> C.UTCTime
-> ProjectId
-> m (TL.Payouts (NetworkId, Address))
replacement in lib/Aftok/Payments.hs at line 213

[5.14995]→[5.14995:15089](∅→∅)

createPayoutsOutputs :: (MonadDB m) => C.UTCTime -> BT.Satoshi -> TL.Payouts -> m [BT.Output]

[5.14995]

[5.4875]

createPayoutsOutputs
:: (MonadDB m, MonadError e m, AsPaymentError e)
=> C.UTCTime
-> BT.Satoshi
-> TL.Payouts (NetworkId, Address)
-> m [BT.Output]
replacement in lib/Aftok/Payments.hs at line 220

[5.4906]→[5.15121:15174](∅→∅),[5.15121]→[5.15121:15174](∅→∅)

let payoutFractions :: [(TL.CreditTo, BT.Satoshi)]

[5.4906]

[5.15174]

let payoutFractions :: [(TL.CreditTo (NetworkId, Address), BT.Satoshi)]
replacement in lib/Aftok/Payments.hs at line 226

[5.6030]→[5.15324:15412](∅→∅),[5.15412]→[5.4907:4965](∅→∅)

createOutputs :: (MonadDB m) => C.UTCTime -> TL.CreditTo -> BT.Satoshi -> m [BT.Output]
createOutputs _ (TL.CreditToAddress (BtcAddr addr)) amt =

[5.6030]

[5.15471]

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 =
edit in lib/Aftok/Payments.hs at line 235

[5.6086]

[3.30317]

createOutputs _ (TL.CreditToCurrency (_, other)) _ =
throwError $ review _IllegalAddress other
replacement in lib/Aftok/Payments.hs at line 240

[3.30420]→[3.30420:30520](∅→∅)

addr <- MaybeT . pure $ user ^. userAddress
pure $ BT.Output amt (PayPKHash (addr ^. _BtcAddr))

[3.30420]

[5.6287]

addr <- MaybeT . pure . fmap snd $ user ^. userAddress
case addr of
PubKeyAddress a -> pure $ BT.Output amt (PayPKHash a)
other -> throwError $ review _IllegalAddress other
edit in lib/Aftok/Project.hs at line 12

[5.1298]→[5.1298:1325](∅→∅),[5.1357]→[5.1357:1381](∅→∅)

import Data.UUID

import Aftok
replacement in lib/Aftok/Project.hs at line 13

[5.1382]→[5.4292:4352](∅→∅),[5.4352]→[5.1437:1460](∅→∅),[5.1437]→[5.1437:1460](∅→∅)

newtype ProjectId = ProjectId UUID deriving (Show, Eq, Ord)
makePrisms ''ProjectId

[5.1382]

[5.1460]

import Aftok.Types
file addition: TimeLog (d--r------)

[5.679]
file addition: Serialization.hs (----------)

[0.29316]

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Aftok.TimeLog.Serialization
( depfFromJSON
, depfToJSON
) where

import ClassyPrelude
import Control.Applicative ((<*>))

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

import Aftok.Types

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

depfFromJSON :: Value -> Parser DepreciationFunction
depfFromJSON = \case
Object v -> do
t <- v .: "type" :: Parser Text
args <- v .: "arguments"
case unpack t of
"LinearDepreciation" ->
let undep = Months <$> (args .: "undep")
dep = Months <$> (args .: "dep")
in LinearDepreciation <$> undep <*> dep
x -> fail $ "No depreciation function recognized for type " <> x

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

[5.3530]→[5.407:443](∅→∅)

{-# LANGUAGE DeriveDataTypeable #-}

[5.846]

[5.4101]

{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE NoImplicitPrelude #-}
replacement in lib/Aftok/TimeLog.hs at line 7

[5.4399]→[5.5166:5248](∅→∅)

, CreditTo(..), _CreditToAddress, _CreditToUser, _CreditToProject, creditToName

[5.4399]

[5.4467]

, CreditTo(..), _CreditToCurrency, _CreditToUser, _CreditToProject, creditToName
replacement in lib/Aftok/TimeLog.hs at line 20

[5.998]→[5.4160:4191](∅→∅),[5.4191]→[5.586:587](∅→∅),[5.586]→[5.586:587](∅→∅)

import ClassyPrelude

[5.998]

[5.4192]

import Control.Arrow ((&&&))
edit in lib/Aftok/TimeLog.hs at line 25

[5.4333]

[5.4333]

import Data.Eq (Eq, (==))
import Data.Either (Either(..), rights)
edit in lib/Aftok/TimeLog.hs at line 28

[5.4374]

[5.4374]

import Data.Function (($), (.), id)
import Data.Functor (fmap)
edit in lib/Aftok/TimeLog.hs at line 32

[5.4456]

[5.4456]

import Data.Maybe (Maybe(..))
replacement in lib/Aftok/TimeLog.hs at line 34

[5.4498]→[5.4498:4537](∅→∅)

import Data.Ratio ()

[5.4498]

[5.4537]

import Data.Ord (Ord(..), Ordering(..))
import Data.Ratio (Rational)
import Data.Text (Text)
edit in lib/Aftok/TimeLog.hs at line 40

[5.4639]

[5.618]

import Prelude ((/), (*))
import Text.Show (Show)
edit in lib/Aftok/TimeLog.hs at line 43

[5.619]→[5.4640:4663](∅→∅)

import Aftok
replacement in lib/Aftok/TimeLog.hs at line 44

[5.4695]→[5.1482:1530](∅→∅)

import Aftok.Project (ProjectId)

[5.4695]

[5.1224]

import Aftok.Types

type NDT = C.NominalDiffTime
edit in lib/Aftok/TimeLog.hs at line 48

[5.1225]

[3.30522]

{-|
- The depreciation function should return a value between 0 and 1;
- this result is multiplied by the length of an interval of work to determine
- the depreciated value of the work.
-}
type DepF = C.UTCTime -> Interval -> NDT
edit in lib/Aftok/TimeLog.hs at line 69

[5.1694]→[5.3806:3807](∅→∅),[5.3806]→[5.3806:3807](∅→∅),[5.3807]→[5.1695:1757](∅→∅),[5.1757]→[5.990:1059](∅→∅),[5.1059]→[5.3928:3954](∅→∅),[5.3928]→[5.3928:3954](∅→∅),[5.3954]→[5.4562:4563](∅→∅),[5.4563]→[5.1531:1545](∅→∅),[5.1545]→[5.4578:4662](∅→∅),[5.4578]→[5.4578:4662](∅→∅),[5.4662]→[3.30633:30662](∅→∅),[5.1574]→[5.4691:4762](∅→∅),[3.30662]→[5.4691:4762](∅→∅),[5.4691]→[5.4691:4762](∅→∅),[5.4762]→[3.30663:30688](∅→∅),[3.30688]→[5.1575:1635](∅→∅),[5.4786]→[5.1575:1635](∅→∅),[5.1635]→[3.30689:30720](∅→∅),[3.30720]→[5.4877:4926](∅→∅),[5.4877]→[5.4877:4926](∅→∅)

nameEvent :: MonadPlus m => Text -> m (C.UTCTime -> LogEvent)
nameEvent "start" = pure StartWork
nameEvent "stop" = pure StopWork
nameEvent _ = mzero

data CreditTo
-- payouts are made directly to this address, or to an address replacing this one
= CreditToAddress !BtcAddr
-- payouts are distributed as requested by the specified contributor
| CreditToUser !UserId
-- payouts are distributed to this project's contributors
| CreditToProject !ProjectId
deriving (Show, Eq, Ord)
makePrisms ''CreditTo
replacement in lib/Aftok/TimeLog.hs at line 70

[5.432]→[5.5249:5337](∅→∅),[5.5337]→[5.2569:2621](∅→∅),[5.2621]→[5.5386:5441](∅→∅),[5.5386]→[5.5386:5441](∅→∅)

creditToName :: CreditTo -> Text
creditToName (CreditToAddress _) = "credit_to_address"
creditToName (CreditToUser _) = "credit_to_user"
creditToName (CreditToProject _) = "credit_to_project"

[5.432]

[5.5441]

nameEvent :: Text -> Maybe (C.UTCTime -> LogEvent)
nameEvent "start" = Just StartWork
nameEvent "stop" = Just StopWork
nameEvent _ = Nothing
replacement in lib/Aftok/TimeLog.hs at line 75

[5.5442]→[5.4696:4721](∅→∅),[5.432]→[5.4696:4721](∅→∅),[5.4721]→[3.30721:30749](∅→∅)

data LogEntry = LogEntry
{ _creditTo :: !CreditTo

[5.5442]

[3.30749]

data LogEntry a = LogEntry
{ _creditTo :: !(CreditTo a)
replacement in lib/Aftok/TimeLog.hs at line 82

[5.214]→[5.214:242](∅→∅)

instance Ord LogEntry where

[5.214]

[5.4775]

instance Ord a => Ord (LogEntry a) where
replacement in lib/Aftok/TimeLog.hs at line 93

[5.5813]→[3.30813:30977](∅→∅)

data EventAmendment = TimeChange !ModTime !C.UTCTime
| CreditToChange !ModTime !CreditTo
| MetadataChange !ModTime !A.Value

[5.5813]

[5.6877]

data EventAmendment a
= TimeChange !ModTime !C.UTCTime
| CreditToChange !ModTime !(CreditTo a)
| MetadataChange !ModTime !A.Value
replacement in lib/Aftok/TimeLog.hs at line 101

[5.5971]→[5.5060:5110](∅→∅)

newtype Payouts = Payouts (Map CreditTo Rational)

[5.5971]

[5.6021]

newtype Payouts a = Payouts (Map (CreditTo a) Rational)
replacement in lib/Aftok/TimeLog.hs at line 104

[5.6043]→[5.5111:5196](∅→∅)

newtype WorkIndex = WorkIndex (Map CreditTo (NonEmpty Interval)) deriving (Show, Eq)

[5.6043]

[5.468]

newtype WorkIndex a = WorkIndex (Map (CreditTo a) (NonEmpty Interval)) deriving (Show, Eq)
edit in lib/Aftok/TimeLog.hs at line 106

[5.613]→[5.6693:6694](∅→∅),[5.6693]→[5.6693:6694](∅→∅),[5.6766]→[5.1866:1896](∅→∅),[5.1896]→[5.89:93](∅→∅),[5.6766]→[5.89:93](∅→∅),[5.351]→[5.89:93](∅→∅),[5.93]→[5.1012:1201](∅→∅),[5.1201]→[5.4792:4833](∅→∅)

type NDT = C.NominalDiffTime

{-|
- The depreciation function should return a value between 0 and 1;
- this result is multiplied by the length of an interval of work to determine
- the depreciated value of the work.
-}
type DepF = C.UTCTime -> Interval -> NDT
replacement in lib/Aftok/TimeLog.hs at line 122

[5.1766]→[5.1766:1819](∅→∅)

payouts :: DepF -> C.UTCTime -> WorkIndex -> Payouts

[5.1766]

[5.4834]

payouts :: Ord a => DepF -> C.UTCTime -> WorkIndex a -> Payouts a
replacement in lib/Aftok/TimeLog.hs at line 131

[5.1582]→[5.4345:4396](∅→∅)

workIndex :: Foldable f => f LogEntry -> WorkIndex

[5.1582]

[5.4957]

workIndex :: (Ord a, Foldable f) => f (LogEntry a) -> (WorkIndex a)
replacement in lib/Aftok/TimeLog.hs at line 147

[5.2114]→[5.5197:5253](∅→∅)

type RawIndex = Map CreditTo [Either LogEvent Interval]

[5.2114]

[5.2169]

type RawIndex a = Map (CreditTo a) [Either LogEvent Interval]
replacement in lib/Aftok/TimeLog.hs at line 149

[5.2170]→[5.2066:2117](∅→∅),[5.26]→[5.2066:2117](∅→∅)

appendLogEntry :: RawIndex -> LogEntry -> RawIndex

[5.2170]

[5.5030]

appendLogEntry :: (Ord a) => RawIndex a -> LogEntry a -> RawIndex a
replacement in lib/Aftok/Types.hs at line 1

[5.805]→[5.806:850](∅→∅),[5.850]→[5.1637:1681](∅→∅)

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

[5.805]

[5.850]

{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TemplateHaskell #-}
replacement in lib/Aftok/Types.hs at line 5

[5.851]→[5.6590:6638](∅→∅)

module Aftok.Types (Satoshi(..), satoshi) where

[5.851]

[5.876]

module Aftok.Types where
replacement in lib/Aftok/Types.hs at line 7

[5.877]→[5.5289:5320](∅→∅),[5.5320]→[5.818:848](∅→∅),[5.848]→[5.2623:2675](∅→∅)

import ClassyPrelude
import Control.Lens
import Network.Bippy.Types (Satoshi (..))

[5.877]

[5.915]

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

newtype UserId = UserId UUID deriving (Show, Eq, Ord)
makePrisms ''UserId
replacement in lib/Aftok/Types.hs at line 21

[5.916]→[5.2676:2708](∅→∅),[5.2708]→[5.6724:6776](∅→∅),[5.6724]→[5.6724:6776](∅→∅)

satoshi :: Lens' Satoshi Word64
satoshi inj (Satoshi value) = Satoshi <$> inj value

[5.916]

[5.1036]

newtype UserName = UserName Text deriving (Show, Eq)
makePrisms ''UserName

newtype Email = Email Text deriving (Show, Eq)
makePrisms ''Email

data User a = User
{ _username :: !UserName
, _userAddress :: !(Maybe a)
, _userEmail :: !Email
}
makeLenses ''User

newtype ProjectId = ProjectId UUID deriving (Show, Eq, Ord)
makePrisms ''ProjectId

data CreditTo a
-- payouts are made directly via a cryptocurrency network
= CreditToCurrency !a
-- payouts are distributed as requested by the specified contributor
| CreditToUser !UserId
-- payouts are distributed to this project's contributors
| CreditToProject !ProjectId
deriving (Show, Eq, Ord, Functor)
makePrisms ''CreditTo
edit in lib/Aftok/Types.hs at line 47

[5.1037]

creditToName :: CreditTo a -> Text
creditToName (CreditToCurrency _) = "credit_via_net"
creditToName (CreditToUser _) = "credit_to_user"
creditToName (CreditToProject _) = "credit_to_project"

data DepreciationFunction = LinearDepreciation Months Months
deriving (Eq, Show)

newtype Months = Months Integer
deriving (Eq, Show)
edit in server/Aftok/QConfig.hs at line 17

[3.32643]

[109.216]

import Aftok.Currency.Bitcoin (NetworkMode)
edit in server/Aftok/QConfig.hs at line 29

[3.32737]

[110.534]

, networkMode :: NetworkMode
edit in server/Aftok/QConfig.hs at line 50

[3.33148]

[5.7968]

<*> C.require cfg "networkMode"
replacement in server/Aftok/Snaplet/Auctions.hs at line 20

[5.2724]→[5.1844:1891](∅→∅)

import Aftok (UserId)

[5.2724]

[5.1891]

import Aftok.Types (UserId)
edit in server/Aftok/Snaplet/Auctions.hs at line 24

[5.2865]→[5.2865:2894](∅→∅)

import Aftok.Types
edit in server/Aftok/Snaplet/Auctions.hs at line 28

[5.2962]

[5.2962]

import Network.Bippy.Types (Satoshi(..))
replacement in server/Aftok/Snaplet/Auth.hs at line 10

[5.424]→[5.7801:7824](∅→∅)

import Aftok

[5.424]

[5.7824]

import Aftok.Types
replacement in server/Aftok/Snaplet/Billing.hs at line 19

[3.34143]→[3.34143:34229](∅→∅)

import Aftok (UserId)
import Aftok.Billables

[3.34143]

[3.34229]

import Aftok.Types (UserId)
import Aftok.Billables
import Network.Bippy.Types (Satoshi(..))
edit in server/Aftok/Snaplet/Billing.hs at line 24

[3.34286]→[3.34286:34317](∅→∅)

import Aftok.Project
replacement in server/Aftok/Snaplet/Billing.hs at line 31

[3.34606]→[3.34606:34629](∅→∅)

p (Version 1 0) o =

[3.34606]

[3.34629]

p (Version 1 0) o =
replacement in server/Aftok/Snaplet/Billing.hs at line 43

[3.35054]→[3.35054:35090](∅→∅)

p v o = badVersion "Billable" v o

[3.35054]

[3.35090]

p ver o = badVersion "Billable" ver o
replacement in server/Aftok/Snaplet/Billing.hs at line 65

[3.35830]→[3.35830:35833](∅→∅)

[3.35830]
replacement in server/Aftok/Snaplet/Projects.hs at line 23

[5.8817]→[5.2443:2466](∅→∅)

import Aftok

[5.8817]

[3.36709]

import Aftok.Types
edit in server/Aftok/Snaplet/Projects.hs at line 30

[5.2596]

[3.36778]

import Aftok.TimeLog.Serialization (depfFromJSON)
replacement in server/Aftok/Snaplet/Projects.hs at line 39

[5.4054]→[5.12100:12167](∅→∅),[5.12100]→[5.12100:12167](∅→∅),[5.12167]→[5.3024:3055](∅→∅)

parseJSON (Object v) = CP <$> v .: "projectName" <*> v .: "depf"
parseJSON _ = mzero

[5.4054]

[5.2914]

parseJSON (Object v) =
CP <$> v .: "projectName"
<*> (depfFromJSON =<< v .: "depf")
parseJSON _ = mzero
edit in server/Aftok/Snaplet/Users.hs at line 2

[5.3105]

[5.3411]

{-# LANGUAGE TupleSections #-}
edit in server/Aftok/Snaplet/Users.hs at line 15

[5.8790]

[5.10431]

import Network.Haskoin.Address (stringToAddr)
replacement in server/Aftok/Snaplet/Users.hs at line 18

[5.10432]→[5.8791:8814](∅→∅)

import Aftok

[5.10432]

[5.8814]

import Aftok.Types
import Aftok.Currency.Bitcoin (NetworkId(..), toNetwork)
replacement in server/Aftok/Snaplet/Users.hs at line 30

[5.12436]→[5.9014:9043](∅→∅)

{ _cuser :: User

[5.12436]

[5.9043]

{ _cuser :: User Text
replacement in server/Aftok/Snaplet/Users.hs at line 39

[5.10414]→[5.10414:10478](∅→∅)

<*> (parseBtcAddr <$> v .: "btcAddr")

[5.10414]

[5.10478]

<*> (v .: "btcAddr")
edit in server/Aftok/Snaplet/Users.hs at line 59

[5.11096]

[5.3593]

nmode <- getNetworkMode
let addr = stringToAddr (toNetwork nmode BTC) =<< (userData ^. cuser . userAddress)
replacement in server/Aftok/Snaplet/Users.hs at line 63

[5.11131]→[5.11131:11180](∅→∅)

userId <- createUser $ userData ^. cuser

[5.11131]

[5.501]

userId <- createUser ((userData ^. cuser) & userAddress .~ ((BTC,) <$> addr))
edit in server/Aftok/Snaplet/WorkLog.hs at line 12

[5.9812]

[5.5641]

import Network.Haskoin.Address (Address, stringToAddr)
replacement in server/Aftok/Snaplet/WorkLog.hs at line 14

[5.5642]→[5.2179:2230](∅→∅)

import Aftok (parseBtcAddr)

[5.5642]

[5.9836]

import Aftok.Currency.Bitcoin (NetworkId(..), toNetwork)
edit in server/Aftok/Snaplet/WorkLog.hs at line 20

[5.9959]

[3.37364]

import Aftok.Types (CreditTo(..))
edit in server/Aftok/Snaplet/WorkLog.hs at line 34

[5.245]

[5.245]

nmode <- getNetworkMode
replacement in server/Aftok/Snaplet/WorkLog.hs at line 37

[5.322]→[2.1426:1505](∅→∅),[2.1505]→[5.397:570](∅→∅),[5.397]→[5.397:570](∅→∅)

case A.eitherDecode requestBody >>= parseEither (parseLogEntry uid evCtr) of
Left err -> snapError 400 $ "Unable to parse log entry " <> (tshow requestBody) <> ": " <> tshow err
Right entry -> snapEval $ createEvent pid uid (entry timestamp)

[5.322]

[5.570]

case A.eitherDecode requestBody >>= parseEither (parseLogEntry nmode uid evCtr) of
Left err ->
snapError 400 $ "Unable to parse log entry " <> (tshow requestBody) <> ": " <> tshow err
Right entry ->
snapEval $ createEvent pid uid (entry timestamp)
edit in server/Aftok/Snaplet/WorkLog.hs at line 47

[5.12656]

[5.5971]

nmode <- getNetworkMode
let network = toNetwork nmode BTC
replacement in server/Aftok/Snaplet/WorkLog.hs at line 52

[5.3394]→[5.6163:6216](∅→∅),[5.3758]→[5.6163:6216](∅→∅),[5.4208]→[5.6163:6216](∅→∅),[5.4818]→[5.6163:6216](∅→∅),[5.6163]→[5.6163:6216](∅→∅)

case fmap decodeUtf8 addrBytes >>= parseBtcAddr of

[5.3064]

[5.10149]

case fmap decodeUtf8 addrBytes >>= stringToAddr network of
replacement in server/Aftok/Snaplet/WorkLog.hs at line 57

[5.1142]→[5.1142:1223](∅→∅)

LogEntry (CreditToAddress addr) (evCtr timestamp) (A.decode requestBody)

[5.1142]

[5.6347]

LogEntry (CreditToCurrency (BTC, addr))
(evCtr timestamp)
(A.decode requestBody)
replacement in server/Aftok/Snaplet/WorkLog.hs at line 61

[5.6348]→[5.18551:18605](∅→∅)

loggedIntervalsHandler :: S.Handler App App WorkIndex

[5.6348]

[5.3428]

loggedIntervalsHandler :: S.Handler App App (WorkIndex (NetworkId, Address))
replacement in server/Aftok/Snaplet/WorkLog.hs at line 67

[5.6632]→[5.18606:18656](∅→∅)

logEntriesHandler :: S.Handler App App [LogEntry]

[5.6632]

[5.4907]

logEntriesHandler :: S.Handler App App [LogEntry (NetworkId, Address)]
replacement in server/Aftok/Snaplet/WorkLog.hs at line 79

[5.5386]→[5.18657:18701](∅→∅)

payoutsHandler :: S.Handler App App Payouts

[5.5386]

[5.10183]

payoutsHandler :: S.Handler App App (Payouts (NetworkId, Address))
edit in server/Aftok/Snaplet/WorkLog.hs at line 93

[5.13339]

[5.8828]

nmode <- getNetworkMode
replacement in server/Aftok/Snaplet/WorkLog.hs at line 104

[5.13417]→[5.13417:13477](∅→∅)

(parseEither (parseEventAmendment modTime) requestJSON)

[5.13417]

(parseEither (parseEventAmendment nmode modTime) requestJSON)
edit in server/Aftok/Snaplet.hs at line 17

[5.1325]→[5.10728:10751](∅→∅)

import Aftok
edit in server/Aftok/Snaplet.hs at line 18

[5.7061]

[5.10751]

import Aftok.Currency.Bitcoin (NetworkMode(..))
replacement in server/Aftok/Snaplet.hs at line 21

[5.10826]→[5.7062:7126](∅→∅)

import Aftok.Project (ProjectId (..))

[5.10826]

[5.10826]

import Aftok.Types (UserId(..), ProjectId(..))
replacement in server/Aftok/Snaplet.hs at line 31

[5.11066]→[5.13498:13534](∅→∅),[5.1705]→[5.13498:13534](∅→∅)

{ _sess :: Snaplet SessionManager

[5.11066]

[5.1770]

{ _networkMode :: NetworkMode
, _sess :: Snaplet SessionManager
replacement in server/Aftok/Snaplet.hs at line 42

[5.2007]→[5.18854:18920](∅→∅)

snapEval :: (MonadSnap m, HasPostgres m) => Program DBOp a -> m a

[5.2007]

[5.11605]

class HasNetworkMode m where
getNetworkMode :: m NetworkMode

instance HasNetworkMode (S.Handler b App) where
getNetworkMode = _networkMode <$> get

snapEval
:: (MonadSnap m, HasPostgres m, HasNetworkMode m)
=> Program DBOp a
-> m a
replacement in server/Aftok/Snaplet.hs at line 60

[5.11873]→[3.37607:37688](∅→∅)

e <- liftPG $ \conn -> liftIO $ runExceptT (runQDBM conn $ interpret liftdb p)

[5.11873]

[5.11945]

nmode <- getNetworkMode
e <- liftPG $ \conn -> liftIO $ runExceptT (runQDBM nmode conn $ interpret liftdb p)
replacement in server/Main.hs at line 15

[5.943]→[5.11391:11422](∅→∅)

import Aftok.QConfig

[5.943]

[5.11422]

import Aftok.QConfig as Q
edit in server/Main.hs at line 45

[5.8755]

[5.2274]

let nmode = Q.networkMode cfg
replacement in server/Main.hs at line 48

[5.2275]→[3.38080:38212](∅→∅)

let loginRoute = method GET requireLogin >> redirect "/home"
xhrLoginRoute = void $ method POST requireLogin

[5.2275]

[3.38212]

loginRoute = method GET requireLogin >> redirect "/home"
xhrLoginRoute = void $ method POST requireLogin
replacement in server/Main.hs at line 59

[5.760]→[5.2315:2492](∅→∅),[5.2315]→[5.2315:2492](∅→∅)

logEntriesRoute = serveJSON (fmap logEntryJSON) $ method GET logEntriesHandler
logIntervalsRoute = serveJSON workIndexJSON $ method GET loggedIntervalsHandler

[5.2146]

[3.38515]

logEntriesRoute = serveJSON (fmap $ logEntryJSON nmode) $ method GET logEntriesHandler
logIntervalsRoute = serveJSON (workIndexJSON nmode) $ method GET loggedIntervalsHandler
replacement in server/Main.hs at line 62

[3.38516]→[5.2492:2570](∅→∅),[5.2492]→[5.2492:2570](∅→∅)

payoutsRoute = serveJSON payoutsJSON $ method GET payoutsHandler

[3.38516]

[3.38517]

payoutsRoute = serveJSON (payoutsJSON nmode) $ method GET payoutsHandler
replacement in server/Main.hs at line 70

[3.38856]→[3.38856:38941](∅→∅)

auctionBidRoute = serveJSON bidIdJSON $ method POST auctionBidHandler

[3.38856]

[5.4230]

auctionBidRoute = serveJSON bidIdJSON $ method POST auctionBidHandler
replacement in server/Main.hs at line 82

[5.2570]→[5.2614:2719](∅→∅)

, ("login", loginRoute)
, ("login", xhrLoginRoute)

[5.2570]

[5.265]

, ("login", loginRoute)
, ("login", xhrLoginRoute)
replacement in server/Main.hs at line 109

[5.12019]→[5.13644:13675](∅→∅),[5.9014]→[5.13644:13675](∅→∅)

return $ App sesss pgs auths

[5.12019]

[5.1077]

return $ App nmode sesss pgs auths
edit in stack.yaml at line 2

[5.1085]→[5.1085:1101](∅→∅),[5.1101]→[5.10542:10554](∅→∅),[5.10554]→[5.3580:3624](∅→∅),[5.3624]→[5.13697:13750](∅→∅),[5.10594]→[5.13697:13750](∅→∅),[5.13750]→[5.10647:10665](∅→∅),[5.23340]→[5.10647:10665](∅→∅),[5.10647]→[5.10647:10665](∅→∅)

packages:
- '.'
- location:
git: https://github.com/aftok/bippy.git
commit: 97fda0368ae660239d1b9398d44530cd5b05eec3
extra-dep: true
replacement in stack.yaml at line 4

[5.10695]→[5.1:120](∅→∅),[5.120]→[4.252:326](∅→∅)

- snap-1.0.0.2
- snaplet-postgresql-simple-1.0.2.0
- haskoin-core-0.4.2
- heist-1.0.1.0
- map-syntax-0.2.0.2
- murmur3-1.0.3
- pbkdf-1.1.1.1
- secp256k1-0.4.8
resolver: lts-8.5

[5.10695]

[5.3625]

# - snap-1.0.0.2
# - snaplet-postgresql-simple-1.0.2.0
# - haskoin-core-0.4.2
# - heist-1.0.1.0
# - map-syntax-0.2.0.2
# - murmur3-1.0.3
# - pbkdf-1.1.1.1
# - secp256k1-0.4.8
- snap-1.1.2.0@sha256:5640450870d06e659b0f31dd47a7b767a053a78b48048ff8c12c014e08d6651e
- snaplet-postgresql-simple-1.1.0.0@sha256:93979aebd232cd92e2971faa118eb78cce399191278d4655354ed292fa980999
- heist-1.1.0.1@sha256:7c0fe723e766e41a234def6ad3162958512ad78d3aaaa9b36676186a4427dd01
- map-syntax-0.3@sha256:84dc86fa1c292af25963bf7212ae7d55ce87239a9f8d4cc85bd0acc35874d2e1
- http-client-openssl-0.3.0.0@sha256:cd617e7bef6c3d8ac4587d7c623b80c35a15735d0142e56eca0ae1c8a67a1b5d
- pwstore-fast-2.4.4@sha256:9b6a37510d8b9f37f409a8ab3babac9181afcaaa3fce8ba1c131a7ed3de30698
- xmlhtml-0.2.5.2@sha256:0e9ada870a5c5c7d522ed8444bef0f9f0e1587e31a5881f15a5f9cdd983af8b4
- git: https://github.com/aftok/bippy.git
commit: 1c60b6fee50fff28f40c5d5412de422f4a501f66

resolver: lts-13.9 #lts-8.5
edit in stack.yaml at line 24

[5.3647]

pvp-bounds: both
file addition: stack.yaml.lock (----------)

[111.2]

# This file was autogenerated by Stack.
# You should not edit this file by hand.
# For more information, please see the documentation at:
# https://docs.haskellstack.org/en/stable/lock_files

packages:
- completed:
hackage: snap-1.1.2.0@sha256:5640450870d06e659b0f31dd47a7b767a053a78b48048ff8c12c014e08d6651e,9175
pantry-tree:
size: 5743
sha256: ef0dfdb19409ce2aae0d8d9c6312e51931b89f0285bf5798a2349d8130cab89a
original:
hackage: snap-1.1.2.0@sha256:5640450870d06e659b0f31dd47a7b767a053a78b48048ff8c12c014e08d6651e
- completed:
hackage: snaplet-postgresql-simple-1.1.0.0@sha256:93979aebd232cd92e2971faa118eb78cce399191278d4655354ed292fa980999,2700
pantry-tree:
size: 655
sha256: 6525a26918dec9179af73a433ac8de4d5a456f5f96a9fcd23f6365e3999b4f5a
original:
hackage: snaplet-postgresql-simple-1.1.0.0@sha256:93979aebd232cd92e2971faa118eb78cce399191278d4655354ed292fa980999
- completed:
hackage: heist-1.1.0.1@sha256:7c0fe723e766e41a234def6ad3162958512ad78d3aaaa9b36676186a4427dd01,8973
pantry-tree:
size: 7354
sha256: 1ed83746a3e9470618ef67da249b0b4d78c87cc5c50d9c892e27db057c0d4866
original:
hackage: heist-1.1.0.1@sha256:7c0fe723e766e41a234def6ad3162958512ad78d3aaaa9b36676186a4427dd01
- completed:
hackage: map-syntax-0.3@sha256:84dc86fa1c292af25963bf7212ae7d55ce87239a9f8d4cc85bd0acc35874d2e1,2420
pantry-tree:
size: 558
sha256: bb33cb3230b362d94f2367b313f06f9d73d2b2afa4626bd2fab8dc4d45468164
original:
hackage: map-syntax-0.3@sha256:84dc86fa1c292af25963bf7212ae7d55ce87239a9f8d4cc85bd0acc35874d2e1
- completed:
hackage: http-client-openssl-0.3.0.0@sha256:cd617e7bef6c3d8ac4587d7c623b80c35a15735d0142e56eca0ae1c8a67a1b5d,1548
pantry-tree:
size: 387
sha256: 5712016dbe69a539ca265b8e1b248d499445a2a414ac3a8bc9c8a62bef0ffc6d
original:
hackage: http-client-openssl-0.3.0.0@sha256:cd617e7bef6c3d8ac4587d7c623b80c35a15735d0142e56eca0ae1c8a67a1b5d
- completed:
hackage: pwstore-fast-2.4.4@sha256:9b6a37510d8b9f37f409a8ab3babac9181afcaaa3fce8ba1c131a7ed3de30698,1351
pantry-tree:
size: 270
sha256: ff4a44ede62515efe5cd366a5803f7183c811c4a0cf56eea88da94181c4844c0
original:
hackage: pwstore-fast-2.4.4@sha256:9b6a37510d8b9f37f409a8ab3babac9181afcaaa3fce8ba1c131a7ed3de30698
- completed:
hackage: xmlhtml-0.2.5.2@sha256:0e9ada870a5c5c7d522ed8444bef0f9f0e1587e31a5881f15a5f9cdd983af8b4,46997
pantry-tree:
size: 61835
sha256: 13fdaf307ac4a3f60999aca0c367792e97f92428f56ffe144092a6360bd1e33f
original:
hackage: xmlhtml-0.2.5.2@sha256:0e9ada870a5c5c7d522ed8444bef0f9f0e1587e31a5881f15a5f9cdd983af8b4
- completed:
cabal-file:
size: 2747
sha256: 6ec7c63e2fa691f9b07015e756018f1dbc13d280521801664cee1317be07cf71
name: bippy
version: 0.1.0.0
git: https://github.com/aftok/bippy.git
pantry-tree:
size: 3547
sha256: 4ee75c44d9cb4b8a39bbd297d63866a3a738108b438e33dfad068a78edcea5dc
commit: 1c60b6fee50fff28f40c5d5412de422f4a501f66
original:
git: https://github.com/aftok/bippy.git
commit: 1c60b6fee50fff28f40c5d5412de422f4a501f66
snapshots:
- completed:
size: 496697
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/13/9.yaml
sha256: 3846ba7d13dd1b2679426dc3f450332a3b8a181063b0f3fc2d0c7d55db2e9c24
original: lts-13.9