nuttycom/aftok - Change 7VGYLTMURLVSVUYFW7TCRZTDQ6RE2EPSPPA43XKHDOBFWYVVSJHQC

Clean up schema version handling.

Follow the types! Too many functions were taking Value as their input rather than Object (for all versioned data structures.) This ended up cleaning up code in a number of unexpected places.

Created by Kris Nuttycombe on October 22, 2016

7VGYLTMURLVSVUYFW7TCRZTDQ6RE2EPSPPA43XKHDOBFWYVVSJHQC

Dependencies

In channels

main

Change contents

Replacement in Dockerfile at line 17 [6.43]

∅:D[5.47] → [6.885:926]

∅:D[7.787] → [6.885:926]

B:BD[6.885] → [6.885:926]

B:BD[6.926] → [4.296:439]

ADD ./aftok.cabal /opt/aftok/aftok.cabal
ADD ./stack.yaml  /opt/aftok/stack.yaml
ADD ./lib         /opt/aftok/lib
ADD ./server      /opt/aftok/server
ADD ./test        /opt/aftok/test

[5.47]

[5.48]

RUN mkdir -p /opt/aftok/bin

Insertion in Dockerfile at line 19 [6.43]

[5.67]

[4.440]

ADD ./aftok.cabal /opt/aftok/aftok.cabal
ADD ./docker/stack.yaml  /opt/aftok/stack.yaml

Replacement in Dockerfile at line 25 [6.43]

B:BD[6.1025] → [7.872:913]

B:BD[7.913] → [4.483:499]

# Install and build aftok-server sources
RUN stack build

[6.1025]

[6.1081]

ADD ./lib         /opt/aftok/lib
ADD ./server      /opt/aftok/server
ADD ./test        /opt/aftok/test
# build and install and aftok-server sources
RUN stack install

Replacement in docker/aftok-server.sh at line 3 [6.1530]
B:BD[6.1544] → [6.1544:1592]
```
/opt/aftok/dist/build/aftok-server/aftok-server
```
[6.1544]
```
/opt/aftok/bin/aftok-server
```

File addition: stack.yaml (----------)

[6.1510]

flags: {}
packages:
- '.'
extra-deps: 
- snaplet-postgresql-simple-0.6.0.4
- resource-pool-catchio-0.2.1.0
resolver: lts-5.3
#allow-newer: true
local-bin-path: /opt/aftok/bin

Replacement in lib/Aftok/Json.hs at line 54 [9.19]

B:BD[8.4331] → [8.4331:4468]

versioned :: Version -> Value -> Value
versioned ver v = object [ "schemaVersion" .= tshow ver
                         , "value" .= v ]

[8.4331]

[10.186]

versioned :: Version -> Object -> Value
versioned ver o = Object $ uncurry O.insert ("schemaVersion" .= tshow ver) o

Replacement in lib/Aftok/Json.hs at line 61 [9.19]

∅:D[8.4578] → [11.4996:5089]

B:BD[10.187] → [11.4996:5089]

B:BD[11.5089] → [12.18:51]

unversion :: (Version -> Value -> Parser a) -> Value -> Parser a
unversion f (Object v) = do
  verstr <- v .: "schemaVersion"

[8.4578]

[12.51]

unversion :: String -> (Version -> Object -> Parser a) -> Value -> Parser a
unversion name f o = do
  verstr <- withObject name (.: "schemaVersion") o

Replacement in lib/Aftok/Json.hs at line 65 [9.19]
∅:D[12.129] → [8.4690:4717]
∅:D[13.460] → [8.4690:4717]
B:BD[8.4690] → [8.4690:4717]
B:BD[8.4717] → [14.1588:1604]
∅:D[14.1604] → [8.4734:4806]
B:BD[8.4734] → [8.4734:4806]
```
  v .: "value" >>= f vers
unversion _ x =
  fail $ show x <> " did not contain the expected version information."
```
[12.129]
[8.4806]
```
  withObject name (f vers) o
```
Replacement in lib/Aftok/Json.hs at line 71 [9.19]
B:BD[8.4853] → [8.4853:4874]
```
v1 :: Value -> Value
```
[8.4853]
[8.4874]
```
v1 :: Object -> Value
```
Replacement in lib/Aftok/Json.hs at line 74 [9.19]
B:BD[15.792] → [15.792:813]
```
v2 :: Value -> Value
```
[15.792]
[15.813]
```
v2 :: Object -> Value
```

Replacement in lib/Aftok/Json.hs at line 77 [9.19]

B:BD[8.4904] → [8.4904:4963]

B:BD[8.4963] → [15.843:939]

