nuttycom/aftok - Change SEWTRB6S5PO5MQBLCPVBD7XT2BDYNZUE2RO6Z2XENZRIOCN6OZJAC

Implement payment request creation functions.

These are the necessary functions that will support the future development of the payment request endpoint and the scheduled bill processing system.

Created by Kris Nuttycombe on February 20, 2017

SEWTRB6S5PO5MQBLCPVBD7XT2BDYNZUE2RO6Z2XENZRIOCN6OZJAC

Dependencies

In channels

main

Change contents

Deletion in aftok.cabal at line 34 [5.1]
B:BD[3.37] → [4.195:228]
```
                      Aftok.Time
```
Insertion in aftok.cabal at line 72 [5.1]
[2.523]
[2.523]
```
    , transformers
```
File deletion: Time.hs
BF:BFD[6.679] → [4.6557:6588]
BF:BFD[4.6588] → [4.6473:6473]
B:BD[4.6473] → [7.14002:14035]
∅:D[7.14035] → [4.6474:6530]
B:BD[4.6473] → [4.6474:6530]
∅:D[8.2567] → [4.6530:6555]
∅:D[7.14093] → [4.6530:6555]
B:BD[4.6530] → [4.6530:6555]
B:BD[4.6555] → [7.14094:14112]
∅:D[7.14112] → [4.6555:6556]
B:BD[4.6555] → [4.6555:6556]
B:BD[4.6530] → [8.2523:2567]
```
{-# LANGUAGE TemplateHaskell #-}
module Aftok.Time where
import           ClassyPrelude
newtype Days = Days Int
makePrisms ''Days
import           Control.Lens  (makePrisms)
```

Replacement in lib/Aftok/Billables.hs at line 10 [4.760]

B:BD[4.857] → [8.3:59]

import           Control.Lens  (makeLenses, makePrisms)

[4.857]

[2.1017]

import           Control.Lens  (makeLenses, makePrisms, preview, view, _Just)
import           Data.List (unfoldr)
import           Data.Thyme.Time as T

Deletion in lib/Aftok/Billables.hs at line 18 [4.760]
B:BD[7.116] → [8.101:144]
```
import           Aftok.Time    (Days (..))
```
Replacement in lib/Aftok/Billables.hs at line 25 [4.760]
B:BD[4.1077] → [4.1077:1109]
```
  | Monthly Int
  | SemiMonthly
```
[4.1077]
[4.1109]
```
  | Monthly T.Months
--  | SemiMonthly
```
Replacement in lib/Aftok/Billables.hs at line 34 [4.760]
B:BD[7.344] → [7.344:387]
```
recurrenceName SemiMonthly = "semimonthly"
```
[7.344]
[7.387]
```
--recurrenceName SemiMonthly = "semimonthly"
```
Replacement in lib/Aftok/Billables.hs at line 41 [4.760]
B:BD[7.578] → [7.578:616]
```
recurrenceCount SemiMonthly = Nothing
```
[7.578]
[7.616]
```
--recurrenceCount SemiMonthly = Nothing
```

Replacement in lib/Aftok/Billables.hs at line 68 [4.760]

B:BD[2.1289] → [2.1289:1342]

  , _requestExpiryPeriod :: Maybe C.NominalDiffTime

[2.1289]

[2.1342]

  , _requestExpiryPeriod :: Maybe C.NominalDiffTime

Replacement in lib/Aftok/Billables.hs at line 77 [4.760]
B:BD[2.1424] → [2.1424:1461]
```
data Subscription' b = Subscription 
```
[2.1424]
[2.1461]
```
data Subscription' b = Subscription
```

Insertion in lib/Aftok/Billables.hs at line 86 [4.760]

[2.1660]

nextRecurrence :: Recurrence -> T.Day -> Maybe T.Day
nextRecurrence r = case r of 
  Annually  -> Just . T.addGregorianYearsClip 1
  Monthly m -> Just . T.addGregorianMonthsClip m
  Weekly w  -> Just . T.addDays (w * 7)
  OneTime   -> const Nothing
{- 
 - A stream of dates upon which the specified subscription
 - should be billed, beginning with the first day of the 
 - subscription.
 -}
