Create amends endpoint, switch to UUID primary keys

[?]

May 25, 2015, 2:37 AM

GCVQD44VRPQVKPZEPIC4AOIXLJIG2ZMV3QI2Y7KALUT6NVUBSGSAC

Dependencies

[2] RPAJLHMT Change to use UUIDs instead of ints for primary keys.
[3] LD4GLVSF More database stuff.
[4] LAROLAYU WIP
[5] 64C6AWH6 Rename Ananke -> Quixotic, project reboot.
[6] TNR3TEHK Switch to Postgres + snaplet arch compiles.
[7] VJPT6HDR Fix remaining type errors after addition of login handler.
[8] KNSI575V Cleanup of EventLog types.
[9] WZUHEZSB Start of migration back toward snap.
[10] WO2MINIF Auctions now compile!
[11] HE3JTXO3 Added client call to payouts.
[12] Z3M53KTL Adrift.
[13] NTPC7KJE Trivial changes, feature scratchpad.
[14] EQXRXRZD Changed to use tasty instead of test-framework
[15] Z7KS5XHH Very WIP. Wow.
[16] 2G3GNDDU Event logging is now functioning in postgres.
[17] BROSTG5K Beginning of modularization of server.
[18] 5XFJNUAZ Start of addition of project infrastructure.
[19] EMVTF2IW WIP moving back to snap.
[20] SLL7262C Make depreciation functions more flexible.
[21] EZQG2APB Update task list.
[22] W35DDBFY Factor common JSON conversions up into client lib module.
[23] Y35QCWYW Minor improvement in WorkIndex type to eliminate duplicated information.
[24] 5DRIWGLU Improving TimeLog specs
[25] 7DBNV3GV Initial, stack-based impl of time log event reduction.
[26] TCOAKCGG Completed conversion to snap.
[27] RSEB2NFG Replacing Snap with Scotty.
[28] TZQJVHBA Add auction functions to ADB.
[29] NJZ3DKZY THEY CAN TALK!
[30] 7KZP4RHZ Switch from Data.Time to Data.Thyme
[31] 2OIPAQCB Merge branch 'master' of github.com:nuttycom/ananke
[32] GKGVYBZG Added JSON serialization to TimeLog
[33] 2Y2QZFVF Switch to more modern cabal2nix-based workflow.
[34] XTBSG4C7 Adding serveJSON combinator to eliminate some boilerplate from handlers.
[35] IZEVQF62 Work in progress replacing sqlite with postgres.
[36] FD7SV5I6 Fix handling of event_t columns.
[37] I2KHGVD4 Require project permissions for access to most data.
[38] 7XN3I3QJ Add 'loggedIntervals' endpoint.
[39] A6HKMINB Attempting to improve JSON handling.
[40] 2KZPOGRB Once you get Haskell to compile, the tests pass!
[41] PBD7LZYQ Postgres & auth are beginning to function.
[42] 4IQVQL4T Added client for payouts endpoint.
[43] OV5AKJHA Remove unused LogInterval type.
[44] O5FVTOM6 Undo JSON silliness, enable a couple more routes.
[45] TLQ72DSJ Lenses, sqlite-simple
[46] OBFPJS2G Project successfully builds and tests under nix.
[47] WFZDMVUX Rename ADB -> QDB
[48] NVOCQVAS Initial failing tests.
[*] 75N3UJ4J More progression toward lenses.
[*] ADMKQQGC Initial empty Snap project.

Change contents

edit in lib/Quixotic/Auction.hs at line 22

[50.188]

[3.5324]

newtype BidId = BidId UUID deriving (Show, Eq)
makePrisms ''BidId
replacement in lib/Quixotic/Database/PostgreSQL.hs at line 8

[3.713]→[3.4:38](∅→∅)

import Data.ByteString.Char8 as B

[3.713]

[3.713]

import qualified Data.ByteString.Char8 as B
edit in lib/Quixotic/Database/PostgreSQL.hs at line 10

[3.731]

[3.731]

import Data.List as L
replacement in lib/Quixotic/Database/PostgreSQL.hs at line 14

[3.56]→[3.753:786](∅→∅),[3.753]→[3.753:786](∅→∅)

import qualified Data.List as DL

[3.56]

[3.786]

import Data.UUID(UUID)
edit in lib/Quixotic/Database/PostgreSQL.hs at line 48

[3.224]

[3.1215]

eidParser :: FieldParser EventId
eidParser f v = EventId <$> fromField f v
edit in lib/Quixotic/Database/PostgreSQL.hs at line 72

[3.1606]→[3.1606:1607](∅→∅),[3.1607]→[3.766:872](∅→∅),[3.229]→[3.1715:1753](∅→∅),[3.303]→[3.1715:1753](∅→∅),[3.872]→[3.1715:1753](∅→∅),[3.3511]→[3.1715:1753](∅→∅),[3.1715]→[3.1715:1753](∅→∅),[3.1753]→[3.873:958](∅→∅),[3.958]→[3.1829:2289](∅→∅),[3.1829]→[3.1829:2289](∅→∅),[3.2289]→[3.52:90](∅→∅),[3.90]→[3.85:472](∅→∅),[3.472]→[3.159:160](∅→∅),[3.159]→[3.159:160](∅→∅),[3.160]→[3.2289:2338](∅→∅),[3.2289]→[3.2289:2338](∅→∅)

workEventParser :: RowParser LogEvent
workEventParser = fieldWith eventTypeParser <*> fieldWith utcParser

logEntryParser :: RowParser LogEntry
logEntryParser = LogEntry <$> fieldWith btcAddrParser <*> workEventParser <*> field

