Add billing daemon

[?]

Sep 24, 2017, 9:28 PM

IPG33FAWXGEQ2PO6OXRT2PWWXHRNMPVUKKADL6UKKN5GD2CNZ25AC

Dependencies

[2] 4B66XH43 Add sample billing config
[3] SOIAMXLW Build versioned docker images.
[4] RSEB2NFG Replacing Snap with Scotty.
[5] 2G3GNDDU Event logging is now functioning in postgres.
[6] ADMKQQGC Initial empty Snap project.
[7] 7KZP4RHZ Switch from Data.Time to Data.Thyme
[8] O5FVTOM6 Undo JSON silliness, enable a couple more routes.
[9] FXJQACES Ensure that auction is not ended at the time of bid
[10] A6HKMINB Attempting to improve JSON handling.
[11] Z3MK2PJ5 Add GET handler for retrieving auction data.
[12] RN7EI6IN Update database layer to use CreditTo
[13] SCXG6TJW Make log reduction safer in presence of overlapping events.
[14] LD4GLVSF More database stuff.
[15] O722AOKE Add route to allow crediting of events to users/projects.
[16] DXIGERDT Change order of Docker build to avoid rebuilding the universe.
[17] Y3LIJ5US Add handler for CreatePaymentRequest
[18] O227CEAV Adds storage of original event JSON for some DBOp constructors.
[19] 3QVT6MA6 Add database support for event amend operations.
[20] AL37SVTC Implement payments service endpoints.
[21] 4FDQGIXN Make payment request retrieval key an opaque 32-bit hash.
[22] WAIX6AGN Add event serialization for PaymentRequest & Payment
[23] 4U7F3CPI THE GREAT RENAMING OF THINGS!
[24] 64C6AWH6 Rename Ananke -> Quixotic, project reboot.
[25] XTBSG4C7 Adding serveJSON combinator to eliminate some boilerplate from handlers.
[26] ASF3UPJL Add auction creation and bid handlers
[27] NTPC7KJE Trivial changes, feature scratchpad.
[28] DFOBMSAO Initial work on payments API
[29] 4ZLEDBK7 Initial attempts at dockerizing, cabal isn't cooperating.
[30] Q5X5RYQL stylish-haskell reformatting
[31] HMDM3B55 Implement core of payments/billing infrastructure.
[32] MJ6R42RC Utility methods for reading key & cert data.
[33] V2VDN77H Enable postgres configuration via environment variable for Heroku.
[34] 6L5BK5EH Use generic SMTP rather than Sendmail-specific mail client.
[35] TNR3TEHK Switch to Postgres + snaplet arch compiles.
[36] LEINLS3X Update deployment documentation.
[37] 2XQD6KKK Add invitation logic and clean up DBProg error handling.
[38] NVOCQVAS Initial failing tests.
[39] 4IQVQL4T Added client for payouts endpoint.
[40] NLZ3JXLO Fix formatting with stylish-haskell.
[41] W35DDBFY Factor common JSON conversions up into client lib module.
[42] 73NDXDEZ Begin implementation of billing event persistence.
[43] NAS4BFL4 Trivial stylish-haskell reformat.
[44] EW2XN7KU Update docker build, clean up migration for payments tables.
[45] EMVTF2IW WIP moving back to snap.
[46] GKGVYBZG Added JSON serialization to TimeLog
[47] KNSI575V Cleanup of EventLog types.
[48] SPJCFHXW Update shell scripts to point to https://aftok.com and prompt for input.
[49] 7HPY3QPF Fix linting errors. (yay hlint!)
[50] SEWTRB6S Implement payment request creation functions.
[51] QMRKFEPG Refactor QDB to use a free monad algebra instead.
[52] POX3UAMT Enabling logging of time to contributor/project accounts
[53] 2Y2QZFVF Switch to more modern cabal2nix-based workflow.
[54] M3KUPGZK Add invitation email template.
[55] UILI6PIL The route-based logStart/logStop is nicer.
[56] WFZDMVUX Rename ADB -> QDB
[57] NEDDHXUK Reformat via stylish-haskell
[58] Z7KS5XHH Very WIP. Wow.
[59] HO2PFRAB Client login now handles response correctly.
[60] 5OI44E4E Add authentication to auction search.
[61] TLQ72DSJ Lenses, sqlite-simple
[62] 5XFJNUAZ Start of addition of project infrastructure.
[63] RPAJLHMT Change to use UUIDs instead of ints for primary keys.
[64] WZFQDWW4 Add retrieval/storage of current exchange rate data to payment recording.
[65] KEP5WUFJ Convert project to stack-based build.
[66] QADKFHAR Adds CreatePayment handler implementation.
[67] JFOEOFGA stylish-haskell formatting.
[68] BSIUHCGF Add payment response handler.
[69] MGOF7IUF Update TASKS list to reflect completed projects.
[70] HALRDT2F Added initial auction create route.
[71] Y35QCWYW Minor improvement in WorkIndex type to eliminate duplicated information.
[72] IZEVQF62 Work in progress replacing sqlite with postgres.
[73] BROSTG5K Beginning of modularization of server.
[74] 7VGYLTMU Clean up schema version handling.
[75] LCBJULKE Fix swapped default and key in QConfig.
[76] ZP62WC47 Begin conversion to build with stack.
[77] PBD7LZYQ Postgres & auth are beginning to function.
[78] GCVQD44V Create amends endpoint, switch to UUID primary keys
[79] I2KHGVD4 Require project permissions for access to most data.
[80] TCOAKCGG Completed conversion to snap.
[81] FD7SV5I6 Fix handling of event_t columns.
[*] EKI57EJR Add alternative implementation of auction winner determination.
[*] 5DRIWGLU Improving TimeLog specs
[*] AXKKXBWN Initial attempt at writing down my ideas for a company based on trust.
[*] 2WOOGXDH Use dbmigrations to manage database state.

Change contents

edit in Dockerfile at line 55

[4.152]

[4.152]

ADD ./daemon /opt/aftok/daemon
edit in Makefile at line 12

[3.614]→[4.1432:1433](∅→∅),[4.701]→[4.1432:1433](∅→∅),[4.1432]→[4.1432:1433](∅→∅)
edit in aftok.cabal at line 26

[4.156]

[4.238]

Aftok.Config
edit in aftok.cabal at line 64

[83.11]

[4.388]

, network
edit in aftok.cabal at line 72

[4.7126]

[84.1576]

, smtp-mail
, system-filepath
edit in aftok.cabal at line 81

[4.2906]

[4.1311]

, x509
, x509-store
edit in aftok.cabal at line 138

[4.592]

[4.1]

, Aftok.Snaplet.Billing
edit in aftok.cabal at line 177

[4.914]

[4.7327]

, system-filepath
, text
, thyme
, transformers
, uuid
, wreq
, x509
, x509-store

Executable aftok-daemon
default-language: Haskell2010
ghc-options: -Wall -Werror
hs-source-dirs: daemon
default-extensions: NoImplicitPrelude
, OverloadedStrings
, RecordWildCards
, ScopedTypeVariables
, KindSignatures

main-is: Main.hs
other-modules: AftokD
, AftokD.AftokM
build-depends:
aftok
, base
, aeson
, attoparsec
, base64-bytestring
, bytestring
, bippy
, cereal
, classy-prelude
, containers
, configurator
, cryptonite
, either
, errors
, hourglass
, HStringTemplate
, iso8601-time
, HsOpenSSL
, http-client
, http-client-openssl
, lens
, mime-mail
, mtl
, network
, network-uri
, optparse-applicative
, postgresql-simple
, protobuf
, smtp-mail
, system-filepath
file addition: daemon (d--r------)

[85.2]
file addition: AftokD (d--r------)

[0.1418]
file addition: AftokM.hs (----------)

[0.1438]

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE FlexibleContexts #-}
module AftokD.AftokM where

import ClassyPrelude

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

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

import Database.PostgreSQL.Simple (Connection, connect)
import Data.Thyme.Clock as C
import Data.Thyme.Time as T
import Network.Mail.Mime
import Network.Mail.SMTP as SMTP
import Network.URI (URI, parseURI)
import Text.StringTemplate
import Filesystem.Path.CurrentOS (encodeString)

import Network.Bippy.Types (Satoshi)

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

data AftokDErr
= ConfigError Text
| DBErr DB.DBError
| PaymentErr P.PaymentError
makeClassyPrisms ''AftokDErr

instance P.AsPaymentError AftokDErr where
_PaymentError = _PaymentErr . P._PaymentError
_Overdue = _PaymentErr . P._Overdue
_SigningError = _PaymentErr . P._SigningError

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

instance P.HasPaymentsConfig AftokMEnv where
network = pcfg . P.network
signingKey = pcfg . P.signingKey
pkiData = pcfg . P.pkiData
paymentsConfig = pcfg

newtype AftokM a = AftokM { runAftokM :: ReaderT AftokMEnv (ExceptT AftokDErr IO) a }
deriving (Functor, Applicative, Monad, MonadIO, MonadError AftokDErr, MonadReader AftokMEnv)

instance MonadRandom AftokM where
getRandomBytes = liftIO . getRandomBytes

instance DB.MonadDB AftokM where
liftdb = liftQDBM . DB.liftdb

liftQDBM :: QDBM a -> AftokM a
liftQDBM (QDBM r) =
AftokM . mapReaderT (withExceptT DBErr) . withReaderT _conn $ r

createAllPaymentRequests :: D.Config -> IO ()
createAllPaymentRequests cfg = do
conn' <- connect $ cfg ^. D.dbConfig
pcfg' <- AC.toPaymentsConfig $ cfg ^. D.billingConfig
let env = AftokMEnv cfg conn' pcfg'
void . runExceptT $ (runReaderT . runAftokM) createProjectsPaymentRequests $ env

createProjectsPaymentRequests :: AftokM ()
createProjectsPaymentRequests = do
projects <- liftQDBM $ DB.listProjects
traverse_ createProjectPaymentRequests projects

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

