Add endpoint for payment request creation.

[?]

Feb 7, 2021, 2:10 AM

H2ABVZI2NFTERQMJ2Z7WGMRNORV3OQQWCCFEN6YO5GAUT2ONM2MAC

Dependencies

[2] KKJSBWO6 Add createPaymentRequestHandler
[3] GMYPBCWE Make docker-compose work.
[4] I2KHGVD4 Require project permissions for access to most data.
[5] IR75ZMX3 Return actual events for interval ends, not just timestamps.
[6] X3ES7NUA Fine. I'll use ormolu. At least it doesn't break the code.
[7] MJDIMD5B Improve documentation of local docker-compose setup.
[8] O227CEAV Adds storage of original event JSON for some DBOp constructors.
[9] AL37SVTC Implement payments service endpoints.
[10] M3KUPGZK Add invitation email template.
[11] EFSXYZPO Autoformat everything with brittany.
[12] 4R7XIYK3 Switch from ClassyPrelude to Relude
[13] U256ZALI Add captcha check to register route.
[14] U7YAT2ZK Add error reporting to signup form.
[15] LTSVBVA2 Update to a recent haskoin-core. Fix Stack build.
[16] 64C6AWH6 Rename Ananke -> Quixotic, project reboot.
[17] ENNZIQJG Use live signup API for client.
[18] HMDM3B55 Implement core of payments/billing infrastructure.
[19] NEDDHXUK Reformat via stylish-haskell
[20] 6L5BK5EH Use generic SMTP rather than Sendmail-specific mail client.
[21] NLZ3JXLO Fix formatting with stylish-haskell.
[22] MU6WOCCJ Update auctions to permit zcash as a funding currency.
[23] PT4276XC Add logout functionality.
[24] IZEVQF62 Work in progress replacing sqlite with postgres.
[25] O5FVTOM6 Undo JSON silliness, enable a couple more routes.
[26] BROSTG5K Beginning of modularization of server.
[27] W35DDBFY Factor common JSON conversions up into client lib module.
[28] V2VDN77H Enable postgres configuration via environment variable for Heroku.
[29] BSIUHCGF Add payment response handler.
[30] WZFQDWW4 Add retrieval/storage of current exchange rate data to payment recording.
[31] 2XQD6KKK Add invitation logic and clean up DBProg error handling.
[32] 4B66XH43 Add sample billing config
[33] VJPT6HDR Fix remaining type errors after addition of login handler.
[34] B6HWAPDP Modularize & update to recent haskoin.
[35] MJ6R42RC Utility methods for reading key & cert data.
[36] UWMGUJOW Autoformat sources.
[37] QMRKFEPG Refactor QDB to use a free monad algebra instead.
[38] O2BZOX7M Add signup form, captcha check.
[39] DFOBMSAO Initial work on payments API
[40] 5IDB3IWS Integrate zcashd-based zaddr validation.
[41] XXJFUZOV Add first revenue date to project payout computation.
[42] 4354Y4PE Add endpoint to list project contributors.
[43] 4U7F3CPI THE GREAT RENAMING OF THINGS!
[44] M4PWY5RU Preliminary work to add support for Zcash payments.
[45] JFOEOFGA stylish-haskell formatting.
[46] A6HKMINB Attempting to improve JSON handling.
[47] IPG33FAW Add billing daemon
[*] QO4NFWIY Added sample config file.
[*] 2WOOGXDH Use dbmigrations to manage database state.
[*] PBD7LZYQ Postgres & auth are beginning to function.
[*] ADMKQQGC Initial empty Snap project.

Change contents

edit in aftok.cabal at line 85

[3.313]

[3.313]

, HStringTemplate
replacement in aftok.cabal at line 159

[3.454]→[3.454:485](∅→∅)

other-modules: Aftok.QConfig

[3.454]

[3.485]

other-modules: Aftok.ServerConfig
edit in aftok.cabal at line 212

[3.324]

[3.324]

, vector-space
replacement in conf/server/aftok.cfg at line 31

[3.12]→[3.12:31](∅→∅),[3.31]→[3.2591:2635](∅→∅),[3.2635]→[3.31:197](∅→∅),[3.31]→[3.31:197](∅→∅)

network = "test"
# Signing key for BIP-70 payment requests
signingKeyFile = "/etc/aftok/aftok.bip70.key.pem"
certsFile = "/etc/aftok/aftok.bip70-chain.cert.pem"
exchangeRateServiceURI = "https://blockchain.info/ticker"

[3.12]

[3.197]

