nuttycom/aftok - Change RN7EI6INGUUHGMNY5RU3NH56WPLRZY5ZMYDNFMNE3TGV4ESFLQIAC

Update database layer to use CreditTo

Created by Kris Nuttycombe on October 14, 2016

RN7EI6INGUUHGMNY5RU3NH56WPLRZY5ZMYDNFMNE3TGV4ESFLQIAC

Dependencies

In channels

main

Change contents

Insertion in lib/Aftok/Database/PostgreSQL.hs at line 19 [5.456]
[4.1559]
[5.1011]
```
import           Database.PostgreSQL.Simple.Types     (Null)
```

Deletion in lib/Aftok/Database/PostgreSQL.hs at line 37 [5.456]

B:BD[6.2026] → [6.2026:2027]

∅:D[6.2027] → [7.39:94]

B:BD[5.1124] → [7.39:94]

∅:D[7.94] → [8.4:48]

B:BD[5.1165] → [8.4:48]

B:BD[8.48] → [4.1739:1769]

∅:D[4.1769] → [7.113:158]

B:BD[7.113] → [7.113:158]

B:BD[7.158] → [4.1770:1814]

∅:D[4.1814] → [7.203:469]

B:BD[7.203] → [7.203:469]

B:BD[7.469] → [4.1815:1824]

∅:D[4.1824] → [7.479:522]

B:BD[7.479] → [7.479:522]

B:BD[7.522] → [4.1825:1867]

∅:D[4.1867] → [7.565:765]

B:BD[7.565] → [7.565:765]


eventTypeParser :: FieldParser (C.UTCTime -> LogEvent)
eventTypeParser f v = do
  tn <- typename f
  case tn of
    "event_t" ->
      let err = UnexpectedNull (B.unpack tn)
                               (tableOid f)
                               (maybe "" B.unpack (name f))
                               "UTCTime -> LogEvent"
                               "columns of type event_t should not contain null values"
      in  maybe (conversionError err) (nameEvent . decodeUtf8) v
    _ ->
      let err = Incompatible (B.unpack tn)
                             (tableOid f)
                             (maybe "" B.unpack (name f))
                             "UTCTime -> LogEvent"
                             "column was not of type event_t"
      in conversionError err

Insertion in lib/Aftok/Database/PostgreSQL.hs at line 61 [5.456]

[4.1910]

[9.271]


nullField :: RowParser Null
nullField = field
eventTypeParser :: FieldParser (C.UTCTime -> LogEvent)
eventTypeParser f v = do
  tn <- typename f
  case tn of
    "event_t" ->
      let err = UnexpectedNull (B.unpack tn)
                               (tableOid f)
                               (maybe "" B.unpack (name f))
                               "UTCTime -> LogEvent"
                               "columns of type event_t should not contain null values"
      in  maybe (conversionError err) (nameEvent . decodeUtf8) v
    _ ->
      let err = Incompatible (B.unpack tn)
                             (tableOid f)
                             (maybe "" B.unpack (name f))
                             "UTCTime -> LogEvent"
                             "column was not of type event_t"
      in conversionError err

Insertion in lib/Aftok/Database/PostgreSQL.hs at line 84 [5.456]

[9.272]

[10.241]

creditToParser :: FieldParser (RowParser CreditTo)
creditToParser f v = do
  tn <- typename f
  let parser :: Text -> Conversion (RowParser CreditTo)
      parser tname = pure $ case tname of 
        "credit_to_btc_addr" -> CreditToAddress <$> (fieldWith btcAddrParser <* nullField <* nullField)
        "credit_to_user"     -> CreditToUser    <$> (nullField *> fieldWith uidParser <* nullField)
        "credit_to_project"  -> CreditToProject <$> (nullField *> nullField *> fieldWith pidParser)
        _ -> empty
  case tn of
    "credit_to_t" -> maybe empty (parser . decodeUtf8) v
    _ -> conversionError $ 
      Incompatible 
        (B.unpack tn)
        (tableOid f)
        (maybe "" B.unpack (name f))
        "RowParser CreditTo"
        "column was not of type event_t"

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 108 [5.456]
B:BD[4.1928] → [4.1928:1967]
```
  LogEntry <$> fieldWith btcAddrParser
```
[4.1928]
[10.336]
```
  LogEntry <$> join (fieldWith creditToParser)
```

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 190 [5.456]