sendPaymentRequestEmail :: P.PaymentRequestId -> AftokM ()
sendPaymentRequestEmail reqId = do
cfg <- ask
let AC.SmtpConfig{..} = cfg ^. (dcfg . D.smtpConfig)
preqCfg = cfg ^. (dcfg . D.paymentRequestConfig)
reqMay = do
preq <- DB.findPaymentRequestId reqId
preq' <- traverseOf P.subscription DB.findSubscriptionBillable preq
preq'' <- traverseOf (P.subscription . customer) DB.findUser preq'
traverseOf (P.subscription . billable . project) DB.findProject preq''
req <- maybeT (throwError $ DBErr DB.SubjectNotFound) pure reqMay
bip70URL <- paymentURL (req ^. paymentKey)
mail <- buildPaymentRequestEmail preqCfg req bip70URL
let mailer = maybe (sendMailWithLogin _smtpHost) (sendMailWithLogin' _smtpHost) _smtpPort
liftIO $ mailer _smtpUser _smtpPass mail

buildPaymentRequestEmail :: (MonadIO m, MonadError AftokDErr m)
=> D.PaymentRequestConfig
-> P.PaymentRequest' (Subscription' User (Billable' Project UserId Satoshi))
-> URI
-> m Mail
buildPaymentRequestEmail cfg req paymentUrl = do
templates <- liftIO . directoryGroup $ encodeString (cfg ^. D.templatePath)
let billTemplate = (newSTMP . unpack) <$> req ^. (subscription . billable . paymentRequestEmailTemplate)
defaultTemplate = getStringTemplate "payment_request" templates
case billTemplate <|> defaultTemplate of
Nothing -> throwError $ ConfigError "Could not find template for invitation email"
Just template ->
let fromEmail = cfg ^. D.billingFromEmail
toEmail = req ^. (subscription . customer . userEmail)
pname = req ^. (subscription . billable . project . projectName)
total = req ^. (P.paymentRequest . to paymentRequestTotal)
setAttrs = setManyAttrib
[ ("from_email", fromEmail ^. _Email)
, ("project_name", pname)
, ("to_email", toEmail ^. _Email)
, ("amount_due", tshow $ total ^. satoshi)
, ("payment_url", tshow paymentUrl)
]
fromAddr = Address Nothing ("billing@aftok.com")
toAddr = Address Nothing (toEmail ^. _Email)
subject = "Payment is due for your "<>pname<>" subscription!"
body = plainTextPart . render $ setAttrs template
in pure $ SMTP.simpleMail fromAddr [toAddr] [] [] subject [body]

memoGen :: Subscription' UserId Billable
-> T.Day
-> C.UTCTime
-> AftokM (Maybe Text)
memoGen sub billingDate requestTime = do
req <- traverseOf (billable . project) DB.findProjectOrError sub
let template = (newSTMP . unpack) <$> (sub ^. (billable . paymentRequestMemoTemplate))
setAttrs = setManyAttrib
[ ("project_name", req ^. (billable . project . projectName))
, ("subscription", req ^. (billable . name))
, ("billing_date", tshow billingDate)
, ("issue_time", tshow requestTime)
]
pure $ fmap (render . setAttrs) template

-- The same URL is used for retrieving a BIP-70 payment request and for submitting
-- the response.
paymentURL :: PaymentKey -> AftokM URI
paymentURL (PaymentKey k) = do
env <- ask
let hostname = env ^. (dcfg . D.paymentRequestConfig . D.aftokHost)
paymentRequestPath = "https://" <> hostname <> "/pay/" <> k
maybe
(throwError . ConfigError $ "Could not parse path " <> paymentRequestPath <> " to a valid URI")
pure
(parseURI $ show paymentRequestPath)

payloadGen :: Monad m => Subscription' UserId Billable -> T.Day -> C.UTCTime -> m (Maybe ByteString)
payloadGen _ _ _ = pure Nothing
file addition: AftokD.hs (----------)

[0.1418]

{-# LANGUAGE TemplateHaskell #-}

module AftokD where

import ClassyPrelude hiding (FilePath)

import Control.Lens

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

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

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

data Config = Config
{ _smtpConfig :: AC.SmtpConfig
, _billingConfig :: AC.BillingConfig
, _dbConfig :: ConnectInfo
, _paymentRequestConfig :: PaymentRequestConfig
}
makeLenses ''Config

loadConfig :: FilePath -> IO Config
loadConfig cfgFile =
readConfig =<< C.load [C.Required $ encodeString cfgFile]

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

readPaymentRequestConfig :: CT.Config -> IO PaymentRequestConfig
readPaymentRequestConfig cfg = PaymentRequestConfig
<$> C.require cfg "aftok_host"
<*> (fromText <$> C.require cfg "template_path")
<*> (Email <$> C.require cfg "payment_from_email")
file addition: Main.hs (----------)

[0.1418]

{-# LANGUAGE TemplateHaskell #-}
module Main (main) where

import ClassyPrelude

import System.Environment (getEnv)
import Filesystem.Path.CurrentOS (decodeString)

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

main :: IO ()
main = do
cfgPath <- try $ getEnv "AFTOK_CFG" :: IO (Either IOError String)
cfg <- D.loadConfig . decodeString $ either (const "conf/aftok.cfg") id cfgPath
createAllPaymentRequests cfg
edit in lib/Aftok/Billables.hs at line 70

[4.357]

[4.1342]

, _paymentRequestEmailTemplate :: Maybe Text
, _paymentRequestMemoTemplate :: Maybe Text
replacement in lib/Aftok/Billables.hs at line 85

[4.694]→[4.1540:1586](∅→∅),[4.1540]→[4.1540:1586](∅→∅)

} deriving (Functor, Foldable, Traversable)

[4.694]

[4.1586]

}
file addition: Config.hs (----------)

[4.679]

{-# LANGUAGE TemplateHaskell #-}

module Aftok.Config where

import ClassyPrelude hiding (FilePath)

import Control.Lens (makeClassy, (^.))
import qualified Data.Configurator as C
import qualified Data.Configurator.Types as CT
import Data.X509
import Data.X509.File (readKeyFile, readSignedObject)
import Database.PostgreSQL.Simple (ConnectInfo(..))
import Filesystem.Path.CurrentOS (FilePath, fromText, encodeString)

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

import Aftok.Payments (PaymentsConfig(..))

data SmtpConfig = SmtpConfig
{ _smtpHost :: NS.HostName
, _smtpPort :: Maybe NS.PortNumber
, _smtpUser :: SMTP.UserName
, _smtpPass :: SMTP.Password
}
makeClassy ''SmtpConfig

data BillingConfig = BillingConfig
{ _network :: BT.Network
, _signingKeyFile :: FilePath
, _certsFile :: FilePath
, _exchangeRateServiceURI :: String
}
makeClassy ''BillingConfig

readSmtpConfig :: CT.Config -> IO SmtpConfig
readSmtpConfig cfg =
SmtpConfig <$> C.require cfg "smtpHost"
<*> ((fmap . fmap) fromInteger $ C.lookup cfg "smtpPort")
<*> C.require cfg "smtpUser"
<*> C.require cfg "smtpKey"

readBillingConfig :: CT.Config -> IO BillingConfig
readBillingConfig cfg =
BillingConfig <$> (parseNetwork <$> C.require cfg "network")
<*> (fromText <$> C.require cfg "signingKeyFile")
<*> (fromText <$> C.require cfg "certsFile")
<*> C.require cfg "exchangeRateServiceURI"
where parseNetwork :: String -> BT.Network
parseNetwork "main" = BT.MainNet
parseNetwork _ = BT.TestNet

readConnectInfo :: CT.Config -> IO ConnectInfo
readConnectInfo cfg =
ConnectInfo <$> C.require cfg "host"
<*> C.require cfg "port"
<*> C.require cfg "user"
<*> C.require cfg "password"
<*> C.require cfg "database"

toPaymentsConfig :: BillingConfig -> IO PaymentsConfig
toPaymentsConfig c = do
privKeys <- readKeyFile . encodeString $ c ^. signingKeyFile
pkiEntries <- readSignedObject . encodeString $ c ^. certsFile
privKey <- case headMay privKeys of
Just (PrivKeyRSA k) -> pure k
Just (PrivKeyDSA _) -> fail "DSA keys not supported for payment request signing."
Nothing -> fail $ "No keys found in private key file " <> encodeString (c ^. signingKeyFile)
let pkiData = BT.X509SHA256 . CertificateChain $ pkiEntries
pure $ PaymentsConfig (c ^. network) privKey pkiData
edit in lib/Aftok/Database/PostgreSQL.hs at line 3

[4.937]

[4.565]

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

[4.566]→[4.1709:1766](∅→∅)

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

[4.566]

[4.622]

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

[4.999]→[4.999:1043](∅→∅)

import Control.Monad.Trans.Either

[4.999]

[4.4]

import Control.Monad.Trans.Except (ExceptT(..), throwE, runExceptT)
edit in lib/Aftok/Database/PostgreSQL.hs at line 25

[4.1559]

[4.4]

import Database.PostgreSQL.Simple.SqlQQ (sql)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 44

[4.1124]→[4.1802:1868](∅→∅)

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

[4.1124]

[4.264]

newtype QDBM a = QDBM (ReaderT Connection (ExceptT DBError IO) a)
edit in lib/Aftok/Database/PostgreSQL.hs at line 53

[4.1928]

[4.342]

instance MonadDB QDBM where
liftdb = pgEval
replacement in lib/Aftok/Database/PostgreSQL.hs at line 56

[4.343]→[4.1928:1984](∅→∅),[4.1928]→[4.1928:1984](∅→∅)

runQDBM :: Connection -> QDBM a -> EitherT DBError IO a

[4.343]

[4.1984]

runQDBM :: Connection -> QDBM a -> ExceptT DBError IO a
replacement in lib/Aftok/Database/PostgreSQL.hs at line 94

[4.2093]→[4.2093:2201](∅→∅)

parser "credit_to_btc_addr" = CreditToAddress <$> (fieldWith btcAddrParser <* nullField <* nullField)

[4.2093]

[4.1537]

parser "credit_to_address" = CreditToAddress <$> (fieldWith btcAddrParser <* nullField <* nullField)
edit in lib/Aftok/Database/PostgreSQL.hs at line 163

[4.3516]

[4.3516]

<*> field
<*> field
replacement in lib/Aftok/Database/PostgreSQL.hs at line 218

[4.1334]→[4.2727:2801](∅→∅)

lift . EitherT $ withTransaction conn (runEitherT $ runReaderT rt conn)

[4.1334]

[4.1361]

lift . ExceptT $ withTransaction conn (runExceptT $ runReaderT rt conn)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 240

[4.661]→[4.661:806](∅→∅)

pinsert EventId
"INSERT INTO aftok_events \
\(event_time, created_by, event_type, event_json) \
\VALUES (?, ?, ?, ?) RETURNING id"

[4.661]

[4.918]

pinsert EventId
[sql| INSERT INTO aftok_events
(event_time, created_by, event_type, event_json)
VALUES (?, ?, ?, ?) RETURNING id |]
replacement in lib/Aftok/Database/PostgreSQL.hs at line 250

[4.4201]→[4.4201:4430](∅→∅)

pinsert EventId
"INSERT INTO work_events \
\(project_id, user_id, credit_to_type, credit_to_btc_addr, event_type, event_time, event_metadata) \
\VALUES (?, ?, ?, ?, ?, ?, ?) \
\RETURNING id"

[4.4201]

[4.4430]

pinsert EventId
[sql| INSERT INTO work_events
( project_id, user_id, credit_to_type, credit_to_address
, event_type, event_time, event_metadata )
VALUES (?, ?, ?, ?, ?, ?, ?)
RETURNING id |]
replacement in lib/Aftok/Database/PostgreSQL.hs at line 259

[4.4575]→[4.4575:4806](∅→∅)

pinsert EventId
"INSERT INTO work_events \
\(project_id, user_id, credit_to_type, credit_to_project_id, event_type, event_time, event_metadata) \
\VALUES (?, ?, ?, ?, ?, ?, ?) \
\RETURNING id"

[4.4575]

[4.4806]

pinsert EventId
[sql| INSERT INTO work_events
( project_id, user_id, credit_to_type, credit_to_project_id
, event_type, event_time, event_metadata )
VALUES (?, ?, ?, ?, ?, ?, ?)
RETURNING id |]
replacement in lib/Aftok/Database/PostgreSQL.hs at line 268

[4.4934]→[4.4934:5162](∅→∅)

pinsert EventId
"INSERT INTO work_events \
\(project_id, user_id, credit_to_type, credit_to_user_id, event_type, event_time, event_metadata) \
\VALUES (?, ?, ?, ?, ?, ?, ?) \
\RETURNING id"

[4.4934]

[4.5162]

pinsert EventId
[sql| INSERT INTO work_events
(project_id, user_id, credit_to_type, credit_to_user_id, event_type, event_time, event_metadata)
VALUES (?, ?, ?, ?, ?, ?, ?)
RETURNING id |]
replacement in lib/Aftok/Database/PostgreSQL.hs at line 276

[4.4403]→[4.5300:5540](∅→∅),[4.5300]→[4.5300:5540](∅→∅)

headMay <$> pquery qdbLogEntryParser
"SELECT project_id, user_id, \
\credit_to_type, credit_to_btc_addr, credit_to_user_id, credit_to_project_id, \
\event_type, event_time, event_metadata FROM work_events \
\WHERE id = ?"

[4.4403]

[4.5540]

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
WHERE id = ? |]
replacement in lib/Aftok/Database/PostgreSQL.hs at line 284

[4.4462]→[4.5619:5813](∅→∅),[4.5619]→[4.5619:5813](∅→∅)

let q (Before e) = pquery logEntryParser
"SELECT btc_addr, event_type, event_time, event_metadata FROM work_events \
\WHERE project_id = ? AND user_id = ? AND event_time <= ?"

[4.4462]

[4.5813]

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
WHERE project_id = ? AND user_id = ? AND event_time <= ? |]
replacement in lib/Aftok/Database/PostgreSQL.hs at line 291

[4.5845]→[4.5845:6072](∅→∅)

q (During s e) = pquery logEntryParser
"SELECT btc_addr, event_type, event_time, event_metadata FROM work_events \
\WHERE project_id = ? AND user_id = ? \
\AND event_time >= ? AND event_time <= ?"

[4.5845]

[4.6072]

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 = ?
AND event_time >= ? AND event_time <= ? |]
replacement in lib/Aftok/Database/PostgreSQL.hs at line 298