bitcoin {
networkMode = "test"
# Signing key for BIP-70 payment requests
signingKeyFile = "/etc/aftok/aftok.bip70.key.pem"
certsFile = "/etc/aftok/aftok.bip70-chain.cert.pem"
exchangeRateServiceURI = "https://blockchain.info/ticker"
bip70Host = "localhost:8443"
}
zcash {
minPayment = 100
}
edit in daemon/AftokD/AftokM.hs at line 6

[3.925]

[3.468]

{-# LANGUAGE TypeApplications #-}
replacement in daemon/AftokD/AftokM.hs at line 12

[3.491]→[3.491:520](∅→∅)

( Billable,
Billable',

[3.491]

[3.520]

( Billable',
edit in daemon/AftokD/AftokM.hs at line 18

[3.655]→[3.655:687](∅→∅)

paymentRequestMemoTemplate,
edit in daemon/AftokD/AftokM.hs at line 23

[3.1073]→[3.1073:1116](∅→∅)

import Aftok.Currency.Zcash (Zatoshi (..))
edit in daemon/AftokD/AftokM.hs at line 26

[3.900]→[3.1117:1181](∅→∅)

import Aftok.Payments.Bitcoin (BillingOps (..), PaymentsConfig)
replacement in daemon/AftokD/AftokM.hs at line 27

[3.1224]→[3.1224:1271](∅→∅)

import qualified Aftok.Payments.Zcash as Zcash

[3.1224]

[3.1012]

import qualified Aftok.Payments.Bitcoin as Bitcoin
edit in daemon/AftokD/AftokM.hs at line 62

[3.1599]→[3.1599:1627](∅→∅)

import Data.Thyme.Time as C
replacement in daemon/AftokD/AftokM.hs at line 69

[3.1828]→[3.1828:1874](∅→∅)

import Network.URI
( URI,
parseURI,
)

[3.1828]

[3.1874]

import Network.URI (URI)
edit in daemon/AftokD/AftokM.hs at line 82

[3.3177]

[3.1993]

| MailGenError
replacement in daemon/AftokD/AftokM.hs at line 95

[3.2121]→[3.1576:1609](∅→∅)

_pcfg :: !PaymentsConfig

[3.2121]

[3.2156]

_pcfg :: !(P.PaymentsConfig AftokM)
edit in daemon/AftokD/AftokM.hs at line 98

[3.2165]→[3.3495:3519](∅→∅),[3.3495]→[3.3495:3519](∅→∅)

makeLenses ''AftokMEnv
edit in daemon/AftokD/AftokM.hs at line 106

[3.3863]

[3.3863]

makeLenses ''AftokMEnv
replacement in daemon/AftokD/AftokM.hs at line 117

[3.944]→[3.944:1014](∅→∅)

let f a = (a ^. dcfg . D.billingConfig . AC.networkMode, a ^. conn)

[3.944]

[3.1014]

let f a = (a ^. dcfg . D.billingConfig . AC.bitcoinConfig . AC.networkMode, a ^. conn)
replacement in daemon/AftokD/AftokM.hs at line 138

[3.4500]→[3.1977:2179](∅→∅)

btcCfg <- asks _pcfg
let btcOps = BillingOps _memoGen (fmap Just . bip70PaymentURL) _payloadGen
zecCfg = Zcash.PaymentsConfig (Zatoshi 100)
pcfg' = P.PaymentsConfig btcOps btcCfg zecCfg

[3.4500]

[3.4569]

pcfg' <- asks _pcfg
edit in daemon/AftokD/AftokM.hs at line 154

[3.5097]

[3.4767]

pcfg' <- liftIO $ AC.toPaymentsConfig @AftokM (cfg ^. dcfg . D.billingConfig)
replacement in daemon/AftokD/AftokM.hs at line 162

[3.2988]→[3.2988:3126](∅→∅)

bip70URL <- bip70PaymentURL (nreq ^. Bitcoin.paymentRequestKey)
mail <- buildBip70PaymentRequestEmail preqCfg req''' bip70URL

[3.2988]

[3.3126]

let bip70URIGen = Bitcoin.uriGen (pcfg' ^. P.bitcoinBillingOps)
bip70URL <- bip70URIGen (nreq ^. Bitcoin.paymentRequestKey)
mail <- traverse (buildBip70PaymentRequestEmail preqCfg req''') bip70URL
replacement in daemon/AftokD/AftokM.hs at line 170

[3.3286]→[3.3286:3333](∅→∅)

liftIO $ mailer _smtpUser _smtpPass mail

[3.3286]

[3.3333]

case mail of
Just email -> liftIO $ mailer _smtpUser _smtpPass email
Nothing -> throwError MailGenError
edit in daemon/AftokD/AftokM.hs at line 230

[3.3552]→[3.7417:7418](∅→∅),[3.7417]→[3.7417:7418](∅→∅),[3.7418]→[3.4765:4960](∅→∅),[3.4960]→[3.6448:6494](∅→∅),[3.7639]→[3.6448:6494](∅→∅),[3.6494]→[3.4961:5012](∅→∅),[3.5012]→[3.3875:3914](∅→∅),[3.6557]→[3.3875:3914](∅→∅),[3.3914]→[3.5013:5120](∅→∅),[3.5120]→[3.4043:4148](∅→∅),[3.4043]→[3.4043:4148](∅→∅),[3.4148]→[3.7983:8127](∅→∅),[3.7983]→[3.7983:8127](∅→∅),[3.8127]→[3.5121:5217](∅→∅),[3.5217]→[3.8197:8210](∅→∅),[3.8197]→[3.8197:8210](∅→∅),[3.8210]→[3.4149:4219](∅→∅),[3.4219]→[3.8280:8354](∅→∅),[3.6684]→[3.8280:8354](∅→∅),[3.8280]→[3.8280:8354](∅→∅),[3.8354]→[3.4220:4356](∅→∅),[3.4356]→[3.6804:6810](∅→∅),[3.6804]→[3.6804:6810](∅→∅),[3.6810]→[3.8454:8505](∅→∅),[3.8454]→[3.8454:8505](∅→∅),[3.8505]→[3.5218:5233](∅→∅),[3.5233]→[3.4371:4384](∅→∅),[3.4371]→[3.4371:4384](∅→∅),[3.4384]→[3.5234:5256](∅→∅),[3.5256]→[3.4419:4468](∅→∅),[3.4419]→[3.4419:4468](∅→∅),[3.4468]→[3.5257:5290](∅→∅)

_memoGen ::
DB.MonadDB m =>
Billable Satoshi ->
C.Day ->
C.UTCTime ->
m (Maybe Text)
_memoGen bill billingDate requestTime = do
req <- traverseOf B.project DB.findProjectOrError bill
let template =
(newSTMP . T.unpack)
<$> (bill ^. paymentRequestMemoTemplate)
setAttrs =
setManyAttrib
[ ("project_name", req ^. B.project . projectName),
("subscription", req ^. B.name),
("billing_date", show billingDate),
("issue_time", show requestTime)
]
pure $ fmap (render . setAttrs) template

-- The same URL is used for retrieving a BIP-70 payment request and for submitting
-- the response.
bip70PaymentURL :: Bitcoin.PaymentKey -> AftokM URI
bip70PaymentURL (Bitcoin.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 =>
Billable Satoshi ->
C.Day ->
C.UTCTime ->
m (Maybe ByteString)
_payloadGen _ _ _ = pure Nothing
edit in lib/Aftok/Config.hs at line 5

[3.10875]

[3.6265]

import qualified Aftok.Billing as B
import Aftok.Project (projectName)
edit in lib/Aftok/Config.hs at line 8

[3.6323]

[3.6323]

import qualified Aftok.Currency.Bitcoin.Payments as Bitcoin
import Aftok.Currency.Zcash (Zatoshi(..))
import Aftok.Database (MonadDB, findProjectOrError)
import Aftok.Payments (PaymentsConfig(..))
edit in lib/Aftok/Config.hs at line 13

[3.6374]

[3.9592]

import qualified Aftok.Payments.Zcash as Zcash
replacement in lib/Aftok/Config.hs at line 17

[3.9657]→[3.9657:9673](∅→∅)

makeClassy,

[3.9657]

[3.9673]

makeLenses,
traverseOf,
edit in lib/Aftok/Config.hs at line 22

[3.9763]

[3.9763]

import Data.Thyme.Clock (UTCTime)
import Data.Thyme.Time (Day)
edit in lib/Aftok/Config.hs at line 37

[3.10096]

[3.10096]

import Network.URI (URI, parseURI)
edit in lib/Aftok/Config.hs at line 39

[3.10118]

[3.11258]

import Text.StringTemplate
( newSTMP,
render,
setManyAttrib,
)
edit in lib/Aftok/Config.hs at line 45

[3.11259]

[3.10119]

readConnectInfo :: C.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"
edit in lib/Aftok/Config.hs at line 61

[3.10305]

[3.11464]

makeLenses ''SmtpConfig
replacement in lib/Aftok/Config.hs at line 64

[3.11626]→[3.11626:11650](∅→∅)

makeClassy ''SmtpConfig

[3.11465]

[3.11650]

readSmtpConfig :: C.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"
replacement in lib/Aftok/Config.hs at line 72

[3.11651]→[3.10306:10343](∅→∅)

data BillingConfig
= BillingConfig

[3.11651]

[3.10343]

data BitcoinConfig
= BitcoinConfig
replacement in lib/Aftok/Config.hs at line 78

[3.6418]→[3.6418:6449](∅→∅)

_minPayment :: Satoshi

[3.6418]

[3.10495]

_minPayment :: Satoshi,
_bip70Host :: NS.HostName
edit in lib/Aftok/Config.hs at line 81

[3.10503]

[3.10503]

makeLenses ''BitcoinConfig
replacement in lib/Aftok/Config.hs at line 84

[3.3797]→[3.11851:11878](∅→∅),[3.10504]→[3.11851:11878](∅→∅),[3.11851]→[3.11851:11878](∅→∅)

makeClassy ''BillingConfig

[3.10504]

[3.11878]

data BillingConfig
= BillingConfig
{ _bitcoinConfig :: BitcoinConfig
, _zcashConfig :: Zcash.PaymentsConfig
}
replacement in lib/Aftok/Config.hs at line 90

[3.11879]→[3.3798:3842](∅→∅),[3.3842]→[3.11924:11945](∅→∅),[3.11924]→[3.11924:11945](∅→∅),[3.11945]→[3.11613:11786](∅→∅)

readSmtpConfig :: C.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"

[3.11879]

[3.12141]

makeLenses ''BillingConfig
edit in lib/Aftok/Config.hs at line 95

[3.11803]

[3.11803]

<$> (readBitcoinConfig $ C.subconfig "bitcoin" cfg)
<*> (readZcashPaymentsConfig $ C.subconfig "zcash" cfg)

readBitcoinConfig :: C.Config -> IO BitcoinConfig
readBitcoinConfig cfg =
BitcoinConfig
edit in lib/Aftok/Config.hs at line 106

[3.6509]

[3.12593]

<*> C.require cfg "bip70Host"
replacement in lib/Aftok/Config.hs at line 108

[3.12594]→[3.3943:3989](∅→∅),[3.3989]→[3.12641:12663](∅→∅),[3.12641]→[3.12641:12663](∅→∅),[3.12663]→[3.11990:12157](∅→∅)

readConnectInfo :: C.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"

[3.12594]

[3.12866]

readZcashPaymentsConfig :: C.Config -> IO Zcash.PaymentsConfig
readZcashPaymentsConfig cfg =
Zcash.PaymentsConfig
<$> (Zatoshi <$> C.require cfg "minPayment")
replacement in lib/Aftok/Config.hs at line 113

[3.12867]→[3.6510:6573](∅→∅),[3.6573]→[3.12922:12946](∅→∅),[3.12922]→[3.12922:12946](∅→∅)

toPaymentsConfig :: BillingConfig -> IO Bitcoin.PaymentsConfig
toPaymentsConfig c = do

[3.12867]

[3.10505]

toBitcoinPaymentsConfig :: BitcoinConfig -> IO Bitcoin.PaymentsConfig
toBitcoinPaymentsConfig c = do
edit in lib/Aftok/Config.hs at line 129

[3.6657]

toPaymentsConfig :: MonadDB m => BillingConfig -> IO (PaymentsConfig m)
toPaymentsConfig cfg = do
btcCfg <- toBitcoinPaymentsConfig (cfg ^. bitcoinConfig)
let btcOps = Bitcoin.BillingOps _memoGen (_uriGen $ cfg ^. bitcoinConfig . bip70Host) _payloadGen
pure $ PaymentsConfig {
_bitcoinBillingOps = btcOps,
_bitcoinPaymentsConfig = btcCfg,
_zcashPaymentsConfig = cfg ^. zcashConfig
}

_memoGen ::
MonadDB m =>
B.Billable Satoshi ->
Day ->
UTCTime ->
m (Maybe Text)
_memoGen bill billingDate requestTime = do
req <- traverseOf B.project findProjectOrError bill
let template =
(newSTMP . toString)
<$> (bill ^. B.paymentRequestMemoTemplate)
setAttrs =
setManyAttrib
[ ("project_name", req ^. B.project . projectName),
("subscription", req ^. B.name),
("billing_date", show billingDate),
("issue_time", show requestTime)
]
pure $ fmap (render . setAttrs) template

_payloadGen ::
Monad m =>
B.Billable Satoshi ->
Day ->
UTCTime ->
m (Maybe ByteString)
_payloadGen _ _ _ = pure Nothing

-- The same URL is used for retrieving a BIP-70 payment request and for submitting
-- the response.
_uriGen ::
Monad m =>
NS.HostName ->
Bitcoin.PaymentKey
-> m (Maybe URI)
_uriGen hostname (Bitcoin.PaymentKey k) =
let paymentRequestPath = "https://" <> fromString hostname <> "/pay/" <> k
in pure . parseURI $ show paymentRequestPath
edit in lib/Aftok/Currency/Bitcoin/Bip70.hs at line 5

[3.6775]

[3.6775]

protoBase64,
fromBase64Proto,
edit in lib/Aftok/Currency/Bitcoin/Bip70.hs at line 11

[3.6805]

import qualified Data.ByteString.Base64 as B64
import Data.ProtocolBuffers (Decode, Encode, decodeMessage, encodeMessage)
import Data.Serialize.Get (runGet)
import Data.Serialize.Put (runPut)

protoBase64 :: Encode a => a -> Text
protoBase64 = B64.encodeBase64 . runPut . encodeMessage

fromBase64Proto :: Decode a => Text -> Either Text a
fromBase64Proto t = (first toText . runGet decodeMessage) <=< B64.decodeBase64 $ encodeUtf8 t
edit in lib/Aftok/Database/PostgreSQL/Json.hs at line 6

[3.43050]

[3.43050]

import qualified Aftok.Currency.Bitcoin.Bip70 as Bip70
edit in lib/Aftok/Database/PostgreSQL/Json.hs at line 25

[3.43644]→[3.43644:43836](∅→∅)

import qualified Data.ByteString.Base64 as B64
import Data.ProtocolBuffers (Decode, Encode, decodeMessage, encodeMessage)
import Data.Serialize.Get (runGet)
import Data.Serialize.Put (runPut)
edit in lib/Aftok/Database/PostgreSQL/Json.hs at line 29

[3.43945]→[3.43945:44187](∅→∅)

protoBase64 :: Encode a => a -> Text
protoBase64 = B64.encodeBase64 . runPut . encodeMessage

fromBase64Proto :: Decode a => Text -> Either Text a
fromBase64Proto t = (first toText . runGet decodeMessage) <=< B64.decodeBase64 $ encodeUtf8 t
replacement in lib/Aftok/Database/PostgreSQL/Json.hs at line 35

[3.44412]→[3.44412:44502](∅→∅)

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

[3.44412]

[3.44502]

"payment_request_protobuf_64" .= (r ^. Bitcoin.bip70Request . to Bip70.protoBase64)
replacement in lib/Aftok/Database/PostgreSQL/Json.hs at line 45

[3.44768]→[3.44768:44869](∅→∅)

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

[3.44768]

[3.44869]

<*> ( either (fail . toString) pure . Bip70.fromBase64Proto =<< (o .: "payment_request_protobuf_64")
replacement in lib/Aftok/Database/PostgreSQL/Json.hs at line 74

[3.45860]→[3.45860:45937](∅→∅)

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

[3.45860]

[3.45937]

"payment_protobuf_64" .= (bp ^. Bitcoin.bip70Payment . to Bip70.protoBase64)
replacement in lib/Aftok/Database/PostgreSQL/Json.hs at line 87

[3.46355]→[3.46355:46446](∅→∅)

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

[3.46355]

[3.46446]

<*> ( either (fail . unpack) pure . Bip70.fromBase64Proto =<< (o .: "payment_protobuf_64")
replacement in lib/Aftok/Database/PostgreSQL/Users.hs at line 96

[3.59401]→[3.59401:59471](∅→∅)

AND currency = 'BTC'
AND is_primary = true |]

[3.59401]

[3.59471]

AND is_primary = true
AND btc_addr IS NOT NULL |]
replacement in lib/Aftok/Database/PostgreSQL/Users.hs at line 105

[3.59666]→[3.59666:59736](∅→∅)

AND currency = 'ZEC'
AND is_primary = true |]

[3.59666]

[3.59736]

AND is_primary = true
AND zcash_addr IS NOT NULL |]
replacement in lib/Aftok/Json.hs at line 13

[3.68533]→[3.31638:31668](∅→∅),[3.31638]→[3.31638:31668](∅→∅),[3.31668]→[3.68534:68573](∅→∅)

import Aftok.Currency.Bitcoin
import Aftok.Currency.Zcash (_Zatoshi)

[3.68533]

[3.31738]

import Aftok.Currency.Bitcoin (Address, NetworkMode, Satoshi, _Satoshi, getNetwork)
import Aftok.Currency.Zcash (Zatoshi, _Zatoshi)
replacement in lib/Aftok/Json.hs at line 165

[3.70780]→[3.70780:70882](∅→∅)

BTC -> object ["satoshi" .= (value ^. _Satoshi)]
ZEC -> object ["zatoshi" .= (value ^. _Zatoshi)]

[3.70780]

[3.70882]

BTC -> satsJSON value
ZEC -> zatsJSON value

zatsJSON :: Zatoshi -> Value
zatsJSON value = object ["zatoshi" .= (value ^. _Zatoshi)]
edit in lib/Aftok/Json.hs at line 171

[3.70883]

[3.6100]

satsJSON :: Satoshi -> Value
satsJSON value = object ["satoshi" .= (value ^. _Satoshi)]
file addition: 2021-02-07_02-43-08_account_detail.txt (----------)

[50.1]

Description: (Describe migration here.)
Created: 2021-02-07 02:43:18.803817984 UTC
Depends: 2020-11-25_04-22-24_zcash-support
Apply: |
ALTER TABLE cryptocurrency_accounts ADD COLUMN name text;
ALTER TABLE cryptocurrency_accounts ADD COLUMN description text;
ALTER TABLE cryptocurrency_accounts DROP COLUMN currency;
file addition: create_payment_request.sh (---r------)

[51.1220]

#!/bin/bash

if [ -f ".env" ]; then
source .env
fi

if [ -z "${AFTOK_HOST}" ]; then
AFTOK_HOST="aftok.com"
fi

if [ -z "${PID}" ]; then
read -p "Project UUID: " PID
echo
fi

if [ -z "${USER}" ]; then
read -p "Username: " USER
echo
fi

read -p "Billable ID: " BID

curl --verbose \
${ALLOW_INSECURE} \
--user $USER \
--header "Content-Type: application/json" \
--data "{}" \
"https://$AFTOK_HOST/api/projects/$PID/billables/$BID/paymentRequests"
file move: QConfig.hs (----------) → ServerConfig.hs (----------)

[3.2063]

[3.4500]
replacement in server/Aftok/ServerConfig.hs at line 4

[3.16707]→[3.4501:4528](∅→∅),[3.24951]→[3.4501:4528](∅→∅),[3.4500]→[3.4501:4528](∅→∅)

module Aftok.QConfig where

[3.24951]

[3.4551]

module Aftok.ServerConfig where
edit in server/Aftok/ServerConfig.hs at line 26

[3.56477]

[3.4838]
replacement in server/Aftok/ServerConfig.hs at line 28

[3.4839]→[3.56478:56503](∅→∅)

data QConfig
= QConfig

[3.4839]

[3.56503]

data ServerConfig
= ServerConfig
replacement in server/Aftok/ServerConfig.hs at line 43

[3.538]→[3.25451:25472](∅→∅)

makeLenses ''QConfig

[3.217]

[3.5084]

makeLenses ''ServerConfig
replacement in server/Aftok/ServerConfig.hs at line 45

[3.5085]→[3.4378:4418](∅→∅),[3.4418]→[3.7326:7351](∅→∅),[3.32776]→[3.7326:7351](∅→∅),[3.5133]→[3.7326:7351](∅→∅)

loadQConfig :: P.FilePath -> IO QConfig
loadQConfig cfgFile = do

[3.5085]

[3.5159]

loadServerConfig :: P.FilePath -> IO ServerConfig
loadServerConfig cfgFile = do
replacement in server/Aftok/ServerConfig.hs at line 50

[3.4495]→[3.4495:4522](∅→∅)

readQConfig cfg dbEnvCfg

[3.4495]

[3.5321]

readServerConfig cfg dbEnvCfg
replacement in server/Aftok/ServerConfig.hs at line 52

[3.5322]→[3.5322:5380](∅→∅),[3.5380]→[3.7390:7411](∅→∅),[3.7411]→[3.44576:44586](∅→∅)

readQConfig :: CT.Config -> Maybe PGSConfig -> IO QConfig
readQConfig cfg pc =
QConfig

[3.5322]

[3.44586]

readServerConfig :: CT.Config -> Maybe PGSConfig -> IO ServerConfig
readServerConfig cfg pc =
ServerConfig
replacement in server/Aftok/ServerConfig.hs at line 84

[3.17125]→[3.17125:17185](∅→∅)

baseSnapConfig :: QConfig -> SC.Config m a -> SC.Config m a

[3.7969]

[3.45252]

baseSnapConfig :: ServerConfig -> SC.Config m a -> SC.Config m a
replacement in server/Aftok/ServerConfig.hs at line 89

[3.6174]→[3.6174:6221](∅→∅)

snapConfig :: QConfig -> IO (SC.Config Snap a)

[3.6174]

[3.6221]

snapConfig :: ServerConfig -> IO (SC.Config Snap a)
edit in server/Aftok/Snaplet/Billing.hs at line 8

[2.16379]

[3.48263]

paymentRequestDetailJSON,
edit in server/Aftok/Snaplet/Billing.hs at line 22

[3.100376]

[3.100376]

import Aftok.Currency.Bitcoin.Bip70 (protoBase64)
import qualified Aftok.Currency.Bitcoin.Payments as Bitcoin
edit in server/Aftok/Snaplet/Billing.hs at line 25

[3.100419]

[3.60150]

import qualified Aftok.Currency.Zcash.Zip321 as Zip321
edit in server/Aftok/Snaplet/Billing.hs at line 28

[3.60187]

[3.60187]

MonadDB,
replacement in server/Aftok/Snaplet/Billing.hs at line 33

[3.60244]→[2.16538:16594](∅→∅)

import Aftok.Json (Version (..), badVersion, unversion)

[3.60244]

[2.16594]

import Aftok.Json
( Version (..),
badVersion,
obj,
satsJSON,
unversion,
v1,
zatsJSON,
)
replacement in server/Aftok/Snaplet/Billing.hs at line 43

[2.16616]→[2.16616:16638](∅→∅)

( PaymentRequestId,

[2.16616]

[2.16638]

( PaymentRequest' (..),
PaymentRequestId,
replacement in server/Aftok/Snaplet/Billing.hs at line 52

[2.16800]→[2.16800:16830](∅→∅)

( PaymentRequestError (..),

[2.16800]

[2.16830]

( NativeRequest (..),
PaymentRequestError (..),
_PaymentRequestId,
billable,
nativeRequest,
createdAt,
replacement in server/Aftok/Snaplet/Billing.hs at line 70

[2.17063]→[2.17063:17120](∅→∅)

import Control.Lens ((.~), (^.))
-- import Data.Aeson ()

[2.17063]

[3.60407]

import Control.Lens ((.~), (^.), to)
import Data.Aeson
replacement in server/Aftok/Snaplet/Billing.hs at line 73

[3.60431]→[2.17121:17154](∅→∅)

( (.:),
(.:?),
Object,

[3.60431]

[2.17154]

( Pair,
edit in server/Aftok/Snaplet/Billing.hs at line 75

[2.17166]→[2.17166:17182](∅→∅)

Value (..),
edit in server/Aftok/Snaplet/Billing.hs at line 76

[2.17199]→[2.17199:17214](∅→∅)

parseJSON,
edit in server/Aftok/Snaplet/Billing.hs at line 77

[2.17218]

[3.25418]

import Data.AffineSpace ((.+^))
edit in server/Aftok/Snaplet/Billing.hs at line 81

[3.60498]→[2.17259:17288](∅→∅)

import Snap.Core (MonadSnap)
replacement in server/Aftok/Snaplet/Billing.hs at line 129

[2.17355]→[2.17355:17372](∅→∅)

MonadSnap m =>

[2.17355]

[2.17372]

MonadDB m =>
replacement in server/Aftok/Snaplet/Billing.hs at line 136

[2.17588]→[2.17588:17656](∅→∅)

billable <- snapEval $ withProjectAuth pid uid (FindBillable bid)

[2.17588]

[2.17656]

billableMay <- snapEval $ withProjectAuth pid uid (FindBillable bid)
replacement in server/Aftok/Snaplet/Billing.hs at line 139

[2.17723]→[2.17723:17742](∅→∅)

case billable of

[2.17723]

[2.17742]

case billableMay of
replacement in server/Aftok/Snaplet/Billing.hs at line 170

[3.26029]→[3.26029:26296](∅→∅)

--
-- paymentRequestDetailJSON :: PaymentRequestDetail Amount -> Object
-- paymentRequestDetailJSON r = obj $ concat
-- [ ["payment_request_id" .= view () r]
-- , paymentRequestKV $ view _2 r
-- , subscriptionKV $ view _3 r
-- , billableKV $ view _4 r
-- ]

[3.26029]

[3.26296]

paymentRequestDetailJSON :: (PaymentRequestId, SomePaymentRequestDetail) -> Object
paymentRequestDetailJSON (rid, (SomePaymentRequest req)) =
obj $ ["payment_request_id" .= (rid ^. _PaymentRequestId)] <> fields req
where
fields :: PaymentRequest' (Billable' ProjectId UserId) c -> [Pair]
fields r = case r ^. nativeRequest of
(Zip321Request req') ->
[ "total" .= (r ^. billable . B.amount . to zatsJSON),
"expires_at" .= ((r ^. createdAt) .+^ (r ^. billable . B.requestExpiryPeriod)),
"native_request" .= zip321PaymentRequestJSON req'
]
(Bip70Request req') ->
[ "total" .= (r ^. billable . B.amount . to satsJSON),
"expires_at" .= ((r ^. createdAt) .+^ (r ^. billable . B.requestExpiryPeriod)),
"native_request" .= bip70PaymentRequestJSON req'
]

bip70PaymentRequestJSON :: Bitcoin.PaymentRequest -> Value
bip70PaymentRequestJSON r =
v1 . obj $
[ "bip70_request"
.= object
[ "payment_key" .= (r ^. Bitcoin.paymentRequestKey . Bitcoin._PaymentKey),
"payment_request_protobuf_64" .= (r ^. Bitcoin.bip70Request . to protoBase64)
]
]
edit in server/Aftok/Snaplet/Billing.hs at line 198

[3.26297]

[2.18871]

zip321PaymentRequestJSON :: Zip321.PaymentRequest -> Value
zip321PaymentRequestJSON r =
v1 . obj $
["zip321_request" .= (toJSON . Zip321.toURI $ r)]
replacement in server/Aftok/Snaplet/Payments.hs at line 54

[3.3971]→[3.101800:101879](∅→∅)

bip70PaymentResponseHandler :: AC.BillingConfig -> S.Handler App App PaymentId

[3.3971]

[3.101879]

bip70PaymentResponseHandler :: AC.BitcoinConfig -> S.Handler App App PaymentId
replacement in server/Aftok/Snaplet/Projects.hs at line 25

[3.63524]→[3.63524:63551](∅→∅)

import Aftok.QConfig as QC

[3.63524]

[3.63551]

import Aftok.ServerConfig as QC
replacement in server/Aftok/Snaplet/Projects.hs at line 151

[3.8937]→[3.18167:18223](∅→∅)

projectInviteHandler :: QConfig -> S.Handler App App ()

[3.8937]

[3.8991]

projectInviteHandler :: ServerConfig -> S.Handler App App ()
replacement in server/Aftok/Snaplet/Projects.hs at line 171

[3.64789]→[3.64789:64802](∅→∅)

QConfig ->

[3.64789]

[3.64802]

ServerConfig ->
edit in server/Main.hs at line 10

[3.75323]

[3.75323]

import Aftok.Database.PostgreSQL (QDBM)
replacement in server/Main.hs at line 13

[3.32101]→[3.75341:75367](∅→∅),[3.75341]→[3.75341:75367](∅→∅)

import Aftok.QConfig as Q

[3.32101]

[3.75367]

import Aftok.ServerConfig
replacement in server/Main.hs at line 51

[3.6491]→[3.76266:76339](∅→∅)

cfg <- loadQConfig . decodeString $ fromRight "conf/aftok.cfg" cfgPath

[3.6491]

[3.76339]

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

[3.8352]→[3.6918:6970](∅→∅)

registerOps :: Manager -> QConfig -> RegisterOps IO

[3.8352]

[3.76366]

registerOps :: Manager -> ServerConfig -> RegisterOps IO
replacement in server/Main.hs at line 62

[3.7158]→[3.8352:8394](∅→∅),[3.8352]→[3.8352:8394](∅→∅)

appInit :: QConfig -> SnapletInit App App

[3.7158]

[3.12368]

appInit :: ServerConfig -> SnapletInit App App
edit in server/Main.hs at line 65

[3.7211]

[3.11380]

paymentsConfig <- liftIO $ C.toPaymentsConfig @QDBM (cfg ^. billingConfig)
replacement in server/Main.hs at line 77

[3.8755]→[3.76656:76707](∅→∅)

let nmode = cfg ^. billingConfig . C.networkMode

[3.8755]

[3.76707]

let nmode = cfg ^. billingConfig . C.bitcoinConfig . C.networkMode
edit in server/Main.hs at line 111

[3.78394]

[3.78394]

-- Routes for billables
edit in server/Main.hs at line 118

[3.32913]

[3.104904]

paymentRequestCreateRoute =
serveJSON paymentRequestDetailJSON $ method POST (createPaymentRequestHandler paymentsConfig)
replacement in server/Main.hs at line 131

[3.32966]→[3.105180:105255](∅→∅),[3.78993]→[3.105180:105255](∅→∅)

method POST (bip70PaymentResponseHandler $ cfg ^. billingConfig)

[3.32966]

[3.64887]

method POST (bip70PaymentResponseHandler $ cfg ^. billingConfig . C.bitcoinConfig)
edit in server/Main.hs at line 149

[3.106255]

[3.106255]

("projects/:projectId/billables/:billableId/paymentRequests", paymentRequestCreateRoute), -- create_billable.sh / list_project_billables.sh