nuttycom/aftok - Change BSIUHCGFDFDFGWYMHZB7OVU3Z3IHPEUXRISIOPGZI2RUXZFDS2EQC

Add payment response handler.

Created by Kris Nuttycombe on February 25, 2017

BSIUHCGFDFDFGWYMHZB7OVU3Z3IHPEUXRISIOPGZI2RUXZFDS2EQC

Dependencies

In channels

main

Change contents

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 9 [4.456]

B:BD[3.1043] → [2.19:163]

import qualified Crypto.Hash.BLAKE2.BLAKE2b           as B2
import           Crypto.Random.Types                  (MonadRandom, getRandomBytes)

[3.1043]

[5.511]

import           Crypto.Random.Types                  (MonadRandom,
                                                       getRandomBytes)

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 26 [4.456]

B:BD[6.1829] → [2.164:252]

import           Network.Haskoin.Crypto               (addrToBase58, encodeBase58Check)

[6.1829]

[4.1011]

import           Network.Haskoin.Crypto               (addrToBase58)

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 180 [4.456]

∅:D[7.1466] → [8.2321:2528]

B:BD[8.2321] → [8.2321:2528]

  PaymentRequest <$> (B.SubscriptionId <$> field)
                 <*> (field >>= (either fail pure . runGet decodeMessage))
                 <*> (toThyme <$> field)
                 <*> (toThyme <$> field)

[7.1466]

[8.2528]

  PaymentRequest <$> fmap B.SubscriptionId field
                 <*> ((either fail pure . runGet decodeMessage) =<< field)
                 <*> fmap PaymentKey field
                 <*> fmap toThyme field
                 <*> fmap toThyme field

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 215 [4.456]
∅:D[5.1413] → [9.200:263]
B:BD[9.200] → [9.200:263]
```
  Just $ storeEventJSON uid "create_billable" (billableJSON b)
```
[5.1413]
[9.263]
```
  Just $ storeEventJSON (Just uid) "create_billable" (billableJSON b)
```

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 218 [4.456]

B:BD[10.434] → [10.434:517]

  Just $ storeEventJSON uid "create_subscription" (createSubscriptionJSON uid bid)

[10.434]

[9.384]

  Just $ storeEventJSON (Just uid) "create_subscription" (createSubscriptionJSON uid bid)

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 220 [4.456]

B:BD[9.385] → [5.1457:1501]

∅:D[5.1501] → [11.170:248]

B:BD[11.170] → [11.170:248]

storeEvent (CreatePaymentRequest uid req) =
  Just $ storeEventJSON uid "create_payment_request" (paymentRequestJSON req)

[9.385]

[11.248]

storeEvent (CreatePaymentRequest req) =
  Just $ storeEventJSON Nothing "create_payment_request" (paymentRequestJSON req)

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 223 [4.456]

B:BD[11.249] → [5.1502:1539]

∅:D[5.1539] → [11.287:350]

B:BD[11.287] → [11.287:350]

storeEvent (CreatePayment uid req) =
  Just $ storeEventJSON uid "create_payment" (paymentJSON req)

[11.249]

[11.350]

storeEvent (CreatePayment req) =
  Just $ storeEventJSON Nothing "create_payment" (paymentJSON req)

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 230 [4.456]

B:BD[9.531] → [9.531:594]

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

[9.531]

[9.594]

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

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 237 [4.456]

B:BD[9.806] → [9.806:854]

    (fromThyme timestamp, uid ^. _UserId, t, v)

[9.806]

[12.425]

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

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 485 [4.456]
B:BD[13.6109] → [13.6109:6157]
```
pgEval dbop @ (CreatePaymentRequest _ req) = do
```
[13.6109]
[14.863]
```
pgEval dbop @ (CreatePaymentRequest req) = do
```

Deletion in lib/Aftok/Database/PostgreSQL.hs at line 487 [4.456]

B:BD[14.896] → [2.344:524]

  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 493 [4.456]

B:BD[5.1566] → [2.657:684]

    , prBytes
    , urlKey

[5.1566]

[8.3477]

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

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 500 [4.456]

∅:D[2.730] → [8.3604:3716]

∅:D[7.1589] → [8.3604:3716]

B:BD[8.3604] → [8.3604:3716]

  headMay <$> pquery paymentRequestParser
  "SELECT subscription_id, request_data, request_time, billing_date \