[4.6117]→[4.6117:6310](∅→∅)

q (After s) = pquery logEntryParser
"SELECT btc_addr, event_type, event_time, event_metadata FROM work_events \
\WHERE project_id = ? AND user_id = ? AND event_time >= ?"

[4.6117]

[4.6310]

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
WHERE project_id = ? AND user_id = ? AND event_time >= ? |]
replacement in lib/Aftok/Database/PostgreSQL.hs at line 307

[4.4517]→[4.6415:6556](∅→∅),[4.6415]→[4.6415:6556](∅→∅)

pinsert AmendmentId
"INSERT INTO event_time_amendments \
\(event_id, amended_at, event_time) \
\VALUES (?, ?, ?) RETURNING id"

[4.4517]

[4.6556]

pinsert AmendmentId
[sql| INSERT INTO event_time_amendments
(event_id, amended_at, event_time)
VALUES (?, ?, ?) RETURNING id |]
replacement in lib/Aftok/Database/PostgreSQL.hs at line 316

[4.6713]→[4.6713:6902](∅→∅)

pinsert AmendmentId
"INSERT INTO event_credit_to_amendments \
\(event_id, amended_at, credit_to_type, credit_to_btc_addr) \
\VALUES (?, ?, ?, ?) RETURNING id"

[4.6713]

[4.6902]

pinsert AmendmentId
[sql| INSERT INTO event_credit_to_amendments
(event_id, amended_at, credit_to_type, credit_to_btc_addr)
VALUES (?, ?, ?, ?) RETURNING id |]
replacement in lib/Aftok/Database/PostgreSQL.hs at line 323

[4.7026]→[4.7026:7217](∅→∅)

pinsert AmendmentId
"INSERT INTO event_credit_to_amendments \
\(event_id, amended_at, credit_to_type, credit_to_project_id) \
\VALUES (?, ?, ?, ?) RETURNING id"

[4.7026]

[4.7217]

pinsert AmendmentId
[sql| INSERT INTO event_credit_to_amendments
(event_id, amended_at, credit_to_type, credit_to_project_id)
VALUES (?, ?, ?, ?) RETURNING id |]
replacement in lib/Aftok/Database/PostgreSQL.hs at line 330

[4.7323]→[4.7323:7511](∅→∅)

pinsert AmendmentId
"INSERT INTO event_credit_to_amendments \
\(event_id, amended_at, credit_to_type, credit_to_user_id) \
\VALUES (?, ?, ?, ?) RETURNING id"

[4.7323]

[4.7511]

pinsert AmendmentId
[sql| INSERT INTO event_credit_to_amendments
(event_id, amended_at, credit_to_type, credit_to_user_id)
VALUES (?, ?, ?, ?) RETURNING id |]
replacement in lib/Aftok/Database/PostgreSQL.hs at line 337

[4.4635]→[4.7651:7800](∅→∅),[4.7651]→[4.7651:7800](∅→∅)

pinsert AmendmentId
"INSERT INTO event_metadata_amendments \
\(event_id, amended_at, event_metadata) \
\VALUES (?, ?, ?) RETURNING id"

[4.4635]

[4.7800]

pinsert AmendmentId
[sql| INSERT INTO event_metadata_amendments
(event_id, amended_at, event_metadata)
VALUES (?, ?, ?) RETURNING id |]
replacement in lib/Aftok/Database/PostgreSQL.hs at line 344

[4.4682]→[4.7894:8032](∅→∅),[4.7894]→[4.7894:8032](∅→∅)

logEntries <- pquery logEntryParser
"SELECT btc_addr, event_type, event_time, event_metadata FROM work_events WHERE project_id = ?"

[4.4682]

[4.8032]

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
WHERE project_id = ? |]
replacement in lib/Aftok/Database/PostgreSQL.hs at line 353

[4.4712]→[4.8112:8247](∅→∅),[4.8112]→[4.8112:8247](∅→∅)

pinsert A.AuctionId
"INSERT INTO auctions (project_id, user_id, raise_amount, end_time) \
\VALUES (?, ?, ?, ?) RETURNING id"

[4.4712]

[4.8247]

pinsert A.AuctionId
[sql| INSERT INTO auctions (project_id, initiator_id, raise_amount, end_time)
VALUES (?, ?, ?, ?) RETURNING id |]
replacement in lib/Aftok/Database/PostgreSQL.hs at line 363

[4.4742]→[4.8449:8597](∅→∅),[4.8449]→[4.8449:8597](∅→∅)

headMay <$> pquery auctionParser
"SELECT project_id, initiator_id, created_at, raise_amount, start_time, end_time FROM auctions WHERE id = ?"

[4.4742]

[4.8597]

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

[4.4788]→[4.8683:8826](∅→∅),[4.8683]→[4.8683:8826](∅→∅)

pinsert A.BidId
"INSERT INTO bids (auction_id, bidder_id, bid_seconds, bid_amount, bid_time) \
\VALUES (?, ?, ?, ?, ?) RETURNING id"

[4.4788]

[4.8826]

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

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

pquery ((,) <$> idParser A.BidId <*> bidParser)
"SELECT id, user_id, bid_seconds, bid_amount, bid_time FROM bids WHERE auction_id = ?"

[4.2753]

[4.9145]

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

[4.9327]→[4.9327:9428](∅→∅)

in pinsert UserId
"INSERT INTO users (handle, btc_addr, email) VALUES (?, ?, ?) RETURNING id"

[4.9327]

[4.9428]

in pinsert UserId
[sql| INSERT INTO users (handle, btc_addr, email) VALUES (?, ?, ?) RETURNING id |]
replacement in lib/Aftok/Database/PostgreSQL.hs at line 396

[4.4878]→[4.9555:9648](∅→∅),[4.9555]→[4.9555:9648](∅→∅)

headMay <$> pquery userParser
"SELECT handle, btc_addr, email FROM users WHERE id = ?"

[4.4878]

[4.9648]

headMay <$> pquery userParser
[sql| SELECT handle, btc_addr, email FROM users WHERE id = ? |]
replacement in lib/Aftok/Database/PostgreSQL.hs at line 401

[4.4918]→[4.2895:2957](∅→∅),[4.2957]→[4.9743:9812](∅→∅),[4.9743]→[4.9743:9812](∅→∅)

headMay <$> pquery ((,) <$> idParser UserId <*> userParser)
"SELECT id, handle, btc_addr, email FROM users WHERE handle = ?"

[4.4918]

[4.9812]

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

[4.9941]→[4.9941:10089](∅→∅)

void $ pexec
"INSERT INTO invitations (project_id, invitor_id, invitee_email, invitation_key, invitation_time) \
\VALUES (?, ?, ?, ?, ?)"

[4.9941]

[4.10089]

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

[4.5023]→[4.10195:10367](∅→∅),[4.10195]→[4.10195:10367](∅→∅)

headMay <$> pquery invitationParser
"SELECT project_id, invitor_id, invitee_email, invitation_time, acceptance_time \
\FROM invitations WHERE invitation_key = ?"

[4.5023]

[4.10367]

headMay <$> pquery invitationParser
[sql| SELECT project_id, invitor_id, invitee_email, invitation_time, acceptance_time
FROM invitations WHERE invitation_key = ? |]
replacement in lib/Aftok/Database/PostgreSQL.hs at line 420

[4.5088]→[4.10469:10558](∅→∅),[4.10469]→[4.10469:10558](∅→∅)

void $ pexec
"UPDATE invitations SET acceptance_time = ? WHERE invitation_key = ?"

[4.5088]

[4.10558]

void $ pexec
[sql| UPDATE invitations SET acceptance_time = ? WHERE invitation_key = ? |]
replacement in lib/Aftok/Database/PostgreSQL.hs at line 423

[4.10596]→[4.10596:10800](∅→∅)

void $ pexec
"INSERT INTO project_companions (project_id, user_id, invited_by, joined_at) \
\SELECT i.project_id, ?, i.invitor_id, ? \
\FROM invitations i \
\WHERE i.invitation_key = ?"

[4.10596]

[4.10800]

void $ pexec
[sql| INSERT INTO project_companions (project_id, user_id, invited_by, joined_at)
SELECT i.project_id, ?, i.invitor_id, ?
FROM invitations i
WHERE i.invitation_key = ? |]
replacement in lib/Aftok/Database/PostgreSQL.hs at line 432

[4.5116]→[4.10876:11027](∅→∅),[4.10876]→[4.10876:11027](∅→∅)

pinsert P.ProjectId
"INSERT INTO projects (project_name, inception_date, initiator_id, depreciation_fn) \
\VALUES (?, ?, ?, ?) RETURNING id"

[4.5116]

[4.11027]

pinsert P.ProjectId
[sql| INSERT INTO projects (project_name, inception_date, initiator_id, depreciation_fn)
VALUES (?, ?, ?, ?) RETURNING id |]
edit in lib/Aftok/Database/PostgreSQL.hs at line 436

[4.11143]

[4.4290]

pgEval ListProjects =
pquery (idParser P.ProjectId)
[sql| SELECT id FROM projects |]
()