auctionRowParser :: RowParser Auction
auctionRowParser = Auction <$> fieldWith btcParser <*> field

bidRowParser :: RowParser Bid
bidRowParser = Bid <$> fieldWith uidParser
<*> fieldWith secondsParser
<*> fieldWith btcParser
<*> field

userRowParser :: RowParser User
userRowParser = User <$> fieldWith usernameParser
<*> fieldWith btcAddrParser
<*> field

qdbUserRowParser :: RowParser QDBUser
qdbUserRowParser = QDBUser <$> fieldWith uidParser
<*> userRowParser

projectRowParser :: RowParser Project
projectRowParser = Project <$> field
<*> field
<*> fieldWith uidParser

qdbProjectRowParser :: RowParser QDBProject
qdbProjectRowParser = QDBProject <$> fieldWith pidParser <*> projectRowParser

-- Local newtypes to permit field serialization
replacement in lib/Quixotic/Database/PostgreSQL.hs at line 84

[2.224]→[3.2484:2597](∅→∅),[3.2484]→[3.2484:2597](∅→∅)

-- Local newtypes to permit row deserialization via
-- typeclass. Wish I could just pass the RowParser instances

[2.224]

[3.2597]

logEntryParser :: RowParser LogEntry
logEntryParser =
LogEntry <$> fieldWith btcAddrParser
<*> (fieldWith eventTypeParser <*> fieldWith utcParser)
<*> field
replacement in lib/Quixotic/Database/PostgreSQL.hs at line 90

[3.2598]→[3.2598:2729](∅→∅)

newtype PLogEntry = PLogEntry { pLogEntry :: LogEntry }
instance FromRow PLogEntry where
fromRow = PLogEntry <$> logEntryParser

[3.2598]

[3.2729]

qdbLogEntryParser :: RowParser QDBLogEntry
qdbLogEntryParser =
(,,,) <$> fieldWith eidParser
<*> fieldWith pidParser
<*> fieldWith uidParser
<*> logEntryParser

auctionParser :: RowParser Auction
auctionParser =
Auction <$> fieldWith btcParser
<*> field
replacement in lib/Quixotic/Database/PostgreSQL.hs at line 102

[3.2730]→[3.2730:2828](∅→∅)

newtype PBid = PBid { pBid :: Bid }
instance FromRow PBid where
fromRow = PBid <$> bidRowParser

[3.2730]

[3.2828]

bidParser :: RowParser Bid
bidParser =
Bid <$> fieldWith uidParser
<*> fieldWith secondsParser
<*> fieldWith btcParser
<*> field
replacement in lib/Quixotic/Database/PostgreSQL.hs at line 109

[3.2829]→[3.2829:2934](∅→∅)

newtype PUser = PUser { pUser :: User }
instance FromRow PUser where
fromRow = PUser <$> userRowParser

[3.2829]

[3.2934]

userParser :: RowParser User
userParser =
User <$> fieldWith usernameParser
<*> fieldWith btcAddrParser
<*> field
replacement in lib/Quixotic/Database/PostgreSQL.hs at line 115

[3.2935]→[3.2935:3061](∅→∅)

newtype PAuction = PAuction { pAuction :: Auction }
instance FromRow PAuction where
fromRow = PAuction <$> auctionRowParser

[3.2935]

[3.3061]

qdbUserParser :: RowParser QDBUser
qdbUserParser =
(,) <$> fieldWith uidParser
<*> userParser
replacement in lib/Quixotic/Database/PostgreSQL.hs at line 120

[3.3062]→[3.187:313](∅→∅)

newtype PQDBUser = PQDBUser { pQDBUser :: QDBUser }
instance FromRow PQDBUser where
fromRow = PQDBUser <$> qdbUserRowParser

[3.3062]

[3.313]

projectParser :: RowParser Project
projectParser =
Project <$> field
<*> field
<*> fieldWith uidParser
replacement in lib/Quixotic/Database/PostgreSQL.hs at line 126

[3.314]→[3.167:293](∅→∅)

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

[3.314]

[3.293]

qdbProjectParser :: RowParser QDBProject
qdbProjectParser =
(,) <$> fieldWith pidParser
<*> projectParser
replacement in lib/Quixotic/Database/PostgreSQL.hs at line 131

[3.294]→[3.473:620](∅→∅),[3.314]→[3.473:620](∅→∅)

newtype PQDBProject = PQDBProject { pQDBProject :: QDBProject }
instance FromRow PQDBProject where
fromRow = PQDBProject <$> qdbProjectRowParser

[3.294]

[3.620]

pexec :: (ToRow d) => Query -> d -> QDBM Int64
pexec q d = do
conn <- ask
lift $ execute conn q d
replacement in lib/Quixotic/Database/PostgreSQL.hs at line 136

[3.621]→[3.1159:1232](∅→∅)

pquery :: (ToRow d, FromRow r) => Query -> d -> QDBM [r]
pquery q d = do

[3.621]

[3.3172]

pinsert :: (ToRow d) => (UUID -> r) -> Query -> d -> QDBM r
pinsert f q d = do
replacement in lib/Quixotic/Database/PostgreSQL.hs at line 139

[3.3186]→[3.1233:1257](∅→∅)

lift $ query conn q d

[3.3186]

[3.1257]

ids <- lift $ query conn q d
pure . f . fromOnly $ L.head ids
replacement in lib/Quixotic/Database/PostgreSQL.hs at line 142

[3.1258]→[3.1258:1320](∅→∅)

pexec :: (ToRow d) => Query -> d -> QDBM Int64
pexec q d = do

[3.1258]