[2.730]

[8.3716]

  headMay <$> pquery ((,) <$> idParser PaymentRequestId <*> paymentRequestParser)
  "SELECT id, subscription_id, request_data, url_key, request_time, billing_date \

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 503 [4.456]
B:BD[8.3743] → [2.731:753]
```
  \WHERE url_key = ?"
```
[8.3743]
[2.753]
```
  \WHERE url_key = ? \
  \AND id NOT IN (SELECT payment_request_id FROM payments)"
```

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 509 [4.456]

B:BD[8.3905] → [8.3905:3979]

  "SELECT id, subscription_id, request_data, request_time, billing_date \

[8.3905]

[8.3979]

  "SELECT id, subscription_id, request_data, url_key, request_time, billing_date \

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 522 [4.456]

∅:D[2.920] → [10.1048:1131]

B:BD[10.1048] → [10.1048:1131]

      \       r.subscription_id, r.request_data, r.request_time, r.billing_date, \

[2.920]

[10.1131]

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

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 533 [4.456]
∅:D[10.1642] → [8.4073:4112]
B:BD[8.4073] → [8.4073:4112]
```
pgEval dbop @ (CreatePayment _ p) = do
```
[10.1642]
[15.48]
```
pgEval dbop @ (CreatePayment p) = do
```

Replacement in lib/Aftok/Database.hs at line 59 [16.4936]

B:BD[6.4200] → [8.4955:5032]

  CreatePaymentRequest  :: UserId -> PaymentRequest -> DBOp PaymentRequestId

[6.4200]

[8.5107]

  CreatePaymentRequest  :: PaymentRequest -> DBOp PaymentRequestId

Replacement in lib/Aftok/Database.hs at line 62 [16.4936]

B:BD[10.1929] → [2.922:991]

  FindPaymentRequest    :: PaymentKey -> DBOp (Maybe PaymentRequest)

[10.1929]

[8.5194]

  FindPaymentRequest    :: PaymentKey -> DBOp (Maybe (PaymentRequestId, PaymentRequest))

Replacement in lib/Aftok/Database.hs at line 64 [16.4936]

B:BD[8.5195] → [8.5195:5251]

  CreatePayment  :: UserId -> Payment -> DBOp PaymentId

[8.5195]

[8.5251]

  CreatePayment  :: Payment -> DBOp PaymentId

Replacement in lib/Aftok/Database.hs at line 205 [16.4936]

B:BD[5.1595] → [2.992:1068]

findPaymentRequest :: (MonadDB m) => PaymentKey -> m (Maybe PaymentRequest)

[5.1595]

[2.1068]

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

Replacement in lib/Aftok/Payments/Types.hs at line 11 [13.10545]

B:BD[13.10647] → [10.4417:4485]

import           Control.Lens        (makeLenses, makePrisms, view)

[13.10647]

[13.10703]

import           Control.Lens           (makeLenses, makePrisms, view)

Replacement in lib/Aftok/Payments/Types.hs at line 13 [13.10545]
∅:D[8.6713] → [13.10704:10746]
B:BD[13.10704] → [13.10704:10746]
B:BD[13.10746] → [7.2309:2351]
```
import           Data.Thyme.Clock    as C
import           Data.Thyme.Time     as T
```
[13.10704]
[13.10746]
```
import           Data.Thyme.Clock       as C
import           Data.Thyme.Time        as T
```

Replacement in lib/Aftok/Payments/Types.hs at line 17 [13.10545]

∅:D[8.6795] → [13.10774:10816]

B:BD[13.10774] → [13.10774:10816]

B:BD[13.10816] → [7.2352:2433]

import qualified Network.Bippy.Proto as P
import           Network.Bippy.Types (expiryTime, getExpires, getPaymentDetails)

[13.10774]

[2.1181]

import qualified Network.Bippy.Proto    as P
import           Network.Bippy.Types    (expiryTime, getExpires,
                                         getPaymentDetails)

Replacement in lib/Aftok/Payments/Types.hs at line 22 [13.10545]

B:BD[13.10817] → [10.4486:4564]

import           Aftok.Billables     (Billable, Subscription, SubscriptionId)

[13.10817]

[13.10857]

import           Aftok.Billables        (Billable, Subscription, SubscriptionId)

