Add authentication to auction search.

[?]

Mar 20, 2016, 1:01 AM

5OI44E4EEVYOMHDWNK2WA7K4L4JWRWCUJUNN2UAUGE5VY4W7GTNAC

Dependencies

[2] HALRDT2F Added initial auction create route.
[3] QMRKFEPG Refactor QDB to use a free monad algebra instead.
[4] KEP5WUFJ Convert project to stack-based build.
[5] IZEVQF62 Work in progress replacing sqlite with postgres.
[6] Z7KS5XHH Very WIP. Wow.
[7] ZP62WC47 Begin conversion to build with stack.
[8] LAROLAYU WIP
[9] 2XQD6KKK Add invitation logic and clean up DBProg error handling.
[10] EKI57EJR Add alternative implementation of auction winner determination.
[11] O5FVTOM6 Undo JSON silliness, enable a couple more routes.
[12] TNR3TEHK Switch to Postgres + snaplet arch compiles.
[13] GCVQD44V Create amends endpoint, switch to UUID primary keys
[14] A6HKMINB Attempting to improve JSON handling.
[15] M4KM76DG Merge branch 'stackify'
[16] NEDDHXUK Reformat via stylish-haskell
[17] NLZ3JXLO Fix formatting with stylish-haskell.
[18] LD4GLVSF More database stuff.
[*] 64C6AWH6 Rename Ananke -> Quixotic, project reboot.

Change contents

edit in lib/Aftok/Auction.hs at line 14

[3.85]

[3.85]

import Aftok.Project (ProjectId)
replacement in lib/Aftok/Auction.hs at line 21

[3.239]→[2.41:69](∅→∅)

{ _initiator :: UserId

[3.239]

[2.69]

{ _projectId :: ProjectId
, _initiator :: UserId
replacement in lib/Aftok/Database/PostgreSQL.hs at line 94

[3.662]→[3.47:47](∅→∅),[3.2039]→[2.241:275](∅→∅)

Auction <$> fieldWith uidParser

[3.2039]

[2.275]

Auction <$> fieldWith pidParser
<*> fieldWith uidParser
replacement in lib/Aftok/Database/PostgreSQL.hs at line 214

[3.4862]→[3.3068:3103](∅→∅)

dbEval (CreateAuction pid auc) =

[3.4862]

[3.3035]

dbEval (CreateAuction auc) =
replacement in lib/Aftok/Database/PostgreSQL.hs at line 218

[2.427]→[2.427:453](∅→∅)

( pid ^. _ProjectId

[2.427]

[2.453]

( auc ^. (A.projectId . _ProjectId)
replacement in lib/Aftok/Database.hs at line 46

[3.6858]→[3.6858:6919](∅→∅)

CreateAuction :: ProjectId -> Auction -> DBOp AuctionId

[3.6858]

[3.6919]

CreateAuction :: Auction -> DBOp AuctionId
edit in lib/Aftok/Database.hs at line 107

[3.5425]

[3.5425]

checkProjectAuth :: ProjectId -> UserId -> DBOp a -> DBProg ()
checkProjectAuth pid uid act = do
px <- findUserProjects uid
if any (\(pid', _) -> pid' == pid) px
then pure ()
else void . fc $ raiseOpForbidden uid UserNotProjectMember act
edit in lib/Aftok/Database.hs at line 116

[3.5426]

[3.5426]
replacement in lib/Aftok/Database.hs at line 140

[3.818]→[3.6398:6461](∅→∅),[3.6398]→[3.6398:6461](∅→∅)

withProjectAuth (i ^. projectId) (i ^. invitingUser) act

[3.818]

[3.1389]

withProjectAuth (i ^. P.projectId) (i ^. P.invitingUser) act
replacement in lib/Aftok/Database.hs at line 167

[3.1306]→[2.850:996](∅→∅)

createAuction :: ProjectId -> Auction -> DBProg AuctionId
createAuction pid a = do
withProjectAuth pid (a ^. A.initiator) $ CreateAuction pid a

[3.1306]

createAuction :: Auction -> DBProg AuctionId
createAuction a = do
withProjectAuth (a ^. A.projectId) (a ^. A.initiator) $ CreateAuction a

findAuction :: AuctionId -> UserId -> DBProg (Maybe Auction)
findAuction aid uid =
let findAuc = FindAuction aid
in do
maybeAuc <- fc findAuc
_ <- traverse (\auc -> checkProjectAuth (auc ^. A.projectId) uid findAuc) maybeAuc
pure maybeAuc
replacement in server/Aftok/Snaplet/Auctions.hs at line 40

[2.3594]→[2.3594:3686](∅→∅)

snapEval . createAuction pid $ Auction uid (Satoshi . raiseAmount $ req) (auctionEnd req)

[2.3594]

snapEval . createAuction $ Auction pid uid (Satoshi . raiseAmount $ req) (auctionEnd req)