[3.1320]

pquery :: (ToRow d) => RowParser r -> Query -> d -> QDBM [r]
pquery p q d = do
replacement in lib/Quixotic/Database/PostgreSQL.hs at line 145

[3.1334]→[3.1334:1361](∅→∅)

lift $ execute conn q d

[3.1334]

[3.1361]

lift $ queryWith p conn q d
replacement in lib/Quixotic/Database/PostgreSQL.hs at line 148

[3.359]→[3.359:424](∅→∅),[3.424]→[3.1489:1510](∅→∅),[3.1024]→[3.1489:1510](∅→∅),[3.1489]→[3.1489:1510](∅→∅)

createEvent' (ProjectId pid) (UserId uid) (LogEntry a e m) = do
eventIds <- pquery

[3.359]

[3.1510]

createEvent' (ProjectId pid) (UserId uid) (LogEntry a e m) =
pinsert EventId
replacement in lib/Quixotic/Database/PostgreSQL.hs at line 159

[3.3405]→[3.1667:1714](∅→∅)

pure . EventId . fromOnly $ DL.head eventIds

[3.3405]

[3.3405]

findEvent' :: EventId -> QDBM (Maybe QDBLogEntry)
findEvent' (EventId eid) = do
logEntries <- pquery qdbLogEntryParser
"SELECT id, project_id, user_id, btc_addr, event_type, event_time, event_metadata FROM work_events \
\WHERE id = ?"
(Only eid)
pure $ headMay logEntries
replacement in lib/Quixotic/Database/PostgreSQL.hs at line 170

[2.374]→[2.374:402](∅→∅)

let q (Before e) = pquery

[2.374]

[2.402]

let q p (Before e) = pquery p
replacement in lib/Quixotic/Database/PostgreSQL.hs at line 174

[2.585]→[2.585:615](∅→∅)

q (During s e) = pquery

[2.585]

[2.615]

q p (During s e) = pquery p
replacement in lib/Quixotic/Database/PostgreSQL.hs at line 179

[2.841]→[2.841:868](∅→∅)

q (After s) = pquery

[2.841]

[2.868]

q p (After s) = pquery p
replacement in lib/Quixotic/Database/PostgreSQL.hs at line 183

[2.1051]→[2.1051:1083](∅→∅)

in fmap pLogEntry <$> q ival

[2.1051]

[2.1083]

in q logEntryParser ival
replacement in lib/Quixotic/Database/PostgreSQL.hs at line 185

[2.1084]→[3.1715:1768](∅→∅),[3.3406]→[3.1715:1768](∅→∅)

amendEvent' :: EventId -> LogModification -> QDBM ()

[2.1084]

[3.1768]

amendEvent' :: EventId -> EventAmendment -> QDBM AmendmentId
replacement in lib/Quixotic/Database/PostgreSQL.hs at line 187

[3.1815]→[3.1815:1920](∅→∅)

void $ pexec
"INSERT INTO event_time_amendments (event_id, mod_time, event_time) VALUES (?, ?, ?)"

[3.1815]

[3.264]

pinsert AmendmentId
"INSERT INTO event_time_amendments (event_id, mod_time, event_time) VALUES (?, ?, ?) RETURNING id"
replacement in lib/Quixotic/Database/PostgreSQL.hs at line 192

[3.2005]→[3.2005:2108](∅→∅)

void $ pexec
"INSERT INTO event_addr_amendments (event_id, mod_time, btc_addr) VALUES (?, ?, ?)"

[3.2005]

[3.318]

pinsert AmendmentId
"INSERT INTO event_addr_amendments (event_id, mod_time, btc_addr) VALUES (?, ?, ?) RETURNING id"
replacement in lib/Quixotic/Database/PostgreSQL.hs at line 197

[3.2208]→[3.2208:2315](∅→∅),[3.2315]→[3.377:420](∅→∅)

void $ pexec
"INSERT INTO event_metadata_amendments (event_id, mod_time, btc_addr) VALUES (?, ?, ?)"
( eid, fromThyme $ mt ^. _ModTime, v )

[3.2208]

[3.2346]

pinsert AmendmentId
"INSERT INTO event_metadata_amendments (event_id, mod_time, btc_addr) VALUES (?, ?, ?) RETURNING id"
( eid, fromThyme $ mt ^. _ModTime, v)
replacement in lib/Quixotic/Database/PostgreSQL.hs at line 203

[3.626]→[3.2394:2411](∅→∅)

rows <- pquery

[3.626]

[2.1085]

logEntries <- pquery logEntryParser
replacement in lib/Quixotic/Database/PostgreSQL.hs at line 206

[3.762]→[3.3583:3624](∅→∅),[3.3583]→[3.3583:3624](∅→∅)

pure . workIndex $ fmap pLogEntry rows

[3.762]

[3.3624]

pure $ workIndex logEntries
replacement in lib/Quixotic/Database/PostgreSQL.hs at line 209

[3.482]→[3.482:510](∅→∅),[3.510]→[3.2467:2486](∅→∅),[3.859]→[3.2467:2486](∅→∅),[3.2486]→[3.860:954](∅→∅),[3.3748]→[3.860:954](∅→∅)

createAuction' pid auc = do
aucIds <- pquery
"INSERT INTO auctions (project_id, raise_amount, end_time) VALUES (?, ?, ?) RETURNING id"

[3.482]

[3.954]

createAuction' pid auc =
pinsert AuctionId
"INSERT INTO auctions (project_id, raise_amount, end_time) \
\VALUES (?, ?, ?) RETURNING id"
edit in lib/Quixotic/Database/PostgreSQL.hs at line 214

