Adds storage of original event JSON for some DBOp constructors.

[?]

Jan 21, 2017, 9:11 PM

O227CEAV7BTKSE3SSC7XHC5IWEBXZL2AOOKJMBMOOFNTLINBLQMAC

Dependencies

[2] QADKFHAR Adds CreatePayment handler implementation.
[3] NEDDHXUK Reformat via stylish-haskell
[4] 7VGYLTMU Clean up schema version handling.
[5] 73NDXDEZ Begin implementation of billing event persistence.
[6] A6HKMINB Attempting to improve JSON handling.
[7] GCVQD44V Create amends endpoint, switch to UUID primary keys
[8] Y3LIJ5US Add handler for CreatePaymentRequest
[9] IZEVQF62 Work in progress replacing sqlite with postgres.
[10] 7HPY3QPF Fix linting errors. (yay hlint!)
[11] POX3UAMT Enabling logging of time to contributor/project accounts
[12] O722AOKE Add route to allow crediting of events to users/projects.
[13] RPAJLHMT Change to use UUIDs instead of ints for primary keys.
[14] QMRKFEPG Refactor QDB to use a free monad algebra instead.
[15] HALRDT2F Added initial auction create route.
[16] DFOBMSAO Initial work on payments API
[17] NAS4BFL4 Trivial stylish-haskell reformat.
[18] 3QVT6MA6 Add database support for event amend operations.
[19] O5FVTOM6 Undo JSON silliness, enable a couple more routes.
[*] 64C6AWH6 Rename Ananke -> Quixotic, project reboot.
[*] W35DDBFY Factor common JSON conversions up into client lib module.
[*] Z3MK2PJ5 Add GET handler for retrieving auction data.
[*] NLZ3JXLO Fix formatting with stylish-haskell.

Change contents

replacement in lib/Aftok/Database/PostgreSQL.hs at line 9

[3.1043]→[3.1043:1106](∅→∅)

import Data.Aeson (toJSON)

[3.1043]

[3.1106]

import Data.Aeson (toJSON, Value)
edit in lib/Aftok/Database/PostgreSQL.hs at line 30

[3.1678]

[3.173]

import Aftok.Json (billableJSON, subscriptionJSON)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 206

[3.3794]→[3.3794:4029](∅→∅)

storeEvent (CreateBillable _) = error "Not implemented"
storeEvent (CreateSubscription _ _) = error "Not implemented"
storeEvent (CreatePaymentRequest _) = error "Not implemented"
storeEvent (CreatePayment _) = error "Not implemented"

[3.3794]

[3.4029]

storeEvent (CreateBillable uid b) =
Just $ storeEventJSON uid "create_billable" (billableJSON b)

storeEvent (CreateSubscription uid bid) =
Just $ storeEventJSON uid "create_subscription" (subscriptionJSON uid bid)

storeEvent (CreatePaymentRequest _ _) = error "Not implemented"
storeEvent (CreatePayment _ _) = error "Not implemented"
edit in lib/Aftok/Database/PostgreSQL.hs at line 215

[3.4052]

[3.425]

type EventType = Text

storeEventJSON :: UserId -> EventType -> Value -> QDBM EventId
storeEventJSON uid t v = do
timestamp <- liftIO C.getCurrentTime
pinsert EventId
"INSERT INTO aftok_events \
\(event_time, created_by, event_type, event_json) \
\VALUES (?, ?, ?, ?) RETURNING id"
(fromThyme timestamp, uid ^. _UserId, t, v)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 421

[3.1043]→[3.11873:11916](∅→∅)

updateCache dbop @ (CreateBillable b) = do

[3.1043]

[3.11916]

updateCache dbop @ (CreateBillable _ b) = do
replacement in lib/Aftok/Database/PostgreSQL.hs at line 453

[3.812]→[3.812:863](∅→∅)

updateCache dbop @ (CreatePaymentRequest req) = do

[3.812]

[3.863]

updateCache dbop @ (CreatePaymentRequest _ req) = do
replacement in lib/Aftok/Database/PostgreSQL.hs at line 464

[3.1189]→[2.4:48](∅→∅)

updateCache dbop @ (CreatePayment req) = do

[3.1189]

[2.48]

updateCache dbop @ (CreatePayment _ req) = do
replacement in lib/Aftok/Database.hs at line 53

[3.4053]→[3.13274:13324](∅→∅)

CreateBillable :: Billable -> DBOp BillableId

[3.4053]

[3.13324]

CreateBillable :: UserId -> Billable -> DBOp BillableId
replacement in lib/Aftok/Database.hs at line 58

[3.4200]→[2.347:465](∅→∅)

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

[3.4200]

[3.7074]

CreatePaymentRequest :: UserId -> PaymentRequest -> DBOp PaymentRequestId
CreatePayment :: UserId -> Payment -> DBOp PaymentId
replacement in lib/Aftok/Database.hs at line 177

[3.834]→[3.13638:13774](∅→∅)

createBillable :: Billable -> DBProg BillableId
createBillable b = withProjectAuth (b ^. B.project) (b ^. B.creator) $ CreateBillable b

[3.834]

[3.4546]

createBillable :: UserId -> Billable -> DBProg BillableId
createBillable uid b =
withProjectAuth (b ^. B.project) uid $ CreateBillable uid b
edit in lib/Aftok/Json.hs at line 24

[23.115]

[24.1294]

import qualified Aftok.Billables as B
replacement in lib/Aftok/Json.hs at line 155

[3.131]→[3.131:254](∅→∅)

logEventJSON :: LogEvent -> Value
logEventJSON ev = object [ eventName ev .= object [ "eventTime" .= (ev ^. eventTime) ] ]

[3.131]

[3.254]

logEventJSON' :: LogEvent -> Value
logEventJSON' ev = object [ eventName ev .= object [ "eventTime" .= (ev ^. eventTime) ] ]
replacement in lib/Aftok/Json.hs at line 161

[3.2274]→[3.2274:2309](∅→∅)

, "event" .= logEventJSON ev

[3.2274]

[3.2309]

, "event" .= logEventJSON' ev
edit in lib/Aftok/Json.hs at line 168

[3.2380]

[3.5681]

billableJSON :: B.Billable -> Value
billableJSON b = v1 $
obj [ "projectId" .= tshow (b ^. (B.project . _ProjectId))
, "name" .= (b ^. B.name)
, "description" .= (b ^. B.description)
, "recurrence" .= recurrenceJSON' (b ^. B.recurrence)
]

recurrenceJSON' :: B.Recurrence -> Value
recurrenceJSON' B.Annually = object [ "annually" .= Null ]
recurrenceJSON' (B.Monthly i) = object [ "monthly " .= object [ "months" .= i ] ]
recurrenceJSON' B.SemiMonthly = object [ "semimonthly" .= Null ]
recurrenceJSON' (B.Weekly i) = object [ "weekly " .= object [ "weeks" .= i ] ]
recurrenceJSON' B.OneTime = object [ "onetime" .= Null ]
edit in lib/Aftok/Json.hs at line 184

[3.5682]

[3.5682]

subscriptionJSON :: UserId -> B.BillableId -> Value
subscriptionJSON uid bid = v1 $
obj [ "userId" .= tshow (uid ^. _UserId)
, "billableId" .= tshow (bid ^. B._BillableId)
]