unv1 :: String -> (Value -> Parser a) -> Value -> Parser a
unv1 name f = unversion $ \x -> case x of
  Version 1 0 -> f
  _           -> badVersion name x

[8.4904]

[15.939]

unv1 :: String -> (Object -> Parser a) -> Value -> Parser a
unv1 name f = unversion name $ p where
  p (Version 1 0) = f
  p ver = badVersion name ver

Replacement in lib/Aftok/Json.hs at line 82 [9.19]

B:BD[15.940] → [15.940:993]

badVersion :: String -> Version -> Value -> Parser a

[15.940]

[15.993]

badVersion :: forall v a. String -> Version -> v -> Parser a

Insertion in lib/Aftok/Json.hs at line 85 [9.19]

[8.5115]

-- convenience function to produce Object rather than Value
obj :: [Pair] -> Object
obj = O.fromList

Replacement in lib/Aftok/Json.hs at line 95 [9.19]
B:BD[16.6666] → [17.1049:1102]
∅:D[17.1102] → [8.5274:5318]
∅:D[16.6721] → [8.5274:5318]
B:BD[8.5274] → [8.5274:5318]
∅:D[8.5318] → [18.1682:1693]
B:BD[18.1682] → [18.1682:1693]
```
  object [ "projectId" .=  tshow (pid ^. _ProjectId)
         , "project" .= projectJSON project
         ]
```
[16.6666]
[19.249]
```
  obj [ "projectId" .=  tshow (pid ^. _ProjectId)
      , "project" .= projectJSON project
      ]
```

Replacement in lib/Aftok/Json.hs at line 101 [9.19]

B:BD[19.311] → [19.311:365]

  object [ "projectId" .= tshow (pid ^. _ProjectId) ]

[19.311]

[18.1693]

  obj [ "projectId" .= tshow (pid ^. _ProjectId) ]

Replacement in lib/Aftok/Json.hs at line 105 [9.19]

∅:D[8.5340] → [11.5315:5417]

B:BD[11.5315] → [11.5315:5417]

B:BD[11.5417] → [13.461:538]

  object [ "projectName"    .= (p ^. projectName)
         , "inceptionDate"  .= (p ^. inceptionDate)
         , "initiator"      .= tshow (p ^. (P.initiator._UserId))
         ]

[8.5340]

[13.538]

  obj [ "projectName"    .= (p ^. projectName)
      , "inceptionDate"  .= (p ^. inceptionDate)
      , "initiator"      .= tshow (p ^. (P.initiator._UserId))
      ]

Replacement in lib/Aftok/Json.hs at line 112 [9.19]

B:BD[19.427] → [19.427:481]

  object [ "auctionId" .= tshow (pid ^. _AuctionId) ]

[19.427]

[19.481]

  obj [ "auctionId" .= tshow (pid ^. _AuctionId) ]

Replacement in lib/Aftok/Json.hs at line 116 [9.19]

B:BD[13.592] → [13.592:782]

∅:D[13.782] → [17.1168:1179]

∅:D[14.1696] → [17.1168:1179]

B:BD[17.1168] → [17.1168:1179]

  object [ "projectId"    .= tshow (x ^. (A.projectId._ProjectId))
         , "initiator"    .= tshow (x ^. (A.initiator._UserId))
         , "raiseAmount"  .= (x ^. (raiseAmount._Satoshi))
         ]

[13.592]

[19.483]

  obj [ "projectId"    .= tshow (x ^. (A.projectId._ProjectId))
      , "initiator"    .= tshow (x ^. (A.initiator._UserId))
      , "raiseAmount"  .= (x ^. (raiseAmount._Satoshi))
      ]

Replacement in lib/Aftok/Json.hs at line 123 [9.19]
B:BD[19.533] → [19.533:579]
```
  object [ "bidId" .= tshow (pid ^. _BidId) ]
```
[19.533]
[20.2560]
```
  obj [ "bidId" .= tshow (pid ^. _BidId) ]
```

Replacement in lib/Aftok/Json.hs at line 126 [9.19]

B:BD[15.1124] → [21.3150:3342]

∅:D[21.3342] → [15.1296:1389]

B:BD[15.1296] → [15.1296:1389]

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

[15.1124]

[19.580]

creditToJSON (CreditToAddress addr) = v2 $ obj [ "creditToAddress" .= (addr ^. _BtcAddr) ]
creditToJSON (CreditToUser uid)     = v2 $ obj [ "creditToUser"    .= tshow (uid ^. _UserId) ]
creditToJSON (CreditToProject pid)  = v2 $ obj [ "creditToProject" .= projectIdJSON pid ]

