Add GET handler for retrieving auction data.

[?]

Mar 20, 2016, 10:14 PM

Z3MK2PJ5U222DXRS22WCDHVPZ7HVAR3HOCUNXIGX6VMEPBQDF6PQC

Dependencies

[2] 5OI44E4E Add authentication to auction search.
[3] NLZ3JXLO Fix formatting with stylish-haskell.
[4] GCVQD44V Create amends endpoint, switch to UUID primary keys
[5] QMRKFEPG Refactor QDB to use a free monad algebra instead.
[6] NEDDHXUK Reformat via stylish-haskell
[7] Z7KS5XHH Very WIP. Wow.
[8] W35DDBFY Factor common JSON conversions up into client lib module.
[9] RPAJLHMT Change to use UUIDs instead of ints for primary keys.
[10] XTBSG4C7 Adding serveJSON combinator to eliminate some boilerplate from handlers.
[11] PBD7LZYQ Postgres & auth are beginning to function.
[12] HALRDT2F Added initial auction create route.
[13] I2KHGVD4 Require project permissions for access to most data.
[14] 7HPY3QPF Fix linting errors. (yay hlint!)
[15] 2XQD6KKK Add invitation logic and clean up DBProg error handling.
[16] A6HKMINB Attempting to improve JSON handling.
[17] O5FVTOM6 Undo JSON silliness, enable a couple more routes.
[*] KEP5WUFJ Convert project to stack-based build.
[*] ADMKQQGC Initial empty Snap project.

Change contents

replacement in lib/Aftok/Json.hs at line 11

[3.1076]→[3.3670:3725](∅→∅),[3.3670]→[3.3670:3725](∅→∅)

import qualified Data.Attoparsec.ByteString.Char8 as P

[3.1076]

[3.1077]

import qualified Data.Attoparsec.ByteString.Char8 as PC
edit in lib/Aftok/Json.hs at line 18

[3.1294]

[3.1294]

import Aftok.Auction as A
replacement in lib/Aftok/Json.hs at line 21

[3.1358]→[3.998:1029](∅→∅)

import Aftok.Project

[3.1358]

[3.1358]

import Aftok.Project as P
edit in lib/Aftok/Json.hs at line 23

[3.1389]

[3.272]

import Aftok.Types
replacement in lib/Aftok/Json.hs at line 35

[3.2226]→[3.4177:4211](∅→∅),[3.4211]→[3.1490:1558](∅→∅)

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

[3.2226]

[3.4309]

versionParser :: PC.Parser Version
versionParser = Version <$> PC.decimal <*> (PC.char '.' >> PC.decimal)
replacement in lib/Aftok/Json.hs at line 48

[3.4892]→[3.4892:4964](∅→∅)

v <- either (fail . show) pure $ P.parseOnly versionParser (C.pack s)

[3.4892]

[3.4964]

v <- either (fail . show) pure $ PC.parseOnly versionParser (C.pack s)
replacement in lib/Aftok/Json.hs at line 62

[3.4614]→[3.4614:4690](∅→∅)

vers <- either fail pure $ P.parseOnly versionParser (encodeUtf8 verstr)

[3.4614]

[3.4690]

vers <- either fail pure $ PC.parseOnly versionParser (encodeUtf8 verstr)
replacement in lib/Aftok/Json.hs at line 95

[3.5417]→[3.1632:1696](∅→∅)

, "initiator" .= tshow (p ^. (initiator._UserId))

[3.5417]

[3.1168]

, "initiator" .= tshow (p ^. (P.initiator._UserId))
]

auctionJSON :: Auction -> Value
auctionJSON x = v1 $
object [ "projectId" .= tshow (x ^. (A.projectId._ProjectId))
, "initiator" .= tshow (x ^. (A.initiator._UserId))
, "raiseAmount" .= (x ^. (raiseAmount._Satoshi))
edit in lib/Aftok/Types.hs at line 2

[19.850]

[19.850]

{-# LANGUAGE TemplateHaskell #-}
edit in lib/Aftok/Types.hs at line 7

[3.5320]

[19.915]

import Control.Lens
edit in lib/Aftok/Types.hs at line 11

[19.1031]

[19.1036]

makePrisms ''Satoshi
edit in server/Aftok/Snaplet/Auctions.hs at line 5

[3.2531]

[3.2531]

, auctionGetHandler
edit in server/Aftok/Snaplet/Auctions.hs at line 13

[3.2677]→[3.2677:2723](∅→∅)

--import Data.Thyme.Format.Aeson ()
edit in server/Aftok/Snaplet/Auctions.hs at line 14

[3.2724]→[3.2724:2776](∅→∅)

import Aftok.Database (createAuction)
edit in server/Aftok/Snaplet/Auctions.hs at line 15

[3.2837]

[3.2837]

import Aftok.Database (createAuction, findAuction)
replacement in server/Aftok/Snaplet/Auctions.hs at line 22

[3.2963]→[3.2963:2993](∅→∅)

import Snap.Snaplet

[3.2963]

[3.2993]

import Snap
edit in server/Aftok/Snaplet/Auctions.hs at line 41

[2.1121]

auctionGetHandler :: Handler App App Auction
auctionGetHandler = do
uid <- requireUserId
aid <- requireAuctionId
maybeAuc <- snapEval $ findAuction aid uid
maybe (snapError 404 $ "Auction not found for id " <> tshow aid) pure maybeAuc
edit in server/Aftok/Snaplet/Auth.hs at line 6

[3.7666]→[3.11680:11710](∅→∅),[3.283]→[3.11680:11710](∅→∅)

-- import Control.Monad.State
edit in server/Aftok/Snaplet/Auth.hs at line 10

[3.7824]

[3.7824]

import Aftok.Auction (AuctionId(..))
edit in server/Aftok/Snaplet/Auth.hs at line 18

[3.8008]→[3.11711:11751](∅→∅),[3.527]→[3.11711:11751](∅→∅)

-- import Snap.Snaplet.PostgresqlSimple
edit in server/Aftok/Snaplet/Auth.hs at line 51

[3.8608]

[3.2558]

requireAuctionId :: MonadSnap m => m AuctionId
requireAuctionId = do
maybeAid <- parseParam "auctionId" aidParser
maybe (snapError 400 "Value of parameter \"auctionId\" cannot be parsed as a valid UUID")
pure
maybeAid
where
aidParser = do
bs <- takeByteString
pure $ AuctionId <$> fromASCIIBytes bs
replacement in server/Main.hs at line 49

[3.3333]→[3.7787:7876](∅→∅)

logIntervalsRoute = serveJSON workIndexJSON $ method GET loggedIntervalsHandler

[3.3333]

[3.12820]

logIntervalsRoute = serveJSON workIndexJSON $ method GET loggedIntervalsHandler
edit in server/Main.hs at line 54

[3.4230]

[3.4230]

auctionRoute = serveJSON auctionJSON $ method GET auctionGetHandler
edit in server/Main.hs at line 74

[3.4299]

[3.4299]

, ("auctions/:auctionId", auctionRoute)