Add alternative implementation of auction winner determination.

Dependencies

• [2] NLZ3JXLO Fix formatting with stylish-haskell.
• [3] LHJ2HFXV Add property test for auction algorithm.
• [4] IZEVQF62 Work in progress replacing sqlite with postgres.
• [5] ZP62WC47 Begin conversion to build with stack.
• [6] WO2MINIF Auctions now compile!
• [7] 75N3UJ4J More progression toward lenses.
• [8] 2XQD6KKK Add invitation logic and clean up DBProg error handling.
• [9] M4KM76DG Merge branch 'stackify'
• [10] QMRKFEPG Refactor QDB to use a free monad algebra instead.
• [11] 4U7F3CPI THE GREAT RENAMING OF THINGS!
• [12] Z7KS5XHH Very WIP. Wow.
• [13] KEP5WUFJ Convert project to stack-based build.
• [14] LAROLAYU WIP
• [15] NEDDHXUK Reformat via stylish-haskell
• [*] 64C6AWH6 Rename Ananke -> Quixotic, project reboot.

Change contents

• edit in aftok.cabal at line 53
  [4.157]

  [4.781]
  + , mtl
• edit in lib/Aftok/Auction.hs at line 7
  [4.64]

  [4.64]
  + import Control.Monad.State
• replacement in lib/Aftok/Auction.hs at line 13
  [4.27]→[4.163:215](∅→∅)
  − import Aftok

  − import Aftok.Types
  [4.27]

  [4.5213]
  + import Aftok (UserId)

  + import Aftok.Types (Satoshi(..))
• replacement in lib/Aftok/Auction.hs at line 20
  [4.239]→[4.266:294](∅→∅),[4.5273]→[4.266:294](∅→∅),[4.294]→[4.240:270](∅→∅)
  − { _raiseAmount :: Satoshi

  − , _auctionEnd :: C.UTCTime
  [4.239]

  [4.5319]
  + { _raiseAmount :: Satoshi

  + , _auctionEnd :: C.UTCTime
• edit in lib/Aftok/Auction.hs at line 36
  [4.276]

  [3.58]
  + data Commitment = Commitment

  + { _baseBid :: Bid

  + , _commitmentSeconds :: Seconds

  + , _commitmentAmount :: Satoshi

  + }

  +
• edit in lib/Aftok/Auction.hs at line 88
  [3.654]
  + 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 remainder = raiseAmount' - x

  + winFraction = toRational remainder / toRational (bid ^. bidAmount)

  + remainderSeconds = Seconds . round $ winFraction * toRational (bid ^. bidSeconds)

  + in put (x + remainder) >>

  + (pure . Just $ Commitment bid (remainderSeconds) remainder)

  +

  + -- otherwise,

  + _ -> pure Nothing

  +
• replacement in lib/Aftok/Database.hs at line 13
  [2.270]→[2.270:301](∅→∅)
  − import Aftok.Auction
  [2.270]

  [2.301]
  + import Aftok.Auction (Auction, AuctionId, Bid, BidId)