Make payment request retrieval key an opaque 32-bit hash.

[?]

Feb 25, 2017, 9:42 PM

4FDQGIXN3Z4J55DILCSI5EOLIIA7R5CADTGFMW5X7N7MH6JIMBWAC

Dependencies

[2] AL37SVTC Implement payments service endpoints.
[3] GCVQD44V Create amends endpoint, switch to UUID primary keys
[4] DFOBMSAO Initial work on payments API
[5] Y3LIJ5US Add handler for CreatePaymentRequest
[6] Q5X5RYQL stylish-haskell reformatting
[7] SEWTRB6S Implement payment request creation functions.
[8] QADKFHAR Adds CreatePayment handler implementation.
[9] WAIX6AGN Add event serialization for PaymentRequest & Payment
[10] HALRDT2F Added initial auction create route.
[11] 2XQD6KKK Add invitation logic and clean up DBProg error handling.
[12] ASF3UPJL Add auction creation and bid handlers
[13] RN7EI6IN Update database layer to use CreditTo
[14] O227CEAV Adds storage of original event JSON for some DBOp constructors.
[15] HMDM3B55 Implement core of payments/billing infrastructure.
[16] JFOEOFGA stylish-haskell formatting.
[17] IZEVQF62 Work in progress replacing sqlite with postgres.
[*] 64C6AWH6 Rename Ananke -> Quixotic, project reboot.
[*] NEDDHXUK Reformat via stylish-haskell
[*] W35DDBFY Factor common JSON conversions up into client lib module.
[*] BROSTG5K Beginning of modularization of server.
[*] ADMKQQGC Initial empty Snap project.

Change contents

edit in aftok.cabal at line 41

[3.99]

[3.99]

, blake2
edit in lib/Aftok/Database/PostgreSQL.hs at line 9

[20.1043]

[3.511]

import qualified Crypto.Hash.BLAKE2.BLAKE2b as B2
import Crypto.Random.Types (MonadRandom, getRandomBytes)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 26

[3.1829]→[3.653:722](∅→∅)

import Network.Haskoin.Crypto (addrToBase58)

[3.1829]

[3.1011]

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

[3.1927]

[3.1927]

instance MonadRandom QDBM where
getRandomBytes = QDBM . lift . lift . getRandomBytes
edit in lib/Aftok/Database/PostgreSQL.hs at line 51

[3.1928]

[3.1928]
edit in lib/Aftok/Database/PostgreSQL.hs at line 486

[3.896]

[3.896]

keyBytes <- getRandomBytes 64
let prBytes = req ^. (paymentRequest . to (runPut . encodeMessage))
urlKey = decodeUtf8 . encodeBase58Check $ B2.hash 32 keyBytes prBytes
replacement in lib/Aftok/Database/PostgreSQL.hs at line 491

[3.959]→[3.3357:3476](∅→∅)

\(subscription_id, event_id, request_data, request_time, billing_date) \
\VALUES (?, ?, ?, ?, ?) RETURNING id"

[3.959]

[3.6158]

\(subscription_id, event_id, request_data, url_key, request_time, billing_date) \
\VALUES (?, ?, ?, ?, ?, ?) RETURNING id"
replacement in lib/Aftok/Database/PostgreSQL.hs at line 495

[3.1566]→[3.1120:1180](∅→∅),[3.1120]→[3.1120:1180](∅→∅)

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

[3.1566]

[3.3477]

, prBytes
, urlKey
replacement in lib/Aftok/Database/PostgreSQL.hs at line 501

[3.1568]→[3.1555:1589](∅→∅)

pgEval (FindPaymentRequest rid) =

[3.1568]

[3.3604]

pgEval (FindPaymentRequest (PaymentKey k)) =
replacement in lib/Aftok/Database/PostgreSQL.hs at line 505

[3.3743]→[3.3743:3796](∅→∅)

\WHERE id = ?"
(Only (rid ^. _PaymentRequestId))

[3.3743]

[3.1590]

\WHERE url_key = ?"
(Only k)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 516

[2.750]→[2.750:886](∅→∅)

let rowp :: RowParser (PaymentRequestId, PaymentRequest, B.Subscription, B.Billable)
rowp = (,,,) <$> idParser PaymentRequestId

[2.750]

[2.886]

let rowp :: RowParser (PaymentKey, PaymentRequest, B.Subscription, B.Billable)
rowp = (,,,) <$> (PaymentKey <$> field)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 522

[2.1028]→[2.1028:1048](∅→∅)

"SELECT id, \

[2.1028]

[2.1048]

"SELECT r.url_key, \
edit in lib/Aftok/Database.hs at line 60

