Update auctions to permit zcash as a funding currency.

[?]

Jan 7, 2021, 6:15 AM

MU6WOCCJQWG4A5NLD3GBFATCE3SRE3QQCYXYH6WIKSGLHQOOBVRAC

Dependencies

[2] JUFBTX45 Add project auction queries.
[3] BROSTG5K Beginning of modularization of server.
[4] Z3MK2PJ5 Add GET handler for retrieving auction data.
[5] LHJ2HFXV Add property test for auction algorithm.
[6] EKI57EJR Add alternative implementation of auction winner determination.
[7] 4R7XIYK3 Switch from ClassyPrelude to Relude
[8] 4354Y4PE Add endpoint to list project contributors.
[9] IZEVQF62 Work in progress replacing sqlite with postgres.
[10] NAS4BFL4 Trivial stylish-haskell reformat.
[11] EW2XN7KU Update docker build, clean up migration for payments tables.
[12] M4PWY5RU Preliminary work to add support for Zcash payments.
[13] AL37SVTC Implement payments service endpoints.
[14] NEDDHXUK Reformat via stylish-haskell
[15] LAROLAYU WIP
[16] GCVQD44V Create amends endpoint, switch to UUID primary keys
[17] LTSVBVA2 Update to a recent haskoin-core. Fix Stack build.
[18] UWMGUJOW Autoformat sources.
[19] HALRDT2F Added initial auction create route.
[20] IPG33FAW Add billing daemon
[21] FXJQACES Ensure that auction is not ended at the time of bid
[22] MWUPXTBF A few steps down a road to be abandoned.
[23] QMEYU4MW Add display for prior intervals.
[24] 5XFJNUAZ Start of addition of project infrastructure.
[25] WO2MINIF Auctions now compile!
[26] EFSXYZPO Autoformat everything with brittany.
[27] Z7KS5XHH Very WIP. Wow.
[28] F2XLL7XW Remove Ord Bid & sort in favor of sortBy
[29] GLFF5ZDK Factor winningBids for easier testing.
[30] 7VGYLTMU Clean up schema version handling.
[31] Q5X5RYQL stylish-haskell reformatting
[32] 75N3UJ4J More progression toward lenses.
[33] TNR3TEHK Switch to Postgres + snaplet arch compiles.
[34] LD4GLVSF More database stuff.
[35] O5FVTOM6 Undo JSON silliness, enable a couple more routes.
[36] JFOEOFGA stylish-haskell formatting.
[37] RSF6UAJK Break out api module for timeline.
[38] UUR6SMCA Add start of specs for auctions.
[39] 3GBSDS5P Fix out-of-date test code, add skeleton for payments spec.
[40] 5ZSKPQ3K Add created_at and auction_start timestamps to auction
[41] DFOBMSAO Initial work on payments API
[42] QMRKFEPG Refactor QDB to use a free monad algebra instead.
[43] W35DDBFY Factor common JSON conversions up into client lib module.
[44] 4U7F3CPI THE GREAT RENAMING OF THINGS!
[45] 2J37EVJM Check for an open interval on project switch.
[46] ASF3UPJL Add auction creation and bid handlers
[47] HBULCDN6 Add tests for auction winner determination algorithm.
[48] RPAJLHMT Change to use UUIDs instead of ints for primary keys.
[49] NVOCQVAS Initial failing tests.
[50] TLQ72DSJ Lenses, sqlite-simple
[51] ZP62WC47 Begin conversion to build with stack.
[52] 5OI44E4E Add authentication to auction search.
[53] B6HWAPDP Modularize & update to recent haskoin.
[54] HMDM3B55 Implement core of payments/billing infrastructure.
[55] X3ES7NUA Fine. I'll use ormolu. At least it doesn't break the code.
[*] 5IDB3IWS Integrate zcashd-based zaddr validation.
[*] 64C6AWH6 Rename Ananke -> Quixotic, project reboot.
[*] ADMKQQGC Initial empty Snap project.

Change contents

replacement in lib/Aftok/Auction.hs at line 5

[3.5192]→[3.5634:5664](∅→∅),[3.5664]→[3.5294:5308](∅→∅),[3.5308]→[3.5677:5687](∅→∅),[3.5677]→[3.5677:5687](∅→∅)