Replacement in lib/Aftok/Json.hs at line 136 [9.19]

B:BD[21.3577] → [21.3577:3622]

  in  toJSON $ fmap payoutsRec (MS.assocs m)

[21.3577]

[18.1904]

  in  obj $ [ "payouts" .= fmap payoutsRec (MS.assocs m) ]

Replacement in lib/Aftok/Json.hs at line 144 [9.19]

B:BD[21.3924] → [21.3924:3969]

  in  toJSON $ fmap widxRec (MS.assocs widx)

[21.3924]

[18.2061]

  in  obj $ [ "workIndex" .= fmap widxRec (MS.assocs widx) ]

Replacement in lib/Aftok/Json.hs at line 148 [9.19]
B:BD[8.5483] → [8.5483:5519]
```
  object [ "eventId" .= tshow eid ]
```
[8.5483]
[22.1798]
```
  obj [ "eventId" .= tshow eid ]
```

Replacement in lib/Aftok/Json.hs at line 156 [9.19]

B:BD[15.1665] → [15.1665:1706]

B:BD[15.1706] → [12.256:294]

∅:D[12.294] → [22.1992:2031]

B:BD[22.1992] → [22.1992:2031]

  object [ "creditTo"  .= creditToJSON c
         , "event" .= logEventJSON ev
         , "eventMeta" .= m
         ]

[15.1665]

[8.5559]

  obj [ "creditTo"  .= creditToJSON c
      , "event" .= logEventJSON ev
      , "eventMeta" .= m
      ]

Replacement in lib/Aftok/Json.hs at line 163 [9.19]
B:BD[8.5641] → [8.5641:5681]
```
  object [ "amendmentId" .= tshow aid ]
```
[8.5641]
[8.5681]
```
  obj [ "amendmentId" .= tshow aid ]
```

Insertion in lib/Aftok/Json.hs at line 169 [9.19]

[18.2134]

[8.5725]

parseCreditTo :: Value -> Parser CreditTo
parseCreditTo = unversion "CreditTo" $ p where 
  p (Version 1 0) = parseCreditToV1
  p (Version 2 0) = parseCreditToV2
  p ver           = badVersion "EventAmendment" ver
parseCreditToV1 :: Object -> Parser CreditTo 
parseCreditToV1 x = CreditToAddress <$> (parseBtcAddrJson =<< (x .: "btcAddr"))
parseCreditToV2 :: Object -> Parser CreditTo
parseCreditToV2 o = 
  let parseCreditToAddr o' = 
        fmap CreditToAddress . parseBtcAddrJson <$> O.lookup "creditToAddress" o'
      parseCreditToUser o' = 
        fmap (CreditToUser . UserId) . parseUUID <$> O.lookup "creditToUser" o'
      parseCreditToProject o' = 
        fmap (CreditToProject . ProjectId) . parseUUID <$> O.lookup "creditToProject" o'
      notFound = fail $ "Value " <> show o <> " does not represent a CreditTo value."
      parseV v = (parseCreditToAddr v <|> parseCreditToUser v <|> parseCreditToProject v)
  in  fromMaybe notFound $ parseV o

Replacement in lib/Aftok/Json.hs at line 195 [9.19]

B:BD[8.5769] → [21.3970:4400]

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

[8.5769]

[8.5859]

parsePayoutsJSON = unversion "Payouts" $ p where
  p :: Version -> Object -> Parser Payouts
  p (Version 1 _) v = Payouts . MS.mapKeys (CreditToAddress . BtcAddr) <$> parseJSON (Object v)
  p (Version 2 0) v =  
    let parsePayoutRecord x = (,) <$> (parseCreditToV2 =<< (x .: "creditTo")) <*> x .: "payoutRatio"
    in  Payouts . MS.fromList <$> (traverse parsePayoutRecord =<< parseJSON (Object v))
  p ver x = badVersion "Payouts" ver x

Replacement in lib/Aftok/Json.hs at line 204 [9.19]

B:BD[8.5925] → [15.1775:1956]

parseEventAmendment t = unversion $ \v -> case v of
  Version 1 0 -> parseEventAmendmentV1 t
  Version 2 0 -> parseEventAmendmentV2 t
  _           -> badVersion "EventAmendment" v

[8.5925]

[15.1956]

parseEventAmendment t = unversion "EventAmendment" $ p where
  p (Version 1 _) = parseEventAmendmentV1 t
  p (Version 2 0) = parseEventAmendmentV2 t
  p ver = badVersion "EventAmendment" ver

Replacement in lib/Aftok/Json.hs at line 209 [9.19]

