nuttycom/aftok - Change O5FVTOM6YFBLEPF3S576K6IMT6ZZ5VQCSB3YVXNS4CKBITKCRZ7AC

Undo JSON silliness, enable a couple more routes.

Created by Kris Nuttycombe on May 7, 2015

O5FVTOM6YFBLEPF3S576K6IMT6ZZ5VQCSB3YVXNS4CKBITKCRZ7AC

Dependencies

In channels

main

Change contents

Insertion in lib/Quixotic/Client.hs at line 8 [3.1]
[3.151]
[4.3]
```
import Data.Aeson.Types
```
Insertion in lib/Quixotic/Client.hs at line 13 [3.1]
[3.172]
[3.193]
```
import Quixotic.Json
```

Replacement in lib/Quixotic/Client.hs at line 27 [3.1]

∅:D[5.120] → [3.411:444]

B:BD[3.411] → [3.411:444]

B:BD[3.444] → [6.1079:1120]

  payoutsResponse <- asJSON resp
  pure $ payoutsResponse ^. responseBody

[5.120]

[3.506]

  valueResponse <- asValue resp
  either fail pure (parseEither parsePayoutsJSON $ valueResponse ^. responseBody)

Insertion in lib/Quixotic/Database/PostgreSQL.hs at line 134 [9.456]

[7.314]

[8.473]

newtype PProject = PProject { pProject :: Project }
instance FromRow PProject where
  fromRow = PProject <$> projectRowParser

Replacement in lib/Quixotic/Database/PostgreSQL.hs at line 152 [9.456]

B:BD[6.1362] → [6.1362:1426]

B:BD[6.1426] → [2.959:1024]

recordEvent' :: ProjectId -> UserId -> LogEntry -> QDBM EventId
recordEvent' (ProjectId pid) (UserId uid) (LogEntry a e m) = do

[6.1362]

[6.1489]

createEvent' :: ProjectId -> UserId -> LogEntry -> QDBM EventId
createEvent' (ProjectId pid) (UserId uid) (LogEntry a e m) = do

Replacement in lib/Quixotic/Database/PostgreSQL.hs at line 189 [9.456]
B:BD[9.3625] → [6.2412:2466]
∅:D[6.2466] → [10.834:859]
B:BD[10.834] → [10.834:859]
```
newAuction' :: ProjectId -> Auction -> QDBM AuctionId
newAuction' pid auc = do
```
[9.3625]
[6.2467]
```
createAuction' :: ProjectId -> Auction -> QDBM AuctionId
createAuction' pid auc = do
```
Replacement in lib/Quixotic/Database/PostgreSQL.hs at line 196 [9.456]
B:BD[9.3929] → [6.2487:2537]
∅:D[6.2537] → [9.3996:4020]
B:BD[9.3996] → [9.3996:4020]
```
readAuction' :: AuctionId -> QDBM (Maybe Auction)
readAuction' aucId = do
```
[9.3929]
[6.2538]
```
findAuction' :: AuctionId -> QDBM (Maybe Auction)
findAuction' aucId = do
```
Replacement in lib/Quixotic/Database/PostgreSQL.hs at line 203 [9.456]
B:BD[9.4201] → [6.2556:2598]
∅:D[6.2598] → [9.4260:4298]
B:BD[9.4260] → [9.4260:4298]
```
recordBid' :: AuctionId -> Bid -> QDBM ()
recordBid' (AuctionId aucId) bid = do
```
[9.4201]
[6.2599]
```
createBid' :: AuctionId -> Bid -> QDBM ()
createBid' (AuctionId aucId) bid = do
```

Insertion in lib/Quixotic/Database/PostgreSQL.hs at line 253 [9.456]

[11.273]

[7.704]


findProject' :: ProjectId -> QDBM (Maybe Project)
findProject' (ProjectId pid) = do
  projects <- pquery
    "SELECT project_name, inception_date, initiator_id FROM projects WHERE id = ?"
    (Only pid)
  pure . fmap pProject $ headMay projects

Replacement in lib/Quixotic/Database/PostgreSQL.hs at line 272 [9.456]
B:BD[9.5587] → [9.5587:5618]
```
  { recordEvent = recordEvent'
```
[9.5587]
[6.3037]
```
  { createEvent = createEvent'
```