billingSchedule :: Subscription' Billable -> [T.Day]
billingSchedule s =
  let rec = view (billable . recurrence) s
      subEndDay = preview (endTime . _Just . C._utctDay) s
      next :: Maybe T.Day -> Maybe (T.Day, Maybe T.Day)
      next d = do
        d' <- d
        if (all (d' <) subEndDay) then Just (d', nextRecurrence rec d') else Nothing
  in  unfoldr next (Just $ view (startTime . C._utctDay) s)

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 11 [10.456]

B:BD[9.1197] → [9.1197:1256]

B:BD[9.1256] → [8.582:652]

import           Data.List                            as L
import           Data.ProtocolBuffers                 (encodeMessage)

[9.1197]

[11.109]

import qualified Data.List                            as L
import           Data.ProtocolBuffers                 (encodeMessage, decodeMessage)
import           Data.Serialize.Get                   (runGet)

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 34 [10.456]
∅:D[12.124] → [11.173:205]
∅:D[13.162] → [11.173:205]
∅:D[8.1008] → [11.173:205]
∅:D[2.1802] → [11.173:205]
B:BD[9.1678] → [11.173:205]
```
import           Aftok.Payments
```
[2.1802]
[7.1208]
```
import           Aftok.Payments.Types                    
```
Deletion in lib/Aftok/Database/PostgreSQL.hs at line 36 [10.456]
B:BD[7.1267] → [8.1009:1082]
```
import           Aftok.Time                           (Days (..), _Days)
```
Replacement in lib/Aftok/Database/PostgreSQL.hs at line 48 [10.456]
B:BD[10.1216] → [2.1803:1862]
∅:D[2.1862] → [10.1373:1374]
B:BD[10.1373] → [10.1373:1374]
B:BD[10.1374] → [2.1863:1932]
```
uidParser :: RowParser UserId
uidParser = UserId <$> field
pidParser :: RowParser P.ProjectId
pidParser = P.ProjectId <$> field
```
[10.1216]
[10.1461]
```
idParser :: (UUID -> a) -> RowParser a
idParser f = f <$> field
```
Deletion in lib/Aftok/Database/PostgreSQL.hs at line 51 [10.456]
B:BD[10.1462] → [2.1933:2034]
∅:D[2.2034] → [14.2103:2104]
B:BD[14.2103] → [14.2103:2104]
```
subscriptionIdParser :: RowParser B.SubscriptionId
subscriptionIdParser = B.SubscriptionId <$> field
```

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 84 [10.456]

B:BD[7.2201] → [2.2418:2606]

      parser "credit_to_user"     = CreditToUser    <$> (nullField *> uidParser <* nullField)
      parser "credit_to_project"  = CreditToProject <$> (nullField *> nullField *> pidParser)

[7.2201]

[7.2409]

      parser "credit_to_user"     = CreditToUser    <$> (nullField *> idParser UserId <* nullField)
      parser "credit_to_project"  = CreditToProject <$> (nullField *> nullField *> idParser P.ProjectId)

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 101 [10.456]

B:BD[9.1988] → [2.2665:2707]

  (,,) <$> pidParser
       <*> uidParser

[9.1988]

[15.95]

  (,,) <$> idParser P.ProjectId
       <*> idParser UserId

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 107 [10.456]

B:BD[9.2039] → [2.2708:2760]

  A.Auction <$> pidParser
            <*> uidParser

[9.2039]

[2.2760]

  A.Auction <$> idParser P.ProjectId
            <*> idParser UserId

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 116 [10.456]
B:BD[9.2052] → [2.2865:2887]
```
  A.Bid <$> uidParser
```
[9.2052]
[2.2887]
```
  A.Bid <$> idParser UserId
```
Deletion in lib/Aftok/Database/PostgreSQL.hs at line 126 [10.456]
∅:D[16.1010] → [10.2934:2935]
∅:D[14.2239] → [10.2934:2935]
B:BD[10.2934] → [10.2934:2935]
B:BD[10.2935] → [17.384:421]
B:BD[17.421] → [9.2161:2177]
B:BD[9.2177] → [2.2997:3017]
∅:D[9.2207] → [16.1094:1115]
∅:D[2.3017] → [16.1094:1115]
B:BD[16.1094] → [16.1094:1115]
```
qdbUserParser :: RowParser KeyedUser
qdbUserParser =
  (,) <$> uidParser
      <*> userParser
```
Replacement in lib/Aftok/Database/PostgreSQL.hs at line 131 [10.456]
B:BD[2.3044] → [2.3044:3070]
```
            <*> uidParser
```
[2.3044]
[7.3169]
```
            <*> idParser UserId
```

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 136 [10.456]

B:BD[9.2298] → [2.3071:3129]

  P.Invitation <$> pidParser
               <*> uidParser

[9.2298]

[2.3129]

  P.Invitation <$> idParser P.ProjectId
               <*> idParser UserId

Deletion in lib/Aftok/Database/PostgreSQL.hs at line 141 [10.456]
∅:D[7.3457] → [14.2530:2531]
B:BD[14.2530] → [14.2530:2531]
∅:D[14.2531] → [17.461:504]
B:BD[18.314] → [17.461:504]
B:BD[17.504] → [9.2299:2318]
B:BD[9.2318] → [2.3195:3215]
∅:D[9.2348] → [16.1337:1361]
∅:D[2.3215] → [16.1337:1361]
B:BD[16.1337] → [16.1337:1361]
```
qdbProjectParser :: RowParser KeyedProject
qdbProjectParser =
  (,) <$> pidParser
      <*> projectParser
```

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 144 [10.456]

B:BD[7.3516] → [2.3256:3310]

  B.Billable <$> pidParser
             <*> uidParser

[7.3516]

[2.3310]

  B.Billable <$> idParser P.ProjectId
             <*> idParser UserId

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 150 [10.456]
B:BD[2.3417] → [2.3417:3451]
```
             <*> (Days <$> field)
```
[2.3417]
[2.3451]
```
             <*> field
```

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 158 [10.456]

B:BD[2.3727] → [2.3727:3786]

      prec "semimonthly" = nullField *> pure B.SemiMonthly

[2.3727]

[2.3786]

      --prec "semimonthly" = nullField *> pure B.SemiMonthly

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 161 [10.456]

B:BD[2.3887] → [2.3887:3920]

      prec _             = empty

[2.3887]

[2.3920]

      prec s             = fail $ "Unrecognized recurrence type: " ++ show s

Insertion in lib/Aftok/Database/PostgreSQL.hs at line 169 [10.456]

[2.4146]

[19.293]


paymentRequestParser :: RowParser PaymentRequest
paymentRequestParser = 
  PaymentRequest <$> (B.SubscriptionId <$> field)
                 <*> (field >>= (either fail pure . runGet decodeMessage))
                 <*> (toThyme <$> field)
                 <*> (toThyme <$> field)
paymentParser :: RowParser Payment
paymentParser = 
  Payment <$> (PaymentRequestId <$> field)
          <*> (field >>= (either fail pure . runGet decodeMessage))
          <*> (toThyme <$> field)

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 350 [10.456]

B:BD[19.668] → [2.4789:4815]

∅:D[2.4815] → [7.9039:9145]

B:BD[7.9039] → [7.9039:9145]

pgEval (ReadBids aucId) =
  pquery bidParser
    "SELECT user_id, bid_seconds, bid_amount, bid_time FROM bids WHERE auction_id = ?"

[19.668]

[7.9145]

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

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 371 [10.456]
∅:D[2.4918] → [7.9708:9743]
B:BD[7.9708] → [7.9708:9743]
```
  headMay <$> pquery qdbUserParser
```
[2.4918]
[7.9743]
```
  headMay <$> pquery ((,) <$> idParser UserId <*> userParser)
```
Replacement in lib/Aftok/Database/PostgreSQL.hs at line 412 [10.456]
∅:D[2.5200] → [7.11387:11413]
B:BD[7.11387] → [7.11387:11413]
```
  pquery qdbProjectParser
```
[2.5200]
[7.11413]
```
  pquery ((,) <$> idParser P.ProjectId <*> projectParser)
```
Replacement in lib/Aftok/Database/PostgreSQL.hs at line 437 [10.456]
B:BD[2.5529] → [2.5529:5564]
```
    , b ^. (B.gracePeriod . _Days)
```
[2.5529]
[7.12451]
```
    , b ^. (B.gracePeriod)
```
Replacement in lib/Aftok/Database/PostgreSQL.hs at line 440 [10.456]
B:BD[4.3719] → [2.5565:5593]
```
pgEval (ReadBillable bid) =
```
[4.3719]
[7.12491]
```
pgEval (FindBillable bid) =
```

Insertion in lib/Aftok/Database/PostgreSQL.hs at line 455 [10.456]

[2.5781]


pgEval (FindSubscription sid) = 
  headMay <$> pquery subscriptionParser
    "SELECT id, billable_id, start_date, end_date \
    \FROM subscriptions s \
    \WHERE s.id = ?"
    (Only (sid ^. B._SubscriptionId))

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 464 [10.456]

B:BD[2.5820] → [2.5820:5883]

  pquery ((,) <$> subscriptionIdParser <*> subscriptionParser)

[2.5820]

[2.5883]

  pquery ((,) <$> idParser B.SubscriptionId <*> subscriptionParser)

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 477 [10.456]

B:BD[11.959] → [11.959:1044]

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

[11.959]

[2.6158]

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

Insertion in lib/Aftok/Database/PostgreSQL.hs at line 482 [10.456]

[11.1180]

    , req ^. (paymentRequestTime . to fromThyme)
    , req ^. (billingDate . to fromThyme)

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 486 [10.456]

B:BD[8.1568] → [2.6207:6248]

pgEval dbop @ (CreatePayment _ req) = do

[8.1568]

[20.48]

pgEval (FindPaymentRequest rid) = 
  headMay <$> pquery paymentRequestParser
  "SELECT subscription_id, request_data, request_time, billing_date \
  \FROM payment_requests \
  \WHERE id = ?"
  (Only (rid ^. _PaymentRequestId))
  
pgEval (FindPaymentRequests sid) = 
  pquery ((,) <$> idParser PaymentRequestId <*> paymentRequestParser)
  "SELECT id, subscription_id, request_data, request_time, billing_date \
  \FROM payment_requests \
  \WHERE subscription_id = ?"
  (Only (sid ^. B._SubscriptionId))
pgEval dbop @ (CreatePayment _ p) = do

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 504 [10.456]

B:BD[20.129] → [20.129:260]

    \(payment_request_id, event_id, payment_data) \
    \VALUES (?, ?, ?) RETURNING id"
    ( req ^. (request . _PaymentRequestId)

[20.129]

[20.260]

    \(payment_request_id, event_id, payment_data, payment_date) \
    \VALUES (?, ?, ?, ?) RETURNING id"
    ( p ^. (request . _PaymentRequestId)

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 508 [10.456]

B:BD[20.286] → [20.286:339]

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

[20.286]

[20.339]

    , p ^. (payment . to (runPut . encodeMessage))
    , p ^. (paymentDate . to fromThyme)

Insertion in lib/Aftok/Database/PostgreSQL.hs at line 511 [10.456]

[20.345]

[19.1044]


pgEval (FindPayments rid) = 
  pquery ((,) <$> idParser PaymentId <*> paymentParser)
  "SELECT id, payment_request_id, payment_data, payment_date \
  \FROM payments \
  \WHERE payment_request_id = ?"
  (Only (rid ^. _PaymentRequestId))

Insertion in lib/Aftok/Database.hs at line 11 [5.4936]
[2.6460]
[21.173]
```
import           Control.Monad.Trans.Maybe (MaybeT(..))
```
Deletion in lib/Aftok/Database.hs at line 24 [5.4936]
B:BD[17.5920] → [17.5920:5956]
```
type KeyedUser     = (UserId, User)
```
Deletion in lib/Aftok/Database.hs at line 25 [5.4936]
B:BD[17.6007] → [17.6007:6049]
```
type KeyedProject  = (ProjectId, Project)
```

Replacement in lib/Aftok/Database.hs at line 31 [5.4936]

B:BD[17.6248] → [17.6248:6305]

  FindUserByName   :: UserName -> DBOp (Maybe KeyedUser)

[17.6248]

[17.6305]

  FindUserByName   :: UserName -> DBOp (Maybe (UserId, User))

Replacement in lib/Aftok/Database.hs at line 35 [5.4936]

B:BD[17.6410] → [17.6410:6462]

  FindUserProjects :: UserId -> DBOp [KeyedProject]

[17.6410]

[17.6462]

  FindUserProjects :: UserId -> DBOp [(ProjectId, Project)]

Replacement in lib/Aftok/Database.hs at line 50 [5.4936]
B:BD[17.7028] → [17.7028:7074]
```
  ReadBids         :: AuctionId -> DBOp [Bid]
```
[17.7028]
[4.4052]
```
  FindBids         :: AuctionId -> DBOp [(BidId, Bid)]
```
Replacement in lib/Aftok/Database.hs at line 53 [5.4936]
∅:D[13.1063] → [7.13324:13382]
B:BD[7.13324] → [7.13324:13382]
```
  ReadBillable     :: BillableId -> DBOp (Maybe Billable)
```
[13.1063]
[7.13382]
```
  FindBillable     :: BillableId -> DBOp (Maybe Billable)
```

Insertion in lib/Aftok/Database.hs at line 56 [5.4936]

[2.6570]

  FindSubscription  :: SubscriptionId -> DBOp (Maybe Subscription)

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

B:BD[4.4200] → [13.1064:1202]

  CreatePaymentRequest :: UserId -> PaymentRequest -> DBOp PaymentRequestId
  CreatePayment        :: UserId -> Payment -> DBOp PaymentId

[4.4200]

[17.7074]

  CreatePaymentRequest  :: UserId -> PaymentRequest -> DBOp PaymentRequestId
  FindPaymentRequest    :: PaymentRequestId -> DBOp (Maybe PaymentRequest)
  FindPaymentRequests   :: SubscriptionId -> DBOp [(PaymentRequestId, PaymentRequest)]
  CreatePayment  :: UserId -> Payment -> DBOp PaymentId
  FindPayments   :: PaymentRequestId -> DBOp [(PaymentId, Payment)]

Replacement in lib/Aftok/Database.hs at line 102 [5.4936]

B:BD[5.5045] → [2.7219:7284]

findUserByName :: (MonadDB m) => UserName -> m (Maybe KeyedUser)

[5.5045]

[2.7284]

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

Replacement in lib/Aftok/Database.hs at line 118 [5.4936]

B:BD[21.565] → [2.7489:7551]

findUserProjects :: (MonadDB m) => UserId -> m [KeyedProject]

[21.565]

[2.7551]

findUserProjects :: (MonadDB m) => UserId -> m [(ProjectId, Project)]

Replacement in lib/Aftok/Database.hs at line 189 [5.4936]

B:BD[4.4547] → [2.9037:9138]

readBillable :: (MonadDB m) => BillableId -> m (Maybe Billable)
readBillable = liftdb . ReadBillable

[4.4547]

[4.4654]

findBillable :: (MonadDB m) => BillableId -> MaybeT m Billable
findBillable = MaybeT . liftdb . FindBillable
findSubscriptions :: (MonadDB m) => UserId -> ProjectId -> m [(SubscriptionId, Subscription)]
findSubscriptions uid pid = liftdb $ FindSubscriptions uid pid
findSubscriptionBillable :: (MonadDB m) => SubscriptionId -> MaybeT m (Subscription' Billable)
findSubscriptionBillable sid = do
  sub <- MaybeT . liftdb $ FindSubscription sid
  traverse findBillable sub

Replacement in lib/Aftok/Database.hs at line 200 [5.4936]

B:BD[4.4655] → [2.9139:9535]

findSubscriptions :: (MonadDB m) 
                  => UserId 
                  -> ProjectId 
                  -> m [(SubscriptionId, Subscription' Billable)]
findSubscriptions uid pid = do
  subscriptions <- liftdb $ FindSubscriptions uid pid
  let sub'' s = sequenceA <$> traverse readBillable s
      sub' (sid, s) = fmap (fmap (sid,)) (sub'' s)
  catMaybes <$> traverse sub' subscriptions

[4.4655]

[8.1594]

findPaymentRequests :: (MonadDB m) => SubscriptionId -> m [(PaymentRequestId, PaymentRequest)]
findPaymentRequests = liftdb . FindPaymentRequests

Replacement in lib/Aftok/Database.hs at line 203 [5.4936]

B:BD[8.1595] → [2.9536:9595]

∅:D[20.515] → [4.4861:4910]

∅:D[2.9595] → [4.4861:4910]

∅:D[7.13896] → [4.4861:4910]

B:BD[4.4861] → [4.4861:4910]

readPaymentHistory :: (MonadDB m) => UserId -> m [Payment]
readPaymentHistory = error "Not yet implemented"

[8.1595]

[4.4910]

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

Insertion in lib/Aftok/Json.hs at line 24 [24.19]
[22.58]
[23.3094]
```
import           Data.Thyme.Calendar (showGregorian)
```
Deletion in lib/Aftok/Json.hs at line 30 [24.19]
∅:D[25.115] → [21.1294:1326]
∅:D[13.1404] → [21.1294:1326]
B:BD[21.1294] → [21.1294:1326]
```
import           Aftok.Database
```
Deletion in lib/Aftok/Json.hs at line 33 [24.19]
B:BD[25.171] → [2.10086:10114]
```
import           Aftok.Time
```
Replacement in lib/Aftok/Json.hs at line 102 [24.19]
B:BD[24.486] → [17.9335:9375]
```
qdbProjectJSON :: KeyedProject -> Value
```
[24.486]
[14.6629]
```
qdbProjectJSON :: (ProjectId, Project) -> Value
```

Replacement in lib/Aftok/Json.hs at line 181 [24.19]

B:BD[2.10168] → [2.10168:10224]

      , "gracePeriod" .= (b ^. (B.gracePeriod . _Days))

[2.10168]

[2.10224]

      , "gracePeriod" .= (b ^. B.gracePeriod)

Replacement in lib/Aftok/Json.hs at line 188 [24.19]

B:BD[13.2030] → [13.2030:2095]

recurrenceJSON' B.SemiMonthly = object [ "semimonthly" .= Null ]

[13.2030]

[13.2095]

--recurrenceJSON' B.SemiMonthly = object [ "semimonthly" .= Null ]

Replacement in lib/Aftok/Json.hs at line 202 [24.19]

B:BD[12.907] → [12.907:967]

      , "payment_request_date" .= (r ^. paymentRequestDate)

[12.907]

[12.967]

      , "payment_request_time" .= (r ^. paymentRequestTime)
      , "billing_date" .= (r ^. (billingDate . to showGregorian))

Insertion in lib/Aftok/Payments/Types.hs at line 2 [2.10545]

[2.10579]

{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}

Insertion in lib/Aftok/Payments/Types.hs at line 12 [2.10545]
[2.10704]
[2.10704]
```
import           Data.Thyme.Time     as T
```

Insertion in lib/Aftok/Payments/Types.hs at line 16 [2.10545]

[2.10774]

import           Network.Bippy.Types (expiryTime, getPaymentDetails, getExpires)

Replacement in lib/Aftok/Payments/Types.hs at line 30 [2.10545]

B:BD[2.11150] → [2.11150:11191]

  , _paymentRequestDate :: C.UTCTime
  }

[2.11150]

[2.11191]

  , _paymentRequestTime :: C.UTCTime
  , _billingDate        :: T.Day
  } deriving (Functor, Foldable, Traversable)

Replacement in lib/Aftok/Payments/Types.hs at line 41 [2.10545]
B:BD[2.11383] → [2.11383:11387]
```
  }
```
[2.11383]
[2.11387]
```
  } deriving (Functor, Foldable, Traversable)
```

Replacement in lib/Aftok/Payments/Types.hs at line 46 [2.10545]

B:BD[2.11452] → [2.11452:11453]

[2.11452]

{- Check whether the specified payment request has expired (whether wallet software
 - will still consider the payment request valid)
 -}
isExpired :: C.UTCTime -> P.PaymentRequest -> Bool
isExpired now req = 
  let check = any ((now >) . T.toThyme . expiryTime)
  -- using error here is reasonable since it would indicate 
  -- a serialization problem
  in  either error (check . getExpires) $ getPaymentDetails req

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

B:BD[4.5782] → [2.11615:11677]

import           Control.Lens  (makeLenses, view, (%~), (^.))

[4.5782]

[2.11677]

import           Control.Error.Util (maybeT)
import           Control.Lens  (makeClassy, makeClassyPrisms, view, (%~), (^.), review)

Replacement in lib/Aftok/Payments.hs at line 14 [4.5686]

B:BD[2.11713] → [2.11713:11829]

import           Control.Monad.Except (MonadError)
import           Crypto.PubKey.RSA.Types (Error(..), PrivateKey)

[2.11713]

[2.11829]

import           Control.Monad.Except (MonadError, throwError)
import qualified Crypto.PubKey.RSA.Types as RSA (Error(..), PrivateKey)

Insertion in lib/Aftok/Payments.hs at line 20 [4.5686]
[2.11965]
[8.2276]
```
import           Data.Thyme.Time     as T
```
Deletion in lib/Aftok/Payments.hs at line 22 [4.5686]
B:BD[8.2318] → [2.11966:12016]
```
import           Data.Thyme.Time.Core (fromThyme)
```
Replacement in lib/Aftok/Payments.hs at line 39 [4.5686]
B:BD[2.12522] → [2.12522:12552]
```
  , _signingKey :: PrivateKey
```
[2.12522]
[2.12552]
```
  , _signingKey :: RSA.PrivateKey
```

Replacement in lib/Aftok/Payments.hs at line 42 [4.5686]

B:BD[2.12583] → [2.12583:12610]

makeLenses ''BillingConfig

[2.12583]

[2.12610]

makeClassy ''BillingConfig
data BillingOps (m :: * -> *) = BillingOps
  { 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
  }
data PaymentRequestStatus 
  = 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

Insertion in lib/Aftok/Payments.hs at line 55 [4.5686]

[2.12611]

data PaymentError
  = Overdue SubscriptionId
  | SigningError RSA.Error
makeClassyPrisms ''PaymentError

Replacement in lib/Aftok/Payments.hs at line 61 [4.5686]

B:BD[2.12612] → [2.12612:13259]

createPaymentRequests :: (MonadRandom m, MonadReader BillingConfig m, MonadError Error m, MonadDB m) => 
                         C.UTCTime -- timestamp for payment request creation
                      -> (Subscription' Billable -> m (Maybe Text))       -- generator user memo
                      -> (Subscription' Billable -> m (Maybe URI))        -- generator for payment response URL
                      -> (Subscription' Billable -> m (Maybe ByteString)) -- generator for merchant payload
                      -> UserId    -- user responsible for payment
                      -> ProjectId -- project whose worklog is to be paid out to

[2.12612]

[2.13259]

createPaymentRequests :: ( MonadRandom m
                         , MonadReader r m, HasBillingConfig r
                         , MonadError e m,  AsPaymentError e
                         , MonadDB m
                         ) 
                      => BillingOps m -- ^ generators for payment request components
                      -> C.UTCTime    -- ^ timestamp for payment request creation
                      -> UserId       -- ^ customer responsible for payment
                      -> ProjectId    -- ^ project whose worklog is to be paid

Replacement in lib/Aftok/Payments.hs at line 71 [4.5686]
B:BD[2.13305] → [2.13305:13366]
```
createPaymentRequests t memogen urigen plgen custId pid = do
```
[2.13305]
[2.13366]
```
createPaymentRequests ops now custId pid = do
```

Insertion in lib/Aftok/Payments.hs at line 73 [4.5686]

[2.13414]

  join <$> traverse (createSubscriptionPaymentRequests ops now custId) subscriptions 
createSubscriptionPaymentRequests :: 
     ( MonadRandom m
     , MonadReader r m, HasBillingConfig r
     , MonadError e m, AsPaymentError e
     , MonadDB m
     ) 
  => BillingOps m 
  -> C.UTCTime
  -> UserId
  -> (SubscriptionId, Subscription)
  -> m [PaymentRequestId]
createSubscriptionPaymentRequests ops now custId (sid, sub) = do
  billableSub <- maybeT (raiseSubjectNotFound . FindBillable $ sub ^. billable) pure $
                 traverse findBillable sub
  paymentRequests <- findPaymentRequests sid
  billableDates   <- findUnbilledDates now (view billable billableSub) paymentRequests $
                     takeWhile (< view _utctDay now) $ billingSchedule billableSub
  traverse (createPaymentRequest ops now custId sid billableSub) billableDates
createPaymentRequest :: 
     ( MonadRandom m
     , MonadReader r m, HasBillingConfig r
     , MonadError e m, AsPaymentError e
     , MonadDB m
     ) 
  => BillingOps m 
  -> C.UTCTime
  -> UserId
  -> SubscriptionId
  -> Subscription' Billable
  -> T.Day
  -> m PaymentRequestId
createPaymentRequest ops now custId sid sub bday = do

Replacement in lib/Aftok/Payments.hs at line 109 [4.5686]

B:BD[2.13427] → [2.13427:13603]

  let createPaymentDetails' s = do
        memo <- memogen s
        uri <- urigen s
        payload <- plgen s
        createPaymentDetails t memo uri payload (s ^. billable)

[2.13427]

[20.610]

  memo    <- memoGen ops sub
  uri     <- uriGen ops sub
  payload <- payloadGen ops sub
  details <- createPaymentDetails bday now memo uri payload (sub ^. billable)
  reqErr  <- B.createPaymentRequest (cfg ^. signingKey) (cfg ^. pkiData) details
  req     <- either (throwError . review _SigningError) pure reqErr
  liftdb $ CreatePaymentRequest custId (PaymentRequest sid req now bday)
  
{-
 - FIXME: The current implementation expects the billing day to be a suitable
 - key for comparison to payment requests. This is almost certainly inadequate.
 -}
findUnbilledDates :: (MonadDB m, MonadError e m, AsPaymentError e)
                  => C.UTCTime -- ^ the date against which payment request expiration should be checked
                  -> Billable
                  -> [(PaymentRequestId, PaymentRequest)] -- ^ the list of existing payment requests 
                  -> [T.Day]   -- ^ the list of expected billing days
                  -> m [T.Day] -- ^ the list of billing days for which no payment request exists
findUnbilledDates now b (px @ (p : ps)) (dx @ (d : ds)) =
  case compare (view (_2 . billingDate) p) d of
    EQ -> getRequestStatus now p >>= \s -> case s of
            Expired r -> if view _utctDay now > addDays (view gracePeriod b) (view billingDate r) 
                           then throwError (review _Overdue (r ^. subscription))
                           else fmap (d :) $ findUnbilledDates now b px dx -- d will be rebilled
            _         -> findUnbilledDates now b ps ds -- if paid or unpaid, nothing to do
    GT -> fmap (d :) $ findUnbilledDates now b px ds 
    LT -> findUnbilledDates now b ps dx
findUnbilledDates _ _ _ ds = pure ds

Replacement in lib/Aftok/Payments.hs at line 138 [4.5686]

B:BD[20.611] → [2.13604:13890]

      createPaymentRequest (sid, s) = do
        details <- createPaymentDetails' s 
        req <- B.createPaymentRequest (cfg ^. signingKey) (cfg ^. pkiData) details
        liftdb $ CreatePaymentRequest custId (PaymentRequest sid req t)
  traverse createPaymentRequest subscriptions

[20.611]

[2.13890]


{- Check whether the specified payment request has a payment associated with
 - it, and return a PaymentRequestStatus value indicating the result.
 -}
getRequestStatus :: (MonadDB m) 
                 => C.UTCTime -- ^ the date against which request expiration should be checked
                 -> (PaymentRequestId, PaymentRequest) -- ^ the request for which to find a payment
                 -> m PaymentRequestStatus
getRequestStatus now (reqid, req) = 
  let ifUnpaid = (if isExpired now (view paymentRequest req) then Expired else Unpaid) req
  in  maybe ifUnpaid Paid <$> findPayment reqid

Replacement in lib/Aftok/Payments.hs at line 150 [4.5686]

B:BD[2.13891] → [2.13891:14275]

createPaymentDetails :: (MonadRandom m, MonadReader BillingConfig m, MonadDB m) =>
                        C.UTCTime         -- timestamp for payment request creation
                     -> Maybe Text        -- user memo
                     -> Maybe URI         -- payment response URL
                     -> Maybe ByteString  -- merchant payload
                     -> Billable

[2.13891]

[2.14275]

{- Create the PaymentDetails section of the payment request.
 -}
createPaymentDetails :: (MonadRandom m, MonadReader r m, HasBillingConfig r, MonadDB m) 
                     => T.Day              -- ^ payout date (billing date)
                     -> C.UTCTime          -- ^ timestamp of payment request creation
                     -> Maybe Text         -- ^ user memo
                     -> Maybe URI          -- ^ payment response URL
                     -> Maybe ByteString   -- ^ merchant payload
                     -> Billable           -- ^ billing information

Replacement in lib/Aftok/Payments.hs at line 160 [4.5686]

B:BD[2.14318] → [2.14318:14551]

createPaymentDetails t memo uri payload b = do
  payouts <- getProjectPayouts t (b ^. project)
  outputs <- createPayoutsOutputs t (b ^. amount) payouts
  let expiry = (BT.Expiry . fromThyme . (t .+^)) <$> (b ^. requestExpiryPeriod)

[2.14318]

[2.14551]

createPaymentDetails payoutDate billingTime memo uri payload b = do
  payouts <- getProjectPayouts payoutTime (b ^. project)
  outputs <- createPayoutsOutputs payoutTime (b ^. amount) payouts
  let expiry = (BT.Expiry . T.fromThyme . (billingTime .+^)) <$> (b ^. requestExpiryPeriod)

Replacement in lib/Aftok/Payments.hs at line 165 [4.5686]

B:BD[2.14564] → [2.14564:14659]

  pure $ B.createPaymentDetails (cfg ^. network) outputs (fromThyme t) expiry memo uri payload

[2.14564]

[2.14659]

  pure $ B.createPaymentDetails 
    (cfg ^. network) 
    outputs 
    (T.fromThyme billingTime) 
    expiry memo uri payload
  where 
    payoutTime = T.mkUTCTime payoutDate (fromInteger 0)

Replacement in server/Aftok/Snaplet/Projects.hs at line 46 [26.2363]
B:BD[26.3443] → [2.18063:18118]
```
projectListHandler :: S.Handler App App [KeyedProject]
```
[26.3443]
[27.1433]
```
projectListHandler :: S.Handler App App [(ProjectId, Project)]
```

Replacement in stack.yaml at line 6 [28.1074]

B:BD[4.10594] → [2.23287:23340]

    commit: ddfc1bf0911351d0be51f33ea9e4166a24d2b19a

[4.10594]

[4.10647]

    commit: 97fda0368ae660239d1b9398d44530cd5b05eec3

Implement payment request creation functions.

Dependencies

In channels

Change contents

Deletion in aftok.cabal at line 34 [5.1]

Insertion in aftok.cabal at line 72 [5.1]

File deletion: Time.hs

Replacement in lib/Aftok/Billables.hs at line 10 [4.760]

Deletion in lib/Aftok/Billables.hs at line 18 [4.760]

Replacement in lib/Aftok/Billables.hs at line 25 [4.760]

Replacement in lib/Aftok/Billables.hs at line 34 [4.760]

Replacement in lib/Aftok/Billables.hs at line 41 [4.760]

Replacement in lib/Aftok/Billables.hs at line 68 [4.760]

Replacement in lib/Aftok/Billables.hs at line 77 [4.760]

Insertion in lib/Aftok/Billables.hs at line 86 [4.760]

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 11 [10.456]

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 34 [10.456]

Deletion in lib/Aftok/Database/PostgreSQL.hs at line 36 [10.456]

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 48 [10.456]

Deletion in lib/Aftok/Database/PostgreSQL.hs at line 51 [10.456]

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 84 [10.456]

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 101 [10.456]

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 107 [10.456]

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 116 [10.456]

Deletion in lib/Aftok/Database/PostgreSQL.hs at line 126 [10.456]

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 131 [10.456]

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 136 [10.456]

Deletion in lib/Aftok/Database/PostgreSQL.hs at line 141 [10.456]

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 144 [10.456]

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 150 [10.456]

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 158 [10.456]

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 161 [10.456]

Insertion in lib/Aftok/Database/PostgreSQL.hs at line 169 [10.456]

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 350 [10.456]

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 371 [10.456]

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 412 [10.456]

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 437 [10.456]

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 440 [10.456]

Insertion in lib/Aftok/Database/PostgreSQL.hs at line 455 [10.456]

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 464 [10.456]

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 477 [10.456]

Insertion in lib/Aftok/Database/PostgreSQL.hs at line 482 [10.456]

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 486 [10.456]

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 504 [10.456]

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 508 [10.456]

Insertion in lib/Aftok/Database/PostgreSQL.hs at line 511 [10.456]

Insertion in lib/Aftok/Database.hs at line 11 [5.4936]

Deletion in lib/Aftok/Database.hs at line 24 [5.4936]

Deletion in lib/Aftok/Database.hs at line 25 [5.4936]

Replacement in lib/Aftok/Database.hs at line 31 [5.4936]

Replacement in lib/Aftok/Database.hs at line 35 [5.4936]

Replacement in lib/Aftok/Database.hs at line 50 [5.4936]

Replacement in lib/Aftok/Database.hs at line 53 [5.4936]

Insertion in lib/Aftok/Database.hs at line 56 [5.4936]

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

Replacement in lib/Aftok/Database.hs at line 102 [5.4936]

Replacement in lib/Aftok/Database.hs at line 118 [5.4936]

Replacement in lib/Aftok/Database.hs at line 189 [5.4936]

Replacement in lib/Aftok/Database.hs at line 200 [5.4936]

Replacement in lib/Aftok/Database.hs at line 203 [5.4936]

Insertion in lib/Aftok/Json.hs at line 24 [24.19]

Deletion in lib/Aftok/Json.hs at line 30 [24.19]

Deletion in lib/Aftok/Json.hs at line 33 [24.19]

Replacement in lib/Aftok/Json.hs at line 102 [24.19]

Replacement in lib/Aftok/Json.hs at line 181 [24.19]

Replacement in lib/Aftok/Json.hs at line 188 [24.19]

Replacement in lib/Aftok/Json.hs at line 202 [24.19]

Insertion in lib/Aftok/Payments/Types.hs at line 2 [2.10545]

Insertion in lib/Aftok/Payments/Types.hs at line 12 [2.10545]

Insertion in lib/Aftok/Payments/Types.hs at line 16 [2.10545]

Replacement in lib/Aftok/Payments/Types.hs at line 30 [2.10545]

Replacement in lib/Aftok/Payments/Types.hs at line 41 [2.10545]

Replacement in lib/Aftok/Payments/Types.hs at line 46 [2.10545]

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

Replacement in lib/Aftok/Payments.hs at line 14 [4.5686]

Insertion in lib/Aftok/Payments.hs at line 20 [4.5686]

Deletion in lib/Aftok/Payments.hs at line 22 [4.5686]

Replacement in lib/Aftok/Payments.hs at line 39 [4.5686]

Replacement in lib/Aftok/Payments.hs at line 42 [4.5686]

Insertion in lib/Aftok/Payments.hs at line 55 [4.5686]