B:BD[15.1957] → [15.1957:2063]

parseEventAmendmentV1 :: ModTime -> Value -> Parser EventAmendment
parseEventAmendmentV1 t v@(Object x) =

[15.1957]

[15.2063]

parseEventAmendmentV1 :: ModTime -> Object -> Parser EventAmendment
parseEventAmendmentV1 t o =

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

B:BD[15.2109] → [15.2109:2314]

      parseA "timeChange"     = TimeChange t <$> x .: "eventTime"
      parseA "addrChange"     = CreditToChange t <$> parseCreditTo v
      parseA "metadataChange" = MetadataChange t <$> x .: "eventMeta"

[15.2109]

[21.4401]

      parseA "timeChange"     = TimeChange t     <$> o .: "eventTime"
      parseA "addrChange"     = CreditToChange t <$> parseCreditToV1 o
      parseA "metadataChange" = MetadataChange t <$> o .: "eventMeta"

Replacement in lib/Aftok/Json.hs at line 216 [9.19]
∅:D[21.4481] → [15.2392:2428]
B:BD[15.2392] → [15.2392:2428]
B:BD[15.2428] → [21.4482:4510]
∅:D[21.4510] → [15.2456:2512]
B:BD[15.2456] → [15.2456:2512]
```
  in  x .: "amendment" >>= parseA 
parseEventAmendmentV1 _ x =
  fail $ "Value " <> show x <> " is not a JSON object."
```
[21.4481]
[15.2512]
```
  in  o .: "amendment" >>= parseA 
```

Replacement in lib/Aftok/Json.hs at line 218 [9.19]

B:BD[15.2513] → [15.2513:2619]

parseEventAmendmentV2 :: ModTime -> Value -> Parser EventAmendment
parseEventAmendmentV2 t v@(Object x) =

[15.2513]

[15.2619]

parseEventAmendmentV2 :: ModTime -> Object -> Parser EventAmendment
parseEventAmendmentV2 t o =

Replacement in lib/Aftok/Json.hs at line 221 [9.19]

B:BD[15.2665] → [15.2665:2870]

      parseA "timeChange"     = TimeChange t <$> x .: "eventTime"
      parseA "creditToChange" = CreditToChange t <$> parseCreditTo v
      parseA "metadataChange" = MetadataChange t <$> x .: "eventMeta"

[15.2665]

[21.4511]

      parseA "timeChange"     = TimeChange t     <$> o .: "eventTime"
      parseA "creditToChange" = CreditToChange t <$> parseCreditToV2 o
      parseA "metadataChange" = MetadataChange t <$> o .: "eventMeta"

Replacement in lib/Aftok/Json.hs at line 225 [9.19]
∅:D[21.4591] → [15.2948:2983]
B:BD[15.2948] → [15.2948:2983]
```
  in  x .: "amendment" >>= parseA 
```
[21.4591]
[15.2983]
```
  in  o .: "amendment" >>= parseA 
```
Deletion in lib/Aftok/Json.hs at line 227 [9.19]
B:BD[15.2984] → [21.4592:4620]
∅:D[21.4620] → [15.3012:3069]
B:BD[15.3012] → [15.3012:3069]
```
parseEventAmendmentV2 _ x =
  fail $ "Value " <> show x <> " is not a JSON object."
```

Deletion in lib/Aftok/Json.hs at line 236 [9.19]

∅:D[21.4851] → [15.3478:3479]

B:BD[15.3478] → [15.3478:3479]

B:BD[15.3479] → [12.295:539]

∅:D[12.539] → [15.3479:3605]

B:BD[15.3479] → [15.3479:3605]

∅:D[14.2003] → [8.6554:6555]

∅:D[15.3605] → [8.6554:6555]

B:BD[8.6554] → [8.6554:6555]

B:BD[8.6555] → [15.3606:3825]

B:BD[15.3825] → [21.4852:4888]


parseCreditTo :: Value -> Parser CreditTo
parseCreditTo = unversion $ \v -> case v of
  Version 1 0 -> withObject "BtcAddr"  parseCreditToV1
  Version 2 0 -> withObject "CreditTo" parseCreditToV2
  _           -> badVersion "EventAmendment" v
