nuttycom/aftok - Change O722AOKEWXWJPRHGJREU6QPW7HEFPPRETZIAADZ2RMAXHARCNEKAC

Add route to allow crediting of events to users/projects.

Created by Kris Nuttycombe on October 20, 2016

O722AOKEWXWJPRHGJREU6QPW7HEFPPRETZIAADZ2RMAXHARCNEKAC

Dependencies

In channels

main

Change contents

Insertion in aftok.cabal at line 118 [5.1]
[3.161]
[4.1]
```
    , errors
```

Replacement in lib/Aftok/Json.hs at line 63 [8.19]

B:BD[6.5089] → [7.4579:4614]

B:BD[7.4614] → [9.383:460]

  verstr   <- v .: "schemaVersion"
  vers  <- either fail pure $ PC.parseOnly versionParser (encodeUtf8 verstr)

[6.5089]

[7.4690]

  verstr <- v .: "schemaVersion"
  vers   <- either fail pure $ PC.parseOnly versionParser (encodeUtf8 verstr)

Insertion in lib/Aftok/Json.hs at line 149 [8.19]

[10.1799]


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

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

∅:D[11.1706] → [10.1909:1992]

B:BD[10.1909] → [10.1909:1992]

         , "eventType" .= eventName ev
         , "eventTime" .= (ev ^. eventTime)

[11.1706]

[10.1992]

         , "event" .= logEventJSON ev

Deletion in lib/Aftok/Json.hs at line 213 [8.19]

B:BD[7.6407] → [11.3236:3322]

B:BD[11.3322] → [2.4621:4676]

∅:D[2.4676] → [11.3376:3478]

B:BD[11.3376] → [11.3376:3478]

B:BD[11.3478] → [2.4677:4678]

parseCreditTo :: Value -> Parser CreditTo
parseCreditTo = unversion $ \x -> case x of
  Version 1 0 -> withObject "BtcAddr"  parseCreditToV1
  Version 2 0 -> withObject "CreditTo" parseCreditToV2
  _           -> badVersion "EventAmendment" x

Insertion in lib/Aftok/Json.hs at line 218 [8.19]

[11.3479]

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

Insertion in lib/Aftok/Json.hs at line 249 [8.19]

[11.4290]

parseLogEvent :: Object -> Parser LogEvent
parseLogEvent x = 
  (StartWork <$> x .: "start") <|> (StopWork <$> x .: "stop")
parseLogEntry :: Value -> Parser LogEntry
parseLogEntry = unversion parseLogEntry' where 
  parseLogEntry' (Version 2 0) (Object x) =
    LogEntry <$> (x .: "creditTo" >>= parseCreditTo)
             <*> (x .: "event" >>= parseLogEvent)
             <*> (x .: "eventMeta")
  parseLogEntry' v x = badVersion "LogEntry" v x

Replacement in lib/Aftok/TimeLog.hs at line 54 [14.846]

∅:D[12.1757] → [13.3855:3928]

B:BD[13.3855] → [13.3855:3928]

nameEvent "start" = return StartWork
nameEvent "stop"  = return StopWork

[12.1757]

[13.3928]

nameEvent "start" = pure StartWork
nameEvent "stop"  = pure StopWork

Replacement in server/Aftok/Snaplet/WorkLog.hs at line 11 [15.5424]
B:BD[15.5642] → [16.9813:9836]
```
import           Aftok
```
[15.5642]
[16.9836]
```
import           Aftok (parseBtcAddr)
```

Replacement in server/Aftok/Snaplet/WorkLog.hs at line 36 [15.5424]

∅:D[16.10182] → [17.12757:12851]

B:BD[7.8301] → [17.12757:12851]

      snapEval $ createEvent pid uid (LogEntry addr (evCtr timestamp) (A.decode requestBody))

[16.10182]

[15.6347]

      snapEval . createEvent pid uid $
        LogEntry (CreditToAddress addr) (evCtr timestamp) (A.decode requestBody)
recordLogEntryHandler :: Handler App App EventId
recordLogEntryHandler = do
  uid <- requireUserId
  pid <- requireProjectId
  requestBody <- readRequestBody 4096
  timestamp <- liftIO C.getCurrentTime
  case A.eitherDecode requestBody >>= parseEither parseLogEntry of
    Left err -> snapError 400 $ "Unable to parse log entry " <> (tshow requestBody) <> ": " <> tshow err
    Right entry -> snapEval $ createEvent pid uid (event.eventTime .~ timestamp $ entry)

Replacement in server/Main.hs at line 39 [19.5188]

B:BD[18.2275] → [18.2275:2397]

B:BD[18.2397] → [20.1075:1145]

  let loginRoute         = requireLogin >> redirect "/home"
      registerRoute      = void $ method POST registerHandler
      acceptInviteRoute  = void $ method POST acceptInvitationHandler