import Aftok.Currency.Bitcoin
( _Satoshi,
ssub,

[3.5192]

[3.5687]

import Aftok.Currency
( IsCurrency (..),
edit in lib/Aftok/Auction.hs at line 12

[3.5741]→[3.5741:5775](∅→∅)

import Bippy.Types (Satoshi (..))
edit in lib/Aftok/Auction.hs at line 17

[3.5913]→[3.5913:5943](∅→∅)

import Data.Traversable (for)
replacement in lib/Aftok/Auction.hs at line 23

[3.5249]→[3.6017:6030](∅→∅)

data Auction

[3.5249]

[3.6030]

data Auction c
replacement in lib/Aftok/Auction.hs at line 30

[2.62]→[3.6138:6171](∅→∅),[3.6138]→[3.6138:6171](∅→∅)

_raiseAmount :: Satoshi,

[2.62]

[3.6171]

_raiseAmount :: c,
replacement in lib/Aftok/Auction.hs at line 41

[3.70]→[3.6252:6261](∅→∅)

data Bid

[3.70]

[3.6261]

data Bid c
replacement in lib/Aftok/Auction.hs at line 45

[3.6329]→[3.6329:6360](∅→∅)

_bidAmount :: Satoshi,

[3.6329]

[3.6360]

_bidAmount :: c,
replacement in lib/Aftok/Auction.hs at line 52

[3.276]→[3.6422:6438](∅→∅)

data Commitment

[3.276]

[3.6438]

data Commitment c
replacement in lib/Aftok/Auction.hs at line 54

[3.6453]→[3.6453:6478](∅→∅)

{ _baseBid :: Bid,

[3.6453]

[3.6478]

{ _baseBid :: Bid c,
replacement in lib/Aftok/Auction.hs at line 56

[3.6517]→[3.6517:6554](∅→∅)

_commitmentAmount :: Satoshi

[3.6517]

[3.6554]

_commitmentAmount :: c
replacement in lib/Aftok/Auction.hs at line 59

[3.311]→[3.58:128](∅→∅),[3.276]→[3.58:128](∅→∅)

data AuctionResult
= WinningBids [Bid]
| InsufficientBids Satoshi

[3.311]

[3.2213]

data AuctionResult c
= WinningBids [Bid c]
| InsufficientBids c
replacement in lib/Aftok/Auction.hs at line 64

[3.151]→[3.151:181](∅→∅),[3.181]→[3.9171:9244](∅→∅)

bidsTotal :: [Bid] -> Satoshi
bidsTotal bids = foldl' (\s b -> s <> (b ^. bidAmount)) (Satoshi 0) bids

[3.151]

[3.253]

bidsTotal :: Monoid c => [Bid c] -> c
bidsTotal = foldMap (view bidAmount)
replacement in lib/Aftok/Auction.hs at line 67

[3.254]→[3.3:38](∅→∅),[3.276]→[3.3:38](∅→∅),[3.38]→[3.9245:9309](∅→∅)

bidOrder :: Bid -> Bid -> Ordering
bidOrder = comparing costRatio `mappend` comparing (^. bidTime)

[3.254]

[3.6563]

bidOrder ::
forall c.
IsCurrency c =>
Bid c ->
Bid c ->
Ordering
bidOrder = comparing costRatio <> comparing (^. bidTime)
replacement in lib/Aftok/Auction.hs at line 75

[3.6571]→[3.6571:6617](∅→∅),[3.6617]→[3.5309:5364](∅→∅),[3.5364]→[3.6671:6710](∅→∅),[3.6671]→[3.6671:6710](∅→∅)

secs bid = toRational $ bid ^. bidSeconds
btc bid = toRational $ bid ^. bidAmount . _Satoshi
costRatio bid = secs bid / btc bid

[3.6571]

[3.293]

costRatio :: Bid c -> Rational
costRatio bid = (toRational $ bid ^. bidSeconds) / (toRational $ bid ^. bidAmount . _Units)
replacement in lib/Aftok/Auction.hs at line 79

[3.328]→[3.255:303](∅→∅)

runAuction :: Auction -> [Bid] -> AuctionResult

[3.328]

[3.303]

runAuction :: IsCurrency c => Auction c -> [Bid c] -> AuctionResult c
replacement in lib/Aftok/Auction.hs at line 82

[3.65]→[3.362:411](∅→∅)

runAuction' :: Satoshi -> [Bid] -> AuctionResult

[3.65]

[3.411]

runAuction' ::
forall c.
IsCurrency c =>
c ->
[Bid c] ->
AuctionResult c
replacement in lib/Aftok/Auction.hs at line 89

[3.443]→[3.6711:6762](∅→∅)

let takeWinningBids :: Satoshi -> [Bid] -> [Bid]

[3.443]

[3.6762]

let takeWinningBids :: c -> [Bid c] -> [Bid c]
replacement in lib/Aftok/Auction.hs at line 91

[3.6801]→[3.6801:6915](∅→∅)

| -- if the total is fully within the raise amount
total <> (bid ^. bidAmount) < raiseAmount' =

[3.6801]

[3.6915]

| total <> (bid ^. bidAmount) < raiseAmount' =
-- if the total is fully within the raise amount
replacement in lib/Aftok/Auction.hs at line 94

[3.6980]→[3.6980:7089](∅→∅),[3.7089]→[3.5365:5429](∅→∅),[3.5429]→[3.7152:7197](∅→∅),[3.7152]→[3.7152:7197](∅→∅)

| -- if the last bid will exceed the raise amount, reduce it to fit
total < raiseAmount' =
let winFraction r = r % (bid ^. bidAmount . _Satoshi)
remainderSeconds (Satoshi r) =

[3.6980]

[3.7197]

| total < raiseAmount' =
-- if the last bid will exceed the raise amount, reduce it to fit
let winFraction r =
(r ^. _Units) % (bid ^. bidAmount . _Units)
remainderSeconds r =
replacement in lib/Aftok/Auction.hs at line 100

[3.7280]→[3.7280:7427](∅→∅)

adjustBid r = bid & bidSeconds .~ remainderSeconds r & bidAmount .~ r
in toList $ adjustBid <$> raiseAmount' `ssub` total

[3.7280]

[3.7427]

adjustBid r =
bid & bidSeconds .~ remainderSeconds r & bidAmount .~ r
in toList $ adjustBid <$> raiseAmount' `csub` total
replacement in lib/Aftok/Auction.hs at line 108

[3.7544]→[3.7544:7619](∅→∅)

(WinningBids $ takeWinningBids (Satoshi 0) $ sortBy bidOrder bids)

[3.7544]

[3.7619]

(WinningBids $ takeWinningBids mempty $ sortBy bidOrder bids)
replacement in lib/Aftok/Auction.hs at line 110

[3.7644]→[3.7644:7689](∅→∅),[3.2958]→[3.653:654](∅→∅),[3.7689]→[3.653:654](∅→∅),[3.10423]→[3.653:654](∅→∅),[3.653]→[3.653:654](∅→∅),[3.654]→[3.312:502](∅→∅),[3.502]→[3.7690:7865](∅→∅),[3.7865]→[3.665:735](∅→∅),[3.665]→[3.665:735](∅→∅),[3.735]→[3.7866:7900](∅→∅),[3.7900]→[3.5430:5492](∅→∅),[3.5492]→[3.7961:8004](∅→∅),[3.7961]→[3.7961:8004](∅→∅),[3.8004]→[3.10581:10662](∅→∅),[3.10581]→[3.10581:10662](∅→∅),[3.10662]→[3.8005:8178](∅→∅),[3.8178]→[3.455:473](∅→∅),[3.1075]→[3.455:473](∅→∅),[3.473]→[3.1094:1116](∅→∅),[3.1094]→[3.1094:1116](∅→∅)

(raiseAmount' `ssub` submittedTotal)

bidCommitment :: Satoshi -> Bid -> State Satoshi (Maybe Commitment)
bidCommitment raiseAmount' bid = do
raised <- get
case raised of
-- if the total is fully within the raise amount
x
| x <> (bid ^. bidAmount) < raiseAmount' ->
put (x <> bid ^. bidAmount)
>> (pure . Just $ Commitment bid (bid ^. bidSeconds) (bid ^. bidAmount))
-- if the last bid will exceed the raise amount, reduce it to fit
x
| x < raiseAmount' ->
let winFraction r = r % (bid ^. bidAmount . _Satoshi)
remainderSeconds (Satoshi r) =
Seconds . round $ winFraction r * fromIntegral (bid ^. bidSeconds)
in for (raiseAmount' `ssub` x) $ \remainder ->
put (x <> remainder)
*> (pure $ Commitment bid (remainderSeconds remainder) remainder)
-- otherwise,
_ -> pure Nothing

[3.7644]

(raiseAmount' `csub` submittedTotal)
edit in lib/Aftok/Currency/Bitcoin.hs at line 13

[3.7995]

[3.7995]

H.Address,
edit in lib/Aftok/Currency/Bitcoin.hs at line 20

[3.10996]

[3.10996]

import qualified Haskoin.Address as H
replacement in lib/Aftok/Currency/Bitcoin.hs at line 23

[3.4646]→[3.8006:8092](∅→∅)

_Satoshi :: Lens' Satoshi Word64
_Satoshi inj (Satoshi value) = Satoshi <$> inj value

[3.4646]

[3.4730]

_Satoshi :: Iso' Satoshi Word64
_Satoshi = iso (\(Satoshi w) -> w) (Satoshi)
edit in lib/Aftok/Currency/Zcash/Types.hs at line 40

[3.9493]

[3.9493]

instance Monoid Zatoshi where
mempty = Zatoshi 0
edit in lib/Aftok/Currency/Zcash/Types.hs at line 44

[3.9494]

[3.9494]

zsub :: Zatoshi -> Zatoshi -> Maybe Zatoshi
zsub (Zatoshi a) (Zatoshi b) | a > b = Just . Zatoshi $ (a - b)
zsub _ _ = Nothing
edit in lib/Aftok/Currency/Zcash.hs at line 14

[3.15720]

[3.11323]

Z.zsub,
edit in lib/Aftok/Currency.hs at line 1

[3.5808]

[3.16482]

{-# LANGUAGE StandaloneDeriving #-}
replacement in lib/Aftok/Currency.hs at line 7

[3.16552]→[3.16552:16710](∅→∅)

import qualified Aftok.Currency.Zcash as Zcash
import qualified Bippy.Types as Bitcoin
import Control.Lens (view)
import qualified Haskoin.Address as Bitcoin

[3.16552]

[3.5837]

import qualified Aftok.Currency.Bitcoin as B
import qualified Aftok.Currency.Zcash as Z
import Control.Lens (Iso')
import qualified Text.Show
replacement in lib/Aftok/Currency.hs at line 13

[3.16735]→[3.16735:16831](∅→∅)

BTC :: Currency Bitcoin.Address Bitcoin.Satoshi
ZEC :: Currency Zcash.Address Zcash.Zatoshi

[3.16735]

[3.16831]

BTC :: Currency B.Address B.Satoshi
ZEC :: Currency Z.Address Z.Zatoshi

instance Eq (Currency a c) where
BTC == BTC = True
ZEC == ZEC = True

instance Show (Currency a c) where
show = \case
BTC -> "BTC"
ZEC -> "ZEC"
edit in lib/Aftok/Currency.hs at line 26

[3.16886]

[3.5917]

instance Eq (Currency' c) where
(Currency' BTC) == (Currency' BTC) = True
(Currency' ZEC) == (Currency' ZEC) = True

instance Show (Currency' c) where
show (Currency' c) = show c
edit in lib/Aftok/Currency.hs at line 40

[3.13890]

[3.16984]

class (Eq c, Ord c, Monoid c) => IsCurrency c where
csub :: c -> c -> Maybe c
cscale :: c -> Rational -> Maybe c
_Units :: Iso' c Word64
currency' :: Currency' c
replacement in lib/Aftok/Currency.hs at line 47

[3.16985]→[3.16985:17308](∅→∅)

scaleCurrency :: Currency a c -> c -> Rational -> Maybe c
scaleCurrency c amount factor = case c of
BTC -> (\(Bitcoin.Satoshi amt) -> Just $ Bitcoin.Satoshi ((round $ toRational amt * factor) :: Word64)) amount
ZEC -> (\amt -> Zcash.toZatoshi ((round $ toRational (view Zcash._Zatoshi amt) * factor) :: Word64)) amount

[3.16985]

instance IsCurrency B.Satoshi where
csub = B.ssub
cscale (B.Satoshi amt) factor =
let r = toRational amt * factor
in if (r >= 0) then Just (B.Satoshi . round $ r) else Nothing
_Units = B._Satoshi
currency' = Currency' BTC

instance IsCurrency Z.Zatoshi where
csub = Z.zsub
cscale (Z.Zatoshi amt) factor =
let r = toRational amt * factor
in if (r >= 0) then Just (Z.Zatoshi . round $ r) else Nothing
_Units = Z._Zatoshi
currency' = Currency' ZEC
edit in lib/Aftok/Database/PostgreSQL/Auctions.hs at line 22

[3.17675]

[3.17675]

auctionStart,
edit in lib/Aftok/Database/PostgreSQL/Auctions.hs at line 27

[3.17732]

[3.17732]

description,
edit in lib/Aftok/Database/PostgreSQL/Auctions.hs at line 29

[3.17747]

[3.17747]

name,
edit in lib/Aftok/Database/PostgreSQL/Auctions.hs at line 32

[3.17779]→[2.85:111](∅→∅)

name,
description
replacement in lib/Aftok/Database/PostgreSQL/Auctions.hs at line 33

[3.17783]→[3.17783:18012](∅→∅),[3.18012]→[2.112:146](∅→∅)

-- import Aftok.Currency ( Amount(..) )

-- import qualified Aftok.Currency.Bitcoin as Bitcoin
import Aftok.Currency.Bitcoin (_Satoshi)
-- import qualified Aftok.Currency.Zcash as Zcash

import Aftok.Database (Limit(..))

[3.17783]

[3.18037]

import Aftok.Currency (Amount (..))
import Aftok.Database (Limit (..))
replacement in lib/Aftok/Database/PostgreSQL/Auctions.hs at line 37

[3.18085]→[3.18085:18106](∅→∅)

btcAmountParser,

[3.18085]

[3.18106]

currencyAmountParser,
currencyType,
currencyValue,
replacement in lib/Aftok/Database/PostgreSQL/Auctions.hs at line 45

[3.18164]→[2.147:186](∅→∅)

import Aftok.Interval (RangeQuery(..))

[3.18164]

[3.18164]

import Aftok.Interval (RangeQuery (..))
replacement in lib/Aftok/Database/PostgreSQL/Auctions.hs at line 62

[3.18600]→[3.18600:18635](∅→∅)

auctionParser :: RowParser Auction

[3.18600]

[3.18635]

auctionParser :: RowParser (Auction Amount)
replacement in lib/Aftok/Database/PostgreSQL/Auctions.hs at line 70

[2.215]→[3.18730:18754](∅→∅),[3.18730]→[3.18730:18754](∅→∅)

<*> btcAmountParser

[2.215]

[3.18754]

<*> currencyAmountParser
replacement in lib/Aftok/Database/PostgreSQL/Auctions.hs at line 74

[3.18791]→[3.18791:18818](∅→∅)

bidParser :: RowParser Bid

[3.18791]

[3.18818]

bidParser :: RowParser (Bid Amount)
replacement in lib/Aftok/Database/PostgreSQL/Auctions.hs at line 76

[3.18830]→[3.18830:18914](∅→∅)

Bid <$> idParser UserId <*> (Seconds <$> field) <*> btcAmountParser <*> utcParser

[3.18830]

[3.18914]

Bid <$> idParser UserId <*> (Seconds <$> field) <*> currencyAmountParser <*> utcParser
replacement in lib/Aftok/Database/PostgreSQL/Auctions.hs at line 78

[3.18915]→[3.18915:18957](∅→∅)

createAuction :: Auction -> DBM AuctionId

[3.18915]

[3.18957]

createAuction :: Auction Amount -> DBM AuctionId
replacement in lib/Aftok/Database/PostgreSQL/Auctions.hs at line 82

[3.19001]→[2.216:317](∅→∅),[2.317]→[3.19083:19204](∅→∅),[3.19083]→[3.19083:19204](∅→∅)

[sql| INSERT INTO auctions (project_id, initiator_id, name, description, raise_amount, end_time)
VALUES (?, ?, ?, ?) RETURNING id |]
( auc ^. (projectId . _ProjectId),
auc ^. (initiator . _UserId),

[3.19001]

[2.318]

[sql| INSERT INTO auctions (project_id, initiator_id, name, description, currency, raise_amount, start_time, end_time)
VALUES (?, ?, ?, ?, ?, ?, ?, ?) RETURNING id |]
( auc ^. projectId . _ProjectId,
auc ^. initiator . _UserId,
replacement in lib/Aftok/Database/PostgreSQL/Auctions.hs at line 88

[2.363]→[3.19204:19286](∅→∅),[3.19204]→[3.19204:19286](∅→∅)

auc ^. (raiseAmount . _Satoshi),
auc ^. (auctionEnd . to C.fromThyme)

[2.363]

[3.19286]

auc ^. raiseAmount . to currencyType,
auc ^. raiseAmount . to currencyValue,
auc ^. auctionStart . to C.fromThyme,
auc ^. auctionEnd . to C.fromThyme
replacement in lib/Aftok/Database/PostgreSQL/Auctions.hs at line 94

[3.19293]→[3.19293:19341](∅→∅)

findAuction :: AuctionId -> DBM (Maybe Auction)

[3.19293]

[3.19341]

findAuction :: AuctionId -> DBM (Maybe (Auction Amount))
replacement in lib/Aftok/Database/PostgreSQL/Auctions.hs at line 104

[3.19584]→[2.476:542](∅→∅)

listAuctions :: ProjectId -> RangeQuery -> Limit -> DBM [Auction]

[3.19584]

[2.542]

listAuctions :: ProjectId -> RangeQuery -> Limit -> DBM [Auction Amount]
replacement in lib/Aftok/Database/PostgreSQL/Auctions.hs at line 109

[2.622]→[2.622:753](∅→∅)

auctionParser
[sql| SELECT project_id, initiator_id, created_at, name, description, raise_amount, start_time, end_time

[2.622]

[2.753]

auctionParser
[sql| SELECT project_id, initiator_id, created_at, name, description, raise_amount, start_time, end_time
replacement in lib/Aftok/Database/PostgreSQL/Auctions.hs at line 115

[2.856]→[2.856:904](∅→∅)

(pid ^. _ProjectId, C.fromThyme e, limit)

[2.856]

[2.904]

(pid ^. _ProjectId, C.fromThyme e, limit)
replacement in lib/Aftok/Database/PostgreSQL/Auctions.hs at line 118

[2.937]→[2.937:1068](∅→∅)

auctionParser
[sql| SELECT project_id, initiator_id, created_at, name, description, raise_amount, start_time, end_time

[2.937]

[2.1068]

auctionParser
[sql| SELECT project_id, initiator_id, created_at, name, description, raise_amount, start_time, end_time
replacement in lib/Aftok/Database/PostgreSQL/Auctions.hs at line 124

[2.1189]→[2.1189:1252](∅→∅)

(pid ^. _ProjectId, C.fromThyme s, C.fromThyme e, limit)

[2.1189]

[2.1252]

(pid ^. _ProjectId, C.fromThyme s, C.fromThyme e, limit)
replacement in lib/Aftok/Database/PostgreSQL/Auctions.hs at line 127

[2.1282]→[2.1282:1413](∅→∅)

auctionParser
[sql| SELECT project_id, initiator_id, created_at, name, description, raise_amount, start_time, end_time

[2.1282]

[2.1413]

auctionParser
[sql| SELECT project_id, initiator_id, created_at, name, description, raise_amount, start_time, end_time
replacement in lib/Aftok/Database/PostgreSQL/Auctions.hs at line 133

[2.1517]→[2.1517:1565](∅→∅)

(pid ^. _ProjectId, C.fromThyme s, limit)

[2.1517]

[2.1565]

(pid ^. _ProjectId, C.fromThyme s, limit)
replacement in lib/Aftok/Database/PostgreSQL/Auctions.hs at line 136

[2.1592]→[2.1592:1723](∅→∅)

auctionParser
[sql| SELECT project_id, initiator_id, created_at, name, description, raise_amount, start_time, end_time

[2.1592]

[2.1723]

auctionParser
[sql| SELECT project_id, initiator_id, created_at, name, description, raise_amount, start_time, end_time
replacement in lib/Aftok/Database/PostgreSQL/Auctions.hs at line 141

[2.1799]→[2.1799:1832](∅→∅)

(pid ^. _ProjectId, limit)

[2.1799]

[2.1832]

(pid ^. _ProjectId, limit)
replacement in lib/Aftok/Database/PostgreSQL/Auctions.hs at line 143

[2.1833]→[3.19584:19627](∅→∅),[3.19584]→[3.19584:19627](∅→∅)

createBid :: AuctionId -> Bid -> DBM BidId

[2.1833]

[3.19627]

createBid :: AuctionId -> Bid Amount -> DBM BidId
replacement in lib/Aftok/Database/PostgreSQL/Auctions.hs at line 153

[3.19921]→[3.19921:19958](∅→∅)

bid ^. (bidAmount . _Satoshi),

[3.19921]

[3.19958]

bid ^. bidAmount . to currencyType,
bid ^. bidAmount . to currencyValue,
replacement in lib/Aftok/Database/PostgreSQL/Auctions.hs at line 158

[3.20005]→[3.20005:20049](∅→∅)

findBids :: AuctionId -> DBM [(BidId, Bid)]

[3.20005]

[3.20049]

findBids :: AuctionId -> DBM [(BidId, Bid Amount)]
replacement in lib/Aftok/Database/PostgreSQL/Events.hs at line 26

[3.34496]→[2.1835:1850](∅→∅)

Limit(..),

[3.34496]

[3.34496]

Limit (..),
replacement in lib/Aftok/Database.hs at line 83

[3.64868]→[2.2158:2229](∅→∅),[2.2229]→[3.64868:65077](∅→∅),[3.64868]→[3.64868:65077](∅→∅)

ListAuctions :: ProjectId -> RangeQuery -> Limit -> DBOp [A.Auction]
CreateAuction :: A.Auction -> DBOp A.AuctionId
FindAuction :: A.AuctionId -> DBOp (Maybe A.Auction)
CreateBid :: A.AuctionId -> A.Bid -> DBOp A.BidId
FindBids :: A.AuctionId -> DBOp [(A.BidId, A.Bid)]

[3.64868]

[3.65077]

ListAuctions :: ProjectId -> RangeQuery -> Limit -> DBOp [A.Auction Amount]
CreateAuction :: A.Auction Amount -> DBOp A.AuctionId
FindAuction :: A.AuctionId -> DBOp (Maybe (A.Auction Amount))
CreateBid :: A.AuctionId -> A.Bid Amount -> DBOp A.BidId
FindBids :: A.AuctionId -> DBOp [(A.BidId, A.Bid Amount)]
replacement in lib/Aftok/Database.hs at line 313

[3.1306]→[3.68112:68171](∅→∅)

createAuction :: (MonadDB m) => A.Auction -> m A.AuctionId

[3.1306]

[3.671]

createAuction :: (MonadDB m) => A.Auction Amount -> m A.AuctionId
replacement in lib/Aftok/Database.hs at line 317

[3.767]→[2.2242:2334](∅→∅)

listAuctions :: (MonadDB m) => UserId -> ProjectId -> RangeQuery -> Limit -> m [A.Auction]

[3.767]

[2.2334]

listAuctions :: (MonadDB m) => UserId -> ProjectId -> RangeQuery -> Limit -> m [A.Auction Amount]
replacement in lib/Aftok/Database.hs at line 321

[2.2416]→[3.68172:68246](∅→∅),[3.767]→[3.68172:68246](∅→∅)

findAuction :: (MonadDB m) => A.AuctionId -> UserId -> MaybeT m A.Auction

[2.2416]

[3.841]

findAuction :: (MonadDB m) => A.AuctionId -> UserId -> MaybeT m (A.Auction Amount)
replacement in lib/Aftok/Database.hs at line 329

[3.293]→[3.68247:68315](∅→∅)

findAuction' :: (MonadDB m) => A.AuctionId -> UserId -> m A.Auction

[3.293]

[3.864]

findAuction' :: (MonadDB m) => A.AuctionId -> UserId -> m (A.Auction Amount)
replacement in lib/Aftok/Database.hs at line 340

[3.22]→[3.68316:68388](∅→∅)

createBid :: (MonadDB m) => A.AuctionId -> UserId -> A.Bid -> m A.BidId

[3.22]

[3.888]

createBid :: (MonadDB m) => A.AuctionId -> UserId -> A.Bid Amount -> m A.BidId
edit in lib/Aftok/Json.hs at line 24

[3.31778]

[3.31811]

import Control.Error.Util (maybeT)
replacement in lib/Aftok/Json.hs at line 45

[3.32540]→[3.32540:32553](∅→∅),[3.32587]→[3.32587:32603](∅→∅)

( Address,
textToAddr,

[3.32540]

[3.32603]

( textToAddr,
replacement in lib/Aftok/Json.hs at line 157

[3.482]→[3.68946:68980](∅→∅)

auctionJSON :: A.Auction -> Value

[3.482]

[3.33843]

auctionJSON :: A.Auction Amount -> Value
replacement in lib/Aftok/Json.hs at line 163

[3.33993]→[3.68981:69040](∅→∅)

"raiseAmount" .= (x ^. (A.raiseAmount . _Satoshi))

[3.33993]

[3.34049]

"name" .= (x ^. A.name),
"description" .= (x ^. A.description),
"raiseAmount" .= (x ^. (A.raiseAmount . to amountJSON)),
"auctionStart" .= (x ^. A.auctionStart),
"auctionEnd" .= (x ^. A.auctionEnd)
edit in lib/Aftok/Json.hs at line 280

[3.70883]

[3.26624]

parseAmountJSON :: Value -> Parser Amount
parseAmountJSON = \case
Object o ->
maybeT (fail $ "Expected to find one of [\"satoshi\", \"zatoshi\"] as a key.") pure $
MaybeT (fmap (Amount BTC . review _Satoshi) <$> o .:? "satoshi")
<|> MaybeT (fmap (Amount ZEC . review _Zatoshi) <$> o .:? "zatoshi")
val -> fail $ "Value " <> show val <> " is not a JSON object."
replacement in lib/Aftok/Json.hs at line 416

[3.28114]→[3.28114:28162](∅→∅),[3.28162]→[3.26962:27041](∅→∅)

parseRecurrence' (Object o) = parseRecurrence o
parseRecurrence' val = fail $ "Value " <> show val <> " is not a JSON object."

[3.28114]

parseRecurrence' = \case
(Object o) -> parseRecurrence o
val -> fail $ "Value " <> show val <> " is not a JSON object."
replacement in lib/Aftok/Payments/Util.hs at line 5

[3.79735]→[3.79735:79783](∅→∅)

import Aftok.Currency (Currency, scaleCurrency)

[3.79735]

[3.79783]

import Aftok.Currency (Currency, IsCurrency, cscale)
replacement in lib/Aftok/Payments/Util.hs at line 42

[3.80724]→[3.80724:80768](∅→∅)

(MonadDB m, Ord a, Semigroup c, Ord c) =>

[3.80724]

[3.80768]

(MonadDB m, Ord a, IsCurrency c) =>
replacement in lib/Aftok/Payments/Util.hs at line 59

[3.81401]→[3.81401:81478](∅→∅)

let scaled frac = note AmountInvalid $ scaleCurrency currency amt frac

[3.81401]

[3.81478]

let scaled frac = note AmountInvalid $ cscale amt frac
replacement in lib/Aftok/Payments/Util.hs at line 64

[3.81686]→[3.81686:81730](∅→∅)

(MonadDB m, Ord a, Semigroup c, Ord c) =>

[3.81686]

[3.81730]

(MonadDB m, Ord a, IsCurrency c) =>
replacement in lib/Aftok/TimeLog.hs at line 41

[3.51021]→[3.51021:51047](∅→∅)

import Data.AdditiveGroup

[3.51021]

[3.51047]

import Data.AdditiveGroup ()
edit in migrations/2021-01-03_16-15-52_auction-descriptions.txt at line 7

[2.2734]

ALTER TABLE auctions ADD COLUMN currency currency_t NOT NULL;
edit in server/Aftok/Snaplet/Auctions.hs at line 7

[3.57373]

[3.45333]

auctionListHandler,
edit in server/Aftok/Snaplet/Auctions.hs at line 17

[3.57457]

[3.57457]

import Aftok.Currency (Amount)
replacement in server/Aftok/Snaplet/Auctions.hs at line 19

[3.57479]→[3.57479:57498](∅→∅)

( createAuction,

[3.57479]

[3.57498]

( Limit (..),
createAuction,
edit in server/Aftok/Snaplet/Auctions.hs at line 23

[3.57530]

[3.57530]

listAuctions,
edit in server/Aftok/Snaplet/Auctions.hs at line 28

[3.57599]

[3.57599]

import Aftok.Snaplet.Util (decimalParam, rangeQueryParam)
edit in server/Aftok/Snaplet/Auctions.hs at line 31

[3.57658]→[3.57658:57692](∅→∅)

import Bippy.Types (Satoshi (..))
replacement in server/Aftok/Snaplet/Auctions.hs at line 38

[3.2963]→[3.57877:57984](∅→∅)

data AuctionCreateRequest = CA {raiseAmount :: Word64, auctionStart :: C.UTCTime, auctionEnd :: C.UTCTime}

[3.2963]

[3.3076]

data AuctionCreateRequest
= CA
{ name :: Text,
description :: Maybe Text,
raiseAmount :: Amount,
auctionStart :: C.UTCTime,
auctionEnd :: C.UTCTime
}
replacement in server/Aftok/Snaplet/Auctions.hs at line 50

[3.58033]→[3.58033:58115](∅→∅)

p o = CA <$> o .: "raiseAmount" <*> o .: "auctionStart" <*> o .: "auctionEnd"

[3.58033]

[3.885]

p o =
CA
<$> o .: "auctionName"
<*> o .:? "auctionDesc"
<*> (parseAmountJSON =<< o .: "raiseAmount")
<*> o .: "auctionStart"
<*> o .: "auctionEnd"
replacement in server/Aftok/Snaplet/Auctions.hs at line 58

[3.886]→[3.46369:46431](∅→∅)

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

[3.886]

[3.58116]

bidCreateParser :: UserId -> C.UTCTime -> Value -> Parser (Bid Amount)
replacement in server/Aftok/Snaplet/Auctions.hs at line 64

[3.58230]→[3.58230:58273](∅→∅)

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

[3.58230]

[3.58273]

<*> (parseAmountJSON =<< o .: "bidAmount")
replacement in server/Aftok/Snaplet/Auctions.hs at line 75

[3.4617]→[3.591:622](∅→∅),[3.46721]→[3.591:622](∅→∅),[3.58443]→[3.591:622](∅→∅),[3.3561]→[3.591:622](∅→∅)

t <- liftIO C.getCurrentTime

[3.58443]

[3.58444]

now <- liftIO C.getCurrentTime
replacement in server/Aftok/Snaplet/Auctions.hs at line 80

[3.58505]→[3.58505:58549](∅→∅)

t
(Satoshi . raiseAmount $ req)

[3.58505]

[3.58549]

now
(name req)
(description req)
(raiseAmount $ req)
replacement in server/Aftok/Snaplet/Auctions.hs at line 87

[2.2810]→[2.2810:2860](∅→∅)

auctionListHandler :: S.Handler App App [Auction]

[2.2810]

[2.2860]

auctionListHandler :: S.Handler App App [Auction Amount]
replacement in server/Aftok/Snaplet/Auctions.hs at line 91

[2.2933]→[2.2933:2967](∅→∅)

snapEval $ listAuctions pid uid

[2.2933]

[3.987]

rq <- rangeQueryParam
limit <- Limit . fromMaybe 1 <$> decimalParam "limit"
snapEval $ listAuctions uid pid rq limit
replacement in server/Aftok/Snaplet/Auctions.hs at line 95

[3.988]→[3.17337:17384](∅→∅)

auctionGetHandler :: S.Handler App App Auction

[3.988]

[3.1033]

auctionGetHandler :: S.Handler App App (Auction Amount)
edit in server/Aftok/Snaplet/Util.hs at line 3

[3.4267]

[3.69898]

import Aftok.Interval (RangeQuery (..))
edit in server/Aftok/Snaplet/Util.hs at line 19

[3.4618]

[3.4618]

rangeQueryParam :: MonadSnap m => m RangeQuery
rangeQueryParam = do
endpoints <- (,) <$> timeParam "after" <*> timeParam "before"
pure $ case endpoints of
(Just s, Just e) -> During s e
(Nothing, Just e) -> Before e
(Just s, Nothing) -> After s
(Nothing, Nothing) -> Always
edit in server/Aftok/Snaplet/WorkLog.hs at line 6

[3.70358]→[3.70358:70380](∅→∅)

import Aftok.Interval
replacement in server/Aftok/Snaplet/WorkLog.hs at line 63

[3.12986]→[3.5005:5069](∅→∅),[3.59141]→[3.5005:5069](∅→∅),[3.72058]→[3.5005:5069](∅→∅),[3.5005]→[3.5005:5069](∅→∅),[3.5069]→[3.4692:4723](∅→∅),[3.4723]→[3.72059:72173](∅→∅),[3.72173]→[3.4841:4878](∅→∅),[3.4841]→[3.4841:4878](∅→∅),[3.4878]→[3.15855:15903](∅→∅)

endpoints <- (,) <$> timeParam "after" <*> timeParam "before"
let ival = case endpoints of
(Just s, Just e) -> During s e
(Nothing, Just e) -> Before e
(Just s, Nothing) -> After s
(Nothing, Nothing) -> Always
limit <- fromMaybe 1 <$> decimalParam "limit"

[3.72058]

[3.4879]

ival <- rangeQueryParam
limit <- Limit . fromMaybe 1 <$> decimalParam "limit"
replacement in server/Main.hs at line 135

[3.106036]→[3.106036:106121](∅→∅)

("projects/:projectId/auctions", auctionCreateRoute), -- <|> auctionListRoute)

[3.106036]

[3.106121]

("projects/:projectId/auctions", auctionCreateRoute <|> auctionListRoute),
replacement in test/Aftok/AuctionSpec.hs at line 23

[3.1028]→[3.1028:1046](∅→∅)

genBid :: Gen Bid

[3.64073]

[3.66678]

genBid :: Gen (Bid Satoshi)