parseCreditToV1 :: Object -> Parser CreditTo 
parseCreditToV1 x = CreditToAddress <$> (parseBtcAddrJson =<< (x .: "btcAddr"))
parseCreditToV2 :: Object -> Parser CreditTo
parseCreditToV2 x = 
  let parseCreditToAddr (Object x') = do 
        addrText <- O.lookup "creditToAddress" x'
        pure (CreditToAddress <$> parseBtcAddrJson addrText)
      parseCreditToAddr _ = Nothing

Deletion in lib/Aftok/Json.hs at line 237 [9.19]

B:BD[15.3863] → [21.4889:5073]

∅:D[21.5073] → [15.3946:3947]

B:BD[15.3946] → [15.3946:3947]

B:BD[15.3947] → [21.5074:5164]

∅:D[21.5164] → [15.4036:4290]

B:BD[15.4036] → [15.4036:4290]

      parseCreditToUser (Object x') = do
        userText <- O.lookup "creditToUser" x'
        pure (CreditToUser . UserId <$> parseUUID userText)
      parseCreditToUser _ = Nothing
      --parseCreditToProject (Object x') = Nothing
      parseCreditToProject _ = Nothing
      notFound = fail $ "Value " <> show x <> " does not represent a CreditTo value."
      parseV v = (parseCreditToAddr v <|> parseCreditToUser v <|> parseCreditToProject v)
  in  do
    body <- x .: "creditTo"
    fromMaybe notFound $ parseV body

Replacement in lib/Aftok/Json.hs at line 238 [9.19]

B:BD[23.87] → [23.87:137]

∅:D[23.137] → [24.164:263]

B:BD[24.164] → [24.164:263]

B:BD[24.263] → [3.3:39]

parseLogEntry f = unversion parseLogEntry' where 
  parseLogEntry' (Version 2 0) (Object x) = do
    creditTo'  <- x .: "creditTo" >>= parseCreditTo
    eventMeta' <- x .:? "eventMeta"

[23.87]

[23.138]

parseLogEntry f = unversion "LogEntry" p where 
  p (Version 2 0) o = do
    creditTo'  <- o .: "creditTo" >>= parseCreditToV2
    eventMeta' <- o .:? "eventMeta"

Replacement in lib/Aftok/Json.hs at line 244 [9.19]
B:BD[12.938] → [12.938:987]
```
  parseLogEntry' v x = badVersion "LogEntry" v x
```
[12.665]
[12.987]
```
  p v o = badVersion "LogEntry" v o
```

Replacement in scripts/log_end.sh at line 8 [26.532]

B:BD[25.562] → [3.67:186]

curl -v -k -u $USER -X POST -d "{\"creditTo\": {\"creditToUser\": \"$UID\"}}" "https://aftok.com/projects/$PID/logEnd"

[25.562]

curl -v -k -u $USER -X POST -d "{\"schemaVersion\": \"2.0\", \"creditTo\": {\"creditToUser\": \"$UID\"}}" "https://aftok.com/projects/$PID/logEnd"

Replacement in scripts/log_start.sh at line 8 [26.689]

B:BD[25.803] → [3.240:361]

curl -v -k -u $USER -X POST -d "{\"creditTo\": {\"creditToUser\": \"$UID\"}}" "https://aftok.com/projects/$PID/logStart"

[25.803]

curl -v -k -u $USER -X POST -d "{\"schemaVersion\": \"2.0\", \"creditTo\": {\"creditToUser\": \"$UID\"}}" "https://aftok.com/projects/$PID/logStart"

Replacement in server/Aftok/Snaplet/Auctions.hs at line 30 [27.2441]

B:BD[27.3137] → [27.3137:3282]

B:BD[27.3282] → [19.861:885]

auctionCreateParser = unv1 "auctions" $ \v ->
  case v of
    (Object o) -> CA <$> o .: "raiseAmount"
                     <*> o .: "auctionEnd"
    _          -> mzero

[27.3137]

[19.885]

auctionCreateParser = unv1 "auctions" p where
  p o = CA <$> o .: "raiseAmount" <*> o .: "auctionEnd"

Replacement in server/Aftok/Snaplet/Auctions.hs at line 34 [27.2441]

B:BD[19.947] → [19.947:1163]

∅:D[19.1163] → [27.3282:3306]

B:BD[27.3282] → [27.3282:3306]

bidCreateParser uid t = unv1 "bids" $ \v ->
  case v of
    (Object o) -> Bid uid <$> (Seconds <$> o .: "bidSeconds")
                          <*> (Satoshi <$> o .: "bidAmount")
                          <*> pure t
    _          -> mzero

[19.947]

[27.3306]

bidCreateParser uid t = unv1 "bids" p where
  p o = Bid uid <$> (Seconds <$> o .: "bidSeconds")
                <*> (Satoshi <$> o .: "bidAmount")
                <*> pure t

Deletion in server/Aftok/Snaplet/Auctions.hs at line 63 [27.2441]
B:BD[19.1576] → [2.781:786]
```
    
```