Replacement in lib/Quixotic/Database/PostgreSQL.hs at line 275 [9.456]

B:BD[9.5654] → [9.5654:5741]

  , newAuction = newAuction'
  , readAuction = readAuction'
  , recordBid = recordBid'

[9.5654]

[9.5741]


  , createAuction = createAuction'
  , findAuction = findAuction'
  , createBid = createBid'

Insertion in lib/Quixotic/Database/PostgreSQL.hs at line 281 [9.456]
[9.5766]
[9.5766]
Insertion in lib/Quixotic/Database/PostgreSQL.hs at line 285 [9.456]
[7.751]
[8.1371]
Insertion in lib/Quixotic/Database/PostgreSQL.hs at line 287 [9.456]
[8.1406]
[8.1406]
```
  , findProject = findProject'
```

Replacement in lib/Quixotic/Database.hs at line 25 [12.4936]

B:BD[9.6687] → [6.3068:3134]

  { recordEvent   :: ProjectId -> UserId -> LogEntry -> m EventId

[9.6687]

[6.3134]

  { createEvent   :: ProjectId -> UserId -> LogEntry -> m EventId

Replacement in lib/Quixotic/Database.hs at line 28 [12.4936]

B:BD[13.342] → [13.342:399]

B:BD[13.399] → [10.1500:1598]

  , newAuction    :: ProjectId -> Auction -> m AuctionId
  , readAuction   :: AuctionId -> m (Maybe Auction)
  , recordBid     :: AuctionId -> Bid -> m ()

[13.342]

[10.1598]


  , createAuction :: ProjectId -> Auction -> m AuctionId
  , findAuction   :: AuctionId -> m (Maybe Auction)
  , createBid     :: AuctionId -> Bid -> m ()

Insertion in lib/Quixotic/Database.hs at line 33 [12.4936]
[10.1640]
[13.578]
Insertion in lib/Quixotic/Database.hs at line 37 [12.4936]
[7.855]
[8.1449]
Insertion in lib/Quixotic/Database.hs at line 39 [12.4936]
[8.1493]
[10.1641]
```
  , findProject   :: ProjectId -> m (Maybe Project)
```
Deletion in lib/Quixotic/Json.hs at line 11 [14.19]
B:BD[6.3653] → [6.3653:3670]
```
import Data.Data
```

Insertion in lib/Quixotic/Json.hs at line 13 [14.19]

[6.3769]

[14.231]

import Data.Data
import Data.List.NonEmpty as L
import Data.Map.Strict as MS

Insertion in lib/Quixotic/Json.hs at line 18 [14.19]

[14.248]

[14.272]

import Quixotic.Database
import Quixotic.Interval
import Quixotic.TimeLog

Insertion in lib/Quixotic/Json.hs at line 61 [14.19]

[14.486]

[6.5266]

qdbProjectJSON :: QDBProject -> Value
qdbProjectJSON qp = 
  object [ "projectId" .= (qp ^. (projectId._ProjectId))
         , "project" .= projectJSON (qp ^. project)
         ]

Insertion in lib/Quixotic/Json.hs at line 73 [14.19]

[10.2561]

payoutsJSON :: Payouts -> Value
payoutsJSON (Payouts m) = toJSON $ MS.mapKeys (^. _BtcAddr) m
parsePayoutsJSON :: Value -> Parser Payouts
parsePayoutsJSON v = 
  Payouts . MS.mapKeys BtcAddr <$> parseJSON v 
workIndexJSON :: WorkIndex -> Value
workIndexJSON (WorkIndex widx) = 
  toJSON $ (L.toList . fmap intervalJSON) <$> (MS.mapKeysMonotonic (^._BtcAddr) widx)
eventIdJSON :: EventId -> Value
eventIdJSON (EventId eid) = toJSON eid

Replacement in lib/Quixotic/TimeLog.hs at line 9 [17.846]
B:BD[15.3854] → [16.3:40]
∅:D[16.40] → [6.5479:5508]
B:BD[18.107] → [6.5479:5508]
```
  , WorkIndex(WorkIndex), _WorkIndex
  , workIndex, workIndexJSON
```
[19.3594]
[20.3]
```
  , WorkIndex(WorkIndex), _WorkIndex, workIndex
```
Replacement in lib/Quixotic/TimeLog.hs at line 11 [17.846]
B:BD[20.12] → [6.5509:5553]
```
  , EventId(EventId), _EventId, eventIdJSON
```
[20.12]
[6.5553]
```
  , EventId(EventId), _EventId
```
Deletion in lib/Quixotic/TimeLog.hs at line 25 [17.846]
B:BD[15.3878] → [6.5636:5660]
```
import Data.Aeson.Types
```
Deletion in lib/Quixotic/TimeLog.hs at line 35 [17.846]
B:BD[21.635] → [6.5661:5682]
```
import Quixotic.Json
```

Deletion in lib/Quixotic/TimeLog.hs at line 82 [17.846]

B:BD[6.6043] → [6.6043:6562]

payoutsJSON :: Payouts -> Value
payoutsJSON (Payouts m) = toJSON $ MS.mapKeys (^. _BtcAddr) m
parsePayoutsJSON :: Value -> Parser Payouts
parsePayoutsJSON v = 
  Payouts . MS.mapKeys BtcAddr <$> parseJSON v 
instance A.ToJSON Payouts where
  toJSON = versioned (Version 1 0 0) . payoutsJSON
instance A.FromJSON Payouts where
  parseJSON v = let parsePayouts (Version 1 0 0) = parsePayoutsJSON 
                    parsePayouts v' = \_ -> fail . show $ printVersion v'
                in  unversion parsePayouts $ v

Deletion in lib/Quixotic/TimeLog.hs at line 84 [17.846]

B:BD[16.491] → [16.491:492]

B:BD[22.351] → [6.6563:6599]

B:BD[6.6599] → [16.493:613]


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

Deletion in lib/Quixotic/TimeLog.hs at line 85 [17.846]
B:BD[6.6694] → [6.6694:6766]
```
eventIdJSON :: EventId -> Value
eventIdJSON (EventId eid) = toJSON eid
```

Replacement in server/Main.hs at line 48 [24.5188]

B:BD[9.8476] → [23.2:55]

  qms  <- nestSnaplet "qmodules" qm qdbpgSnapletInit

[9.8476]

[9.8526]

  qms   <- nestSnaplet "qmodules" qm qdbpgSnapletInit

Replacement in server/Main.hs at line 53 [24.5188]

B:BD[9.8755] → [6.6991:7055]

∅:D[6.7055] → [11.851:914]

B:BD[25.179] → [11.851:914]

B:BD[11.914] → [6.7056:7504]

∅:D[6.7504] → [26.847:926]

B:BD[26.847] → [26.847:926]

B:BD[26.926] → [6.7505:7585]

  addRoutes [ ("login",    requireLogin >> (redirect "/home")) 
            , ("register", void $ method POST registerHandler)
            , ("projects/:projectId/logStart/:btcAddr", serveJSON eventIdJSON . method POST $ logWorkHandler StartWork)
            , ("projects/:projectId/logEnd/:btcAddr",   serveJSON eventIdJSON . method POST $ logWorkHandler StopWork)
            , ("projects/:projectId/log/:btcAddr",      serveJSON workIndexJSON $ method GET loggedIntervalsHandler)
            , ("projects/:projectId", serveJSON projectJSON $ method GET projectGetHandler)
            , ("projects",            void $ method POST projectCreateHandler)
            , ("payouts/:projectId",  serveJSON id $ method GET payoutsHandler)

[9.8755]

[9.8999]


  let loginRoute         = requireLogin >> redirect "/home"
      registerRoute      = void $ method POST registerHandler
      logEventRoute f    = serveJSON eventIdJSON . method POST $ logWorkHandler f
      loggedIntervalsRoute = serveJSON workIndexJSON $ method GET loggedIntervalsHandler
      projectCreateRoute = void $ method POST projectCreateHandler
      projectRoute       = serveJSON projectJSON $ method GET projectGetHandler
      listProjectsRoute  = serveJSON (fmap qdbProjectJSON) $ method GET projectListHandler
      payoutsRoute       = serveJSON payoutsJSON $ method GET payoutsHandler
  addRoutes [ ("login", loginRoute)   
            , ("register", registerRoute)
            , ("projects/:projectId/logStart/:btcAddr", logEventRoute StartWork)
            , ("projects/:projectId/logEnd/:btcAddr", logEventRoute StopWork) 
            , ("projects/:projectId/log/:btcAddr", loggedIntervalsRoute)
            , ("projects/:projectId", projectRoute)
            , ("projects", listProjectsRoute)
            , ("projects", projectCreateRoute)
            , ("payouts/:projectId", payoutsRoute)

Deletion in server/Quixotic/Snaplet/Projects.hs at line 24 [27.2363]
B:BD[27.2914] → [26.1312:1381]
```
projectGetHandler :: Handler App App Project
projectGetHandler = ok
```

Insertion in server/Quixotic/Snaplet/Projects.hs at line 40 [27.2363]

[26.1564]

projectGetHandler :: Handler App App Project
projectGetHandler = do
  QDB{..} <- view qdb <$> with qm get
  uid <- requireUserId
  pid <- requireProjectAccess uid
  mp <- liftPG . runReaderT $ findProject pid
  maybe (snapError 404 $ "Project not found for id " <> tshow pid) pure mp

Replacement in server/Quixotic/Snaplet/WorkLog.hs at line 30 [28.5424]

B:BD[2.3324] → [2.3324:3394]

      storeEv addr = runReaderT . recordEvent pid uid $ logEntry addr

[2.3324]

[28.6163]

      storeEv addr = runReaderT . createEvent pid uid $ logEntry addr

Undo JSON silliness, enable a couple more routes.

Dependencies

In channels

Change contents

Insertion in lib/Quixotic/Client.hs at line 8 [3.1]

Insertion in lib/Quixotic/Client.hs at line 13 [3.1]

Replacement in lib/Quixotic/Client.hs at line 27 [3.1]

Insertion in lib/Quixotic/Database/PostgreSQL.hs at line 134 [9.456]

Replacement in lib/Quixotic/Database/PostgreSQL.hs at line 152 [9.456]

Replacement in lib/Quixotic/Database/PostgreSQL.hs at line 189 [9.456]

Replacement in lib/Quixotic/Database/PostgreSQL.hs at line 196 [9.456]

Replacement in lib/Quixotic/Database/PostgreSQL.hs at line 203 [9.456]

Insertion in lib/Quixotic/Database/PostgreSQL.hs at line 253 [9.456]

Replacement in lib/Quixotic/Database/PostgreSQL.hs at line 272 [9.456]

Replacement in lib/Quixotic/Database/PostgreSQL.hs at line 275 [9.456]

Insertion in lib/Quixotic/Database/PostgreSQL.hs at line 281 [9.456]

Insertion in lib/Quixotic/Database/PostgreSQL.hs at line 285 [9.456]

Insertion in lib/Quixotic/Database/PostgreSQL.hs at line 287 [9.456]

Replacement in lib/Quixotic/Database.hs at line 25 [12.4936]

Replacement in lib/Quixotic/Database.hs at line 28 [12.4936]

Insertion in lib/Quixotic/Database.hs at line 33 [12.4936]

Insertion in lib/Quixotic/Database.hs at line 37 [12.4936]

Insertion in lib/Quixotic/Database.hs at line 39 [12.4936]

Deletion in lib/Quixotic/Json.hs at line 11 [14.19]

Insertion in lib/Quixotic/Json.hs at line 13 [14.19]

Insertion in lib/Quixotic/Json.hs at line 18 [14.19]

Insertion in lib/Quixotic/Json.hs at line 61 [14.19]

Insertion in lib/Quixotic/Json.hs at line 73 [14.19]

Replacement in lib/Quixotic/TimeLog.hs at line 9 [17.846]

Replacement in lib/Quixotic/TimeLog.hs at line 11 [17.846]

Deletion in lib/Quixotic/TimeLog.hs at line 25 [17.846]

Deletion in lib/Quixotic/TimeLog.hs at line 35 [17.846]