pgEval (FindSubscribers pid) =
pquery (idParser UserId)
[sql| SELECT s.user_id
FROM subscripions s
JOIN billables b ON s.billable_id = b.id
WHERE b.project_id = ? |]
(Only (pid ^. P._ProjectId))
replacement in lib/Aftok/Database/PostgreSQL.hs at line 451

[4.5158]→[4.11190:11325](∅→∅),[4.11190]→[4.11190:11325](∅→∅)

headMay <$> pquery projectParser
"SELECT project_name, inception_date, initiator_id, depreciation_fn FROM projects WHERE id = ?"

[4.5158]

[4.11325]

headMay <$> pquery projectParser
[sql| SELECT project_name, inception_date, initiator_id, depreciation_fn FROM projects WHERE id = ? |]
replacement in lib/Aftok/Database/PostgreSQL.hs at line 456

[4.5200]→[4.2958:3016](∅→∅),[4.3016]→[4.11413:11642](∅→∅),[4.11413]→[4.11413:11642](∅→∅)

pquery ((,) <$> idParser P.ProjectId <*> projectParser)
"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 = ? \
\OR p.initiator_id = ?"

[4.5200]

[4.11642]

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 = ?
OR p.initiator_id = ? |]
replacement in lib/Aftok/Database/PostgreSQL.hs at line 464

[4.5252]→[4.11714:11810](∅→∅),[4.11714]→[4.11714:11810](∅→∅)

pexec
"INSERT INTO project_companions (project_id, user_id, invited_by) VALUES (?, ?, ?)"

[4.5252]

[4.11810]

pexec
[sql| INSERT INTO project_companions (project_id, user_id, invited_by) VALUES (?, ?, ?) |]
replacement in lib/Aftok/Database/PostgreSQL.hs at line 470

[4.11949]→[4.5294:5317](∅→∅),[4.5317]→[4.11973:12002](∅→∅),[4.11973]→[4.11973:12002](∅→∅),[4.12002]→[4.1090:1226](∅→∅),[4.522]→[4.12120:12171](∅→∅),[4.1226]→[4.12120:12171](∅→∅),[4.12120]→[4.12120:12171](∅→∅)

pinsert B.BillableId
"INSERT INTO billables \
\( project_id, event_id, name, description \
\, recurrence_type, recurrence_count \
\, billing_amount, grace_period_days) \
\VALUES (?, ?, ?, ?, ?, ?, ?, ?) RETURNING id"

[4.11949]

[4.5318]

pinsert B.BillableId
[sql| INSERT INTO billables
( project_id, event_id, name, description
, recurrence_type, recurrence_count
, billing_amount, grace_period_days
, payment_request_email_template
, payment_request_memo_template)
VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?) RETURNING id |]
edit in lib/Aftok/Database/PostgreSQL.hs at line 486

[4.3044]

[4.12451]

, b ^. (B.paymentRequestEmailTemplate)
, b ^. (B.paymentRequestMemoTemplate)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 491

[4.3073]→[4.12491:12769](∅→∅),[4.5593]→[4.12491:12769](∅→∅),[4.12491]→[4.12491:12769](∅→∅)

headMay <$> pquery billableParser
"SELECT b.project_id, e.created_by, b.name, b.description, b.recurrence_type, b.recurrence_count, \
\ b.billing_amount, b.grace_period_days \
\FROM billables b JOIN aftok_events e ON e.id = b.event_id \
\WHERE b.id = ?"

[4.3073]

[4.5594]

headMay <$> pquery billableParser
[sql| SELECT b.project_id, e.created_by, b.name, b.description,
b.recurrence_type, b.recurrence_count,
b.billing_amount, b.grace_period_days,
b.payment_request_email_template, b.payment_request_memo_template
FROM billables b JOIN aftok_events e ON e.id = b.event_id
WHERE b.id = ? |]
edit in lib/Aftok/Database/PostgreSQL.hs at line 499

[4.5628]

[4.3942]

pgEval (FindBillables pid) =
pquery ((,) <$> idParser B.BillableId <*> billableParser)
[sql| SELECT b.id, b.project_id, e.created_by, b.name, b.description,
b.recurrence_type, b.recurrence_count,
b.billing_amount, b.grace_period_days
b.payment_request_email_template, b.payment_request_memo_template
FROM billables b JOIN aftok_events e ON e.id = b.event_id
WHERE b.project_id = ? |]
(Only (pid ^. P._ProjectId))
replacement in lib/Aftok/Database/PostgreSQL.hs at line 512

[4.609]→[4.5676:5703](∅→∅),[4.5703]→[4.637:710](∅→∅),[4.637]→[4.637:710](∅→∅),[4.710]→[4.1287:1326](∅→∅)

pinsert B.SubscriptionId
"INSERT INTO subscriptions \
\(user_id, billable_id, event_id) \
\VALUES (?, ?, ?, ?) RETURNING id"

[4.609]

[4.567]

pinsert B.SubscriptionId
[sql| INSERT INTO subscriptions
(user_id, billable_id, event_id, start_date)
VALUES (?, ?, ?, ?) RETURNING id |]
replacement in lib/Aftok/Database/PostgreSQL.hs at line 523

[4.1516]→[4.3108:3249](∅→∅),[4.3108]→[4.3108:3249](∅→∅)

headMay <$> pquery subscriptionParser
"SELECT id, billable_id, start_date, end_date \
\FROM subscriptions s \
\WHERE s.id = ?"

[4.1516]

[4.3249]

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

[4.1554]→[4.3288:3356](∅→∅),[4.5820]→[4.3288:3356](∅→∅),[4.3356]→[4.654:715](∅→∅),[4.715]→[4.5935:6065](∅→∅),[4.5935]→[4.5935:6065](∅→∅)

pquery ((,) <$> idParser B.SubscriptionId <*> subscriptionParser)
"SELECT 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 = ? \
\AND b.project_id = ?"

[4.1554]

[4.6065]

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 = ?
AND b.project_id = ? |]
replacement in lib/Aftok/Database/PostgreSQL.hs at line 541

[4.524]→[4.896:959](∅→∅),[4.896]→[4.896:959](∅→∅),[4.959]→[4.525:656](∅→∅)

pinsert PaymentRequestId
"INSERT INTO payment_requests \
\(subscription_id, event_id, request_data, url_key, request_time, billing_date) \
\VALUES (?, ?, ?, ?, ?, ?) RETURNING id"

[4.896]

[4.6158]

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

[4.730]→[4.1130:1295](∅→∅),[4.1295]→[4.3716:3743](∅→∅),[4.3716]→[4.3716:3743](∅→∅),[4.3743]→[4.1296:1379](∅→∅)

headMay <$> pquery ((,) <$> idParser PaymentRequestId <*> paymentRequestParser)
"SELECT id, subscription_id, request_data, url_key, request_time, billing_date \
\FROM payment_requests \
\WHERE url_key = ? \
\AND id NOT IN (SELECT payment_request_id FROM payments)"

[4.730]

[4.753]

headMay <$> pquery ((,) <$> idParser PaymentRequestId <*> paymentRequestParser)
[sql| SELECT id, subscription_id, request_data, url_key, request_time, billing_date
FROM payment_requests
WHERE url_key = ?
AND id NOT IN (SELECT payment_request_id FROM payments) |]
edit in lib/Aftok/Database/PostgreSQL.hs at line 560

[4.764]

[4.1590]

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

[4.1626]→[4.3835:3905](∅→∅),[4.3835]→[4.3835:3905](∅→∅),[4.3905]→[4.1380:1463](∅→∅),[4.1463]→[4.3979:4036](∅→∅),[4.3979]→[4.3979:4036](∅→∅)

pquery ((,) <$> idParser PaymentRequestId <*> paymentRequestParser)
"SELECT id, subscription_id, request_data, url_key, request_time, billing_date \
\FROM payment_requests \
\WHERE subscription_id = ?"

[4.1626]

[4.4036]

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

[4.1010]→[4.1010:1028](∅→∅),[4.1028]→[4.893:920](∅→∅),[4.920]→[4.1464:1558](∅→∅),[4.1558]→[4.1131:1601](∅→∅),[4.1131]→[4.1131:1601](∅→∅)

in pquery rowp
"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, \
\ b.recurrence_count, b.billing_amount, b.grace_period_days \
\FROM payment_requests r \
\JOIN subscriptions s on s.id = r.subscription_id \
\JOIN billables b on b.id = s.billable_id \
\WHERE subscription_id = ? \
\AND r.id NOT IN (SELECT payment_request_id FROM payments)"

[4.1010]

[4.1601]

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,
b.recurrence_count, b.billing_amount, b.grace_period_days,
b.payment_request_email_template, b.payment_request_memo_template
FROM payment_requests r
JOIN subscriptions s on s.id = r.subscription_id
JOIN billables b on b.id = s.billable_id
JOIN aftok_events e on e.id = b.event_id
WHERE subscription_id = ?
AND r.id NOT IN (SELECT payment_request_id FROM payments) |]
replacement in lib/Aftok/Database/PostgreSQL.hs at line 598

[4.81]→[4.81:129](∅→∅),[4.129]→[4.286:368](∅→∅),[4.368]→[4.4179:4218](∅→∅),[4.4179]→[4.4179:4218](∅→∅)

pinsert PaymentId
"INSERT INTO payments \
\(payment_request_id, event_id, payment_data, payment_date, exchange_rates) \
\VALUES (?, ?, ?, ?) RETURNING id"

[4.81]

[4.4218]

pinsert PaymentId
[sql| INSERT INTO payments
(payment_request_id, event_id, payment_data, payment_date, exchange_rates)
VALUES (?, ?, ?, ?, ?) RETURNING id |]
replacement in lib/Aftok/Database/PostgreSQL.hs at line 610

[4.1655]→[4.4382:4553](∅→∅),[4.4382]→[4.4382:4553](∅→∅)

pquery ((,) <$> idParser PaymentId <*> paymentParser)
"SELECT id, payment_request_id, payment_data, payment_date \
\FROM payments \
\WHERE payment_request_id = ?"

[4.1655]

[4.4553]

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

[4.13185]→[4.13185:13217](∅→∅),[4.13217]→[4.3946:3947](∅→∅),[4.3946]→[4.3946:3947](∅→∅),[4.3947]→[4.6295:6341](∅→∅)

raiseError = QDBM . lift . left

instance MonadDB QDBM where
liftdb = pgEval

[4.13185]

raiseError = QDBM . lift . throwE
edit in lib/Aftok/Database.hs at line 6

[4.6416]

[4.426]

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

[4.143]→[4.1731:1787](∅→∅)

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

[4.143]

[4.1787]

import Control.Lens (view, (^.), makeClassyPrisms, traverseOf)
edit in lib/Aftok/Database.hs at line 37

[4.6410]

[4.4711]

ListProjects :: DBOp [ProjectId]
FindSubscribers :: ProjectId -> DBOp [UserId]
edit in lib/Aftok/Database.hs at line 58

[4.4886]

[4.13382]

FindBillables :: ProjectId -> DBOp [(BillableId, Billable)]
edit in lib/Aftok/Database.hs at line 68

[4.1755]

[4.5194]

FindPaymentRequestId :: PaymentRequestId -> DBOp (Maybe PaymentRequest)
edit in lib/Aftok/Database.hs at line 87