Insertion in lib/Aftok/Payments/Types.hs at line 36 [13.10545]
[13.11150]
[8.6796]
```
  , _paymentKey         :: PaymentKey
```

Replacement in lib/Aftok/Payments.hs at line 18 [6.5686]

B:BD[7.3045] → [7.3045:3100]

import           Crypto.Random.Types     (MonadRandom)

[7.3045]

[6.5839]

import           Crypto.Random.Types     (MonadRandom, getRandomBytes)

Insertion in lib/Aftok/Payments.hs at line 28 [6.5686]
[7.3432]
[7.3432]
```
import           Network.Haskoin.Crypto  (encodeBase58Check)
```

Replacement in lib/Aftok/Payments.hs at line 49 [6.5686]

B:BD[8.7803] → [10.4795:5100]

  { memoGen    :: Subscription' UserId Billable -> m (Maybe Text) -- ^ generator user memo
  , uriGen     :: Subscription' UserId Billable -> m (Maybe URI)  -- ^ generator for payment response URL
  , payloadGen :: Subscription' UserId Billable -> m (Maybe ByteString) -- ^ generator for merchant payload

[8.7803]

[8.8102]

  { -- | generator for user memo
    memoGen    :: Subscription' UserId Billable -> T.Day -> C.UTCTime -> m (Maybe Text)
    -- | generator for payment response URL
  , uriGen     :: PaymentKey -> m (Maybe URI)
    -- | generator for merchant payload
  , payloadGen :: Subscription' UserId Billable -> T.Day -> C.UTCTime -> m (Maybe ByteString)

Replacement in lib/Aftok/Payments.hs at line 79 [6.5686]

B:BD[13.13414] → [7.4138:4223]

  join <$> traverse (createSubscriptionPaymentRequests ops now custId) subscriptions

[13.13414]

[8.9182]

  join <$> traverse (createSubscriptionPaymentRequests ops now) subscriptions

Deletion in lib/Aftok/Payments.hs at line 89 [6.5686]
B:BD[8.9384] → [8.9384:9396]
```
  -> UserId
```

Replacement in lib/Aftok/Payments.hs at line 91 [6.5686]

B:BD[8.9458] → [8.9458:9523]

createSubscriptionPaymentRequests ops now custId (sid, sub) = do

[8.9458]

[8.9523]

createSubscriptionPaymentRequests ops now (sid, sub) = do

Replacement in lib/Aftok/Payments.hs at line 97 [6.5686]

B:BD[8.9870] → [8.9870:9949]

  traverse (createPaymentRequest ops now custId sid billableSub) billableDates

[8.9870]

[8.9949]

  traverse (createPaymentRequest ops now sid billableSub) billableDates

Deletion in lib/Aftok/Payments.hs at line 107 [6.5686]
B:BD[8.10138] → [8.10138:10150]
```
  -> UserId
```
Replacement in lib/Aftok/Payments.hs at line 111 [6.5686]
B:BD[8.10233] → [8.10233:10287]
```
createPaymentRequest ops now custId sid sub bday = do
```
[8.10233]
[13.13414]
```
createPaymentRequest ops now sid sub bday = do
```

Replacement in lib/Aftok/Payments.hs at line 113 [6.5686]

B:BD[13.13427] → [8.10288:10377]

  memo    <- memoGen ops sub
  uri     <- uriGen ops sub
  payload <- payloadGen ops sub

[13.13427]

[8.10377]

  -- TODO: maybe
  pkey    <- PaymentKey . decodeUtf8 . encodeBase58Check <$> getRandomBytes 32
  memo    <- memoGen ops sub bday now
  uri     <- uriGen ops pkey
  payload <- payloadGen ops sub bday now

Replacement in lib/Aftok/Payments.hs at line 121 [6.5686]

B:BD[8.10604] → [8.10604:10677]

  liftdb $ CreatePaymentRequest custId (PaymentRequest sid req now bday)

[8.10604]

[7.4339]

  liftdb $ CreatePaymentRequest (PaymentRequest sid req pkey now bday)

Replacement in server/Aftok/Snaplet/Payments.hs at line 1 [6.9762]

B:BD[6.9762] → [6.9763:9799]

module Aftok.Snaplet.Payments where

[6.9762]

[6.9799]

module Aftok.Snaplet.Payments
  ( listPayableRequestsHandler
  , getPaymentRequestHandler
  , paymentResponseHandler
  ) where

Replacement in server/Aftok/Snaplet/Payments.hs at line 9 [6.9762]

B:BD[10.5783] → [2.1518:1562]

∅:D[2.1562] → [10.5835:5919]

B:BD[10.5835] → [10.5835:5919]

import           Control.Lens        (view)
import           Data.Thyme.Clock    as C
import           Network.Bippy.Proto as P

[10.5783]

[6.9831]

import           Control.Lens         (view, _1, _2)
import           Data.ProtocolBuffers (decodeMessage)
import           Data.Serialize.Get   (runGetLazy)
import           Data.Thyme.Clock     as C
import qualified Network.Bippy.Proto  as P

Replacement in server/Aftok/Snaplet/Payments.hs at line 15 [6.9762]

B:BD[6.9832] → [10.5920:5962]

import           Snap.Snaplet        as S

[6.9832]

[10.5962]

import           Snap.Core            (readRequestBody)
import           Snap.Snaplet         as S

Insertion in server/Aftok/Snaplet/Payments.hs at line 19 [6.9762]
[10.5996]
[10.5996]
```
import           Aftok.Database
```
Deletion in server/Aftok/Snaplet/Payments.hs at line 21 [6.9762]
B:BD[10.6028] → [2.1563:1595]
```
import           Aftok.Database
```

Replacement in server/Aftok/Snaplet/Payments.hs at line 33 [6.9762]

B:BD[10.6408] → [10.6408:6438]

B:BD[10.6438] → [2.1596:1750]

getPaymentRequestHandler = do
  pkBytes <- requireParam "paymentRequestKey" 
  pkey <- maybe 
          (snapError 400 $ "parameter paymentRequestKey is formatted incorrectly.") pure

[10.6408]

[2.1750]

getPaymentRequestHandler =
  view (_2 . paymentRequest) <$> getPaymentRequestHandler'
paymentResponseHandler :: S.Handler App App PaymentId
paymentResponseHandler = do
  requestBody <- readRequestBody 4096
  preq <- getPaymentRequestHandler'
  pmnt <- either
          (\msg -> snapError 400 $ "Could not decode payment response: " <> tshow msg)
          pure
          (runGetLazy decodeMessage requestBody)
  now  <- liftIO $ C.getCurrentTime
  snapEval . liftdb . CreatePayment $ Payment (view _1 preq) pmnt now
getPaymentRequestHandler' :: S.Handler App App (PaymentRequestId, PaymentRequest)
getPaymentRequestHandler' = do
  pkBytes <- requireParam "paymentRequestKey"
  pkey <- maybe
          (snapError 400 $ "parameter paymentRequestKey is formatted incorrectly.") pure

Replacement in server/Aftok/Snaplet/Payments.hs at line 55 [6.9762]
B:BD[2.1934] → [2.1934:1985]
∅:D[17.1418] → [13.17952:17953]
∅:D[2.1985] → [13.17952:17953]
∅:D[10.6832] → [13.17952:17953]
B:BD[6.10307] → [13.17952:17953]
B:BD[13.17953] → [7.5390:5391]
∅:D[7.5391] → [6.10307:10308]
∅:D[13.17956] → [6.10307:10308]
B:BD[6.10307] → [6.10307:10308]
B:BD[6.10308] → [13.17957:17958]
```
        (pure . view paymentRequest)
        prMay
```
[2.1934]
[7.5392]
```
        pure prMay
```
Deletion in server/Aftok/Snaplet/Payments.hs at line 59 [6.9762]
B:BD[10.6835] → [10.6835:6836]

Replacement in server/Main.hs at line 62 [18.5188]

B:BD[10.8276] → [10.8276:8383]

      paymentRequestRoute  = writeLBS . runPutLazy . encodeMessage =<< method GET getPaymentRequestHandler

[10.8276]

[10.8383]

      paymentRoute         = (writeLBS . runPutLazy . encodeMessage =<< method GET getPaymentRequestHandler)
                             <|> (void $ method POST paymentResponseHandler)

Replacement in server/Main.hs at line 88 [18.5188]

B:BD[10.8473] → [2.2378:2440]

            , ("pay/:paymentRequestKey", paymentRequestRoute)

[10.8473]

[19.4299]

            , ("pay/:paymentRequestKey", paymentRoute)