[3.1029]→[3.3881:3928](∅→∅),[3.3881]→[3.3881:3928](∅→∅)

pure . AuctionId . fromOnly $ DL.head aucIds
replacement in lib/Quixotic/Database/PostgreSQL.hs at line 217

[3.585]→[3.2538:2555](∅→∅),[3.4020]→[3.2538:2555](∅→∅),[3.2555]→[3.4062:4129](∅→∅),[3.4062]→[3.4062:4129](∅→∅)

rows <- pquery
"SELECT raise_amount, end_time FROM auctions WHERE ROWID = ?"

[3.585]

[3.4129]

auctions <- pquery auctionParser
"SELECT raise_amount, end_time FROM auctions WHERE id = ?"
replacement in lib/Quixotic/Database/PostgreSQL.hs at line 220

[3.4162]→[3.4162:4200](∅→∅)

pure . fmap pAuction $ headMay rows

[3.4162]

[3.4200]

pure $ headMay auctions
replacement in lib/Quixotic/Database/PostgreSQL.hs at line 222

[3.4201]→[3.586:628](∅→∅)

createBid' :: AuctionId -> Bid -> QDBM ()

[3.4201]

[3.628]

createBid' :: AuctionId -> Bid -> QDBM BidId
replacement in lib/Quixotic/Database/PostgreSQL.hs at line 224

[3.666]→[3.2599:2614](∅→∅),[3.4298]→[3.2599:2614](∅→∅),[3.2614]→[3.54:159](∅→∅),[3.4341]→[3.54:159](∅→∅)

void $ pexec
"INSERT INTO bids (auction_id, bidder_id, bid_seconds, bid_amount, bid_time) values (?, ?, ?, ?, ?)"

[3.666]

[3.4444]

pinsert BidId
"INSERT INTO bids (auction_id, bidder_id, bid_seconds, bid_amount, bid_time) \
\VALUES (?, ?, ?, ?, ?) RETURNING id"
replacement in lib/Quixotic/Database/PostgreSQL.hs at line 235

[3.2652]→[3.4652:4673](∅→∅),[3.4652]→[3.4652:4673](∅→∅),[3.4673]→[3.2653:2670](∅→∅)

readBids' aucId = do
rows <- pquery

[3.2652]

[3.4715]

readBids' aucId =
pquery bidParser
edit in lib/Quixotic/Database/PostgreSQL.hs at line 239

[3.4837]→[3.4837:4861](∅→∅)

pure $ fmap pBid rows
replacement in lib/Quixotic/Database/PostgreSQL.hs at line 241

[3.2706]→[3.315:338](∅→∅),[3.4914]→[3.315:338](∅→∅),[3.338]→[3.2707:2724](∅→∅)

createUser' user' = do
uids <- pquery

[3.2706]

[3.160]

createUser' user' =
pinsert UserId
edit in lib/Quixotic/Database/PostgreSQL.hs at line 245

[3.427]→[3.5140:5182](∅→∅),[3.3777]→[3.5140:5182](∅→∅),[3.5140]→[3.5140:5182](∅→∅)

pure . UserId . fromOnly $ DL.head uids
replacement in lib/Quixotic/Database/PostgreSQL.hs at line 248

[3.5269]→[3.2767:2785](∅→∅)

users <- pquery

[3.5269]

[3.5312]

users <- pquery userParser
replacement in lib/Quixotic/Database/PostgreSQL.hs at line 251

[3.5388]→[3.5388:5424](∅→∅)

pure . fmap pUser $ headMay users

[3.5388]

[3.5424]

pure $ headMay users
replacement in lib/Quixotic/Database/PostgreSQL.hs at line 255

[3.539]→[3.2843:2861](∅→∅)

users <- pquery

[3.539]

[3.582]

users <- pquery qdbUserParser
replacement in lib/Quixotic/Database/PostgreSQL.hs at line 258

[3.664]→[3.664:703](∅→∅)

pure . fmap pQDBUser $ headMay users

[3.664]

[3.5524]

pure $ headMay users
replacement in lib/Quixotic/Database/PostgreSQL.hs at line 263

[3.41]→[3.2907:2924](∅→∅)

pids <- pquery

[3.41]

[3.747]

pid <- pinsert ProjectId
replacement in lib/Quixotic/Database/PostgreSQL.hs at line 266

[3.90]→[3.90:126](∅→∅),[3.126]→[3.2925:2940](∅→∅),[3.2940]→[3.155:273](∅→∅),[3.155]→[3.155:273](∅→∅)

let pid = fromOnly $ DL.head pids
void $ pexec
"INSERT INTO project_companions (project_id, companion_id) VALUES (?, ?)"
(pid, uid)
pure . ProjectId $ pid

[3.90]

[3.667]

void $ pexec
"INSERT INTO project_companions (project_id, user_id) VALUES (?, ?)"
(pid ^. _ProjectId, uid)
pure pid
replacement in lib/Quixotic/Database/PostgreSQL.hs at line 273

[3.752]→[3.752:773](∅→∅)

projects <- pquery

[3.752]

[3.773]

projects <- pquery projectParser
replacement in lib/Quixotic/Database/PostgreSQL.hs at line 276

[3.871]→[3.871:913](∅→∅)

pure . fmap pProject $ headMay projects

[3.871]

[3.704]

pure $ headMay projects
replacement in lib/Quixotic/Database/PostgreSQL.hs at line 279

[3.2990]→[3.1030:1066](∅→∅),[3.1030]→[3.1030:1066](∅→∅),[3.1066]→[3.2991:3011](∅→∅)