[3.5032]→[3.5032:5107](∅→∅)

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

[2.1929]

[3.5194]

FindPaymentRequest :: PaymentKey -> DBOp (Maybe PaymentRequest)
edit in lib/Aftok/Database.hs at line 205

[3.1595]

[2.2092]

findPaymentRequest :: (MonadDB m) => PaymentKey -> m (Maybe PaymentRequest)
findPaymentRequest = liftdb . FindPaymentRequest
replacement in lib/Aftok/Json.hs at line 235

[2.4205]→[2.4205:4274](∅→∅)

[ ["payment_request_id" .= idJSON _PaymentRequestId (view _1 r)]

[2.4205]

[2.4274]

[ ["payment_request_id" .= view (_1 . _PaymentKey) r]
edit in lib/Aftok/Payments/Types.hs at line 19

[3.2433]

[3.10816]

import Network.Haskoin.Crypto (decodeBase58Check)
edit in lib/Aftok/Payments/Types.hs at line 28

[3.11036]

[3.11036]

newtype PaymentKey = PaymentKey Text deriving (Eq)
makePrisms ''PaymentKey
replacement in lib/Aftok/Payments/Types.hs at line 51

[3.11452]→[2.4565:4642](∅→∅)

type BillDetail = (PaymentRequestId, PaymentRequest, Subscription, Billable)

[3.11452]

[2.4642]

type BillDetail = (PaymentKey, PaymentRequest, Subscription, Billable)
edit in lib/Aftok/Payments/Types.hs at line 63

[3.2572]

parsePaymentKey :: ByteString -> Maybe PaymentKey
parsePaymentKey bs = (PaymentKey . decodeUtf8) <$> decodeBase58Check bs
replacement in server/Aftok/Snaplet/Payments.hs at line 5

[2.5783]→[2.5783:5835](∅→∅)

import Control.Lens (view, _1, _2)

[2.5783]

[2.5835]

import Control.Lens (view)
edit in server/Aftok/Snaplet/Payments.hs at line 13

[2.6028]

[3.9900]

import Aftok.Database
replacement in server/Aftok/Snaplet/Payments.hs at line 27

[2.6438]→[3.10077:10100](∅→∅),[3.10077]→[3.10077:10100](∅→∅),[3.10100]→[2.6439:6832](∅→∅)

uid <- requireUserId
sid <- requireId "subscriptionId" SubscriptionId
rid <- requireId "paymentRequestId" PaymentRequestId
now <- liftIO $ C.getCurrentTime
requests <- snapEval $ findPayableRequests uid sid now
let prMay = fmap (view (_2 . paymentRequest)) . headMay $ filter ((==) rid . view _1) requests
maybe (snapError 404 $ "Outstanding payment request not found for id " <> tshow rid) pure prMay

[2.6438]

[3.17952]

pkBytes <- requireParam "paymentRequestKey"
pkey <- maybe
(snapError 400 $ "parameter paymentRequestKey is formatted incorrectly.") pure
(parsePaymentKey pkBytes)
prMay <- snapEval $ findPaymentRequest pkey
maybe (snapError 404 $ "Outstanding payment request not found for key " <> (view _PaymentKey pkey))
(pure . view paymentRequest)
prMay
edit in server/Aftok/Snaplet.hs at line 64

[3.11977]

[2.7127]

requireParam :: MonadSnap m => Text -> m ByteString
requireParam name = do
maybeBytes <- getParam (encodeUtf8 name)
maybe (snapError 400 $ "Parameter "<> tshow name <>" is required") pure maybeBytes
replacement in server/Aftok/Snaplet.hs at line 74

[3.12064]→[2.7338:7381](∅→∅),[2.7381]→[3.12094:12366](∅→∅),[3.12094]→[3.12094:12366](∅→∅)

maybeBytes <- getParam (encodeUtf8 name)
case maybeBytes of
Nothing -> snapError 400 $ "Parameter "<> tshow name <>" is required"
Just bytes -> either
(const . snapError 400 $ "Value of parameter "<> tshow name <>" could not be parsed to a valid value.")
pure
(parseOnly parser bytes)

[3.12064]

[2.7382]

bytes <- requireParam name
either
(const . snapError 400 $ "Value of parameter "<> tshow name <>" could not be parsed to a valid value.")
pure
(parseOnly parser bytes)
replacement in server/Main.hs at line 87

[2.8473]→[2.8473:8577](∅→∅)

, ("subscriptions/:subscriptionId/payment_requests/:paymentRequestId", paymentRequestRoute)

[2.8473]

[3.4299]

, ("pay/:paymentRequestKey", paymentRequestRoute)