pijul nest
guest › [sign in] [explore]

Implement payments service endpoints.

[?]
Feb 23, 2017, 4:29 AM
AL37SVTCKRSG4HG2PCYK5Z7QSIZZH5JHH4Q2VLMXFAXSAQRFFG4QC

Dependencies

  • [2] JFOEOFGA stylish-haskell formatting.
  • [3] GCVQD44V Create amends endpoint, switch to UUID primary keys
  • [4] 5ZSKPQ3K Add created_at and auction_start timestamps to auction
  • [5] PBD7LZYQ Postgres & auth are beginning to function.
  • [6] 2XQD6KKK Add invitation logic and clean up DBProg error handling.
  • [7] NAS4BFL4 Trivial stylish-haskell reformat.
  • [8] WAIX6AGN Add event serialization for PaymentRequest & Payment
  • [9] Y3LIJ5US Add handler for CreatePaymentRequest
  • [10] BROSTG5K Beginning of modularization of server.
  • [11] I2KHGVD4 Require project permissions for access to most data.
  • [12] DFOBMSAO Initial work on payments API
  • [13] HALRDT2F Added initial auction create route.
  • [14] Z3MK2PJ5 Add GET handler for retrieving auction data.
  • [15] QMRKFEPG Refactor QDB to use a free monad algebra instead.
  • [16] 73NDXDEZ Begin implementation of billing event persistence.
  • [17] O227CEAV Adds storage of original event JSON for some DBOp constructors.
  • [18] Q5X5RYQL stylish-haskell reformatting
  • [19] O5FVTOM6 Undo JSON silliness, enable a couple more routes.
  • [20] ASF3UPJL Add auction creation and bid handlers
  • [21] MJ6R42RC Utility methods for reading key & cert data.
  • [22] 7VGYLTMU Clean up schema version handling.
  • [23] SEWTRB6S Implement payment request creation functions.
  • [24] RPAJLHMT Change to use UUIDs instead of ints for primary keys.
  • [25] NEDDHXUK Reformat via stylish-haskell
  • [26] HMDM3B55 Implement core of payments/billing infrastructure.
  • [*] 64C6AWH6 Rename Ananke -> Quixotic, project reboot.
  • [*] IZEVQF62 Work in progress replacing sqlite with postgres.
  • [*] W35DDBFY Factor common JSON conversions up into client lib module.
  • [*] NLZ3JXLO Fix formatting with stylish-haskell.
  • [*] ADMKQQGC Initial empty Snap project.
  • [*] O722AOKE Add route to allow crediting of events to users/projects.