[18.2275]

[21.212]

  let loginRoute          = requireLogin >> redirect "/home"
      registerRoute       = void $ method POST registerHandler
      acceptInviteRoute   = void $ method POST acceptInvitationHandler

Replacement in server/Main.hs at line 43 [19.5188]

B:BD[21.213] → [4.1578:1664]

∅:D[4.1664] → [22.12647:12738]

B:BD[22.12647] → [22.12647:12738]

      projectCreateRoute = serveJSON projectIdJSON $ method POST projectCreateHandler
      listProjectsRoute  = serveJSON (fmap qdbProjectJSON) $ method GET projectListHandler

[21.213]

[18.2397]

      projectCreateRoute  = serveJSON projectIdJSON $ method POST projectCreateHandler
      listProjectsRoute   = serveJSON (fmap qdbProjectJSON) $ method GET projectListHandler

Replacement in server/Main.hs at line 46 [19.5188]

B:BD[18.2398] → [22.12739:12819]

B:BD[22.12819] → [4.1665:1747]

∅:D[4.1747] → [10.3245:3333]

B:BD[18.2480] → [10.3245:3333]

B:BD[10.3333] → [9.1634:1721]

∅:D[9.1721] → [22.12820:12970]

B:BD[7.7876] → [22.12820:12970]

      projectRoute       = serveJSON projectJSON $ method GET projectGetHandler
      logEventRoute f    = serveJSON eventIdJSON $ method POST (logWorkHandler f)
      logEntriesRoute    = serveJSON (fmap logEntryJSON) $ method GET logEntriesHandler
      logIntervalsRoute  = serveJSON workIndexJSON $ method GET loggedIntervalsHandler
      payoutsRoute       = serveJSON payoutsJSON $ method GET payoutsHandler
      inviteRoute        = void . method POST $ projectInviteHandler cfg

[18.2398]

[22.12970]

      projectRoute        = serveJSON projectJSON $ method GET projectGetHandler
      logWorkRoute f      = serveJSON eventIdJSON $ method POST (logWorkHandler f)
      recordLogEntryRoute = serveJSON eventIdJSON $ method POST recordLogEntryHandler
      logEntriesRoute     = serveJSON (fmap logEntryJSON) $ method GET logEntriesHandler
      logIntervalsRoute   = serveJSON workIndexJSON $ method GET loggedIntervalsHandler
      payoutsRoute        = serveJSON payoutsJSON $ method GET payoutsHandler
      inviteRoute         = void . method POST $ projectInviteHandler cfg

Replacement in server/Main.hs at line 54 [19.5188]

B:BD[22.12971] → [4.1748:1834]

∅:D[4.1834] → [9.1722:1802]

B:BD[23.4230] → [9.1722:1802]

B:BD[9.1802] → [4.1835:1914]

      auctionCreateRoute = serveJSON auctionIdJSON $ method POST auctionCreateHandler
      auctionRoute       = serveJSON auctionJSON $ method GET auctionGetHandler
      auctionBidRoute    = serveJSON bidIdJSON $ method POST auctionBidHandler

[22.12971]

[23.4230]

      auctionCreateRoute  = serveJSON auctionIdJSON $ method POST auctionCreateHandler
      auctionRoute        = serveJSON auctionJSON $ method GET auctionGetHandler
      auctionBidRoute     = serveJSON bidIdJSON $ method POST auctionBidHandler

Replacement in server/Main.hs at line 58 [19.5188]

∅:D[23.4231] → [7.7876:7960]

∅:D[22.12971] → [7.7876:7960]

B:BD[7.7876] → [7.7876:7960]

      amendEventRoute    = serveJSON amendmentIdJSON $ method PUT amendEventHandler

[23.4231]

[18.2569]

      amendEventRoute     = serveJSON amendmentIdJSON $ method PUT amendEventHandler

Replacement in server/Main.hs at line 68 [19.5188]

∅:D[10.3549] → [18.2968:3049]

∅:D[7.8018] → [18.2968:3049]

∅:D[22.13135] → [18.2968:3049]

B:BD[18.2968] → [18.2968:3049]

B:BD[18.3049] → [16.11924:12004]

            , ("projects/:projectId/logStart/:btcAddr", logEventRoute StartWork)
            , ("projects/:projectId/logEnd/:btcAddr",   logEventRoute StopWork)

[22.13135]

[10.3631]

            , ("projects/:projectId/logStart/:btcAddr", logWorkRoute StartWork)
            , ("projects/:projectId/logEnd/:btcAddr",   logWorkRoute StopWork)
            , ("projects/:projectId/logWorkEvent",      recordLogEntryRoute)