findUserProjects' (UserId uid) = do
results <- pquery

[3.2990]

[3.1111]

findUserProjects' (UserId uid) =
pquery qdbProjectParser
replacement in lib/Quixotic/Database/PostgreSQL.hs at line 283

[3.348]→[3.348:380](∅→∅)

\WHERE pc.companion_id = ?"

[3.348]

[3.380]

\WHERE pc.user_id = ?"
edit in lib/Quixotic/Database/PostgreSQL.hs at line 285

[3.395]→[3.1334:1368](∅→∅),[3.1334]→[3.1334:1368](∅→∅)

pure $ fmap pQDBProject results
edit in lib/Quixotic/Database/PostgreSQL.hs at line 286

[3.1369]

[3.3012]
edit in lib/Quixotic/Database/PostgreSQL.hs at line 291

[3.3066]

[2.1187]

, findEvent = findEvent'
edit in lib/Quixotic/Database.hs at line 6

[3.838]→[3.6556:6576](∅→∅)

import Control.Lens
replacement in lib/Quixotic/Database.hs at line 12

[3.5045]→[3.6578:6668](∅→∅)

data QDBUser = QDBUser
{ _userId :: UserId
, _user :: User
}
makeLenses ''QDBUser

[3.5045]

[3.1389]

type QDBUser = (UserId, User)
type QDBLogEntry = (EventId, ProjectId, UserId, LogEntry)
type QDBProject = (ProjectId, Project)
edit in lib/Quixotic/Database.hs at line 16

[3.1390]→[3.1390:1499](∅→∅),[3.1499]→[3.6668:6669](∅→∅),[3.6668]→[3.6668:6669](∅→∅)

data QDBProject = QDBProject
{ _projectId :: ProjectId
, _project :: Project
}
makeLenses ''QDBProject
replacement in lib/Quixotic/Database.hs at line 18

[3.1145]→[3.3134:3190](∅→∅),[3.3134]→[3.3134:3190](∅→∅)

, amendEvent :: EventId -> LogModification -> m ()

[3.1145]

[2.1244]

, amendEvent :: EventId -> EventAmendment -> m AmendmentId
, findEvent :: EventId -> m (Maybe QDBLogEntry)
replacement in lib/Quixotic/Database.hs at line 25

[3.1256]→[3.1256:1302](∅→∅)

, createBid :: AuctionId -> Bid -> m ()

[3.1256]

[3.1598]

, createBid :: AuctionId -> Bid -> m BidId
edit in lib/Quixotic/Json.hs at line 27

[3.3941]→[3.3941:3991](∅→∅)

, trivialVersion :: Word8
replacement in lib/Quixotic/Json.hs at line 29

[3.485]→[3.4043:4176](∅→∅)

printVersion :: Version -> Text
printVersion Version{..} = intercalate "." (fmap tshow [majorVersion, minorVersion, trivialVersion])

[3.485]

[3.2225]

instance Show Version where
show Version{..} = intercalate "." $ fmap show [majorVersion, minorVersion]
replacement in lib/Quixotic/Json.hs at line 33

[3.4211]→[3.4211:4309](∅→∅)

versionParser = Version <$> P.decimal <*> (P.char '.' >> P.decimal) <*> (P.char '.' >> P.decimal)

[3.4211]

[3.4309]

versionParser = Version <$> P.decimal <*> (P.char '.' >> P.decimal)
edit in lib/Quixotic/Json.hs at line 35

[3.4310]→[3.4310:4454](∅→∅),[3.4454]→[3.2288:2289](∅→∅),[3.2288]→[3.2288:2289](∅→∅)

versioned :: Version -> Value -> Value
versioned ver v = object [ "schemaVersion" .= printVersion ver
, "value" .= v ]
replacement in lib/Quixotic/Json.hs at line 42

[3.2559]→[3.127:128](∅→∅)

[3.2415]

[3.4828]

-- TODO: Include source location information, and implement quote patterns.
edit in lib/Quixotic/Json.hs at line 47

[3.4995]

[3.186]

versioned :: Version -> Value -> Value
versioned ver v = object [ "schemaVersion" .= tshow ver
, "value" .= v ]
edit in lib/Quixotic/Json.hs at line 52

[3.187]

[3.4996]

{-|
- Convenience function to allow dispatch of different serialized
- versions to different parsers.
-}
replacement in lib/Quixotic/Json.hs at line 58

[3.5089]→[3.5089:5265](∅→∅)

vers <- v .: "schemaVersion"
vers' <- either (\_ -> mzero) pure $ P.parseOnly versionParser (encodeUtf8 vers)
value <- v .: "value"
f vers' value
unversion _ _ = mzero

[3.5089]

[3.485]

verstr <- v .: "schemaVersion"
vers <- either fail pure $ P.parseOnly versionParser (encodeUtf8 verstr)
v .: "value" >>= f vers

unversion _ x =
fail $ show x <> " did not contain the expected version information."

--------------
-- Versions --
--------------

v1 :: Value -> Value
v1 = versioned $ Version 1 0

unv1 :: String -> (Value -> Parser a) -> Value -> Parser a
unv1 name f v =
let p (Version 1 0) = f
p ver = const . fail $ "Unrecognized " <> name <> " schema version: " <> show ver
in unversion p v

-----------------
-- Serializers --
-----------------
replacement in lib/Quixotic/Json.hs at line 83

[3.1552]→[3.1552:1573](∅→∅),[3.1573]→[2.1663:1728](∅→∅),[2.1728]→[3.1630:1682](∅→∅),[3.1630]→[3.1630:1682](∅→∅)

