Add payouts spec.

[?]

Jan 31, 2021, 5:28 AM

CI4OPKQMU4CIX3QPGA5GWSEOPJ2FAREDBVU6X33E7X3EEQXAICRQC

Dependencies

[2] U7YAT2ZK Add error reporting to signup form.
[3] EFSXYZPO Autoformat everything with brittany.
[4] Y35QCWYW Minor improvement in WorkIndex type to eliminate duplicated information.
[5] 64C6AWH6 Rename Ananke -> Quixotic, project reboot.
[6] OV5AKJHA Remove unused LogInterval type.
[7] KNSI575V Cleanup of EventLog types.
[8] IR75ZMX3 Return actual events for interval ends, not just timestamps.
[9] SCXG6TJW Make log reduction safer in presence of overlapping events.
[10] LHJ2HFXV Add property test for auction algorithm.
[11] 5DRIWGLU Improving TimeLog specs
[12] X3ES7NUA Fine. I'll use ormolu. At least it doesn't break the code.
[13] M4PWY5RU Preliminary work to add support for Zcash payments.
[14] B6HWAPDP Modularize & update to recent haskoin.
[15] EMVTF2IW WIP moving back to snap.
[16] LTSVBVA2 Update to a recent haskoin-core. Fix Stack build.
[17] RPAJLHMT Change to use UUIDs instead of ints for primary keys.
[18] NEDDHXUK Reformat via stylish-haskell
[19] 7KZP4RHZ Switch from Data.Time to Data.Thyme
[20] 4SCFOJGN Specs for recovering intervals from the log now pass.
[21] A6HKMINB Attempting to improve JSON handling.
[22] UUR6SMCA Add start of specs for auctions.
[23] IPG33FAW Add billing daemon
[*] NVOCQVAS Initial failing tests.
[*] NMWWP4ZN Trying out Hspec

Change contents

replacement in lib/Aftok/Database/PostgreSQL/Events.hs at line 68

[2.20660]→[2.20660:20675](∅→∅)

eventTime,

[2.20660]

[2.20675]

leEventTime,
replacement in lib/Aftok/Database/PostgreSQL/Events.hs at line 173

[3.37634]→[3.37634:37670](∅→∅)

fromThyme $ e ^. eventTime,

[3.37634]

[3.37670]

fromThyme $ e ^. leEventTime,
replacement in lib/Aftok/Database/PostgreSQL/Events.hs at line 189

[3.38079]→[3.38079:38115](∅→∅)

fromThyme $ e ^. eventTime,

[3.38079]

[3.38115]

fromThyme $ e ^. leEventTime,
replacement in lib/Aftok/Database/PostgreSQL/Events.hs at line 205

[3.38514]→[3.38514:38550](∅→∅)

fromThyme $ e ^. eventTime,

[3.38514]

[3.38550]

fromThyme $ e ^. leEventTime,
replacement in lib/Aftok/Database/PostgreSQL/Events.hs at line 315

[3.14608]→[3.14608:14689](∅→∅)

pure (aid, set (logEntry . event . eventTime) t kle, "amend_event_time")

[3.14608]

[3.14689]

pure (aid, set (logEntry . event . leEventTime) t kle, "amend_event_time")
edit in lib/Aftok/TimeLog.hs at line 4

[3.19027]

[25.883]

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
replacement in lib/Aftok/TimeLog.hs at line 24

[2.22423]→[2.22423:22498](∅→∅)

import Control.Lens ((.~), (^.), makeClassy, makeLenses, makePrisms, view)

[2.22423]

[3.51047]