B:BD[3.182] → [3.182:316]

          \(project_id, user_id, credit_to_btc_addr, event_type, event_time, event_metadata) \
          \VALUES (?, ?, ?, ?, ?, ?) \

[3.182]

[3.316]

          \(project_id, user_id, credit_to_type, credit_to_btc_addr, event_type, event_time, event_metadata) \
          \VALUES (?, ?, ?, ?, ?, ?, ?) \

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 193 [5.456]

B:BD[3.341] → [3.341:425]

          ( pid, uid, addr ^. _BtcAddr, eventName e, fromThyme $ e ^. eventTime, m)

[3.341]

[3.425]

          ( pid, uid, creditToName c, addr ^. _BtcAddr, eventName e, fromThyme $ e ^. eventTime, m)

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 195 [5.456]
B:BD[3.426] → [3.426:455]
```
      CreditToProject pid ->
```
[3.426]
[3.455]
```
      CreditToProject pid' ->
```

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 198 [5.456]

B:BD[3.516] → [3.516:652]

          \(project_id, user_id, credit_to_project_id, event_type, event_time, event_metadata) \
          \VALUES (?, ?, ?, ?, ?, ?) \

[3.516]

[3.652]

          \(project_id, user_id, credit_to_type, credit_to_project_id, event_type, event_time, event_metadata) \
          \VALUES (?, ?, ?, ?, ?, ?, ?) \

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 201 [5.456]

B:BD[3.677] → [3.677:762]

          ( pid, uid, pid ^. _ProjectId, eventName e, fromThyme $ e ^. eventTime, m)

[3.677]