Change contents

  • edit in aftok.cabal at line 132
    [3.592]
    [3.592]
    , Aftok.Snaplet.Payments
  • edit in aftok.cabal at line 146
    [3.758]
    [3.1144]
    , cereal
  • edit in aftok.cabal at line 163
    [29.7376]
    [3.731]
    , protobuf
  • edit in lib/Aftok/Billables.hs at line 4
    [3.1016]
    [2.74]
    {-# LANGUAGE ExplicitForAll #-}
  • replacement in lib/Aftok/Billables.hs at line 78
    [3.1424]→[3.358:394](∅→∅),[3.394]→[2.639:659](∅→∅)
    data Subscription' b = Subscription
    { _billable :: b
    [3.1424]
    [3.1480]
    data Subscription' u b = Subscription
    { _customer :: u
    , _billable :: b
  • replacement in lib/Aftok/Billables.hs at line 86
    [3.1030]→[3.1614:1659](∅→∅)
    type Subscription = Subscription' BillableId
    [3.1030]
    [3.1659]
    type Subscription = Subscription' UserId BillableId
  • replacement in lib/Aftok/Billables.hs at line 100
    [3.787]→[3.787:840](∅→∅)
    billingSchedule :: Subscription' Billable -> [T.Day]
    [3.787]
    [3.840]
    billingSchedule :: forall u. Subscription' u Billable -> [T.Day]
  • replacement in lib/Aftok/Database/PostgreSQL.hs at line 167
    [2.1442]→[3.4011:4057](∅→∅),[3.4011]→[3.4011:4057](∅→∅)
    B.Subscription <$> (B.BillableId <$> field)
    [2.1442]
    [3.4057]
    B.Subscription <$> idParser UserId
    <*> idParser B.BillableId
  • replacement in lib/Aftok/Database/PostgreSQL.hs at line 210
    [3.264]→[3.4147:4268](∅→∅)
    storeEvent (CreateSubscription uid s) =
    Just $ storeEventJSON uid "create_subscription" (createSubscriptionJSON uid s)
    [3.264]
    [3.384]
    storeEvent (CreateSubscription uid bid) =
    Just $ storeEventJSON uid "create_subscription" (createSubscriptionJSON uid bid)
  • replacement in lib/Aftok/Database/PostgreSQL.hs at line 450
    [3.3943]→[3.5629:5675](∅→∅)
    pgEval dbop @ (CreateSubscription uid s) = do
    [3.3943]
    [3.576]
    pgEval dbop @ (CreateSubscription uid bid) = do
  • replacement in lib/Aftok/Database/PostgreSQL.hs at line 456
    [3.746]→[3.5704:5781](∅→∅)
    (uid ^. _UserId, s ^. (B.billable . B._BillableId), eventId ^. _EventId)
    [3.746]
    [3.3074]
    ( view _UserId uid
    , view B._BillableId bid
    , view _EventId eventId
    )
  • replacement in lib/Aftok/Database/PostgreSQL.hs at line 470
    [3.3356]→[3.5883:5935](∅→∅),[3.5883]→[3.5883:5935](∅→∅)
    "SELECT id, billable_id, start_date, end_date \
    [3.3356]
    [3.5935]
    "SELECT id, user_id, billable_id, start_date, end_date \
  • edit in lib/Aftok/Database/PostgreSQL.hs at line 505
    [3.4073]
    [3.4073]
    pgEval (FindUnpaidRequests sid) =
    let rowp :: RowParser (PaymentRequestId, PaymentRequest, B.Subscription, B.Billable)
    rowp = (,,,) <$> idParser PaymentRequestId
    <*> paymentRequestParser
    <*> subscriptionParser
    <*> billableParser
    in pquery rowp
    "SELECT id, \
    \ r.subscription_id, r.request_data, 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)"
    (Only (sid ^. B._SubscriptionId))
  • replacement in lib/Aftok/Database.hs at line 55
    [3.13383]→[3.6500:6570](∅→∅),[3.6570]→[3.4887:4954](∅→∅),[3.4954]→[3.6570:6654](∅→∅),[3.6570]→[3.6570:6654](∅→∅)
    CreateSubscription :: UserId -> Subscription -> DBOp SubscriptionId
    FindSubscription :: SubscriptionId -> DBOp (Maybe Subscription)
    FindSubscriptions :: UserId -> ProjectId -> DBOp [(SubscriptionId, Subscription)]
    [3.13383]
    [3.4199]
    CreateSubscription :: UserId -> BillableId -> DBOp SubscriptionId
    FindSubscription :: SubscriptionId -> DBOp (Maybe Subscription)
    FindSubscriptions :: UserId -> ProjectId -> DBOp [(SubscriptionId, Subscription)]
  • edit in lib/Aftok/Database.hs at line 62
    [3.5194]
    [3.5194]
    FindUnpaidRequests :: SubscriptionId -> DBOp [BillDetail]
  • edit in lib/Aftok/Database.hs at line 71
    [3.7295]
    [3.4843]
    | UserNotSubscriber SubscriptionId
  • replacement in lib/Aftok/Database.hs at line 197
    [3.5730]→[3.5730:5825](∅→∅)
    findSubscriptionBillable :: (MonadDB m) => SubscriptionId -> MaybeT m (Subscription' Billable)
    [3.5730]
    [3.5825]
    findSubscriptionBillable :: (MonadDB m) => SubscriptionId -> MaybeT m (Subscription' UserId Billable)
  • edit in lib/Aftok/Database.hs at line 205
    [3.1595]
    [3.6084]
    -- this could be implemented in terms of other operations, but it's
    -- much cleaner to just do the joins in the database
    findUnpaidRequests :: (MonadDB m) => SubscriptionId -> m [BillDetail]
    findUnpaidRequests = liftdb . FindUnpaidRequests
  • edit in lib/Aftok/Json.hs at line 3
    [3.1002]
    [31.881]
    {-# LANGUAGE RankNTypes #-}
  • edit in lib/Aftok/Json.hs at line 33
    [3.551]
    [3.116]
    import Aftok.Payments.Types (BillDetail)
  • edit in lib/Aftok/Json.hs at line 103
    [3.5169]
    [30.485]
    idJSON :: forall a. Lens' a UUID -> a -> Value
    idJSON l a = toJSON . tshow $ view l a
  • replacement in lib/Aftok/Json.hs at line 180
    [3.1605]→[3.1605:1627](∅→∅),[3.1627]→[3.552:620](∅→∅),[3.620]→[3.1690:1836](∅→∅),[3.1690]→[3.1690:1836](∅→∅),[3.1836]→[3.10115:10168](∅→∅),[3.10168]→[3.6328:6374](∅→∅),[3.6374]→[3.10224:10305](∅→∅),[3.10224]→[3.10224:10305](∅→∅),[3.10305]→[3.1836:1844](∅→∅),[3.1836]→[3.1836:1844](∅→∅)
    billableJSON b = v1 $
    obj [ "projectId" .= (b ^. (B.project . _ProjectId . to tshow))
    , "name" .= (b ^. B.name)
    , "description" .= (b ^. B.description)
    , "recurrence" .= recurrenceJSON' (b ^. B.recurrence)
    , "amount" .= (b ^. (B.amount . satoshi))
    , "gracePeriod" .= (b ^. B.gracePeriod)
    , "requestExpiryPeriod" .= (C.toSeconds' <$> (b ^. B.requestExpiryPeriod))
    ]
    [3.1605]
    [3.1844]
    billableJSON = v1 . obj . billableKV
    billableKV :: (KeyValue kv) => B.Billable -> [kv]
    billableKV b =
    [ "projectId" .= (b ^. (B.project . _ProjectId . to tshow))
    , "name" .= (b ^. B.name)
    , "description" .= (b ^. B.description)
    , "recurrence" .= recurrenceJSON' (b ^. B.recurrence)
    , "amount" .= (b ^. (B.amount . satoshi))
    , "gracePeriod" .= (b ^. B.gracePeriod)
    , "requestExpiryPeriod" .= (C.toSeconds' <$> (b ^. B.requestExpiryPeriod))
    ]
  • replacement in lib/Aftok/Json.hs at line 200
    [3.5682]→[3.10306:10521](∅→∅)
    createSubscriptionJSON :: UserId -> B.Subscription -> Value
    createSubscriptionJSON uid sub = v1 $
    obj [ "user_id" .= tshow (uid ^. _UserId)
    , "billable_id" .= tshow (sub ^. (B.billable . B._BillableId))
    [3.5682]
    [3.621]
    createSubscriptionJSON :: UserId -> B.BillableId -> Value
    createSubscriptionJSON uid bid = v1 $
    obj [ "user_id" .= idJSON _UserId uid
    , "billable_id" .= idJSON B._BillableId bid
  • edit in lib/Aftok/Json.hs at line 205
    [3.629]
    [3.629]
    subscriptionJSON :: B.Subscription -> Value
    subscriptionJSON = v1 . obj . subscriptionKV
  • edit in lib/Aftok/Json.hs at line 209
    [3.630]
    [3.630]
    subscriptionKV :: (KeyValue kv) => B.Subscription -> [kv]
    subscriptionKV sub =
    [ "user_id" .= idJSON (B.customer . _UserId) sub
    , "billable_id" .= idJSON (B.billable . B._BillableId) sub
    , "start_time" .= view B.startTime sub
    , "end_time" .= view B.endTime sub
    ]
  • replacement in lib/Aftok/Json.hs at line 218
    [3.676]→[3.676:907](∅→∅),[3.907]→[3.6443:6569](∅→∅),[3.6569]→[3.967:975](∅→∅),[3.967]→[3.967:975](∅→∅)
    paymentRequestJSON r = v1 $
    obj [ "subscription_id" .= (r ^. (subscription . B._SubscriptionId . to tshow))
    , "payment_request_protobuf_64" .= (r ^. (paymentRequest . to (decodeUtf8 . B64.encode . runPut . encodeMessage)))
    , "payment_request_time" .= (r ^. paymentRequestTime)
    , "billing_date" .= (r ^. (billingDate . to showGregorian))
    ]
    [3.676]
    [3.975]
    paymentRequestJSON = v1 . obj . paymentRequestKV
    paymentRequestKV :: (KeyValue kv) => PaymentRequest -> [kv]
    paymentRequestKV r =
    [ "subscription_id" .= (r ^. (subscription . B._SubscriptionId . to tshow))
    , "payment_request_protobuf_64" .= (r ^. (paymentRequest . to (decodeUtf8 . B64.encode . runPut . encodeMessage)))
    , "payment_request_time" .= (r ^. paymentRequestTime)
    , "billing_date" .= (r ^. (billingDate . to showGregorian))
    ]
    billDetailsJSON :: [BillDetail] -> Value
    billDetailsJSON r = v1 $
    obj ["payment_requests" .= fmap billDetailJSON r ]
  • edit in lib/Aftok/Json.hs at line 232
    [3.976]
    [3.976]
    billDetailJSON :: BillDetail -> Object
    billDetailJSON r =
    obj $ concat
    [ ["payment_request_id" .= idJSON _PaymentRequestId (view _1 r)]
    , paymentRequestKV $ view _2 r
    , subscriptionKV $ view _3 r
    , billableKV $ view _4 r
    ]
  • edit in lib/Aftok/Payments/Types.hs at line 4
    [3.6670]
    [2.2210]
    {-# LANGUAGE ExplicitForAll #-}
  • replacement in lib/Aftok/Payments/Types.hs at line 11
    [3.10647]→[2.2246:2308](∅→∅)
    import Control.Lens (makeLenses, makePrisms)
    [3.10647]
    [3.10703]
    import Control.Lens (makeLenses, makePrisms, view)
  • replacement in lib/Aftok/Payments/Types.hs at line 20
    [3.10817]→[2.2434:2488](∅→∅)
    import Aftok.Billables (SubscriptionId)
    [3.10817]
    [3.10857]
    import Aftok.Billables (Billable, Subscription, SubscriptionId)
  • edit in lib/Aftok/Payments/Types.hs at line 47
    [3.11452]
    [3.6960]
    type BillDetail = (PaymentRequestId, PaymentRequest, Subscription, Billable)
  • replacement in lib/Aftok/Payments/Types.hs at line 52
    [3.7098]→[3.7098:7149](∅→∅)
    isExpired :: C.UTCTime -> P.PaymentRequest -> Bool
    [3.7098]
    [2.2489]
    isExpired :: forall s. C.UTCTime -> PaymentRequest' s -> Bool
  • replacement in lib/Aftok/Payments/Types.hs at line 57
    [3.7313]→[3.7313:7377](∅→∅)
    in either error (check . getExpires) $ getPaymentDetails req
    [3.7313]
    [2.2571]
    in either error (check . getExpires) $ getPaymentDetails (view paymentRequest req)
  • replacement in lib/Aftok/Payments.hs at line 48
    [3.7803]→[2.3877:4080](∅→∅),[2.4080]→[3.8000:8102](∅→∅),[3.8000]→[3.8000:8102](∅→∅)
    { memoGen :: Subscription' Billable -> m (Maybe Text) -- ^ generator user memo
    , uriGen :: Subscription' Billable -> m (Maybe URI) -- ^ generator for payment response URL
    , payloadGen :: Subscription' Billable -> m (Maybe ByteString) -- ^ generator for merchant payload
    [3.7803]
    [3.8102]
    { 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
  • edit in lib/Aftok/Payments.hs at line 63
    [2.4109]→[3.12611:12612](∅→∅),[3.8495]→[3.12611:12612](∅→∅),[3.12611]→[3.12611:12612](∅→∅)
  • replacement in lib/Aftok/Payments.hs at line 106
    [3.10170]→[3.10170:10198](∅→∅)
    -> Subscription' Billable
    [3.10170]
    [3.10198]
    -> Subscription' UserId Billable
  • replacement in lib/Aftok/Payments.hs at line 149
    [2.4665]→[3.12434:12525](∅→∅),[3.12434]→[3.12434:12525](∅→∅)
    let ifUnpaid = (if isExpired now (view paymentRequest req) then Expired else Unpaid) req
    [2.4665]
    [3.12525]
    let ifUnpaid = (if isExpired now req then Expired else Unpaid) req
  • edit in lib/Aftok/Payments.hs at line 210
    [3.15982]
    findPayableRequests :: (MonadDB m) => UserId -> SubscriptionId -> C.UTCTime -> m [BillDetail]
    findPayableRequests uid sid now = do
    requests <- liftdb findOp
    join <$> (traverse checkAccess $ filter (not . isExpired now . view _2) requests)
    where
    findOp = FindUnpaidRequests sid
    checkAccess d =
    if view (_3 . customer) d == uid
    then pure [d]
    else raiseOpForbidden uid (UserNotSubscriber sid) findOp
  • edit in server/Aftok/Snaplet/Auctions.hs at line 15
    [3.1843]
    [3.2723]
    import Snap.Snaplet as S
  • replacement in server/Aftok/Snaplet/Auctions.hs at line 24
    [3.2895]→[3.17190:17233](∅→∅)
    import Aftok.Snaplet as S
    [3.2895]
    [3.2926]
    import Aftok.Snaplet
  • edit in server/Aftok/Snaplet/Auctions.hs at line 27
    [3.2963]→[2.5345:5388](∅→∅),[3.986]→[3.2993:2994](∅→∅),[2.5388]→[3.2993:2994](∅→∅),[3.17283]→[3.2993:2994](∅→∅),[3.2993]→[3.2993:2994](∅→∅)
    import Snap.Snaplet as S
  • replacement in server/Aftok/Snaplet/Auth.hs at line 6
    [3.11710]→[3.7667:7800](∅→∅)
    import Data.Attoparsec.ByteString (parseOnly, takeByteString)
    import Data.UUID (fromASCIIBytes)
    [3.7666]
    [3.423]
    import Data.Attoparsec.ByteString (parseOnly)
  • edit in server/Aftok/Snaplet/Auth.hs at line 9
    [3.7824]→[3.2052:2113](∅→∅)
    import Aftok.Auction (AuctionId (..))
  • edit in server/Aftok/Snaplet/Auth.hs at line 10
    [3.7887]→[3.3727:3758](∅→∅)
    import Aftok.Project
  • edit in server/Aftok/Snaplet/Auth.hs at line 38
    [3.2162]→[3.8268:8315](∅→∅),[3.8315]→[3.8351:8512](∅→∅),[3.8512]→[3.8479:8608](∅→∅),[3.8479]→[3.8479:8608](∅→∅),[3.8608]→[3.1294:1632](∅→∅),[3.1632]→[3.2558:2559](∅→∅),[3.2361]→[3.2558:2559](∅→∅),[3.8608]→[3.2558:2559](∅→∅),[3.11997]→[3.2558:2559](∅→∅),[3.2558]→[3.2558:2559](∅→∅)
    requireProjectId :: MonadSnap m => m ProjectId
    requireProjectId = do
    maybePid <- parseParam "projectId" pidParser
    maybe (snapError 400 "Value of parameter \"projectId\" cannot be parsed as a valid UUID")
    pure
    maybePid
    where
    pidParser = do
    bs <- takeByteString
    pure $ ProjectId <$> fromASCIIBytes bs
    requireAuctionId :: MonadSnap m => m AuctionId
    requireAuctionId = do
    maybeAid <- parseParam "auctionId" aidParser
    maybe (snapError 400 "Value of parameter \"auctionId\" cannot be parsed as a valid UUID")
    pure
    maybeAid
    where
    aidParser = do
    bs <- takeByteString
    pure $ AuctionId <$> fromASCIIBytes bs
  • edit in server/Aftok/Snaplet/Payments.hs at line 4
    [3.9831]
    [3.9831]
    import Control.Lens (view, _1, _2)
    import Data.Thyme.Clock as C
    import Network.Bippy.Proto as P
  • replacement in server/Aftok/Snaplet/Payments.hs at line 9
    [3.9832]→[3.9832:9900](∅→∅)
    import Network.Bippy
    import Network.Bippy.Types
    [3.9832]
    [3.9900]
    import Snap.Snaplet as S
    import Aftok.Billables
    import Aftok.Payments
  • replacement in server/Aftok/Snaplet/Payments.hs at line 14
    [3.9901]→[3.9901:9958](∅→∅)
    import Snap.Core
    import Snap.Snaplet
    [3.9901]
    [3.9958]
    import Aftok.Snaplet
    import Aftok.Snaplet.Auth
  • replacement in server/Aftok/Snaplet/Payments.hs at line 17
    [3.9959]→[3.17619:17650](∅→∅)
    import Aftok.QConfig
    [3.9959]
    [3.17650]
    listPayableRequestsHandler :: S.Handler App App [BillDetail]
    listPayableRequestsHandler = do
    uid <- requireUserId
    sid <- requireId "subscriptionId" SubscriptionId
    now <- liftIO $ C.getCurrentTime
    snapEval $ findPayableRequests uid sid now
  • replacement in server/Aftok/Snaplet/Payments.hs at line 24
    [3.17651]→[3.17651:17734](∅→∅),[3.17734]→[3.10028:10077](∅→∅),[3.10028]→[3.10028:10077](∅→∅)
    requestPaymentHandler :: QConfig -> Handler App App
    requestPaymentHandler cfg = do
    -- get payout percentages from payouts handler
    [3.17651]
    [3.10077]
    getPaymentRequestHandler :: S.Handler App App P.PaymentRequest
    getPaymentRequestHandler = do
  • replacement in server/Aftok/Snaplet/Payments.hs at line 27
    [3.10100]→[3.10100:10163](∅→∅),[3.10163]→[3.1355:1414](∅→∅),[3.1414]→[3.17779:17951](∅→∅),[3.17779]→[3.17779:17951](∅→∅)
    pid <- requireProjectId
    ptime <- liftIO $ C.getCurrentTime
    createPaymentRequests ptime memogen urigen plgen uid pid
    -- look up outstanding subscriptions the user has for this project
    -- determine which subscriptions need to be paid
    -- create a payment request for each subscription
    [3.10100]
    [3.17952]
    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
  • edit in server/Aftok/Snaplet/Payments.hs at line 38
    [2.5393]
  • replacement in server/Aftok/Snaplet.hs at line 13
    [3.10660]→[3.10660:10727](∅→∅)
    import Data.Attoparsec.ByteString (Parser, parseOnly)
    [3.10660]
    [3.1324]
    import Data.Attoparsec.ByteString (Parser, parseOnly,
    takeByteString)
    import Data.UUID
  • edit in server/Aftok/Snaplet.hs at line 18
    [3.10751]
    [3.10751]
    import Aftok.Auction (AuctionId (..))
  • edit in server/Aftok/Snaplet.hs at line 21
    [3.10826]
    [3.10826]
    import Aftok.Project (ProjectId (..))
  • replacement in server/Aftok/Snaplet.hs at line 64
    [3.11977]→[3.11977:12036](∅→∅)
    parseParam :: MonadSnap m => ByteString -> Parser a -> m a
    [3.11977]
    [3.12036]
    parseParam :: MonadSnap m
    => Text -- ^ the name of the parameter to be parsed
    -> Parser a -- ^ parser for the value of the parameter
    -> m a -- ^ the parsed value
  • replacement in server/Aftok/Snaplet.hs at line 69
    [3.12064]→[3.12064:12094](∅→∅)
    maybeBytes <- getParam name
    [3.12064]
    [3.12094]
    maybeBytes <- getParam (encodeUtf8 name)
  • edit in server/Aftok/Snaplet.hs at line 76
    [3.12366]
    [3.9523]
    requireId :: MonadSnap m
    => Text -- ^ name of the parameter
    -> (UUID -> a) -- ^ constructor for the identifier
    -> m a
    requireId name f = do
    maybeId <- parseParam name idParser
    maybe (snapError 400 $ "Value of parameter \"" <> name <> "\" is not a valid UUID") pure maybeId
    where
    idParser = do
    bs <- takeByteString
    pure $ f <$> fromASCIIBytes bs
  • edit in server/Aftok/Snaplet.hs at line 94
    [3.3904]
    [3.3828]
    requireProjectId :: MonadSnap m => m ProjectId
    requireProjectId = requireId "projectId" ProjectId
  • edit in server/Aftok/Snaplet.hs at line 97
    [3.3829]
    requireAuctionId :: MonadSnap m => m AuctionId
    requireAuctionId = requireId "auctionId" AuctionId
  • edit in server/Main.hs at line 6
    [3.11294]
    [3.11294]
    import Data.ProtocolBuffers (encodeMessage)
    import Data.Serialize.Put (runPutLazy)
  • edit in server/Main.hs at line 17
    [3.2268]
    [3.11489]
    import Aftok.Snaplet.Payments
  • edit in server/Main.hs at line 61
    [3.4231]
    [33.2894]
    payableRequestsRoute = serveJSON billDetailsJSON $ method GET listPayableRequestsHandler
    paymentRequestRoute = writeLBS . runPutLazy . encodeMessage =<< method GET getPaymentRequestHandler
  • edit in server/Main.hs at line 85
    [3.1979]
    [3.4299]
    , ("subscriptions/:subscriptionId/payment_requests", payableRequestsRoute)
    , ("subscriptions/:subscriptionId/payment_requests/:paymentRequestId", paymentRequestRoute)