[4.5117]

[4.5117]

makeClassyPrisms ''DBError
replacement in lib/Aftok/Database.hs at line 108

[4.7466]→[4.7137:7218](∅→∅)

findUser :: (MonadDB m) => UserId -> m (Maybe User)
findUser = liftdb . FindUser

[4.7466]

[4.5044]

findUser :: (MonadDB m) => UserId -> MaybeT m User
findUser = MaybeT . liftdb . FindUser
replacement in lib/Aftok/Database.hs at line 111

[4.5045]→[4.5320:5390](∅→∅),[4.5390]→[4.7284:7325](∅→∅),[4.7284]→[4.7284:7325](∅→∅)

findUserByName :: (MonadDB m) => UserName -> m (Maybe (UserId, User))
findUserByName = liftdb . FindUserByName

[4.5045]

[4.7626]

findUserByName :: (MonadDB m) => UserName -> MaybeT m (UserId, User)
findUserByName = MaybeT . liftdb . FindUserByName
edit in lib/Aftok/Database.hs at line 121

[4.7809]

[4.7809]

listProjects :: (MonadDB m) => m [ProjectId]
listProjects = liftdb ListProjects

findSubscribers :: (MonadDB m) => ProjectId -> m [UserId]
findSubscribers = liftdb . FindSubscribers
replacement in lib/Aftok/Database.hs at line 128

[4.7810]→[4.7417:7488](∅→∅),[4.7488]→[4.7871:7896](∅→∅),[4.7871]→[4.7871:7896](∅→∅),[4.7896]→[4.533:563](∅→∅),[4.563]→[4.7927:7984](∅→∅),[4.7927]→[4.7927:7984](∅→∅)