[3.762]

          ( pid, uid, creditToName c, pid' ^. _ProjectId, eventName e, fromThyme $ e ^. eventTime, m)

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 203 [5.456]
B:BD[3.763] → [3.763:789]
```
      CreditToUser uid ->
```
[3.763]
[3.789]
```
      CreditToUser uid' ->
```

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 206 [5.456]

B:BD[3.850] → [3.850:983]

          \(project_id, user_id, credit_to_user_id, event_type, event_time, event_metadata) \
          \VALUES (?, ?, ?, ?, ?, ?) \

[3.850]

[3.983]

          \(project_id, user_id, credit_to_type, credit_to_user_id, event_type, event_time, event_metadata) \
          \VALUES (?, ?, ?, ?, ?, ?, ?) \

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 209 [5.456]

B:BD[3.1008] → [3.1008:1090]

          ( pid, uid, pid ^. _UserId, eventName e, fromThyme $ e ^. eventTime, m)

[3.1008]

[10.1807]

          ( pid, uid, creditToName c, uid' ^. _UserId, eventName e, fromThyme $ e ^. eventTime, m)

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 213 [5.456]

∅:D[11.277] → [12.1059:1162]

B:BD[12.1059] → [12.1059:1162]

      "SELECT project_id, user_id, btc_addr, event_type, event_time, event_metadata FROM work_events \

[11.277]

[12.1162]

      "SELECT project_id, user_id, \
      \credit_to_type, credit_to_btc_addr, credit_to_user_id, credit_to_project_id, \
      \event_type, event_time, event_metadata FROM work_events \

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 242 [5.456]

B:BD[13.1952] → [3.1217:1305]

  dbEval (AmendEvent (EventId eid) (CreditToChange mt creditTo)) =
    case creditTo of

[13.1952]

[3.1305]

  dbEval (AmendEvent (EventId eid) (CreditToChange mt c)) =
    case c of

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 249 [5.456]

B:BD[3.1532] → [3.1532:1617]

          ( eid, fromThyme $ mt ^. _ModTime, "credit_to_address", addr ^. _BtcAddr )

[3.1532]

[4.2903]

          ( eid, fromThyme $ mt ^. _ModTime, creditToName c, addr ^. _BtcAddr )

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 256 [5.456]

B:BD[3.1846] → [3.1846:1932]

          ( eid, fromThyme $ mt ^. _ModTime, "credit_to_project", pid ^. _ProjectId )

[3.1846]

[3.1932]

          ( eid, fromThyme $ mt ^. _ModTime, creditToName c, pid ^. _ProjectId )

Insertion in lib/Aftok/Database/PostgreSQL.hs at line 259 [5.456]
[3.1960]
[3.1960]
```
        pinsert AmendmentId
```

Replacement in lib/Aftok/Database/PostgreSQL.hs at line 263 [5.456]

B:BD[3.2128] → [3.2128:2208]

          ( eid, fromThyme $ mt ^. _ModTime, "credit_to_user", uid ^. _UserId )

[3.2128]

[3.2208]

          ( eid, fromThyme $ mt ^. _ModTime, creditToName c, uid ^. _UserId )

Insertion in lib/Aftok/Json.hs at line 17 [14.19]
[2.790]
[14.231]
```
import           Data.UUID                        as U
```

Replacement in lib/Aftok/Json.hs at line 125 [14.19]

B:BD[2.1124] → [2.1124:1296]

creditToJSON (CreditToAddress addr) = v2 $ object [ "creditToAddress" .= addr ]
creditToJSON (CreditToUser uid)     = v2 $ object [ "creditToUser"    .= (uid ^. _UserId) ]

[2.1124]

[2.1296]

creditToJSON (CreditToAddress addr) = v2 $ object [ "creditToAddress" .= (addr ^. _BtcAddr) ]
creditToJSON (CreditToUser uid)     = v2 $ object [ "creditToUser"    .= tshow (uid ^. _UserId) ]

Replacement in lib/Aftok/Json.hs at line 130 [14.19]

B:BD[15.1727] → [10.5341:5372]

B:BD[10.5372] → [2.1390:1439]

payoutsJSON (Payouts m) = v1 $
  toJSON $ (creditToJSON *** id) <$> MS.assocs m

[15.1727]

[15.1904]

payoutsJSON (Payouts m) = v2 $
  let payoutsRec :: (CreditTo, Rational) -> Value
      payoutsRec (c, r) = object [ "creditTo" .= creditToJSON c
                                 , "payoutRatio" .= r
                                 ]
  in  toJSON $ fmap payoutsRec (MS.assocs m)

Replacement in lib/Aftok/Json.hs at line 137 [14.19]

B:BD[15.1905] → [2.1440:1625]

workIndexJSONV1 :: WorkIndex -> Value
workIndexJSONV1 (WorkIndex widx) = v1 $
  toJSON $ (L.toList . fmap intervalJSON) <$> 
  MS.mapKeysMonotonic (^? (_CreditToAddress._BtcAddr)) widx

[15.1905]

[15.2061]

workIndexJSON :: WorkIndex -> Value
workIndexJSON (WorkIndex widx) = v2 $
  let widxRec :: (CreditTo, NonEmpty Interval) -> Value
      widxRec (c, l) = object [ "creditTo"  .= creditToJSON c
                              , "intervals" .= (intervalJSON <$> L.toList l)
                              ]
  in  toJSON $ fmap widxRec (MS.assocs widx)

Replacement in lib/Aftok/Json.hs at line 166 [14.19]

B:BD[10.5769] → [10.5769:5811]

B:BD[10.5811] → [2.1707:1774]

parsePayoutsJSON = unv1 "payouts" $ \v ->
  Payouts . MS.mapKeys (CreditToAddress . BtcAddr) <$> parseJSON v

[10.5769]

[10.5859]

parsePayoutsJSON = unversion $ \ver -> case ver of
  (Version 1 _) -> \v -> Payouts . MS.mapKeys (CreditToAddress . BtcAddr) <$> parseJSON v 
  (Version 2 0) -> \v -> do
    xs <- parseJSON v
    let parsePayoutRecord x = (,) <$> (parseCreditTo =<< (x .: "creditTo"))
                                  <*> x .: "payoutRatio"
    Payouts . MS.fromList <$> traverse parsePayoutRecord xs 
  _             -> badVersion "Payouts" ver

Replacement in lib/Aftok/Json.hs at line 187 [14.19]

B:BD[2.2314] → [2.2314:2392]

      parseA id = fail . show $ "Amendment type " <> id <> " not recognized."

[2.2314]

[2.2392]

      parseA tid = fail . show $ "Amendment type " <> tid <> " not recognized."

Replacement in lib/Aftok/Json.hs at line 190 [14.19]
B:BD[2.2428] → [2.2428:2456]
```
parseEventAmendmentV1 t x =
```
[2.2428]
[2.2456]
```
parseEventAmendmentV1 _ x =
```

Replacement in lib/Aftok/Json.hs at line 199 [14.19]

B:BD[2.2870] → [2.2870:2948]

      parseA id = fail . show $ "Amendment type " <> id <> " not recognized."

[2.2870]

[2.2948]

      parseA tid = fail . show $ "Amendment type " <> tid <> " not recognized."

Replacement in lib/Aftok/Json.hs at line 202 [14.19]
B:BD[2.2984] → [2.2984:3012]
```
parseEventAmendmentV2 t x =
```
[2.2984]
[2.3012]
```
parseEventAmendmentV2 _ x =
```

Replacement in lib/Aftok/Json.hs at line 212 [14.19]

B:BD[2.3322] → [2.3322:3376]

  Version 1 0 -> withObject "BtcAddr" parseCreditToV1

[2.3322]

[2.3376]

  Version 1 0 -> withObject "BtcAddr"  parseCreditToV1

Insertion in lib/Aftok/Json.hs at line 215 [14.19]

[2.3478]


parseUUID :: Value -> Parser U.UUID
parseUUID v = do
  str <- parseJSON v
  maybe (fail $ "Value " <> str <> "Could not be parsed as a valid UUID.") pure $ U.fromString str

Replacement in lib/Aftok/Json.hs at line 229 [14.19]
B:BD[2.3825] → [2.3825:3862]
```
      parseCreditToAddr x' = Nothing
```
[2.3825]
[2.3862]
```
      parseCreditToAddr _ = Nothing
```

Replacement in lib/Aftok/Json.hs at line 231 [14.19]

B:BD[2.3863] → [2.3863:3946]

      parseCreditToUser (Object x') = Nothing
      parseCreditToUser x' = Nothing

[2.3863]

[2.3946]

      parseCreditToUser (Object x') = do
        userText <- O.lookup "creditToUser" x'
        pure (CreditToUser . UserId <$> parseUUID userText)
      parseCreditToUser _ = Nothing

Replacement in lib/Aftok/Json.hs at line 236 [14.19]

B:BD[2.3947] → [2.3947:4036]

      parseCreditToProject (Object x') = Nothing
      parseCreditToProject x' = Nothing

[2.3947]

[2.4036]

      --parseCreditToProject (Object x') = Nothing
      parseCreditToProject _ = Nothing

Replacement in lib/Aftok/TimeLog.hs at line 6 [16.846]

B:BD[2.4399] → [2.4399:4467]

  , CreditTo(..), _CreditToAddress, _CreditToUser, _CreditToProject

[2.4399]

[2.4467]

  , CreditTo(..), _CreditToAddress, _CreditToUser, _CreditToProject, creditToName

Insertion in lib/Aftok/TimeLog.hs at line 68 [16.846]

[17.432]

[4.4696]

creditToName :: CreditTo -> Text
creditToName (CreditToAddress _) = "credit_to_address"
creditToName (CreditToUser _) = "credit_to_user"
creditToName (CreditToProject _) = "credit_to_project"

Replacement in migrations/2016-10-14_02-49-36_event-amendments.txt at line 10 [3.2345]

B:BD[3.2739] → [3.2739:2811]

  alter table work_events rename column btc_addr to credit_to_btc_addr;

[3.2739]

[3.2811]

  alter table work_events rename column btc_addr to credit_to_address;