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