findProject :: (MonadDB m) => ProjectId -> UserId -> m (Maybe Project)
findProject pid uid = do
kps <- findUserProjects uid
pure $ fmap snd (find (\(pid', _) -> pid' == pid) kps)

[4.7810]

[4.564]

findProject :: (MonadDB m) => ProjectId -> MaybeT m Project
findProject = MaybeT . liftdb . FindProject

findProjectOrError :: (MonadDB m) => ProjectId -> m Project
findProjectOrError pid = fromMaybeT
(raiseSubjectNotFound $ FindProject pid)
(findProject pid)

findUserProject :: (MonadDB m) => UserId -> ProjectId -> MaybeT m Project
findUserProject uid pid = do
kps <- lift $ findUserProjects uid
MaybeT . pure $ fmap snd (find (\(pid', _) -> pid' == pid) kps)
replacement in lib/Aftok/Database.hs at line 221

[4.5907]→[4.2040:2068](∅→∅)

traverse findBillable sub

[4.5907]

[4.4654]

traverseOf B.billable findBillable sub
replacement in lib/Aftok/Database.hs at line 226

[4.1595]→[4.1803:1899](∅→∅),[4.1899]→[4.1068:1117](∅→∅),[4.1068]→[4.1068:1117](∅→∅)

findPaymentRequest :: (MonadDB m) => PaymentKey -> m (Maybe (PaymentRequestId, PaymentRequest))
findPaymentRequest = liftdb . FindPaymentRequest

[4.1595]

[4.1117]

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

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

[4.2333]→[4.6084:6223](∅→∅),[4.1595]→[4.6084:6223](∅→∅)

findPayment :: (MonadDB m) => PaymentRequestId -> m (Maybe Payment)
findPayment prid = (fmap snd . headMay) <$> liftdb (FindPayments prid)

[4.2333]

[4.4910]

findPayment :: (MonadDB m) => PaymentRequestId -> MaybeT m Payment
findPayment prid = MaybeT $ (fmap snd . headMay) <$> liftdb (FindPayments prid)
replacement in lib/Aftok/Database.hs at line 246

[4.767]→[4.9652:9723](∅→∅)

findAuction :: (MonadDB m) => AuctionId -> UserId -> m (Maybe Auction)

[4.767]

[4.841]

findAuction :: (MonadDB m) => AuctionId -> UserId -> MaybeT m Auction
replacement in lib/Aftok/Database.hs at line 250

[4.892]→[4.9724:9754](∅→∅),[4.9754]→[4.205:291](∅→∅),[4.205]→[4.205:291](∅→∅),[4.291]→[4.1006:1024](∅→∅),[4.1006]→[4.1006:1024](∅→∅)

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

[4.892]

[4.292]

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

[4.486]→[4.6279:6327](∅→∅),[4.6327]→[4.6629:6666](∅→∅),[4.9375]→[4.6629:6666](∅→∅),[4.6666]→[4.1803:1850](∅→∅),[4.1850]→[4.1247:1288](∅→∅),[4.1247]→[4.1247:1288](∅→∅)

qdbProjectJSON :: (ProjectId, Project) -> Value
qdbProjectJSON (pid, project) = v1 $
obj [ "projectId" .= idValue _ProjectId pid
, "project" .= projectJSON project

[4.486]

[4.1288]

qdbJSON :: Text -> (Lens' a UUID) -> (b -> Value) -> (a, b) -> Value
qdbJSON name l f (xid, x) = v1 $
obj [ (name <> "Id") .= idValue l xid
, name .= f x
edit in lib/Aftok/Json.hs at line 126

[4.1516]

[4.538]

qdbProjectJSON :: (ProjectId, Project) -> Value
qdbProjectJSON = qdbJSON "project" _ProjectId projectJSON
edit in lib/Aftok/Json.hs at line 180

[4.2251]

[4.1568]

billableIdJSON :: B.BillableId -> Value
billableIdJSON = idJSON "billableId" B._BillableId
edit in lib/Aftok/Json.hs at line 197

[4.2997]

[4.1844]

qdbBillableJSON :: (B.BillableId, B.Billable) -> Value
qdbBillableJSON = qdbJSON "billable" B._BillableId billableJSON
edit in lib/Aftok/Json.hs at line 226

[4.3562]

[4.630]

subscriptionIdJSON :: B.SubscriptionId -> Value
subscriptionIdJSON = idJSON "subscriptionId" B._SubscriptionId
edit in lib/Aftok/Json.hs at line 255

[4.4377]

[4.4377]

paymentIdJSON :: PaymentId -> Value
paymentIdJSON = idJSON "paymentId" _PaymentId
edit in lib/Aftok/Json.hs at line 271

[4.5724]

[4.2133]

parseUUID :: Value -> Parser U.UUID
parseUUID v = do
str <- parseJSON v
maybe (fail $ "Value " <> str <> "Could not be parsed as a valid UUID.") pure $ U.fromString str

parseId :: forall a. Prism' a UUID -> Value -> Parser a
parseId p = fmap (review p) . parseUUID
replacement in lib/Aftok/Json.hs at line 294

[4.1271]→[4.2932:3012](∅→∅),[4.2932]→[4.2932:3012](∅→∅)

fmap (CreditToUser . UserId) . parseUUID <$> O.lookup "creditToUser" o'

[4.1271]

[4.3012]

fmap CreditToUser . parseId _UserId <$> O.lookup "creditToUser" o'
replacement in lib/Aftok/Json.hs at line 297

[4.1304]→[4.3046:3135](∅→∅),[4.3046]→[4.3046:3135](∅→∅)

fmap (CreditToProject . ProjectId) . parseUUID <$> O.lookup "creditToProject" o'

[4.1304]

[4.3135]

fmap CreditToProject . parseId _ProjectId <$> O.lookup "creditToProject" o'
edit in lib/Aftok/Json.hs at line 345

[4.3235]→[4.6406:6407](∅→∅),[4.6406]→[4.6406:6407](∅→∅),[4.4678]→[4.4678:4851](∅→∅)

parseUUID :: Value -> Parser U.UUID
parseUUID v = do
str <- parseJSON v
maybe (fail $ "Value " <> str <> "Could not be parsed as a valid UUID.") pure $ U.fromString str
edit in lib/Aftok/Json.hs at line 354

[4.4874]→[4.3111:3226](∅→∅)

parseBillable :: Value -> Parser B.Billable
parseBillable = unversion "Billable" p where
--p (Version 1 0) o =
replacement in lib/Aftok/Json.hs at line 355

[4.3227]→[4.3227:3263](∅→∅)

p v o = badVersion "Billable" v o

[4.3227]

[4.987]

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

[4.988]

[4.3264]

notFound = fail $ "Value " <> show o <> " does not represent a Recurrence value."
parseV v = parseAnnually v <|> parseMonthly v <|> parseWeekly v <|> parseOneTime v
in fromMaybe notFound $ parseV o
edit in lib/Aftok/Json.hs at line 366

[4.3265]

parseRecurrence' :: Value -> Parser B.Recurrence
parseRecurrence' (Object o) = parseRecurrence o
parseRecurrence' v = fail $ "Value " <> show v <> " is not a JSON object."
replacement in lib/Aftok/Payments/Types.hs at line 20

[4.2175]→[4.2175:2235](∅→∅)

getPaymentDetails)

[4.2175]

[4.1181]

getPaymentDetails, Satoshi(..))
edit in lib/Aftok/Payments/Types.hs at line 31

[4.1243]

[4.1243]

-- A unique identifier for the payment request, suitable
-- for URL embedding.
edit in lib/Aftok/Payments/Types.hs at line 71

[4.1513]

paymentRequestTotal :: P.PaymentRequest -> Satoshi
paymentRequestTotal _ = error "Not yet implemented"
replacement in lib/Aftok/Payments.hs at line 14

[4.2845]→[4.2845:2905](∅→∅)

view, (%~), (^.))

[4.2845]

[4.11677]

view, (%~), (^.), traverseOf)
edit in lib/Aftok/Payments.hs at line 17

[4.2972]

[4.2972]

import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
replacement in lib/Aftok/Payments.hs at line 42

[4.12460]→[4.12460:12495](∅→∅),[4.12495]→[4.3815:3845](∅→∅),[4.3845]→[4.7697:7731](∅→∅),[4.12522]→[4.7697:7731](∅→∅),[4.7731]→[4.3846:3876](∅→∅)

data BillingConfig = BillingConfig
{ _network :: BT.Network
, _signingKey :: RSA.PrivateKey
, _pkiData :: BT.PKIData

[4.12460]

[4.12579]

data PaymentsConfig = PaymentsConfig
{ _network :: !BT.Network
, _signingKey :: !RSA.PrivateKey
, _pkiData :: !BT.PKIData
replacement in lib/Aftok/Payments.hs at line 47

[4.12583]→[4.7732:7759](∅→∅)

makeClassy ''BillingConfig

[4.12583]

[4.7759]

makeClassy ''PaymentsConfig
replacement in lib/Aftok/Payments.hs at line 51

[4.2525]→[4.2525:2613](∅→∅)

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

[4.2525]

[4.2613]

memoGen :: Subscription' UserId Billable -- ^ subscription being billed
-> T.Day -- ^ billing date
-> C.UTCTime -- ^ payment request generation time
-> m (Maybe Text)
replacement in lib/Aftok/Payments.hs at line 56

[4.2657]→[4.2657:2703](∅→∅)

, uriGen :: PaymentKey -> m (Maybe URI)

[4.2657]

[4.2703]

, uriGen :: PaymentKey -- ^ payment key to be included in the URL
-> m (Maybe URI)
replacement in lib/Aftok/Payments.hs at line 59

[4.2743]→[4.2743:2837](∅→∅)

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

[4.2743]

[4.8102]

, payloadGen :: Subscription' UserId Billable -- ^ subscription being billed
-> T.Day -- ^ billing date
-> C.UTCTime -- ^ payment request generation time
-> m (Maybe ByteString)
replacement in lib/Aftok/Payments.hs at line 66

[4.4107]→[4.8134:8387](∅→∅),[4.8134]→[4.8134:8387](∅→∅)

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

[4.4107]

[4.12610]

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

[4.8406]→[4.8406:8460](∅→∅)

= Overdue SubscriptionId
| SigningError RSA.Error

[4.8406]

[4.8460]

= Overdue !SubscriptionId
| SigningError !RSA.Error
edit in lib/Aftok/Payments.hs at line 75

[4.4109]

[4.8496]

{--
- Find all the subscriptions for the specified customer, and
- determine which if any are up for renewal. Create a payment
- request for each such subscription.
--}
replacement in lib/Aftok/Payments.hs at line 81

[4.8537]→[4.8537:8600](∅→∅)

, MonadReader r m, HasBillingConfig r

[4.8537]

[4.8600]

, MonadReader r m, HasPaymentsConfig r
replacement in lib/Aftok/Payments.hs at line 96

[4.9242]→[4.9242:9285](∅→∅)

, MonadReader r m, HasBillingConfig r

[4.9242]

[4.9285]

, MonadReader r m, HasPaymentsConfig r
replacement in lib/Aftok/Payments.hs at line 106

[4.9610]→[4.9610:9653](∅→∅)

traverse findBillable sub

[4.9610]

[4.9653]

traverseOf billable findBillable sub
replacement in lib/Aftok/Payments.hs at line 114

[4.9996]→[4.9996:10039](∅→∅)

, MonadReader r m, HasBillingConfig r

[4.9996]

[4.10039]

, MonadReader r m, HasPaymentsConfig r
replacement in lib/Aftok/Payments.hs at line 167

[4.5206]→[4.12525:12573](∅→∅),[4.12525]→[4.12525:12573](∅→∅)

in maybe ifUnpaid Paid <$> findPayment reqid

[4.5206]

[4.13890]

in maybe ifUnpaid Paid <$> runMaybeT (findPayment reqid)
replacement in lib/Aftok/Payments.hs at line 171

[4.12639]→[4.4666:4754](∅→∅)

createPaymentDetails :: (MonadRandom m, MonadReader r m, HasBillingConfig r, MonadDB m)

[4.12639]

[4.12728]

createPaymentDetails :: (MonadRandom m, MonadReader r m, HasPaymentsConfig r, MonadDB m)
replacement in lib/Aftok/Payments.hs at line 215

[4.6086]→[4.15514:15733](∅→∅)

createOutputs _ (TL.CreditToUser uid) amt = do
addrMay <- (>>= view userAddress) <$> findUser uid
let createOutput addr = BT.Output amt (PayPKHash (addr ^. _BtcAddr))
pure . maybeToList $ createOutput <$> addrMay

[4.6086]

[4.6287]

createOutputs _ (TL.CreditToUser uid) amt = (fmap maybeToList) . runMaybeT $ do
user <- findUser uid
addr <- MaybeT . pure $ user ^. userAddress
pure $ BT.Output amt (PayPKHash (addr ^. _BtcAddr))
replacement in lib/Aftok/TimeLog.hs at line 38

[4.1225]→[4.2070:2178](∅→∅)

data LogEvent = StartWork { _eventTime :: C.UTCTime }
| StopWork { _eventTime :: C.UTCTime }

[4.1225]

[4.1237]

data LogEvent = StartWork { _eventTime :: !C.UTCTime }
| StopWork { _eventTime :: !C.UTCTime }
replacement in lib/Aftok/TimeLog.hs at line 60

[4.4662]→[4.1546:1574](∅→∅)

= CreditToAddress BtcAddr

[4.4662]

[4.4691]

= CreditToAddress !BtcAddr
replacement in lib/Aftok/TimeLog.hs at line 62

[4.4762]→[4.4762:4786](∅→∅)

| CreditToUser UserId

[4.4762]

[4.1575]

| CreditToUser !UserId
replacement in lib/Aftok/TimeLog.hs at line 64

[4.1635]→[4.4847:4877](∅→∅),[4.4847]→[4.4847:4877](∅→∅)

| CreditToProject ProjectId

[4.1635]

[4.4877]

| CreditToProject !ProjectId
replacement in lib/Aftok/TimeLog.hs at line 74

[4.4721]→[4.4927:4954](∅→∅),[4.4954]→[4.4747:4774](∅→∅),[4.4747]→[4.4747:4774](∅→∅),[4.4774]→[4.1784:1816](∅→∅),[4.1784]→[4.1784:1816](∅→∅)

{ _creditTo :: CreditTo
, _event :: LogEvent
, _eventMeta :: Maybe A.Value

[4.4721]

[4.613]

{ _creditTo :: !CreditTo
, _event :: !LogEvent
, _eventMeta :: !(Maybe A.Value)
replacement in lib/Aftok/TimeLog.hs at line 91

[4.5813]→[4.6721:6772](∅→∅),[4.6772]→[4.5005:5059](∅→∅),[4.5059]→[4.6824:6877](∅→∅),[4.6824]→[4.6824:6877](∅→∅)

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

[4.5813]

[4.6877]

data EventAmendment = TimeChange !ModTime !C.UTCTime
| CreditToChange !ModTime !CreditTo
| MetadataChange !ModTime !A.Value
edit in lib/Aftok/Util.hs at line 7

[4.5594]

[4.5594]

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

[4.5637]

[4.5637]

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

[4.7007]

fromMaybeT :: (Monad m) => m a -> MaybeT m a -> m a
fromMaybeT a m = maybeT a pure m
replacement in lib/Aftok.hs at line 44

[4.2885]→[4.6188:6217](∅→∅),[4.6217]→[4.7359:7393](∅→∅),[4.7393]→[4.6218:6244](∅→∅),[4.2939]→[4.6218:6244](∅→∅)

{ _username :: UserName
, _userAddress :: Maybe BtcAddr
, _userEmail :: Email

[4.2885]

[4.2962]

{ _username :: !UserName
, _userAddress :: !(Maybe BtcAddr)
, _userEmail :: !Email
replacement in migrations/2016-10-14_02-49-36_event-amendments.txt at line 42

[4.3899]→[4.3899:3971](∅→∅)

alter table work_events rename column credit_to_btc_addr to btc_addr;

[4.3899]

[4.3971]

alter table work_events rename column credit_to_address to btc_addr;
file addition: 2017-06-08_04-37-31_event-metadata-ids.txt (----------)

[86.1]

Description: Add missing identifiers to event metadata tables
Created: 2017-06-08 04:38:05.341636 UTC
Depends: 2016-10-14_02-49-36_event-amendments
Apply: |
alter table event_metadata_amendments
add column id uuid primary key default uuid_generate_v4();

alter table event_credit_to_amendments
add column id uuid primary key default uuid_generate_v4();

alter table event_time_amendments
add column id uuid primary key default uuid_generate_v4();
file addition: 2017-09-24_22-06-01_billing-templates.txt (----------)

[86.1]

Description: (Describe migration here.)
Created: 2017-09-24 22:06:53.509947 UTC
Depends: 2016-12-31_03-45-17_create-payments
Apply: |
alter table billables add column payment_request_email_template text null;
alter table billables add column payment_request_memo_template text null;

Revert: |
alter table billables drop column payment_request_email_template;
alter table billables drop column payment_request_memo_template;
replacement in server/Aftok/QConfig.hs at line 4

[4.4529]→[4.6509:6540](∅→∅)

import ClassyPrelude

[4.4529]

[4.4551]

import ClassyPrelude hiding (FilePath)
replacement in server/Aftok/QConfig.hs at line 6

[4.4552]→[4.6541:6593](∅→∅)

import qualified Data.ByteString.Char8 as C

[4.4552]

[4.6593]

import qualified Data.ByteString.Char8 as C8
replacement in server/Aftok/QConfig.hs at line 9

[4.6698]→[4.33:60](∅→∅),[4.60]→[4.5065:5144](∅→∅),[4.5144]→[4.124:177](∅→∅),[4.124]→[4.124:177](∅→∅),[4.177]→[4.6698:6900](∅→∅),[4.16760]→[4.6698:6900](∅→∅),[4.6698]→[4.6698:6900](∅→∅)

import Data.X509
import Data.X509.File (readKeyFile, readSignedObject)
import qualified Network.Bippy.Types as BT
import qualified Network.Mail.SMTP as SMTP
import qualified Network.Socket as NS
import System.Environment
import System.IO (FilePath)

[4.6698]

[4.4736]

import System.Environment (getEnvironment)
import Filesystem.Path.CurrentOS (FilePath, fromText, encodeString)
replacement in server/Aftok/QConfig.hs at line 16

[4.4839]→[4.5145:5198](∅→∅)

import qualified Aftok.Payments as AP

[4.4839]

[4.216]

import Aftok.Config
replacement in server/Aftok/QConfig.hs at line 21

[4.7086]→[4.7086:7126](∅→∅)

, authSiteKey :: System.IO.FilePath

[4.7086]

[4.4944]

, authSiteKey :: FilePath
replacement in server/Aftok/QConfig.hs at line 26

[4.253]→[4.7190:7230](∅→∅),[4.16792]→[4.7190:7230](∅→∅),[4.7190]→[4.7190:7230](∅→∅),[4.7230]→[4.2054:2096](∅→∅),[4.2096]→[4.7230:7234](∅→∅),[4.7230]→[4.7230:7234](∅→∅),[4.7234]→[4.377:378](∅→∅),[4.5084]→[4.377:378](∅→∅),[4.378]→[4.7235:7264](∅→∅),[4.7264]→[4.408:472](∅→∅),[4.408]→[4.408:472](∅→∅),[4.472]→[4.7265:7325](∅→∅)

, templatePath :: System.IO.FilePath
, staticAssetPath :: System.IO.FilePath
}

data SmtpConfig = SmtpConfig
{ smtpHost :: NS.HostName
, smtpPort :: Maybe NS.PortNumber
, smtpUser :: SMTP.UserName
, smtpPass :: SMTP.Password

[4.253]

[4.534]

, templatePath :: FilePath
, staticAssetPath :: FilePath
replacement in server/Aftok/QConfig.hs at line 30

[4.5085]→[4.254:289](∅→∅),[4.289]→[4.1020:1196](∅→∅),[4.1196]→[4.392:396](∅→∅),[4.5274]→[4.392:396](∅→∅),[4.392]→[4.392:396](∅→∅),[4.396]→[4.16851:16852](∅→∅),[4.16851]→[4.16851:16852](∅→∅),[4.16852]→[4.5085:5133](∅→∅),[4.5085]→[4.5085:5133](∅→∅)

data BillingConfig = BillingConfig
{ network :: BT.Network
, signingKeyFile :: System.IO.FilePath
, certsFile :: System.IO.FilePath
, exchangeRateServiceURI :: String
}

loadQConfig :: System.IO.FilePath -> IO QConfig

[4.5085]

[4.7326]

loadQConfig :: FilePath -> IO QConfig
replacement in server/Aftok/QConfig.hs at line 33

[4.5183]→[4.7352:7389](∅→∅),[4.7389]→[4.5221:5294](∅→∅),[4.5221]→[4.5221:5294](∅→∅)

cfg <- C.load [C.Required cfgFile]
let dbEnvCfg = pgsDefaultConfig . C.pack <$> lookup "DATABASE_URL" env

[4.5183]

[4.5294]

cfg <- C.load [C.Required $ encodeString cfgFile]
let dbEnvCfg = pgsDefaultConfig . C8.pack <$> lookup "DATABASE_URL" env
replacement in server/Aftok/QConfig.hs at line 41

[4.7458]→[4.5506:5544](∅→∅),[4.5506]→[4.5506:5544](∅→∅)

<*> C.require cfg "siteKey"

[4.7458]

[4.7459]

<*> (fromText <$> C.require cfg "siteKey")
replacement in server/Aftok/QConfig.hs at line 46

[2.266]→[4.3:83](∅→∅),[4.433]→[4.3:83](∅→∅),[4.572]→[4.3:83](∅→∅),[4.16885]→[4.3:83](∅→∅),[4.7925]→[4.3:83](∅→∅),[4.83]→[4.2097:2177](∅→∅)

<*> C.lookupDefault "/opt/aftok/server/templates/" cfg "templatePath"
<*> C.lookupDefault "/opt/aftok/server/static/" cfg "staticAssetPath"

[2.266]

[4.7968]

<*> (fromText <$> C.lookupDefault "/opt/aftok/server/templates/" cfg "templatePath")
<*> (fromText <$> C.lookupDefault "/opt/aftok/server/static/" cfg "staticAssetPath")
edit in server/Aftok/QConfig.hs at line 49

[4.7969]→[4.573:618](∅→∅),[4.618]→[4.7503:7524](∅→∅),[4.7524]→[4.640:836](∅→∅),[4.640]→[4.640:836](∅→∅),[4.836]→[4.5811:5812](∅→∅),[4.8170]→[4.5811:5812](∅→∅),[4.5811]→[4.5811:5812](∅→∅),[4.5812]→[4.434:485](∅→∅),[4.485]→[4.5275:5299](∅→∅),[4.5299]→[4.510:670](∅→∅),[4.510]→[4.510:670](∅→∅),[4.670]→[4.1197:1256](∅→∅),[4.1256]→[4.670:756](∅→∅),[4.670]→[4.670:756](∅→∅),[4.756]→[4.5300:5342](∅→∅),[4.813]→[4.17124:17125](∅→∅),[4.5342]→[4.17124:17125](∅→∅),[4.17124]→[4.17124:17125](∅→∅)

readSmtpConfig :: CT.Config -> IO SmtpConfig
readSmtpConfig cfg =
SmtpConfig <$> C.require cfg "smtpHost"
<*> ((fmap . fmap) fromInteger $ C.lookup cfg "smtpPort")
<*> C.require cfg "smtpUser"
<*> C.require cfg "smtpKey"

readBillingConfig :: CT.Config -> IO BillingConfig
readBillingConfig cfg =
BillingConfig <$> (parseNetwork <$> C.require cfg "network")
<*> C.require cfg "signingKeyFile"
<*> C.require cfg "certsFile"
<*> C.require cfg "exchangeRateServiceURI"
where parseNetwork :: String -> BT.Network
parseNetwork "main" = BT.MainNet
parseNetwork _ = BT.TestNet
edit in server/Aftok/QConfig.hs at line 59

[4.6294]→[4.814:1352](∅→∅)

toBillingConfig :: BillingConfig -> IO AP.BillingConfig
toBillingConfig c = do
privKeys <- readKeyFile (signingKeyFile c)
pkiEntries <- readSignedObject (certsFile c)
privKey <- case headMay privKeys of
Just (PrivKeyRSA k) -> pure k
Just (PrivKeyDSA _) -> fail "DSA keys not supported for payment request signing."
Nothing -> fail $ "No keys found in private key file " <> signingKeyFile c
let pkiData = BT.X509SHA256 . CertificateChain $ pkiEntries
pure $ AP.BillingConfig (network c) privKey pkiData
edit in server/Aftok/Snaplet/Auctions.hs at line 10

[4.2573]

[4.2573]

import Control.Monad.Trans.Maybe (mapMaybeT)
edit in server/Aftok/Snaplet/Auctions.hs at line 25

[4.2894]

[4.2894]

import Aftok.Util (fromMaybeT)
replacement in server/Aftok/Snaplet/Auctions.hs at line 58

[4.1105]→[4.1164:1244](∅→∅),[4.1244]→[4.1150:1231](∅→∅),[4.1150]→[4.1150:1231](∅→∅)

maybeAuc <- snapEval $ findAuction aid uid -- this will verify auction access
maybe (snapError 404 $ "Auction not found for id " <> tshow aid) pure maybeAuc

[4.1105]

[4.1245]

fromMaybeT
(snapError 404 $ "Auction not found for id " <> tshow aid)
(mapMaybeT snapEval $ findAuction aid uid) -- this will verify auction access
edit in server/Aftok/Snaplet/Auth.hs at line 6

[4.7666]

[4.5724]

import Control.Error.Util (maybeT)
import Control.Monad.Trans.Maybe (mapMaybeT)
replacement in server/Aftok/Snaplet/Auth.hs at line 34

[4.1780]→[4.1400:1458](∅→∅),[4.1458]→[4.11752:11803](∅→∅),[4.1524]→[4.2024:2042](∅→∅),[4.11803]→[4.2024:2042](∅→∅),[4.2024]→[4.2024:2042](∅→∅),[4.2042]→[4.8265:8350](∅→∅),[4.8350]→[4.8071:8100](∅→∅),[4.2128]→[4.8071:8100](∅→∅)

currentUser <- UserName . AU.userLogin <$> requireLogin
qdbUser <- snapEval $ findUserByName currentUser
case qdbUser of
Nothing -> snapError 403 "Unable to retrieve user record for authenticated user"
Just u -> pure (u ^. _1)

[4.1742]

[4.2161]

currentUser <- UserName . AU.userLogin <$> requireUser
maybeT
(snapError 403 "Unable to retrieve user record for authenticated user")
(pure . (^. _1))
(mapMaybeT snapEval $ findUserByName currentUser)
file addition: Billing.hs (----------)

[4.2082]

{-# LANGUAGE TemplateHaskell #-}

module Aftok.Snaplet.Billing
( billableCreateHandler
, billableListHandler
, subscribeHandler
) where

import ClassyPrelude

import Control.Lens ((^.))
import Data.Aeson
import Data.Aeson.Types
import Data.Thyme.Clock as C
import Data.Thyme.Time.Core (toThyme)

import Snap.Snaplet as S

import Aftok (UserId)
import Aftok.Billables
import Aftok.Json
import Aftok.Types
import Aftok.Project
import Aftok.Database (createBillable, withProjectAuth, liftdb, DBOp(..))

import Aftok.Snaplet
import Aftok.Snaplet.Auth

parseCreateBillable :: UserId -> ProjectId -> Value -> Parser Billable
parseCreateBillable uid pid = unversion "Billable" p where
p (Version 1 0) o =
Billable <$> pure pid
<*> pure uid
<*> o .: "name"
<*> o .: "description"
<*> (parseRecurrence' =<< o .: "recurrence")
<*> (Satoshi <$> o .: "amount")
<*> o .: "gracePeriod"
<*> (fmap toThyme <$> o .: "requestExpiryPeriod")
<*> o .:? "paymentRequestEmailTemplate"
<*> o .:? "paymentRequestMemoTemplate"

p v o = badVersion "Billable" v o

billableCreateHandler :: S.Handler App App BillableId
billableCreateHandler = do
uid <- requireUserId
pid <- requireProjectId
requestBody <- readRequestJSON 4096
b <- either (snapError 400 . tshow) pure $ parseEither (parseCreateBillable uid pid) requestBody
snapEval $ createBillable uid b

billableListHandler :: S.Handler App App [(BillableId, Billable)]
billableListHandler = do
uid <- requireUserId
pid <- requireProjectId
snapEval $ withProjectAuth pid uid (FindBillables pid)

subscribeHandler :: S.Handler App App SubscriptionId
subscribeHandler = do
uid <- requireUserId
bid <- requireId "billableId" BillableId
t <- liftIO C.getCurrentTime
snapEval . liftdb $ CreateSubscription uid bid (t ^. C._utctDay)
replacement in server/Aftok/Snaplet/Payments.hs at line 9

[4.9800]→[4.9800:9831](∅→∅)

import ClassyPrelude

[4.9800]

[4.5782]

import ClassyPrelude
replacement in server/Aftok/Snaplet/Payments.hs at line 11

[4.5783]→[4.1295:1383](∅→∅)

import Control.Lens (view, _1, _2, _Right, _Left, preview, (&), (.~))

[4.5783]

[4.3559]

import Control.Lens (view, _1, _2, _Right, _Left, preview, (&), (.~), (^.))
import Control.Monad.Trans.Maybe (mapMaybeT)
edit in server/Aftok/Snaplet/Payments.hs at line 26

[4.5963]

[4.5963]

import Aftok.Config as AC
replacement in server/Aftok/Snaplet/Payments.hs at line 29

[4.3883]→[4.5996:6028](∅→∅),[4.5996]→[4.5996:6028](∅→∅)

import Aftok.Payments

[4.3883]

[4.9900]

import Aftok.Payments
import Aftok.Util (fromMaybeT)
edit in server/Aftok/Snaplet/Payments.hs at line 32

[4.9901]→[4.1731:1775](∅→∅)

import Aftok.QConfig as QC
replacement in server/Aftok/Snaplet/Payments.hs at line 46

[4.3971]→[4.1776:1850](∅→∅)

paymentResponseHandler :: QC.BillingConfig -> S.Handler App App PaymentId

[4.3971]

[4.1850]

paymentResponseHandler :: AC.BillingConfig -> S.Handler App App PaymentId
replacement in server/Aftok/Snaplet/Payments.hs at line 59

[4.2064]→[4.2064:2164](∅→∅)

exchResp <- liftIO . try $ asValue =<< (withOpenSSL $ getWith opts (exchangeRateServiceURI cfg))

[4.2064]

[4.2164]

exchResp <- liftIO . try $ asValue =<< (withOpenSSL $ getWith opts (cfg ^. exchangeRateServiceURI))
replacement in server/Aftok/Snaplet/Payments.hs at line 70

[4.1786]→[4.1786:1934](∅→∅),[4.1934]→[4.4667:4686](∅→∅)

prMay <- snapEval $ findPaymentRequest pkey
maybe (snapError 404 $ "Outstanding payment request not found for key " <> (view _PaymentKey pkey))
pure prMay

[4.1786]

[4.5392]

fromMaybeT
(snapError 404 $ "Outstanding payment request not found for key " <> (view _PaymentKey pkey))
(mapMaybeT snapEval $ findPaymentRequest pkey)
replacement in server/Aftok/Snaplet/Projects.hs at line 11

[4.2463]→[4.2042:2073](∅→∅)

import ClassyPrelude

[4.2463]

[4.2485]

import ClassyPrelude hiding (FilePath)
edit in server/Aftok/Snaplet/Projects.hs at line 14

[4.2104]

[4.2104]

import Control.Monad.Trans.Maybe (mapMaybeT, runMaybeT)
edit in server/Aftok/Snaplet/Projects.hs at line 18

[4.2263]

[4.2263]

import Filesystem.Path.CurrentOS (FilePath, encodeString)
edit in server/Aftok/Snaplet/Projects.hs at line 21

[4.2350]→[4.2350:2405](∅→∅)

import System.IO (FilePath)
edit in server/Aftok/Snaplet/Projects.hs at line 24

[4.2466]

[4.2466]

import Aftok.Config
replacement in server/Aftok/Snaplet/Projects.hs at line 27

[4.3928]→[4.2498:2529](∅→∅),[4.2498]→[4.2498:2529](∅→∅)

import Aftok.QConfig

[4.3928]

[4.2529]

import Aftok.QConfig as QC
edit in server/Aftok/Snaplet/Projects.hs at line 30

[4.2596]

[4.2650]

import Aftok.Util (fromMaybeT)
replacement in server/Aftok/Snaplet/Projects.hs at line 58

[4.12379]→[4.12379:12418](∅→∅),[4.12418]→[4.3610:3685](∅→∅),[4.3610]→[4.3610:3685](∅→∅)

mp <- snapEval $ findProject pid uid
maybe (snapError 404 $ "Project not found for id " <> tshow pid) pure mp

[4.12379]

[4.8936]

fromMaybeT
(snapError 404 $ "Project not found for id " <> tshow pid)
(mapMaybeT snapEval $ findUserProject uid pid)
replacement in server/Aftok/Snaplet/Projects.hs at line 69

[4.2697]→[4.9219:9278](∅→∅),[4.9219]→[4.9219:9278](∅→∅)

(,,) <$> findUser uid
<*> findProject pid uid

[4.2697]

[4.9278]

(,,) <$> (runMaybeT $ findUser uid)
<*> (runMaybeT $ findUserProject uid pid)
replacement in server/Aftok/Snaplet/Projects.hs at line 82

[4.2837]→[4.1332:1459](∅→∅),[4.1332]→[4.1332:1459](∅→∅)

let SmtpConfig{..} = smtpConfig cfg
mailer = maybe (sendMailWithLogin smtpHost) (sendMailWithLogin' smtpHost) smtpPort

[4.2837]

[4.2838]

let SmtpConfig{..} = QC.smtpConfig cfg
mailer = maybe (sendMailWithLogin _smtpHost) (sendMailWithLogin' _smtpHost) _smtpPort
replacement in server/Aftok/Snaplet/Projects.hs at line 85

[4.2920]→[4.1542:1575](∅→∅),[4.1542]→[4.1542:1575](∅→∅)

(mailer smtpUser smtpPass)

[4.2920]

[4.2921]

(mailer _smtpUser _smtpPass)
replacement in server/Aftok/Snaplet/Projects.hs at line 88

[4.9688]→[4.2923:2969](∅→∅)

buildProjectInviteEmail :: System.IO.FilePath

[4.9688]

[4.2969]

buildProjectInviteEmail :: FilePath
replacement in server/Aftok/Snaplet/Projects.hs at line 95

[4.1953]→[4.3052:3095](∅→∅)

templates <- directoryGroup templatePath

[4.1953]

[4.1954]

templates <- directoryGroup $ encodeString templatePath
edit in server/Aftok/Snaplet/WorkLog.hs at line 6

[4.9655]

[4.9655]

import Control.Monad.Trans.Maybe (mapMaybeT)
edit in server/Aftok/Snaplet/WorkLog.hs at line 19

[4.9959]

[4.5728]

import Aftok.Util (fromMaybeT)
replacement in server/Aftok/Snaplet/WorkLog.hs at line 74

[4.13074]→[4.10204:10251](∅→∅),[4.10251]→[4.13122:13216](∅→∅),[4.13122]→[4.13122:13216](∅→∅)

projectMay <- snapEval $ findProject pid uid
project <- maybe (snapError 400 $ "Project not found for id " <> tshow pid) pure projectMay

[4.13074]

[4.13216]

project <- fromMaybeT
(snapError 400 $ "Project not found for id " <> tshow pid)
(mapMaybeT snapEval $ findUserProject uid pid)
replacement in server/Aftok/Snaplet.hs at line 11

[4.10564]→[4.10564:10608](∅→∅)

import Control.Monad.Trans.Either

[4.10564]

[4.10608]

import Control.Monad.Trans.Except (runExceptT)
replacement in server/Aftok/Snaplet.hs at line 50

[4.11873]→[4.18921:19002](∅→∅)

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

[4.11873]

[4.11945]

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

[4.1461]→[4.11196:11227](∅→∅)

import ClassyPrelude

[4.1461]

[4.5259]

import ClassyPrelude hiding (FilePath)
edit in server/Main.hs at line 6

[4.11294]

[4.7988]

import Data.Either.Combinators (fromRight)
edit in server/Main.hs at line 9

[4.8139]

[4.11294]

import Filesystem.Path.CurrentOS (decodeString, encodeString)
edit in server/Main.hs at line 18

[4.4162]

[4.2232]

import Aftok.Snaplet.Billing
replacement in server/Main.hs at line 35

[4.1730]→[4.1730:1796](∅→∅)

cfg <- loadQConfig $ either (const "conf/aftok.cfg") id cfgPath

[4.1730]

[4.8231]

cfg <- loadQConfig . decodeString $ fromRight "conf/aftok.cfg" cfgPath
replacement in server/Main.hs at line 42

[4.11874]→[4.19134:19237](∅→∅)

initCookieSessionManager (authSiteKey cfg) "quookie" (Just "aftok.com") (cookieTimeout cfg)

[4.11874]

[4.12521]

initCookieSessionManager (encodeString $ authSiteKey cfg) "quookie" (Just "aftok.com") (cookieTimeout cfg)
replacement in server/Main.hs at line 46

[4.2275]→[4.2286:2548](∅→∅)

let loginRoute = method GET requireLogin >> redirect "/home"
xhrLoginRoute = void $ method POST requireLogin
registerRoute = void $ method POST registerHandler
acceptInviteRoute = void $ method POST acceptInvitationHandler

[4.2275]

[4.212]

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

inviteRoute = void $ method POST (projectInviteHandler cfg)
acceptInviteRoute = void $ method POST acceptInvitationHandler
replacement in server/Main.hs at line 54

[4.1972]→[4.1972:2064](∅→∅)

listProjectsRoute = serveJSON (fmap qdbProjectJSON) $ method GET projectListHandler

[4.1972]

[4.2397]

projectListRoute = serveJSON (fmap qdbProjectJSON) $ method GET projectListHandler
edit in server/Main.hs at line 57

[4.2146]→[4.2146:2229](∅→∅),[4.2229]→[4.674:760](∅→∅)

logWorkRoute f = serveJSON eventIdJSON $ method POST (logWorkHandler f)
logWorkBTCRoute f = serveJSON eventIdJSON $ method POST (logWorkBTCHandler f)
edit in server/Main.hs at line 59

[4.2492]

[4.2492]
replacement in server/Main.hs at line 61

[4.2570]→[4.2570:2644](∅→∅)

inviteRoute = void . method POST $ projectInviteHandler cfg

[4.2570]

[4.12970]

logWorkRoute f = serveJSON eventIdJSON $ method POST (logWorkHandler f)
logWorkBTCRoute f = serveJSON eventIdJSON $ method POST (logWorkBTCHandler f)
amendEventRoute = serveJSON amendmentIdJSON $ method PUT amendEventHandler
replacement in server/Main.hs at line 67

[4.2732]→[4.2732:2893](∅→∅)

auctionRoute = serveJSON auctionJSON $ method GET auctionGetHandler
auctionBidRoute = serveJSON bidIdJSON $ method POST auctionBidHandler

[4.2732]

[4.4230]

auctionRoute = serveJSON auctionJSON $ method GET auctionGetHandler
auctionBidRoute = serveJSON bidIdJSON $ method POST auctionBidHandler
replacement in server/Main.hs at line 70

[4.4231]→[4.8181:8276](∅→∅),[4.8276]→[4.4688:4797](∅→∅),[4.4797]→[4.2396:2495](∅→∅)

payableRequestsRoute = serveJSON billDetailsJSON $ method GET listPayableRequestsHandler
paymentRoute = (writeLBS . runPutLazy . encodeMessage =<< method GET getPaymentRequestHandler)
<|> (void . method POST . paymentResponseHandler $ billingConfig cfg)

[4.4231]

[4.8383]

billableCreateRoute = serveJSON billableIdJSON $ method POST billableCreateHandler
billableListRoute = serveJSON (fmap qdbBillableJSON) $ method GET billableListHandler
subscribeRoute = serveJSON subscriptionIdJSON $ method POST subscribeHandler
replacement in server/Main.hs at line 74

[4.8384]→[4.2894:2979](∅→∅),[4.4231]→[4.2894:2979](∅→∅)

amendEventRoute = serveJSON amendmentIdJSON $ method PUT amendEventHandler

[4.8384]

[4.2549]

payableRequestsRoute = serveJSON billDetailsJSON $ method GET listPayableRequestsHandler
getPaymentRequestRoute = writeLBS . runPutLazy . encodeMessage =<< method GET getPaymentRequestHandler
submitPaymentRoute = serveJSON paymentIdJSON $ method POST (paymentResponseHandler $ billingConfig cfg)
replacement in server/Main.hs at line 78

[4.2550]→[4.2550:2613](∅→∅)

addRoutes [ ("static", serveDirectory $ staticAssetPath cfg)

[4.2550]

[4.2569]

addRoutes [ ("static", serveDirectory . encodeString $ staticAssetPath cfg)
edit in server/Main.hs at line 89

[4.920]→[4.614:690](∅→∅)

, ("projects/:projectId/auctions", auctionCreateRoute)
edit in server/Main.hs at line 91

[4.3779]

[4.13136]

, ("projects/:projectId/auctions", auctionCreateRoute) -- <|> auctionListRoute
, ("projects/:projectId/billables", billableCreateRoute <|> billableListRoute)
replacement in server/Main.hs at line 96

[4.761]→[4.761:854](∅→∅)

, ("projects", projectCreateRoute)
, ("projects", listProjectsRoute)

[4.761]

[4.321]

, ("projects", projectCreateRoute <|> projectListRoute)
edit in server/Main.hs at line 101

[4.8386]

[4.8386]

, ("subscribe/:billableId", subscribeRoute)
replacement in server/Main.hs at line 103

[4.8473]→[4.4875:4930](∅→∅)

, ("pay/:paymentRequestKey", paymentRoute)

[4.8473]

[4.4299]

, ("pay/:paymentRequestKey", getPaymentRequestRoute <|> submitPaymentRoute)
replacement in server/Main.hs at line 112

[4.1271]→[4.1271:1308](∅→∅)

writeLBS =<< (A.encode . f <$> ma)

[4.1271]

value <- ma
writeLBS $ A.encode (f value)