import Control.Lens (Lens', (.~), (^.), makeClassy, makeLenses, makePrisms, view)
edit in lib/Aftok/TimeLog.hs at line 37

[25.1225]

[3.51638]

class HasEventTime a where
eventTime :: Lens' a C.UTCTime

instance HasEventTime C.UTCTime where
eventTime = id
replacement in lib/Aftok/TimeLog.hs at line 50

[3.51849]→[3.51849:51930](∅→∅)

= StartWork {_eventTime :: !C.UTCTime}
| StopWork {_eventTime :: !C.UTCTime}

[3.51849]

[3.51930]

= StartWork {_leEventTime :: !C.UTCTime}
| StopWork {_leEventTime :: !C.UTCTime}
edit in lib/Aftok/TimeLog.hs at line 55

[3.19329]

[3.51952]

makeLenses ''LogEvent
replacement in lib/Aftok/TimeLog.hs at line 57

[3.51953]→[3.2179:2201](∅→∅),[3.1271]→[3.2179:2201](∅→∅)

makeLenses ''LogEvent

[3.51953]

[3.5414]

instance HasEventTime LogEvent where
eventTime = leEventTime
edit in lib/Aftok/TimeLog.hs at line 91

[3.52464]

[25.1724]

instance {-# OVERLAPPABLE #-} HasLogEntry a => HasEventTime a where
eventTime = event . leEventTime
replacement in lib/Aftok/TimeLog.hs at line 130

[3.90622]→[3.19475:19566](∅→∅)

newtype WorkIndex t = WorkIndex (Map CreditTo (NonEmpty (Interval t))) deriving (Show, Eq)

[3.90622]

[3.52473]

newtype WorkIndex t = WorkIndex (Map CreditTo (NonEmpty (Interval t)))
deriving (Show, Eq, Functor)
replacement in lib/Aftok/TimeLog.hs at line 142

[2.23037]→[2.23037:23134](∅→∅)

workCredit :: (Foldable f, HasLogEntry le) => DepF -> C.UTCTime -> f (Interval le) -> (NDT, NDT)

[2.23037]

[2.23134]

workCredit :: (Foldable f, HasEventTime le) => DepF -> C.UTCTime -> f (Interval le) -> (NDT, NDT)
replacement in lib/Aftok/TimeLog.hs at line 144

[2.23164]→[2.23164:23274](∅→∅)

bimap getSum getSum $ F.foldMap ((Sum . ilen &&& Sum . depf ptime) . fmap (view $ event . eventTime)) ivals

[2.23164]

[3.1576]

bimap getSum getSum $ F.foldMap ((Sum . ilen &&& Sum . depf ptime) . fmap (view eventTime)) ivals
replacement in lib/Aftok/TimeLog.hs at line 150

[3.90753]→[2.23275:23365](∅→∅)

payouts :: forall le. (HasLogEntry le) => DepF -> C.UTCTime -> WorkIndex le -> WorkShares

[3.90753]

[3.4834]

payouts :: forall le. (HasEventTime le) => DepF -> C.UTCTime -> WorkIndex le -> WorkShares
replacement in lib/Aftok/TimeLog.hs at line 192

[3.20497]→[3.20497:20570](∅→∅)

case extension (view (event . eventTime) <$> ival) logEvent of

[3.20497]

[3.20570]

case extension (view (event . leEventTime) <$> ival) logEvent of
edit in test/Aftok/TimeLogSpec.hs at line 2

[3.82682]

[3.12097]

{-# LANGUAGE TypeApplications #-}
edit in test/Aftok/TimeLogSpec.hs at line 12

[3.1660]

[3.106753]

import Prelude hiding (head, tail)
replacement in test/Aftok/TimeLogSpec.hs at line 16

[3.82762]→[3.106788:106821](∅→∅),[3.106821]→[3.82762:82789](∅→∅),[3.82762]→[3.82762:82789](∅→∅)

import Aftok.Types (UserId (..))
import Control.Lens ((^.))

[3.82762]

[3.82789]

import Aftok.Types (UserId (..), DepreciationFunction(..))
import Control.Lens ((^.), view, to)
edit in test/Aftok/TimeLogSpec.hs at line 19

[3.82813]

[3.82813]

import Data.Maybe (fromJust)
import Data.List (head, tail)
import Data.Ratio ((%))
replacement in test/Aftok/TimeLogSpec.hs at line 35

[3.3480]→[3.2383:2427](∅→∅)

genIntervals :: Gen (L.NonEmpty I.Interval)

[3.3480]

[3.2427]

genIntervals :: Gen (L.NonEmpty (I.Interval T.UTCTime))
replacement in test/Aftok/TimeLogSpec.hs at line 40

[3.83169]→[3.2531:2602](∅→∅),[3.3533]→[3.2531:2602](∅→∅)

buildIntervals :: T.UTCTime -> [NominalDiffTime] -> [I.Interval]

[3.83169]

[3.83170]

buildIntervals :: T.UTCTime -> [NominalDiffTime] -> [I.Interval T.UTCTime]
replacement in test/Aftok/TimeLogSpec.hs at line 51

[3.2046]→[3.106822:106852](∅→∅)

genWorkIndex :: Gen WorkIndex

[3.2046]

[3.2852]

genWorkIndex :: Gen (WorkIndex T.UTCTime)
replacement in test/Aftok/TimeLogSpec.hs at line 53

[3.2867]→[3.106853:106910](∅→∅)

let recordGen :: Gen (CreditTo, L.NonEmpty I.Interval)

[3.2867]

[3.65032]

let recordGen :: Gen (CreditTo, L.NonEmpty (I.Interval T.UTCTime))
replacement in test/Aftok/TimeLogSpec.hs at line 77

[3.83768]→[3.107046:107098](∅→∅)

testIntervals :: [(CreditTo, I.Interval)]

[3.83768]

[3.1422]

testIntervals :: [(CreditTo, I.Interval T.UTCTime)]
edit in test/Aftok/TimeLogSpec.hs at line 83

[3.107193]

[3.107193]
edit in test/Aftok/TimeLogSpec.hs at line 88

[3.4256]

[3.4257]
replacement in test/Aftok/TimeLogSpec.hs at line 91

[3.83869]→[3.65614:65667](∅→∅),[3.65614]→[3.65614:65667](∅→∅)

(workIndex testLogEntries) `shouldBe` expected

[3.83869]

[3.70731]

actual = view eventTime <$> workIndex id testLogEntries
actual `shouldBe` expected
replacement in test/Aftok/TimeLogSpec.hs at line 112

[3.4558]→[3.84112:84145](∅→∅),[3.84145]→[3.71351:71422](∅→∅),[3.71351]→[3.71351:71422](∅→∅)

in workIndex logEntries
`shouldBe` (WorkIndex $ fmap (L.reverse . L.sort) widx')

[3.4558]

[3.3975]

expected = (WorkIndex $ fmap (L.reverse . L.sort) widx')
actual = view eventTime <$> workIndex id logEntries
in actual `shouldBe` expected

it "computes correct work shares" $ do
[u0, u1, u2] <- fmap CreditToUser . take 3 <$> sample' (UserId <$> genUUID)
let initTime = toThyme . fromJust $ parseISO8601 "2014-01-01T00:08:00Z"
len = fromInteger @NominalDiffTime 360
timestamps = iterate (addUTCTime len) initTime
intervals =
fmap (uncurry I.Interval . snd)
. filter (\i -> fst i `mod` 2 == 0)
$ ([(0 :: Int)..] `zip` (timestamps `zip` tail timestamps))

widx = WorkIndex $ M.fromList
[ (u0, L.fromList $ take 10 intervals)
, (u1, L.fromList $ take 30 intervals)
, (u2, L.fromList $ take 120 intervals)
]

-- for this test we'll be entirely within undepreciated period
depf = toDepF $ LinearDepreciation 180 1800
evalTime = I._start . head $ drop 120 intervals
edit in test/Aftok/TimeLogSpec.hs at line 136

[3.3976]

[26.1680]

shares = payouts depf evalTime widx
(shares ^. loggedTotal `shouldBe` (fromInteger @NominalDiffTime (360 * 160)))
(shares ^. creditToShares . to (fromJust . M.lookup u0) . wsShare) `shouldBe` (10 % 160)
(shares ^. creditToShares . to (fromJust . M.lookup u1) . wsShare) `shouldBe` (30 % 160)
(shares ^. creditToShares . to (fromJust . M.lookup u2) . wsShare) `shouldBe` (120 % 160)