Add auction creation and bid handlers

Dependencies

• [2] Z3MK2PJ5 Add GET handler for retrieving auction data.
• [3] NLZ3JXLO Fix formatting with stylish-haskell.
• [4] O5FVTOM6 Undo JSON silliness, enable a couple more routes.
• [5] HALRDT2F Added initial auction create route.
• [6] RPAJLHMT Change to use UUIDs instead of ints for primary keys.
• [7] GCVQD44V Create amends endpoint, switch to UUID primary keys
• [8] MB5SHULB Add route for accepting an invitation with an existing account
• [9] 2XQD6KKK Add invitation logic and clean up DBProg error handling.
• [10] 5OI44E4E Add authentication to auction search.
• [11] IZEVQF62 Work in progress replacing sqlite with postgres.
• [12] QMRKFEPG Refactor QDB to use a free monad algebra instead.
• [13] MGOF7IUF Update TASKS list to reflect completed projects.
• [*] 64C6AWH6 Rename Ananke -> Quixotic, project reboot.
• [*] WZUHEZSB Start of migration back toward snap.
• [*] W35DDBFY Factor common JSON conversions up into client lib module.
• [*] 7HPY3QPF Fix linting errors. (yay hlint!)
• [*] Z7KS5XHH Very WIP. Wow.
• [*] ADMKQQGC Initial empty Snap project.

Change contents

• edit in aftok.cabal at line 117
  [16.161]

  [3.1178]
  + , hourglass
• edit in lib/Aftok/Database.hs at line 114
  [3.554]→[3.554:555](∅→∅),[3.555]→[3.5425:5426](∅→∅),[3.5425]→[3.5425:5426](∅→∅)
  −

  −
• edit in lib/Aftok/Database.hs at line 176
  [3.1024]
  +

  + createBid :: AuctionId -> UserId -> Bid -> DBProg (BidId)

  + createBid aid uid bid = do

  + maybeAuc <- findAuction aid uid

  + let createOp = CreateBid aid bid

  + fc $ maybe (raiseSubjectNotFound createOp) (const createOp) maybeAuc
• edit in lib/Aftok/Json.hs at line 90
  [3.1693]

  [3.1693]
  +

  + projectIdJSON :: ProjectId -> Value

  + projectIdJSON pid = v1 $

  + object [ "projectId" .= tshow (pid ^. _ProjectId) ]
• edit in lib/Aftok/Json.hs at line 102
  [2.539]

  [2.539]
  + auctionIdJSON :: AuctionId -> Value

  + auctionIdJSON pid = v1 $

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

  +
• edit in lib/Aftok/Json.hs at line 112
  [18.1179]

  [19.2560]
  +

  + bidIdJSON :: BidId -> Value

  + bidIdJSON pid = v1 $

  + object [ "bidId" .= tshow (pid ^. _BidId) ]
• edit in lib/Aftok/Json.hs at line 117
  [19.2561]

  [3.1695]
  +
• edit in server/Aftok/Snaplet/Auctions.hs at line 6
  [2.897]

  [3.2531]
  + , auctionBidHandler
• edit in server/Aftok/Snaplet/Auctions.hs at line 13
  [3.2636]

  [3.2636]
  + import Data.Hourglass.Types (Seconds(..))
• replacement in server/Aftok/Snaplet/Auctions.hs at line 16
  [3.2776]→[3.2776:2837](∅→∅),[3.2837]→[2.898:963](∅→∅)
  − import Aftok.Auction (AuctionId, Auction(..))

  − import Aftok.Database (createAuction, findAuction)
  [3.2724]

  [3.2837]
  + import Aftok (UserId)

  + import Aftok.Auction (AuctionId, Auction(..), BidId, Bid(..))

  + import Aftok.Database (createAuction, findAuction, createBid)
• edit in server/Aftok/Snaplet/Auctions.hs at line 34
  [3.3282]

  [3.3282]
  + _ -> mzero

  +

  + bidCreateParser :: UserId -> C.UTCTime-> Value -> Parser Bid

  + bidCreateParser uid t = unv1 "bids" $ \v ->

  + case v of

  + (Object o) -> Bid uid <$> (Seconds <$> o .: "bidSeconds")

  + <*> (Satoshi <$> o .: "bidAmount")

  + <*> pure t
• replacement in server/Aftok/Snaplet/Auctions.hs at line 57
  [2.1105]→[2.1105:1150](∅→∅)
  − maybeAuc <- snapEval $ findAuction aid uid
  [2.1105]

  [2.1150]
  + maybeAuc <- snapEval $ findAuction aid uid -- this will verify auction access
• edit in server/Aftok/Snaplet/Auctions.hs at line 59
  [2.1231]
  +

  + auctionBidHandler :: Handler App App BidId

  + auctionBidHandler = do

  + uid <- requireUserId

  + aid <- requireAuctionId

  + timestamp <- liftIO C.getCurrentTime

  + requestBody <- readRequestJSON 4096

  + bid <- either (snapError 400 . tshow) pure $ parseEither (bidCreateParser uid timestamp) requestBody

  + snapEval $ createBid aid uid bid
• replacement in server/Main.hs at line 43
  [3.213]→[3.12580:12647](∅→∅),[3.1145]→[3.12580:12647](∅→∅),[3.2397]→[3.12580:12647](∅→∅)
  − projectCreateRoute = void $ method POST projectCreateHandler
  [3.213]

  [3.12647]
  + projectCreateRoute = serveJSON projectIdJSON $ method POST projectCreateHandler
• replacement in server/Main.hs at line 47
  [3.12819]→[3.2398:2480](∅→∅),[3.2398]→[3.2398:2480](∅→∅)
  − logEventRoute f = serveJSON eventIdJSON . method POST $ logWorkHandler f
  [3.12819]

  [3.3245]
  + logEventRoute f = serveJSON eventIdJSON $ method POST (logWorkHandler f)
• replacement in server/Main.hs at line 53
  [3.12971]→[3.4163:4230](∅→∅)
  − auctionCreateRoute = void $ method POST auctionCreateHandler
  [3.12971]

  [2.1722]
  + auctionCreateRoute = serveJSON auctionIdJSON $ method POST auctionCreateHandler
• edit in server/Main.hs at line 55
  [2.1802]

  [3.4230]
  + auctionBidRoute = serveJSON bidIdJSON $ method POST auctionBidHandler
• edit in server/Main.hs at line 76
  [2.1864]

  [3.4299]
  + , ("auctions/:auctionId/bid", auctionBidRoute)