qdbProjectJSON qp =
object [ "projectId" .= (tshow $ qp ^. (projectId._ProjectId))
, "project" .= projectJSON (qp ^. project)

[3.1552]

[3.1682]

qdbProjectJSON (projectId, project) = v1 $
object [ "projectId" .= (tshow $ projectId ^. _ProjectId)
, "project" .= projectJSON project
replacement in lib/Quixotic/Json.hs at line 89

[3.5298]→[3.5298:5315](∅→∅)

projectJSON p =

[3.5298]

[3.5315]

projectJSON p = v1 $
replacement in lib/Quixotic/Json.hs at line 95

[3.1727]→[3.1727:1904](∅→∅)

payoutsJSON (Payouts m) = toJSON $ MS.mapKeys (^. _BtcAddr) m

parsePayoutsJSON :: Value -> Parser Payouts
parsePayoutsJSON v =
Payouts . MS.mapKeys BtcAddr <$> parseJSON v

[3.1727]

[3.1904]

payoutsJSON (Payouts m) = v1 $
toJSON $ MS.mapKeys (^. _BtcAddr) m
replacement in lib/Quixotic/Json.hs at line 99

[3.1941]→[3.1941:1975](∅→∅)

workIndexJSON (WorkIndex widx) =

[3.1941]

[3.1975]

workIndexJSON (WorkIndex widx) = v1 $
replacement in lib/Quixotic/Json.hs at line 103

[3.2094]→[3.2094:2133](∅→∅)

eventIdJSON (EventId eid) = toJSON eid

[3.2094]

[2.1798]

eventIdJSON (EventId eid) = v1 $
object [ "eventId" .= tshow eid ]
replacement in lib/Quixotic/Json.hs at line 107

[2.1833]→[2.1833:1867](∅→∅)

logEntryJSON (LogEntry a ev m) =

[2.1833]

[2.1867]

logEntryJSON (LogEntry a ev m) = v1 $
edit in lib/Quixotic/Json.hs at line 113

[2.2031]

[3.2133]

amendmentIdJSON :: AmendmentId -> Value
amendmentIdJSON (AmendmentId aid) = v1 $
object [ "amendmentId" .= tshow aid ]

-------------
-- Parsers --
-------------
edit in lib/Quixotic/Json.hs at line 122

[3.2134]

parsePayoutsJSON :: Value -> Parser Payouts
parsePayoutsJSON = unv1 "payouts" $ \v ->
Payouts . MS.mapKeys BtcAddr <$> parseJSON v

parseEventAmendment :: ModTime -> Value -> Parser EventAmendment
parseEventAmendment t =
let parseA x "timeChange" = TimeChange t <$> x .: "eventTime"
parseA x "addrChage" = do
addrText <- x .: "btcAddr"
maybe
(fail $ (show addrText) <> "is not a valid BTC address")
(pure . AddressChange t)
$ parseBtcAddr addrText
parseA x "metadataChange" =
MetadataChange t <$> x .: "eventMeta"
parseA _ other =
fail $ "Amendment value " <> other <> " not recognized."

p (Object x) = x .: "amendment" >>= parseA x
p x = fail $ "Value " <> show x <> " missing 'amendment' field."
in unv1 "amendment" p
replacement in lib/Quixotic/TimeLog.hs at line 13

[3.5584]→[3.5584:5608](∅→∅)

, LogModification(..)

[3.5584]

[3.5326]

, EventAmendment(..)
, AmendmentId(AmendmentId), _AmendmentId
edit in lib/Quixotic/TimeLog.hs at line 27

[3.808]

[3.41]

import Data.Foldable as F
edit in lib/Quixotic/TimeLog.hs at line 30

[3.94]→[3.65:91](∅→∅),[3.119]→[3.65:91](∅→∅),[3.225]→[3.65:91](∅→∅),[3.808]→[3.65:91](∅→∅),[3.3878]→[3.65:91](∅→∅),[3.5660]→[3.65:91](∅→∅),[3.1808]→[3.65:91](∅→∅)

import Data.Foldable as F
edit in lib/Quixotic/TimeLog.hs at line 33

[3.838]

[3.838]

import Data.UUID
replacement in lib/Quixotic/TimeLog.hs at line 71

[3.1725]→[3.5683:5735](∅→∅)

newtype EventId = EventId Int64 deriving (Show, Eq)

[3.1725]

[3.5735]

newtype EventId = EventId UUID deriving (Show, Eq)
replacement in lib/Quixotic/TimeLog.hs at line 77

[3.5813]→[3.929:981](∅→∅),[3.981]→[3.5863:5970](∅→∅),[3.5863]→[3.5863:5970](∅→∅)

data LogModification = TimeChange ModTime C.UTCTime
| AddressChange ModTime BtcAddr
| MetadataChange ModTime A.Value

[3.5813]

[3.5970]

data EventAmendment = TimeChange ModTime C.UTCTime
| AddressChange ModTime BtcAddr
| MetadataChange ModTime A.Value

newtype AmendmentId = AmendmentId UUID deriving (Show, Eq)
makePrisms ''AmendmentId
replacement in lib/Quixotic.hs at line 50

[3.3400]→[3.3400:3442](∅→∅)

newtype InvitationId = InvitationId Int64

[3.3400]

[3.3442]

newtype InvitationId = InvitationId UUID deriving (Show, Eq)
edit in payouts/Main.hs at line 12

[3.1745]

[3.810]

import System.IO(FilePath)
replacement in payouts/Main.hs at line 37

[3.2108]→[3.478:516](∅→∅)

loadConfig :: FilePath -> IO QPConfig

[3.2108]

[3.516]

loadConfig :: System.IO.FilePath -> IO QPConfig
edit in quixotic.cabal at line 53

[3.1528]

[2.2997]

, semigroupoids
replacement in quixotic.cabal at line 58

[2.3113]→[2.3113:3149](∅→∅)

, uuid >= 1.3.10

[2.3113]

[3.2887]

, uuid >= 1.3
edit in quixotic.cabal at line 101

[3.1277]

[3.487]

, aeson
, attoparsec
, base64-bytestring
edit in quixotic.cabal at line 106

[3.1319]→[3.119:131](∅→∅),[3.119]→[3.119:131](∅→∅)

, aeson
edit in quixotic.cabal at line 107

[3.148]

[3.148]

, configurator
edit in quixotic.cabal at line 110

[2.3169]→[3.161:209](∅→∅),[3.161]→[3.161:209](∅→∅)

, mtl >= 2 && < 3
replacement in quixotic.cabal at line 111

[3.52]→[3.52:72](∅→∅),[3.72]→[3.222:233](∅→∅),[3.222]→[3.222:233](∅→∅),[3.233]→[3.2965:2977](∅→∅),[3.2977]→[3.73:92](∅→∅),[3.244]→[3.73:92](∅→∅)

, sqlite-simple
, text
, thyme
, transformers

[3.52]

[3.244]

, mtl >= 2 && < 3
edit in quixotic.cabal at line 113

[3.294]→[3.3150:3183](∅→∅)

, configurator
edit in quixotic.cabal at line 115

[3.7376]

[3.7376]

, resource-pool-catchio
replacement in quixotic.cabal at line 120

[3.7467]→[3.505:546](∅→∅),[3.546]→[3.7467:7495](∅→∅),[3.7467]→[3.7467:7495](∅→∅)

, attoparsec
, base64-bytestring
, resource-pool-catchio

[3.7467]

[3.3217]

, text
, thyme
, transformers
, uuid >= 1.3
replacement in scripts/log_end.sh at line 1

[3.532]→[3.533:652](∅→∅)

curl -v -u "nuttycom:kjntest" -X POST -d '' http://localhost:8000/projects/1/logEnd/1KamUn1BaRMd2HwikyQWGTdUvfPScg9QA5

[3.532]

curl -v -u "nuttycom:kjntest" -X POST -d '' http://localhost:8000/projects/6f4cba6f-02ec-4cc3-9241-00609d6a6f6a/logEnd/1KamUn1BaRMd2HwikyQWGTdUvfPScg9QA5
replacement in scripts/log_start.sh at line 1

[3.689]→[3.690:811](∅→∅)

curl -v -u "nuttycom:kjntest" -X POST -d '' http://localhost:8000/projects/1/logStart/1KamUn1BaRMd2HwikyQWGTdUvfPScg9QA5

[3.689]

curl -v -u "nuttycom:kjntest" -X POST -d '' http://localhost:8000/projects/6f4cba6f-02ec-4cc3-9241-00609d6a6f6a/logStart/1KamUn1BaRMd2HwikyQWGTdUvfPScg9QA5
edit in server/Main.hs at line 11

[3.626]

[3.918]

import System.IO(FilePath)
replacement in server/Main.hs at line 33

[3.383]→[3.7875:7903](∅→∅)

, authSiteKey :: FilePath

[3.383]

[3.7903]

, authSiteKey :: System.IO.FilePath
replacement in server/Main.hs at line 60

[2.3333]→[2.3333:3485](∅→∅)

logIntervalsRoute = serveJSON workIndexJSON $ method GET loggedIntervalsHandler
--amendEventRoute = void $ method PUT amendEventHandler

[2.3333]

[3.2569]

logIntervalsRoute = serveJSON workIndexJSON $ method GET loggedIntervalsHandler
amendEventRoute = serveJSON amendmentIdJSON $ method PUT amendEventHandler
replacement in server/Main.hs at line 71

[3.2968]→[2.3486:3549](∅→∅)

--, ("events/:eventId/amend", amendEventHandler),

[3.2968]

[3.2968]

, ("events/:eventId/amend", amendEventRoute)
replacement in server/Main.hs at line 83

[3.9051]→[3.431:469](∅→∅),[3.315]→[3.431:469](∅→∅)

loadQConfig :: FilePath -> IO QConfig

[3.9051]

[3.469]

loadQConfig :: System.IO.FilePath -> IO QConfig
replacement in server/Quixotic/Snaplet/Auth.hs at line 39

[3.2128]→[3.2128:2161](∅→∅)

Just u -> pure (u ^. userId)

[3.2128]

[3.2161]

Just u -> pure (u ^. _1)
replacement in server/Quixotic/Snaplet/Auth.hs at line 50

[3.2181]→[3.2181:2233](∅→∅)

if any (\p -> p ^. projectId == pid) projects

[3.2181]

[2.4135]

if any (\p -> p ^. _1 == pid) projects
edit in server/Quixotic/Snaplet/WorkLog.hs at line 8

[3.5625]

[3.2995]

import Data.Aeson.Types
import Data.UUID as U
edit in server/Quixotic/Snaplet/WorkLog.hs at line 15

[2.4678]

[3.5704]

import Quixotic.Json
edit in server/Quixotic/Snaplet/WorkLog.hs at line 26

[3.5831]

[3.3150]

-- TODO: ignore "duplicate" events within some small time limit?
edit in server/Quixotic/Snaplet/WorkLog.hs at line 34

[3.3064]→[3.3247:3324](∅→∅),[3.3324]→[2.4747:4818](∅→∅)

let logEntry addr = LogEntry addr (evCtr timestamp) (A.decode requestBody)
storeEv addr = runReaderT . createEvent pid uid $ logEntry addr
replacement in server/Quixotic/Snaplet/WorkLog.hs at line 36

[3.6308]→[3.6308:6347](∅→∅)

Just addr -> liftPG $ storeEv addr

[3.6308]

[3.6347]

Just addr ->
let logEntry a = LogEntry a (evCtr timestamp) (A.decode requestBody)
storeEv a = runReaderT . createEvent pid uid $ logEntry a
in liftPG $ storeEv addr
replacement in server/Quixotic/Snaplet/WorkLog.hs at line 56

[2.5224]→[2.5224:5337](∅→∅)

(Nothing, Nothing) -> snapError 400 $ "You must at least one of the \"after\" or \"before\" query parameter"

[2.5224]

[2.5337]

(Nothing, Nothing) -> snapError 400 "You must at least one of the \"after\" or \"before\" query parameter"
replacement in server/Quixotic/Snaplet/WorkLog.hs at line 62

[3.6744]→[2.5387:5426](∅→∅),[2.5426]→[3.3730:3780](∅→∅),[3.3730]→[3.3730:3780](∅→∅)

pid <- fmap snd requireProjectAccess
widx <- liftPG . runReaderT $ readWorkIndex pid

[3.6744]

[3.3065]

pid <- fmap snd requireProjectAccess
widx <- liftPG . runReaderT $ readWorkIndex pid
replacement in server/Quixotic/Snaplet/WorkLog.hs at line 67

[3.3782]→[2.5427:5479](∅→∅)

-- amendEventHandler :: Handler App App AmendmentId

[3.3782]

[2.5479]

amendEventHandler :: Handler App App AmendmentId
amendEventHandler = do
QDB{..} <- view qdb <$> with qm get
(uid, _) <- requireProjectAccess
eventIdBytes <- getParam "eventId"
eventId <- maybe
(snapError 400 "eventId parameter is required")
(pure . EventId)
(eventIdBytes >>= U.fromASCIIBytes)
edit in server/Quixotic/Snaplet/WorkLog.hs at line 77

[2.5480]

ev <- liftPG . runReaderT $ findEvent eventId
(_, _, uid', _) <- maybe (snapError 404 ("Event not found for id " <> tshow eventId)) pure ev

modTime <- ModTime <$> liftIO C.getCurrentTime
requestJSON <- readRequestJSON 4096
if uid' == uid
then either
(snapError 400 . pack)
(liftPG . runReaderT . amendEvent eventId)
(parseEither (parseEventAmendment modTime) requestJSON)
else
(snapError 403 "You do not have permission to view this event.")
edit in server/Quixotic/Snaplet.hs at line 10

[3.1290]

[3.1290]

import qualified Data.Aeson as A
edit in server/Quixotic/Snaplet.hs at line 56

[3.3199]

[3.3903]

readRequestJSON :: MonadSnap m => Int64 -> m A.Value
readRequestJSON i = do
requestBody <- A.decode <$> readRequestBody i
maybe (snapError 400 "Could not interpret request body as a nonempty JSON value.") pure requestBody
edit in sql/quixotic-pg.sql at line 1

[3.3144]

[3.3145]

create extension "uuid-ossp";
replacement in sql/quixotic-pg.sql at line 4

[3.3166]→[3.3832:3857](∅→∅)

id serial primary key,

[3.3166]

[3.3857]

id uuid primary key default uuid_generate_v4(),
replacement in sql/quixotic-pg.sql at line 11

[3.3959]→[3.3959:3984](∅→∅)

id serial primary key,

[3.3959]

[3.3984]

id uuid primary key default uuid_generate_v4(),
replacement in sql/quixotic-pg.sql at line 14

[3.1620]→[3.4069:4123](∅→∅),[3.4069]→[3.4069:4123](∅→∅)

initiator_id integer references users (id) not null

[3.1620]

[3.1621]

initiator_id uuid references users (id) not null
replacement in sql/quixotic-pg.sql at line 18

[3.1659]→[3.1659:1767](∅→∅)

project_id integer references projects(id) not null,
companion_id integer references users(id) not null

[3.1659]

[3.3201]

project_id uuid references projects(id) not null,
companion_id uuid references users(id) not null
replacement in sql/quixotic-pg.sql at line 25

[3.4209]→[3.3234:3259](∅→∅),[3.3234]→[3.3234:3259](∅→∅),[3.3259]→[3.4210:4314](∅→∅)

id serial primary key,
project_id integer references projects(id) not null,
user_id integer references users(id) not null,

[3.4209]

[3.4314]

id uuid primary key default uuid_generate_v4(),
project_id uuid references projects(id) not null,
user_id uuid references users(id) not null,
replacement in sql/quixotic-pg.sql at line 35

[3.4449]→[3.4449:4584](∅→∅)

id serial primary key,
project_id integer references projects(id) not null,
initiator_id integer references users (id) not null,

[3.4449]

[3.4584]

id uuid primary key default uuid_generate_v4(),
project_id uuid references projects(id) not null,
initiator_id uuid references users (id) not null,
replacement in sql/quixotic-pg.sql at line 43

[3.4689]→[3.3442:3467](∅→∅),[3.3442]→[3.3442:3467](∅→∅),[3.3467]→[3.4690:4798](∅→∅)

id serial primary key,
auction_id integer references projects (id) not null,
bidder_id integer references users (id) not null,

[3.4689]

[3.4798]

id uuid primary key default uuid_generate_v4(),
auction_id uuid references projects (id) not null,
bidder_id uuid references users (id) not null,