Return actual events for interval ends, not just timestamps.

[?]

Jan 23, 2021, 6:08 AM

IR75ZMX32SFFMDNV2I2L22X5JTWCOC4UUBCSPU7S6VHR6HFV6ADQC

Dependencies

[2] 5SBSBFLS Bind log directories to local paths for development.
[3] 4354Y4PE Add endpoint to list project contributors.
[4] MU6WOCCJ Update auctions to permit zcash as a funding currency.
[5] A2J7B4SC Initial impl of depreciation function.
[6] Y35QCWYW Minor improvement in WorkIndex type to eliminate duplicated information.
[7] LTSVBVA2 Update to a recent haskoin-core. Fix Stack build.
[8] EZQG2APB Update task list.
[9] 2XQD6KKK Add invitation logic and clean up DBProg error handling.
[10] ASF3UPJL Add auction creation and bid handlers
[11] TLQ72DSJ Lenses, sqlite-simple
[12] W35DDBFY Factor common JSON conversions up into client lib module.
[13] O5FVTOM6 Undo JSON silliness, enable a couple more routes.
[14] 4IQVQL4T Added client for payouts endpoint.
[15] PBD7LZYQ Postgres & auth are beginning to function.
[16] WRPIYG3E Use project listing functionality to check for whether we have a cookie.
[17] QMEYU4MW Add display for prior intervals.
[18] 2J37EVJM Check for an open interval on project switch.
[19] ZIG57EE6 Fix project selection, end log end on project switch.
[20] XTBSG4C7 Adding serveJSON combinator to eliminate some boilerplate from handlers.
[21] EQXRXRZD Changed to use tasty instead of test-framework
[22] 7KZP4RHZ Switch from Data.Time to Data.Thyme
[23] RPAJLHMT Change to use UUIDs instead of ints for primary keys.
[24] SOIAMXLW Build versioned docker images.
[25] QU5FW67R Add project selection to time tracker.
[26] UILI6PIL The route-based logStart/logStop is nicer.
[27] Z24SZOGZ Return richer information from event logging calls.
[28] 64C6AWH6 Rename Ananke -> Quixotic, project reboot.
[29] Z7KS5XHH Very WIP. Wow.
[30] QMRKFEPG Refactor QDB to use a free monad algebra instead.
[31] RN7EI6IN Update database layer to use CreditTo
[32] B6HWAPDP Modularize & update to recent haskoin.
[33] SQ7UMLN5 Get z-addr checks working.
[34] SCXG6TJW Make log reduction safer in presence of overlapping events.
[35] BWN72T44 Don't accept work timestamp from an external source.
[36] NAS4BFL4 Trivial stylish-haskell reformat.
[37] N4NDAZYT Initial implementation of payouts.
[38] Q5X5RYQL stylish-haskell reformatting
[39] 4U7F3CPI THE GREAT RENAMING OF THINGS!
[40] GMYPBCWE Make docker-compose work.
[41] 7HPY3QPF Fix linting errors. (yay hlint!)
[42] AL37SVTC Implement payments service endpoints.
[43] EW2XN7KU Update docker build, clean up migration for payments tables.
[44] BFZN4SUA Make timeline component work.
[45] JXG3FCXY Upgrade ps + halogen versions.
[46] RSF6UAJK Break out api module for timeline.
[47] JUUMYIQE Add groupBy utility function for use in TimeLog.
[48] GKGVYBZG Added JSON serialization to TimeLog
[49] U256ZALI Add captcha check to register route.
[50] 7XN3I3QJ Add 'loggedIntervals' endpoint.
[51] J6S23MDG Use server timestamps for interval start and end.
[52] I2KHGVD4 Require project permissions for access to most data.
[53] O227CEAV Adds storage of original event JSON for some DBOp constructors.
[54] BROSTG5K Beginning of modularization of server.
[55] Z3MK2PJ5 Add GET handler for retrieving auction data.
[56] HALRDT2F Added initial auction create route.
[57] POX3UAMT Enabling logging of time to contributor/project accounts
[58] GCVQD44V Create amends endpoint, switch to UUID primary keys
[59] 5XFJNUAZ Start of addition of project infrastructure.
[60] O722AOKE Add route to allow crediting of events to users/projects.
[61] OUR4PAOT Use local dates for display of intervals.
[62] 4QX5E5AC Initial compilation of payouts function succeeds.
[63] SEWTRB6S Implement payment request creation functions.
[64] NLZ3JXLO Fix formatting with stylish-haskell.
[65] NSRSSSTR Update nginx.conf, make aftok host configurable for cli scripts.
[66] NJNMO72S Add zcash.com submodule and update client to modern halogen.
[67] SLL7262C Make depreciation functions more flexible.
[68] MJDIMD5B Improve documentation of local docker-compose setup.
[69] 5DRIWGLU Improving TimeLog specs
[70] 7DBNV3GV Initial, stack-based impl of time log event reduction.
[71] NVOCQVAS Initial failing tests.
[72] KNSI575V Cleanup of EventLog types.
[73] EFSXYZPO Autoformat everything with brittany.
[74] HMDM3B55 Implement core of payments/billing infrastructure.
[75] X3ES7NUA Fine. I'll use ormolu. At least it doesn't break the code.
[76] M4PWY5RU Preliminary work to add support for Zcash payments.
[77] IPG33FAW Add billing daemon
[78] NEDDHXUK Reformat via stylish-haskell
[79] JUFBTX45 Add project auction queries.
[80] 7VGYLTMU Clean up schema version handling.
[81] DFOBMSAO Initial work on payments API
[82] WAIX6AGN Add event serialization for PaymentRequest & Payment
[83] AWWC6P5Z Add migration to include payment network with addresses.
[84] A6HKMINB Attempting to improve JSON handling.
[85] 4R7XIYK3 Switch from ClassyPrelude to Relude
[86] 4FDQGIXN Make payment request retrieval key an opaque 32-bit hash.
[87] GKLIPHR5 Fix error in parsing of event metadata
[88] UWMGUJOW Autoformat sources.
[*] LEINLS3X Update deployment documentation.
[*] RB2ETNIF Add skeletal PureScript client project.
[*] 4ZLEDBK7 Initial attempts at dockerizing, cabal isn't cooperating.
[*] IZEVQF62 Work in progress replacing sqlite with postgres.
[*] 2WOOGXDH Use dbmigrations to manage database state.
[*] ADMKQQGC Initial empty Snap project.
[*] EMVTF2IW WIP moving back to snap.

Change contents

replacement in Makefile at line 6

[5.93]→[5.321:334](∅→∅),[5.321]→[5.321:334](∅→∅)

build-image:

[5.93]

[5.37]

build-server-image:
replacement in Makefile at line 9

[5.376]→[5.376:402](∅→∅)

deploy-image: build-image

[5.376]

[5.83]

build-client-image:
docker build -t aftok/aftok-client:latest -f ./client/Dockerfile .

build-images: build-server-image build-client-image

deploy-images: build-server-image build-client-image
edit in Makefile at line 18

[5.204]

docker tag aftok/aftok-client:latest aftok/aftok-client:$(VERSION)
docker push docker.io/aftok/aftok-client:latest
docker push docker.io/aftok/aftok-client:$(VERSION)
edit in aftok.cabal at line 163

[5.232]

[5.1]

, Aftok.Snaplet.Json
edit in aftok.cabal at line 209

[5.297]

[5.297]

, unordered-containers
file addition: Dockerfile (----------)

[91.1]

FROM ubuntu:focal
MAINTAINER Kris Nuttycombe <kris@aftok.com>

ENV LANG C.UTF-8
ENV TZ America/Denver
RUN ln -snf /usr/share/zoneinfo/$TZ /etc/localtime && echo $TZ > /etc/timezone

# Install build tools & library dependencies
RUN apt-get update && \
apt-get install -y --no-install-recommends \
libtinfo5 nodejs npm netbase

RUN apt-get install -y --no-install-recommends ca-certificates
RUN update-ca-certificates

RUN mkdir -p /opt/aftok/client
WORKDIR /opt/aftok/client

ADD ./client/package.json /opt/aftok/client/package.json

RUN npm install
ENV PATH="./node_modules/.bin:${PATH}"

# Add static assets
ADD ./aftok.com/src/assets /opt/aftok/aftok.com/src/assets
ADD ./client/dev /opt/aftok/client/dev
RUN mkdir -p /opt/aftok/client/prod && \
ln -s /opt/aftok/aftok.com/src/assets /opt/aftok/client/prod/assets

# Add purescript build config & sources
ADD ./client/spago.dhall /opt/aftok/client/spago.dhall
ADD ./client/packages.dhall /opt/aftok/client/packages.dhall
ADD ./client/src /opt/aftok/client/src

RUN npm run build-prod

# Add dist-volume directory for use with docker-compose sharing
# of client executables via volumes.
ADD ./docker/aftok-client-cp.sh /opt/aftok/
RUN chmod 700 /opt/aftok/aftok-client-cp.sh
RUN mkdir /opt/aftok/client/dist-volume
edit in client/src/Aftok/Api/Timeline.purs at line 10

[5.30]

[5.202]

import Data.Argonaut.Core (Json)
replacement in client/src/Aftok/Api/Timeline.purs at line 21

[5.631]→[5.631:661](∅→∅)

import Type.Proxy (Proxy(..))

[5.631]

[5.661]

import Foreign.Object (Object)
-- import Type.Proxy (Proxy(..))
replacement in client/src/Aftok/Api/Timeline.purs at line 35

[5.957]→[5.957:1031](∅→∅)

import Aftok.Types (APIError, JsonCompose, decompose, parseDatedResponse)

[5.957]

[5.1031]

-- import Aftok.Types (APIError, JsonCompose, decompose, parseDatedResponse)
import Aftok.Types (APIError, decompose, parseDatedResponse)
replacement in client/src/Aftok/Api/Timeline.purs at line 47

[5.1224]→[5.1224:1271](∅→∅)

data Event' i
= StartEvent i
| StopEvent i

[5.1224]

[5.1271]

data Event t
= StartEvent t
| StopEvent t
replacement in client/src/Aftok/Api/Timeline.purs at line 51

[5.1272]→[5.1272:1300](∅→∅)

type Event = Event' Instant

[5.1272]

[5.1300]

eventTime :: forall i. Event i -> i
eventTime = case _ of
StartEvent t -> t
StopEvent t -> t
replacement in client/src/Aftok/Api/Timeline.purs at line 56

[5.1301]→[5.1301:1348](∅→∅)

derive instance eventFunctor :: Functor Event'

[5.1301]

[5.1348]

instance showEvent :: (Show i) => Show (Event i) where
show = case _ of
StartEvent t -> "Start " <> show t
StopEvent t -> "Stop " <> show t
replacement in client/src/Aftok/Api/Timeline.purs at line 61

[5.1349]→[5.1349:1397](∅→∅)

instance eventFoldable :: Foldable Event' where

[5.1349]

[5.1397]

derive instance eventFunctor :: Functor Event

instance eventFoldable :: Foldable Event where
replacement in client/src/Aftok/Api/Timeline.purs at line 72

[5.1576]→[5.1576:1630](∅→∅)

instance eventTraversable :: Traversable Event' where

[5.1576]

[5.1630]

instance eventTraversable :: Traversable Event where
replacement in client/src/Aftok/Api/Timeline.purs at line 74

[5.1655]→[5.1655:1733](∅→∅)

StartEvent a -> StartEvent <$> f a
StopEvent a -> StopEvent <$> f a

[5.1655]

[5.1733]

StartEvent a -> StartEvent <$> f a
StopEvent a -> StopEvent <$> f a
replacement in client/src/Aftok/Api/Timeline.purs at line 78

[5.1765]→[5.1765:1826](∅→∅)

instance decodeJsonEvent :: DecodeJson (Event' String) where

[5.1765]

[5.1826]

parseEventFields :: Object Json -> Either String (Event String)
parseEventFields obj = do
ev <- obj .: "event"
start' <- traverse (_ .: "eventTime") =<< ev .:? "start"
stop' <- traverse (_ .: "eventTime") =<< ev .:? "stop"
note "Only 'stop' and 'start' events are supported." $
(StartEvent <$> start') <|>
(StopEvent <$> stop')

instance eventDecodeJSON :: DecodeJson (Event String) where
decodeJson = parseEventFields <=< decodeJson

newtype KeyedEvent i = KeyedEvent
{ eventId :: String
, event :: Event i
}

keyedEvent :: forall i. String -> Event i -> KeyedEvent i
keyedEvent eid ev = KeyedEvent { eventId: eid, event: ev }

eventId :: forall i. KeyedEvent i -> String
eventId (KeyedEvent xs) = xs.eventId

event :: forall i. KeyedEvent i -> Event i
event (KeyedEvent xs) = xs.event

derive instance keyedEventFunctor :: Functor KeyedEvent

instance keyedEventFoldable :: Foldable KeyedEvent where
foldr f b = foldr f b <<< event
foldl f b = foldl f b <<< event
foldMap = foldMapDefaultR

instance keyedEventTraversable :: Traversable KeyedEvent where
traverse f (KeyedEvent xs) = (\ev -> KeyedEvent { eventId: xs.eventId, event: ev }) <$> traverse f xs.event
sequence = traverse identity

instance keyedEventDecodeJson :: DecodeJson (KeyedEvent String) where
replacement in client/src/Aftok/Api/Timeline.purs at line 118

[5.1876]→[5.1876:2140](∅→∅)

event <- obj .: "event"
start' <- traverse (_ .: "eventTime") =<< event .:? "start"
stop' <- traverse (_ .: "eventTime") =<< event .:? "stop"
note "Only 'stop' and 'start' events are supported." $ (StartEvent <$> start') <|> (StopEvent <$> stop')

[5.1876]

[5.2140]

keyedEvent <$> obj .: "eventId" <*> parseEventFields obj
replacement in client/src/Aftok/Api/Timeline.purs at line 120

[5.2141]→[5.2141:2172](∅→∅)

newtype Interval' i = Interval

[5.2141]

[5.2172]

newtype Interval i = Interval
replacement in client/src/Aftok/Api/Timeline.purs at line 125

[5.2205]→[5.2205:2321](∅→∅)

derive instance intervalEq :: (Eq i) => Eq (Interval' i)
derive instance intervalNewtype :: Newtype (Interval' i) _

[5.2205]

[5.2321]

derive instance intervalEq :: (Eq i) => Eq (Interval i)
derive instance intervalNewtype :: Newtype (Interval i) _
replacement in client/src/Aftok/Api/Timeline.purs at line 128

[5.2322]→[5.5:65](∅→∅)

instance showInterval :: Show i => Show (Interval' i) where

[5.2322]

[5.65]

instance showInterval :: Show i => Show (Interval i) where
replacement in client/src/Aftok/Api/Timeline.purs at line 131

[5.158]→[5.2322:2356](∅→∅),[5.2322]→[5.2322:2356](∅→∅)

type Interval = Interval' Instant

[5.158]

[5.2356]

type TimeInterval = Interval Instant
replacement in client/src/Aftok/Api/Timeline.purs at line 133

[5.2357]→[5.2357:2410](∅→∅)

derive instance intervalFunctor :: Functor Interval'

[5.2357]

[5.2410]

derive instance intervalFunctor :: Functor Interval
replacement in client/src/Aftok/Api/Timeline.purs at line 135

[5.2411]→[5.2411:2565](∅→∅)

instance intervalFoldable :: Foldable Interval' where
foldr f b (Interval i) = f i.start (f i.end b)
foldl f b (Interval i) = f (f b i.start) i.end

[5.2411]

[5.2565]

instance intervalFoldable :: Foldable Interval where
foldr f b (Interval i) = f i.start (f i.end b)
foldl f b (Interval i) = f (f b i.start) i.end
replacement in client/src/Aftok/Api/Timeline.purs at line 140

[5.2594]→[5.2594:2718](∅→∅)

instance intervalTraversable :: Traversable Interval' where
traverse f (Interval i) = interval <$> f i.start <*> f i.end

[5.2594]

[5.2718]

instance intervalTraversable :: Traversable Interval where
traverse f (Interval i) = interval <$> f i.start <*> f i.end
replacement in client/src/Aftok/Api/Timeline.purs at line 144

[5.2750]→[5.2750:2817](∅→∅)

instance decodeJsonInterval :: DecodeJson (Interval' String) where

[5.2750]

[5.2817]

instance intervalDecodeJSON :: DecodeJson i => DecodeJson (Interval i) where
replacement in client/src/Aftok/Api/Timeline.purs at line 149

[5.2917]→[5.2917:2961](∅→∅)

interval :: forall i. i -> i -> Interval' i

[5.2917]

[5.2961]

interval :: forall i. i -> i -> Interval i
replacement in client/src/Aftok/Api/Timeline.purs at line 152

[5.3007]→[5.159:195](∅→∅)

start :: forall i. Interval' i -> i

[5.3007]

[5.195]

start :: forall i. Interval i -> i
replacement in client/src/Aftok/Api/Timeline.purs at line 155

[5.225]→[5.225:259](∅→∅)

end :: forall i. Interval' i -> i

[5.225]

[5.259]

end :: forall i. Interval i -> i
replacement in client/src/Aftok/Api/Timeline.purs at line 160

[5.3037]→[5.3037:3062](∅→∅)

| During (Interval' t)

[5.3037]

[5.3062]

| During (Interval t)
replacement in client/src/Aftok/Api/Timeline.purs at line 184

[5.3657]→[5.3657:3720](∅→∅)

apiLogStart :: ProjectId -> Aff (Either TimelineError Instant)

[5.3657]

[5.3720]

apiLogStart :: ProjectId -> Aff (Either TimelineError (KeyedEvent Instant))
replacement in client/src/Aftok/Api/Timeline.purs at line 189

[5.3964]→[5.3964:4162](∅→∅)

event <- withExceptT LogFailure $ parseDatedResponse response
case event of
StartEvent t -> pure t
StopEvent _ -> throwError <<< Unexpected $ "Expected start event, got stop."

[5.3964]

[5.4162]

kev <- withExceptT LogFailure $ parseDatedResponse response
case event kev of
StartEvent _ -> pure kev
StopEvent _ -> throwError <<< Unexpected $ "Expected start event, got stop."
replacement in client/src/Aftok/Api/Timeline.purs at line 194

[5.4163]→[5.4163:4224](∅→∅)

apiLogEnd :: ProjectId -> Aff (Either TimelineError Instant)

[5.4163]

[5.4224]

apiLogEnd :: ProjectId -> Aff (Either TimelineError (KeyedEvent Instant))
replacement in client/src/Aftok/Api/Timeline.purs at line 199

[5.4464]→[5.4464:4548](∅→∅)

event <- withExceptT LogFailure $ parseDatedResponse response
case event of

[5.4464]

[5.4548]

kev <- withExceptT LogFailure $ parseDatedResponse response
case event kev of
replacement in client/src/Aftok/Api/Timeline.purs at line 202

[5.4632]→[5.4632:4661](∅→∅)

StopEvent t -> pure t

[5.4632]

[5.4661]

StopEvent _ -> pure kev
replacement in client/src/Aftok/Api/Timeline.purs at line 205

[5.4718]→[5.4718:4769](∅→∅)

{ workIndex :: Array ({ intervals :: Array a })

[5.4718]

[5.4769]

{ workIndex :: Array ({ intervals :: Array a })
replacement in client/src/Aftok/Api/Timeline.purs at line 217

[5.5290]→[5.5290:5332](∅→∅)

traverse f (ListIntervalsResponse r) =

[5.5290]

[5.5332]

traverse f (ListIntervalsResponse r) =
edit in client/src/Aftok/Api/Timeline.purs at line 224

[5.5699]→[5.5699:5816](∅→∅)

_ListIntervalsResponse :: Proxy (JsonCompose ListIntervalsResponse Interval' String)
_ListIntervalsResponse = Proxy
replacement in client/src/Aftok/Api/Timeline.purs at line 225

[5.5817]→[5.5817:5906](∅→∅)

apiListIntervals :: ProjectId -> TimeSpan -> Aff (Either TimelineError (Array Interval))

[5.5817]

[5.5906]

apiListIntervals :: ProjectId -> TimeSpan -> Aff (Either TimelineError (Array (Interval (KeyedEvent Instant))))
replacement in client/src/Aftok/Api/Timeline.purs at line 233

[5.6300]→[5.6300:6334](∅→∅)

liftEffect
<<< runExceptT

[5.6300]

[5.6334]

liftEffect
<<< runExceptT
replacement in client/src/Aftok/Api/Timeline.purs at line 236

[5.6408]→[5.6408:6462](∅→∅)

<<< map decompose
<<< withExceptT LogFailure

[5.6408]

[5.6462]

<<< map (map decompose <<< decompose)
<<< withExceptT LogFailure
replacement in client/src/Aftok/Api/Timeline.purs at line 240

[5.6499]→[5.217:289](∅→∅)

apiLatestEvent :: ProjectId -> Aff (Either TimelineError (Maybe Event))

[5.6499]

[5.289]

apiLatestEvent :: ProjectId -> Aff (Either TimelineError (Maybe (KeyedEvent Instant)))
replacement in client/src/Aftok/Api/Timeline.purs at line 243

[5.390]→[5.390:424](∅→∅)

liftEffect
<<< runExceptT

[5.390]

[5.424]

liftEffect
<<< runExceptT
replacement in client/src/Aftok/Api/Timeline.purs at line 247

[5.463]→[5.463:495](∅→∅)

<<< withExceptT LogFailure

[5.463]

[5.495]

<<< withExceptT LogFailure
replacement in client/src/Aftok/Timeline.purs at line 11

[5.2521]→[5.402:452](∅→∅)

import Data.Array (reverse)
import Data.Date as D

[5.2521]

[5.760]

import Data.Array (reverse, cons)
replacement in client/src/Aftok/Timeline.purs at line 23

[5.2571]→[5.2571:2626](∅→∅)

import Data.Time.Duration (Milliseconds(..), Days(..))

[5.2571]

[5.591]

import Data.Time.Duration (Milliseconds(..), Hours(..), Days(..))
replacement in client/src/Aftok/Timeline.purs at line 51

[5.6710]→[5.825:924](∅→∅)

import Aftok.Api.Timeline (TimelineError, Interval'(..), Interval, TimeSpan, start, end, interval)

[5.6710]

[5.2875]

import Aftok.Api.Timeline
( TimelineError,
Event(..),
Interval(..),
TimeInterval,
KeyedEvent,
TimeSpan,
start, end, interval,
event, eventTime, keyedEvent
)
replacement in client/src/Aftok/Timeline.purs at line 66

[5.1123]→[5.3988:4012](∅→∅)

{ bounds :: Interval

[5.1123]

[5.3327]

{ bounds :: TimeInterval
edit in client/src/Aftok/Timeline.purs at line 70

[5.3422]

[5.990]

data TimelineEvent
= LoggedEvent (KeyedEvent Instant)
| PhantomEvent Instant

instance showTimelineEvent :: Show TimelineEvent where
show = case _ of
LoggedEvent kev -> "Real event at " <> show (event kev)
PhantomEvent i -> "Phantom at " <> show i

tlEventTime :: TimelineEvent -> Instant
tlEventTime = case _ of
LoggedEvent kev -> eventTime <<< event $ kev
PhantomEvent i -> i
replacement in client/src/Aftok/Timeline.purs at line 85

[5.1011]→[5.1011:1075](∅→∅)

{ dayBounds :: Interval
, loggedIntervals :: Array Interval

[5.1011]

[5.1075]

{ dayBounds :: TimeInterval
, loggedIntervals :: Array (Interval TimelineEvent)
replacement in client/src/Aftok/Timeline.purs at line 94

[5.1197]→[5.302007:302037](∅→∅),[5.4056]→[5.302007:302037](∅→∅),[5.3503]→[5.302007:302037](∅→∅)

, active :: Maybe Interval

[5.1197]

[5.1198]

, active :: Maybe (Interval TimelineEvent)
replacement in client/src/Aftok/Timeline.purs at line 115

[5.4145]→[5.4145:4207](∅→∅),[5.4207]→[5.3336:3396](∅→∅),[5.3336]→[5.3336:3396](∅→∅),[5.3396]→[5.4208:4296](∅→∅),[5.4296]→[5.605:682](∅→∅)

, logStart :: ProjectId -> m (Either TimelineError Instant)
, logEnd :: ProjectId -> m (Either TimelineError Instant)
, listIntervals :: ProjectId -> TimeSpan -> m (Either TimelineError (Array Interval))
, getLatestEvent :: ProjectId -> m (Either TimelineError (Maybe TL.Event))

[5.4145]

[5.254]

, logStart :: ProjectId -> m (Either TimelineError (KeyedEvent Instant))
, logEnd :: ProjectId -> m (Either TimelineError (KeyedEvent Instant))
, listIntervals :: ProjectId -> TimeSpan -> m (Either TimelineError (Array (Interval (KeyedEvent Instant))))
, getLatestEvent :: ProjectId -> m (Either TimelineError (Maybe (KeyedEvent Instant)))
replacement in client/src/Aftok/Timeline.purs at line 200

[5.2215]→[5.1002:1137](∅→∅),[5.1137]→[5.2348:2377](∅→∅),[5.2348]→[5.2348:2377](∅→∅)

--(system.log $ "Got " <> show (length ivals :: Int) <> " intervals for project " <> pidStr (unwrap p).projectId) *>
pure ivals

[5.2215]

[5.1138]

pure $ map (map LoggedEvent) ivals
replacement in client/src/Aftok/Timeline.purs at line 214

[5.1499]→[5.1499:1619](∅→∅)

let activeInterval :: TL.Event -> m (Maybe Interval)
activeInterval ev = case ev of

[5.1499]

[5.1619]

let activeInterval :: TL.KeyedEvent Instant -> m (Maybe (Interval TimelineEvent))
activeInterval ev = case event ev of
replacement in client/src/Aftok/Timeline.purs at line 218

[5.1761]→[5.1761:1822](∅→∅)

(Just <<< interval i <$> system.now)

[5.1761]

[5.1822]

(Just <<< interval (LoggedEvent ev) <<< PhantomEvent <$> system.now)
replacement in client/src/Aftok/Timeline.purs at line 269

[5.3617]→[5.3617:3632](∅→∅),[5.3632]→[5.6576:6596](∅→∅),[5.6576]→[5.6576:6596](∅→∅)

-> Interval
-> Array Interval

[5.3617]

[5.3633]

-> TimeInterval
-> Array (Interval TimelineEvent)
replacement in client/src/Aftok/Timeline.purs at line 298

[5.4066]→[5.7462:7476](∅→∅),[5.304908]→[5.7462:7476](∅→∅),[5.7476]→[5.3373:3387](∅→∅),[5.3373]→[5.3373:3387](∅→∅)

. Interval
-> Interval

[5.4066]

[5.4067]

. TimeInterval
-> Interval TimelineEvent
replacement in client/src/Aftok/Timeline.purs at line 304

[5.1128]→[5.4165:4206](∅→∅),[5.4206]→[5.3453:3487](∅→∅),[5.3453]→[5.3453:3487](∅→∅)

ileft = ilen limits.start i.start
iwidth = ilen i.start i.end

[5.1128]

[5.3544]

ileft = ilen limits.start (tlEventTime i.start)
iwidth = ilen (tlEventTime i.start) (tlEventTime i.end)
replacement in client/src/Aftok/Timeline.purs at line 308

[5.973]→[5.4207:4247](∅→∅)

put $ toPct (ilen limits.start i.end)

[5.973]

[5.4247]

put $ toPct (ilen limits.start (tlEventTime i.end))
replacement in client/src/Aftok/Timeline.purs at line 328

[5.6224]→[5.4313:4442](∅→∅)

updateStart :: Instant -> TimelineState -> TimelineState
updateStart t s =
s { active = s.active <|> Just (TL.interval t t) }

[5.6224]

[5.6387]

updateStart :: KeyedEvent Instant -> TimelineState -> TimelineState
updateStart ev s =
s { active = s.active <|> Just (TL.interval (LoggedEvent ev) (PhantomEvent <<< eventTime <<< event $ ev)) }
replacement in client/src/Aftok/Timeline.purs at line 336

[5.4497]→[5.4497:4511](∅→∅)

-> Instant

[5.4497]

[5.4511]

-> KeyedEvent Instant
replacement in client/src/Aftok/Timeline.purs at line 339

[5.4552]→[5.4552:4687](∅→∅)

updateStop system t st = do
newHistory <- join <$> traverse (\i -> runMaybeT $ toHistory system [TL.interval (start i) t]) st.active

[5.4552]

[5.4687]

updateStop system ev st = do
let updateHistory i = runMaybeT $ toHistory system [TL.interval (start i) (LoggedEvent ev)]
newHistory <- join <$> traverse updateHistory st.active
replacement in client/src/Aftok/Timeline.purs at line 350

[5.3547]→[5.4874:4943](∅→∅)

s { active = map (\(Interval i) -> TL.interval i.start t) s.active

[5.3547]

[5.306012]

s { active = map (\i -> TL.interval (start i) (PhantomEvent t)) s.active
replacement in client/src/Aftok/Timeline.purs at line 370

[5.10424]→[5.10424:10469](∅→∅),[5.10469]→[5.7354:7398](∅→∅),[5.7354]→[5.7354:7398](∅→∅)

, logStart: \_ -> Right <$> liftEffect now
, logEnd: \_ -> Right <$> liftEffect now

[5.10424]

[5.10470]

, logStart: \_ -> Right <<< keyedEvent "" <<< StartEvent <$> liftEffect now
, logEnd: \_ -> Right <<< keyedEvent "" <<< StopEvent <$> liftEffect now
replacement in client/src/Aftok/Timeline.purs at line 376

[5.10517]→[5.4993:5029](∅→∅)

utcDayBounds :: Instant -> Interval

[5.10517]

[5.5029]

utcDayBounds :: Instant -> TimeInterval
replacement in client/src/Aftok/Timeline.purs at line 388

[5.5344]→[5.5344:5380](∅→∅)

-> MaybeT m (Tuple Date Interval)

[5.5344]

[5.5380]

-> MaybeT m (Tuple Date TimeInterval)
replacement in client/src/Aftok/Timeline.purs at line 391

[5.5471]→[5.5471:5555](∅→∅)

end <- MaybeT <<< pure $ fromDateTime <$> DT.adjust (Days 1.0) (toDateTime start)

[5.5471]

[5.5555]

nextNoon <- MaybeT <<< pure $
fromDateTime <$> (
DT.adjust (Hours 12.0) <=< DT.adjust (Days 1.0) $
(toDateTime start)
)
Tuple _ end <- MaybeT $ system.dateFFI.midnightLocal nextNoon
edit in client/src/Aftok/Timeline.purs at line 398

[5.5596]→[5.5596:5865](∅→∅)

incrementDayBounds :: Tuple Date Interval -> Maybe (Tuple Date Interval)
incrementDayBounds (Tuple d i) =
let nextEnd = fromDateTime <$> (DT.adjust (Days 1.0) $ toDateTime (end i))
in Tuple <$> D.adjust (Days 1.0) d
<*> (interval (end i) <$> nextEnd)
replacement in client/src/Aftok/Timeline.purs at line 403

[5.5922]→[5.5922:5937](∅→∅)

-> Interval

[5.5922]

[5.5937]

-> Interval TimelineEvent
replacement in client/src/Aftok/Timeline.purs at line 406

[5.6013]→[5.2141:2199](∅→∅),[5.2199]→[5.6069:6523](∅→∅),[5.6069]→[5.6069:6523](∅→∅)

--lift <<< system.log $ "Splitting interval " <> show i
dayBounds@(Tuple date bounds) <- localDayBounds system (start i)
split <- if end i < (end bounds)
then do
pure [Tuple date { dayBounds: bounds, loggedIntervals: [i] }]
else do
let firstFragment = [ Tuple date { dayBounds: bounds
, loggedIntervals: [interval (start i) (end bounds)]
} ]
append firstFragment <$> splitInterval system (interval (end bounds) (end i))

[5.6013]

[5.2200]

lift <<< system.log $ "Splitting interval " <> show i
-- day bounds are based on the start event.
Tuple date bounds <- localDayBounds system (tlEventTime $ start i)
lift <<< system.log $ "Splitting on day bounds: " <> show (start bounds) <> " to " <> show (end bounds)
split <- if tlEventTime (end i) < end bounds
then do
lift <<< system.log $ "Split complete"
pure [Tuple date { dayBounds: bounds, loggedIntervals: [i] }]
else do
let splitEvent = PhantomEvent (end bounds)
currInterval = Tuple date { dayBounds: bounds, loggedIntervals: [interval (start i) splitEvent] }
nextInterval = interval splitEvent (end i)
lift <<< system.log $ "Split required; first fragment: " <> show currInterval <> "; next interval: " <> show nextInterval
cons currInterval <$> splitInterval system nextInterval
replacement in client/src/Aftok/Timeline.purs at line 427

[5.6644]→[5.6644:6665](∅→∅)

-> Array Interval

[5.6644]

[5.6665]

-> Array (Interval TimelineEvent)
replacement in client/src/Aftok/Timeline.purs at line 430

[5.6730]→[5.6730:6855](∅→∅)

splitIntervals <- join <$> traverse (splitInterval system) xs
pure $ M.fromFoldableWith unionDayIntervals splitIntervals

[5.6730]

[5.10747]

splits <- join <$> traverse (splitInterval system) xs
pure $ M.fromFoldableWith unionDayIntervals splits
file addition: aftok-client-cp.sh (----------)

[92.1510]

#!/bin/bash

echo "Copying client build artifacts to mounted volume..."
cp -r /opt/aftok/client/dist/* /opt/aftok/client/dist-volume
echo "Client copy complete. The container will now shut down."
edit in docker-compose.yml at line 11

[5.23906]→[5.2859:2874](∅→∅)

- zcashd
edit in docker-compose.yml at line 24

[5.24073]

[5.24073]

aftok-client:
image: aftok/aftok-client:latest
container_name: aftok-client
entrypoint: /opt/aftok/aftok-client-cp.sh
volumes:
- type: volume
source: v_aftok-client
target: /opt/aftok/client/dist-volume
replacement in docker-compose.yml at line 58

[5.309567]→[5.309567:309598](∅→∅)

source: ./client/dist/

[5.309567]

[5.309598]

source: ./client/dist
edit in docker-compose.yml at line 61

[2.405]

[5.24404]

# - type: volume
# source: v_aftok-client
# target: /opt/static/app
# read_only: true
replacement in docker-compose.yml at line 90

[5.2945]→[5.2945:3028](∅→∅),[5.3028]→[5.312:340](∅→∅),[5.340]→[5.3028:3039](∅→∅),[5.3028]→[5.3028:3039](∅→∅),[5.3039]→[2.474:496](∅→∅),[5.363]→[5.3059:3091](∅→∅),[2.496]→[5.3059:3091](∅→∅),[5.3059]→[5.3059:3091](∅→∅),[5.3091]→[2.497:539](∅→∅),[2.539]→[5.3138:3192](∅→∅),[5.3138]→[5.3138:3192](∅→∅),[5.3192]→[2.540:584](∅→∅),[2.584]→[5.3241:3283](∅→∅),[5.3241]→[5.3241:3283](∅→∅),[5.3283]→[2.585:609](∅→∅),[5.521]→[5.24689:24721](∅→∅),[2.609]→[5.24689:24721](∅→∅),[5.3283]→[5.24689:24721](∅→∅),[5.24689]→[5.24689:24721](∅→∅)

zcashd:
image: electriccoinco/zcashd:v4.0.0
container_name: aftok-zcashd
expose:
- "18232"
ports:
- "18233:18233"
volumes:
- type: bind
source: ./local/zcashd/zcash-data
target: /srv/zcashd/.zcash
- type: bind
source: ./local/zcashd/zcash-params
target: /srv/zcashd/.zcash-params
read_only: true
networks:
- back-tier

[5.2945]

[5.24721]

# zcashd:
# image: electriccoinco/zcashd:v4.0.0
# container_name: aftok-zcashd
# expose:
# - "18232"
# ports:
# - "18233:18233"
# volumes:
# - type: bind
# source: ./local/zcashd/zcash-data
# target: /srv/zcashd/.zcash
# - type: bind
# source: ./local/zcashd/zcash-params
# target: /srv/zcashd/.zcash-params
# read_only: true
# networks:
# - back-tier
edit in docker-compose.yml at line 110

[5.24745]

[5.24745]

v_aftok-client:
edit in lib/Aftok/Database/PostgreSQL/Events.hs at line 17

[5.34300]

[5.34300]

import qualified Aftok.Billing as B
replacement in lib/Aftok/Database/PostgreSQL/Events.hs at line 26

[5.34477]→[5.34477:34496](∅→∅)

KeyedLogEntry,

[5.34477]

[4.5021]

KeyedLogEntry(KeyedLogEntry),
edit in lib/Aftok/Database/PostgreSQL/Events.hs at line 28

[4.5037]

[5.34496]

logEntry,
workId,
edit in lib/Aftok/Database/PostgreSQL/Events.hs at line 40

[5.34682]

[5.34682]

pexec,
edit in lib/Aftok/Database/PostgreSQL/Events.hs at line 43

[5.34707]

[5.34707]

ptransact,
replacement in lib/Aftok/Database/PostgreSQL/Events.hs at line 49

[5.34784]→[5.34784:34812](∅→∅)

createSubscriptionJSON,

[5.34784]

[5.34812]

idValue,
obj,
v1,
replacement in lib/Aftok/Database/PostgreSQL/Events.hs at line 54

[5.34844]→[5.34844:34865](∅→∅)

import Aftok.TimeLog

[5.34844]

[5.34865]

import Aftok.TimeLog (
WorkIndex,
LogEntry(LogEntry),
LogEvent(..),
EventId(..),
EventAmendment(..),
AmendmentId(..),
eventMeta,
_ModTime,
_EventId,
_AmendmentId,
creditTo,
eventTime,
event,
workIndex,
eventName,
nameEvent,
)
replacement in lib/Aftok/Database/PostgreSQL/Events.hs at line 73

[5.34884]→[5.34884:34927](∅→∅)

import Control.Lens ((^.), _Just, preview)

[5.34884]

[5.34927]

import Control.Lens ((^.), _Just, preview, set, view)
replacement in lib/Aftok/Database/PostgreSQL/Events.hs at line 76

[5.34988]→[5.34988:34999](∅→∅)

( Value,

[5.34988]

[5.34999]

( (.=),
Value,
replacement in lib/Aftok/Database/PostgreSQL/Events.hs at line 113

[5.35932]→[5.35932:36001](∅→∅)

(,,) <$> idParser ProjectId <*> idParser UserId <*> logEntryParser

[5.35932]

[5.36001]

KeyedLogEntry <$> idParser EventId <*> logEntryParser
edit in lib/Aftok/Database/PostgreSQL/Events.hs at line 138

[5.36740]

[5.36740]

createSubscriptionJSON :: UserId -> B.BillableId -> Day -> Value
createSubscriptionJSON uid bid d =
v1 $
obj
[ "user_id" .= idValue _UserId uid,
"billable_id" .= idValue B._BillableId bid,
"start_date" .= showGregorian d
]
replacement in lib/Aftok/Database/PostgreSQL/Events.hs at line 209

[5.38569]→[5.38569:38619](∅→∅)

findEvent :: EventId -> DBM (Maybe KeyedLogEntry)

[5.38569]

[5.38619]

findEvent :: EventId -> DBM (Maybe (ProjectId, UserId, KeyedLogEntry))
replacement in lib/Aftok/Database/PostgreSQL/Events.hs at line 213

[5.38673]→[5.38673:38739](∅→∅)

keyedLogEntryParser
[sql| SELECT project_id, user_id,

[5.38673]

[5.38739]

((,,) <$> idParser ProjectId <*> idParser UserId <*> keyedLogEntryParser)
[sql| SELECT project_id, user_id, id,
replacement in lib/Aftok/Database/PostgreSQL/Events.hs at line 216

[5.38832]→[5.38832:38931](∅→∅)

event_type, event_time, event_metadata FROM work_events
WHERE id = ? |]

[5.38832]

[5.38931]

event_type, event_time, event_metadata
FROM work_events
WHERE id = ?
AND replacement_id IS NULL
|]
replacement in lib/Aftok/Database/PostgreSQL/Events.hs at line 223

[5.38949]→[5.1851:1926](∅→∅)

findEvents :: ProjectId -> UserId -> RangeQuery -> Limit -> DBM [LogEntry]

[5.38949]

[5.1926]

findEvents :: ProjectId -> UserId -> RangeQuery -> Limit -> DBM [KeyedLogEntry]
replacement in lib/Aftok/Database/PostgreSQL/Events.hs at line 228

[5.39131]→[5.39131:39517](∅→∅)

logEntryParser
[sql| SELECT credit_to_type,
credit_to_account, credit_to_user_id, credit_to_project_id,
event_type, event_time,
event_metadata
FROM work_events
WHERE project_id = ? AND user_id = ? AND event_time <= ?
ORDER BY event_time DESC
LIMIT ?
|]

[5.39131]

[5.39517]

keyedLogEntryParser
[sql| SELECT id, credit_to_type,
credit_to_account, credit_to_user_id, credit_to_project_id,
event_type, event_time,
event_metadata
FROM work_events
WHERE project_id = ? AND user_id = ? AND event_time <= ?
AND replacement_id IS NULL
ORDER BY event_time DESC
LIMIT ?
|]
replacement in lib/Aftok/Database/PostgreSQL/Events.hs at line 242

[5.39589]→[5.39589:39988](∅→∅)

logEntryParser
[sql| SELECT credit_to_type,
credit_to_account, credit_to_user_id, credit_to_project_id,
event_type, event_time, event_metadata
FROM work_events
WHERE project_id = ? AND user_id = ?
AND event_time >= ? AND event_time <= ?
ORDER BY event_time DESC
LIMIT ?
|]

[5.39589]

[5.39988]

keyedLogEntryParser
[sql| SELECT id, credit_to_type,
credit_to_account, credit_to_user_id, credit_to_project_id,
event_type, event_time, event_metadata
FROM work_events
WHERE project_id = ? AND user_id = ?
AND replacement_id IS NULL
AND event_time >= ? AND event_time <= ?
ORDER BY event_time DESC
LIMIT ?
|]
replacement in lib/Aftok/Database/PostgreSQL/Events.hs at line 256

[5.40070]→[5.40070:40437](∅→∅)

logEntryParser
[sql| SELECT credit_to_type,
credit_to_account, credit_to_user_id, credit_to_project_id,
event_type, event_time, event_metadata
FROM work_events
WHERE project_id = ? AND user_id = ? AND event_time >= ?
ORDER BY event_time DESC
LIMIT ?
|]

[5.40070]

[5.40437]

keyedLogEntryParser
[sql| SELECT id, credit_to_type,
credit_to_account, credit_to_user_id, credit_to_project_id,
event_type, event_time, event_metadata
FROM work_events
WHERE project_id = ? AND user_id = ? AND event_time >= ?
AND replacement_id IS NULL
ORDER BY event_time DESC
LIMIT ?
|]
replacement in lib/Aftok/Database/PostgreSQL/Events.hs at line 269

[5.40505]→[5.40505:40852](∅→∅)

logEntryParser
[sql| SELECT credit_to_type,
credit_to_account, credit_to_user_id, credit_to_project_id,
event_type, event_time, event_metadata
FROM work_events
WHERE project_id = ? AND user_id = ?
ORDER BY event_time DESC
LIMIT ?
|]

[5.40505]

[5.40852]

keyedLogEntryParser
[sql| SELECT id, credit_to_type,
credit_to_account, credit_to_user_id, credit_to_project_id,
event_type, event_time, event_metadata
FROM work_events
WHERE project_id = ? AND user_id = ?
AND replacement_id IS NULL
ORDER BY event_time DESC
LIMIT ?
|]
edit in lib/Aftok/Database/PostgreSQL/Events.hs at line 280

[5.40878]→[5.40878:42449](∅→∅)

amendEvent :: EventId -> EventAmendment -> DBM AmendmentId
amendEvent (EventId eid) = \case
(TimeChange mt t) ->
pinsert
AmendmentId
[sql| INSERT INTO event_time_amendments
(event_id, amended_at, event_time)
VALUES (?, ?, ?) RETURNING id |]
(eid, fromThyme $ mt ^. _ModTime, fromThyme t)
(CreditToChange mt c@(CreditToAccount acctId)) ->
pinsert
AmendmentId
[sql| INSERT INTO event_credit_to_amendments
(event_id, amended_at, credit_to_type, credit_to_account)
VALUES (?, ?, ?, ?) RETURNING id |]
(eid, fromThyme $ mt ^. _ModTime, creditToName c, acctId ^. _AccountId)
(CreditToChange mt c@(CreditToProject pid)) ->
pinsert
AmendmentId
[sql| INSERT INTO event_credit_to_amendments
(event_id, amended_at, credit_to_type, credit_to_project_id)
VALUES (?, ?, ?, ?) RETURNING id |]
(eid, fromThyme $ mt ^. _ModTime, creditToName c, pid ^. _ProjectId)
(CreditToChange mt c@(CreditToUser uid)) ->
pinsert
AmendmentId
[sql| INSERT INTO event_credit_to_amendments
(event_id, amended_at, credit_to_type, credit_to_user_id)
VALUES (?, ?, ?, ?) RETURNING id |]
(eid, fromThyme $ mt ^. _ModTime, creditToName c, uid ^. _UserId)
(MetadataChange mt v) ->
pinsert
AmendmentId
[sql| INSERT INTO event_metadata_amendments
(event_id, amended_at, event_metadata)
VALUES (?, ?, ?) RETURNING id |]
(eid, fromThyme $ mt ^. _ModTime, v)
replacement in lib/Aftok/Database/PostgreSQL/Events.hs at line 281

[5.42450]→[5.42450:42494](∅→∅)

readWorkIndex :: ProjectId -> DBM WorkIndex

[5.42450]

[5.42494]

readWorkIndex :: ProjectId -> DBM (WorkIndex KeyedLogEntry)
replacement in lib/Aftok/Database/PostgreSQL/Events.hs at line 285

[5.42556]→[5.42556:42612](∅→∅)

logEntryParser
[sql| SELECT credit_to_type,

[5.42556]

[5.42612]

keyedLogEntryParser
[sql| SELECT id, credit_to_type,
replacement in lib/Aftok/Database/PostgreSQL/Events.hs at line 292

[5.42823]→[5.42823:42853](∅→∅)

pure $ workIndex logEntries

[5.42823]

pure $ workIndex (view logEntry) logEntries

amendEvent :: ProjectId -> UserId -> KeyedLogEntry -> EventAmendment -> DBM (EventId, AmendmentId)
amendEvent pid uid kle amendment = ptransact $ do
(amendId, replacement, amend_t :: Text) <- amend
newEventId <- createEvent pid uid (replacement ^. logEntry)
void $
pexec
[sql| UPDATE work_events
SET replacement_id = ?, amended_by_id = ?, amended_by_type = ?
WHERE id = ? |]
(newEventId ^. _EventId, amendId ^. _AmendmentId, amend_t, kle ^. workId . _EventId)
pure (newEventId, amendId)
where
amend = case amendment of
(TimeChange mt t) -> do
aid <-
pinsert
AmendmentId
[sql| INSERT INTO event_time_amendments
(work_event_id, amended_at, event_time)
VALUES (?, ?, ?) RETURNING id |]
(kle ^. workId . _EventId, fromThyme $ mt ^. _ModTime, fromThyme t)
pure (aid, set (logEntry . event . eventTime) t kle, "amend_event_time")
(CreditToChange mt c@(CreditToAccount acctId)) -> do
aid <-
pinsert
AmendmentId
[sql| INSERT INTO event_credit_to_amendments
(work_event_id, amended_at, credit_to_type, credit_to_account)
VALUES (?, ?, ?, ?) RETURNING id |]
(kle ^. workId . _EventId, fromThyme $ mt ^. _ModTime, creditToName c, acctId ^. _AccountId)
pure (aid, set (logEntry . creditTo) c kle, "amend_credit_to")
(CreditToChange mt c@(CreditToProject cpid)) -> do
aid <-
pinsert
AmendmentId
[sql| INSERT INTO event_credit_to_amendments
(work_event_id, amended_at, credit_to_type, credit_to_project_id)
VALUES (?, ?, ?, ?) RETURNING id |]
(kle ^. workId . _EventId, fromThyme $ mt ^. _ModTime, creditToName c, cpid ^. _ProjectId)
pure (aid, set (logEntry . creditTo) c kle, "amend_credit_to")
(CreditToChange mt c@(CreditToUser cuid)) -> do
aid <-
pinsert
AmendmentId
[sql| INSERT INTO event_credit_to_amendments
(work_event_id, amended_at, credit_to_type, credit_to_user_id)
VALUES (?, ?, ?, ?) RETURNING id |]
(kle ^. workId . _EventId, fromThyme $ mt ^. _ModTime, creditToName c, cuid ^. _UserId)
pure (aid, set (logEntry . creditTo) c kle, "amend_credit_to")
(MetadataChange mt v) -> do
aid <-
pinsert
AmendmentId
[sql| INSERT INTO event_metadata_amendments
(work_event_id, amended_at, event_metadata)
VALUES (?, ?, ?) RETURNING id |]
(kle ^. workId . _EventId, fromThyme $ mt ^. _ModTime, v)
pure (aid, set (logEntry . eventMeta) (Just v) kle, "amend_metadata")
replacement in lib/Aftok/Database/PostgreSQL.hs at line 48

[5.61523]→[5.61523:61584](∅→∅)

(AmendEvent eid amendment) -> Q.amendEvent eid amendment

[5.61523]

[5.61584]

(AmendEvent pid uid kle amendment) -> Q.amendEvent pid uid kle amendment
edit in lib/Aftok/Database.hs at line 25

[5.26639]

[5.26639]

import qualified Aftok.TimeLog as TL
edit in lib/Aftok/Database.hs at line 32

[5.64140]

[5.64140]

HasLogEntry,
edit in lib/Aftok/Database.hs at line 45

[5.26727]

[5.26727]

makeClassy,
edit in lib/Aftok/Database.hs at line 56

[5.26928]

[5.5919]

data KeyedLogEntry = KeyedLogEntry {
_workId :: !EventId,
_logEntry :: !LogEntry
}

makeClassy ''KeyedLogEntry
replacement in lib/Aftok/Database.hs at line 64

[5.5920]→[5.64304:64355](∅→∅)

type KeyedLogEntry = (ProjectId, UserId, LogEntry)

[5.5920]

[5.18985]

instance HasLogEntry KeyedLogEntry where
logEntry = Aftok.Database.logEntry
replacement in lib/Aftok/Database.hs at line 90

[5.64627]→[5.64627:64742](∅→∅),[5.64742]→[5.2079:2157](∅→∅),[5.2157]→[5.64821:64868](∅→∅),[5.64821]→[5.64821:64868](∅→∅)

AmendEvent :: EventId -> EventAmendment -> DBOp AmendmentId
FindEvent :: EventId -> DBOp (Maybe KeyedLogEntry)
FindEvents :: ProjectId -> UserId -> RangeQuery -> Limit -> DBOp [LogEntry]
ReadWorkIndex :: ProjectId -> DBOp WorkIndex

[5.64627]

[4.5039]

AmendEvent :: ProjectId -> UserId -> KeyedLogEntry -> EventAmendment -> DBOp (EventId, AmendmentId)
FindEvent :: EventId -> DBOp (Maybe (ProjectId, UserId, KeyedLogEntry))
FindEvents :: ProjectId -> UserId -> RangeQuery -> Limit -> DBOp [KeyedLogEntry]
ReadWorkIndex :: ProjectId -> DBOp (WorkIndex KeyedLogEntry)
replacement in lib/Aftok/Database.hs at line 260

[5.29656]→[5.66472:66542](∅→∅)

(MonadDB m) => UserId -> EventId -> EventAmendment -> m AmendmentId

[5.29656]

[5.8764]

(MonadDB m) => UserId -> EventId -> EventAmendment -> m (EventId, AmendmentId)
replacement in lib/Aftok/Database.hs at line 262

[5.8790]→[5.8790:8812](∅→∅),[5.8812]→[5.29734:29763](∅→∅),[5.29181]→[5.6524:6586](∅→∅),[5.29763]→[5.6524:6586](∅→∅),[5.8841]→[5.6524:6586](∅→∅),[5.6586]→[5.29764:29901](∅→∅)

ev <- findEvent eid
let act = AmendEvent eid a
forbidden = raiseOpForbidden uid UserNotEventLogger act
missing = raiseSubjectNotFound act
maybe
missing
(\(_, uid', _) -> if uid' == uid then liftdb act else forbidden)
ev

[5.8790]

[5.1146]

evMay <- findEvent eid
maybe missing saveAmendment evMay
where
missing = raiseSubjectNotFound (FindEvent eid)
saveAmendment (pid, uid', le) =
let act = AmendEvent pid uid le a
in if uid' == uid
then liftdb act
else raiseOpForbidden uid UserNotEventLogger act
replacement in lib/Aftok/Database.hs at line 272

[5.1147]→[5.66543:66606](∅→∅)

findEvent :: (MonadDB m) => EventId -> m (Maybe KeyedLogEntry)

[5.1147]

[5.8744]

findEvent :: (MonadDB m) => EventId -> m (Maybe (ProjectId, UserId, KeyedLogEntry))
replacement in lib/Aftok/Database.hs at line 281

[5.2241]→[5.66607:66622](∅→∅),[5.29988]→[5.66607:66622](∅→∅)

m [LogEntry]

[5.2241]

[5.3664]

m [KeyedLogEntry]
replacement in lib/Aftok/Database.hs at line 284

[5.8233]→[5.66623:66690](∅→∅)

readWorkIndex :: (MonadDB m) => ProjectId -> UserId -> m WorkIndex

[5.8233]

[5.9265]

readWorkIndex :: (MonadDB m) => ProjectId -> UserId -> m (WorkIndex KeyedLogEntry)
edit in lib/Aftok/Interval.hs at line 1

[5.1422]

[5.1692]

{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveTraversable #-}
replacement in lib/Aftok/Interval.hs at line 33

[5.2729]→[5.31119:31133](∅→∅)

data Interval

[5.2729]

[5.31133]

data Interval t
replacement in lib/Aftok/Interval.hs at line 35

[5.31146]→[5.31146:31201](∅→∅)

{ _start :: C.UTCTime,
_end :: C.UTCTime

[5.31146]

[5.31201]

{ _start :: t,
_end :: t
replacement in lib/Aftok/Interval.hs at line 38

[5.31209]→[5.31209:31236](∅→∅)

deriving (Show, Eq, Ord)

[5.31209]

[5.1544]

deriving (Show, Eq, Ord, Functor, Foldable, Traversable)
replacement in lib/Aftok/Interval.hs at line 50

[5.116]→[5.636:683](∅→∅)

interval :: C.UTCTime -> C.UTCTime -> Interval

[5.116]

[5.3]

interval :: Ord t => t -> t -> Interval t
replacement in lib/Aftok/Interval.hs at line 56

[5.1661]→[5.132:183](∅→∅),[5.132]→[5.132:183](∅→∅)

containsInclusive :: C.UTCTime -> Interval -> Bool

[5.1661]

[5.183]

containsInclusive :: Ord t => t -> Interval t -> Bool
replacement in lib/Aftok/Interval.hs at line 59

[5.1745]→[5.684:722](∅→∅)

ilen :: Interval -> C.NominalDiffTime

[5.1745]

[5.1018]

ilen :: Interval C.UTCTime -> C.NominalDiffTime
replacement in lib/Aftok/Interval.hs at line 62

[5.121]→[5.3310:3424](∅→∅)

intervalJSON :: Interval -> Value
intervalJSON ival = object ["start" .= (ival ^. start), "end" .= (ival ^. end)]

[5.121]

[5.3424]

intervalJSON :: (t -> Value) -> Interval t -> Value
intervalJSON f ival = object ["start" .= f (ival ^. start), "end" .= f (ival ^. end)]
replacement in lib/Aftok/Interval.hs at line 65

[5.3425]→[5.3425:3471](∅→∅)

parseIntervalJSON :: Value -> Parser Interval

[5.3425]

[5.3471]

parseIntervalJSON :: (Ord t, FromJSON t) => Value -> Parser (Interval t)
edit in lib/Aftok/Json.hs at line 11

[5.273]→[5.68445:68481](∅→∅)

import qualified Aftok.Auction as A
edit in lib/Aftok/Json.hs at line 15

[5.68573]→[5.31668:31690](∅→∅),[5.31668]→[5.31668:31690](∅→∅),[5.31690]→[5.68574:68673](∅→∅)

import Aftok.Interval
import Aftok.Payments.Types
( PaymentId,
_PaymentId,
)
import qualified Aftok.Project as P
edit in lib/Aftok/Json.hs at line 22

[5.31905]→[5.31905:31940](∅→∅)

import qualified Control.Lens as L
edit in lib/Aftok/Json.hs at line 28

[5.32178]→[5.32178:32238](∅→∅)

import Data.List.NonEmpty as L
import Data.Map.Strict as MS
edit in lib/Aftok/Json.hs at line 30

[5.32390]→[5.32390:32433](∅→∅)

import Data.Thyme.Calendar (showGregorian)
edit in lib/Aftok/Json.hs at line 31

[5.32466]→[5.32466:32495](∅→∅)

import Data.Thyme.Time (Day)
replacement in lib/Aftok/Json.hs at line 55

[5.4310]→[5.21036:21142](∅→∅)

version :: MonadFail m => ByteString -> m Version
version = fromEitherM fail . PC.parseOnly versionParser

[5.4310]

[5.21142]

parseVersion :: MonadFail m => ByteString -> m Version
parseVersion = fromEitherM fail . PC.parseOnly versionParser
replacement in lib/Aftok/Json.hs at line 70

[5.4892]→[5.21479:21507](∅→∅)

ver <- version $ C.pack s

[5.4892]

[5.21507]

ver <- parseVersion $ C.pack s
edit in lib/Aftok/Json.hs at line 119

[5.21864]→[5.1699:1700](∅→∅),[5.1699]→[5.1699:1700](∅→∅),[5.1700]→[5.33600:33656](∅→∅),[5.4321]→[5.33340:33383](∅→∅),[5.33656]→[5.33340:33383](∅→∅),[5.33340]→[5.33340:33383](∅→∅),[5.411]→[5.485:486](∅→∅),[5.807]→[5.485:486](∅→∅),[5.1802]→[5.485:486](∅→∅),[5.2523]→[5.485:486](∅→∅),[5.2559]→[5.485:486](∅→∅),[5.5169]→[5.485:486](∅→∅),[5.5265]→[5.485:486](∅→∅),[5.33383]→[5.485:486](∅→∅),[5.485]→[5.485:486](∅→∅),[5.486]→[5.4322:4415](∅→∅),[5.4415]→[5.4232:4300](∅→∅),[5.1296]→[5.249:286](∅→∅),[5.4300]→[5.249:286](∅→∅),[5.4497]→[5.249:286](∅→∅),[5.33470]→[5.249:286](∅→∅),[5.1693]→[5.249:286](∅→∅),[5.286]→[5.1851:1897](∅→∅),[5.365]→[5.1693:1694](∅→∅),[5.1348]→[5.1693:1694](∅→∅),[5.1897]→[5.1693:1694](∅→∅),[5.1693]→[5.1693:1694](∅→∅),[5.1694]→[5.68674:68708](∅→∅),[5.68708]→[5.33657:33688](∅→∅),[5.5298]→[5.33657:33688](∅→∅),[5.33688]→[5.68709:68807](∅→∅),[5.68807]→[5.33782:33842](∅→∅),[5.33782]→[5.33782:33842](∅→∅),[5.33632]→[5.26515:26516](∅→∅),[5.33842]→[5.26515:26516](∅→∅),[5.1516]→[5.26515:26516](∅→∅),[5.26516]→[5.68808:68858](∅→∅),[5.68858]→[5.4498:4575](∅→∅),[5.26564]→[5.4498:4575](∅→∅),[5.1516]→[5.538:539](∅→∅),[5.4575]→[5.538:539](∅→∅),[5.26622]→[5.538:539](∅→∅),[5.538]→[5.538:539](∅→∅),[5.539]→[5.68859:68945](∅→∅),[5.1568]→[5.481:482](∅→∅),[5.1944]→[5.481:482](∅→∅),[5.68945]→[5.481:482](∅→∅),[5.481]→[5.481:482](∅→∅),[5.482]→[4.5819:5860](∅→∅),[4.5860]→[5.33843:33993](∅→∅),[5.68980]→[5.33843:33993](∅→∅),[5.571]→[5.33843:33993](∅→∅),[5.33993]→[4.5861:6099](∅→∅),[4.6099]→[5.34049:34057](∅→∅),[5.69040]→[5.34049:34057](∅→∅),[5.34049]→[5.34049:34057](∅→∅)

idJSON :: forall a. Text -> Getter a UUID -> a -> Value
idJSON t l a = v1 $ obj [t .= idValue l a]

qdbJSON :: Text -> Getter a UUID -> Getter a Value -> a -> Value
qdbJSON name _id _value x =
v1 $ obj [(name <> "Id") .= idValue _id x, name .= (x ^. _value)]

projectIdJSON :: ProjectId -> Value
projectIdJSON = idJSON "projectId" _ProjectId

projectJSON :: P.Project -> Value
projectJSON p =
v1 $
obj
[ "projectName" .= (p ^. P.projectName),
"inceptionDate" .= (p ^. P.inceptionDate),
"initiator" .= (p ^. P.initiator . _UserId)
]

qdbProjectJSON :: (ProjectId, P.Project) -> Value
qdbProjectJSON = qdbJSON "project" (_1 . _ProjectId) (_2 . L.to projectJSON)

auctionIdJSON :: A.AuctionId -> Value
auctionIdJSON = idJSON "auctionId" A._AuctionId

auctionJSON :: A.Auction Amount -> Value
auctionJSON x =
v1 $
obj
[ "projectId" .= idValue (A.projectId . _ProjectId) x,
"initiator" .= idValue (A.initiator . _UserId) x,
"name" .= (x ^. A.name),
"description" .= (x ^. A.description),
"raiseAmount" .= (x ^. (A.raiseAmount . to amountJSON)),
"auctionStart" .= (x ^. A.auctionStart),
"auctionEnd" .= (x ^. A.auctionEnd)
]
replacement in lib/Aftok/Json.hs at line 120

[5.484]→[5.69041:69127](∅→∅)

bidIdJSON :: A.BidId -> Value
bidIdJSON pid = v1 $ obj ["bidId" .= (pid ^. A._BidId)]

[5.484]

[5.21865]

identifiedJSON :: Text -> Getter a UUID -> Getter a Value -> a -> Value
identifiedJSON name _id _value x =
object [(name <> "Id") .= idValue _id x, name .= (x ^. _value)]
replacement in lib/Aftok/Json.hs at line 130

[5.69205]→[5.69205:69268](∅→∅)

v2 $ obj ["creditToAccount" .= idValue _AccountId accountId]

[5.69205]

[5.69268]

object ["creditToAccount" .= idValue _AccountId accountId]
replacement in lib/Aftok/Json.hs at line 132

[5.69302]→[5.34059:34110](∅→∅),[5.22188]→[5.34059:34110](∅→∅)

v2 $ obj ["creditToUser" .= idValue _UserId uid]

[5.69302]

[5.69303]

object ["creditToUser" .= idValue _UserId uid]
replacement in lib/Aftok/Json.hs at line 134

[5.69340]→[5.34111:34163](∅→∅),[5.22283]→[5.34111:34163](∅→∅),[5.34163]→[5.22337:22338](∅→∅),[5.22337]→[5.22337:22338](∅→∅),[5.22338]→[5.69341:69463](∅→∅),[5.69463]→[5.34257:34298](∅→∅),[5.22551]→[5.34257:34298](∅→∅)

v2 $ obj ["creditToProject" .= projectIdJSON pid]

parseCreditTo :: Value -> Parser CreditTo
parseCreditTo = unversion "CreditTo" $ \case
(Version 2 0) -> parseCreditToV2
ver -> badVersion "EventAmendment" ver

[5.69340]

[5.22602]

object ["creditToProject" .= idValue _ProjectId pid]
edit in lib/Aftok/Json.hs at line 160

[5.23920]→[5.23920:23934](∅→∅),[5.1389]→[5.580:581](∅→∅),[5.2079]→[5.580:581](∅→∅),[5.23934]→[5.580:581](∅→∅),[5.2561]→[5.580:581](∅→∅),[5.581]→[5.69883:69951](∅→∅),[5.69951]→[5.35611:35618](∅→∅),[5.35478]→[5.35611:35618](∅→∅),[5.35618]→[5.69952:70004](∅→∅),[5.70004]→[5.35691:35719](∅→∅),[5.35691]→[5.35691:35719](∅→∅),[5.35719]→[5.70005:70127](∅→∅),[5.70127]→[5.35793:35852](∅→∅),[5.35793]→[5.35793:35852](∅→∅),[5.35852]→[5.24497:24498](∅→∅),[5.35923]→[5.24497:24498](∅→∅),[5.24497]→[5.24497:24498](∅→∅),[5.24498]→[5.70128:70225](∅→∅),[5.70225]→[5.35986:35994](∅→∅),[5.35986]→[5.35986:35994](∅→∅),[5.35994]→[5.70226:70281](∅→∅),[5.70281]→[5.36196:36254](∅→∅),[5.36196]→[5.36196:36254](∅→∅),[5.36254]→[5.35954:35970](∅→∅),[5.35954]→[5.35954:35970](∅→∅),[5.35970]→[5.70282:70340](∅→∅),[5.70340]→[5.36034:36073](∅→∅),[5.36034]→[5.36034:36073](∅→∅),[5.36073]→[5.36255:36412](∅→∅),[5.36185]→[5.24755:24756](∅→∅),[5.36412]→[5.24755:24756](∅→∅),[5.24755]→[5.24755:24756](∅→∅),[5.1905]→[5.24800:24803](∅→∅)

-- Payouts
--

payoutsJSON :: FractionalPayouts -> Value
payoutsJSON (Payouts m) =
v2 $
let payoutsRec :: (CreditTo, Rational) -> Value
payoutsRec (c, r) =
object ["creditTo" .= creditToJSON c, "payoutRatio" .= r, "payoutPercentage" .= (fromRational @Double r * 100)]
in obj $ ["payouts" .= fmap payoutsRec (MS.assocs m)]

parsePayoutsJSON :: Value -> Parser FractionalPayouts
parsePayoutsJSON = unversion "Payouts" $ p
where
p :: Version -> Object -> Parser FractionalPayouts
p (Version 2 0) val =
let parsePayoutRecord x =
(,)
<$> (parseCreditToV2 =<< (x .: "creditTo"))
<*> (x .: "payoutRatio")
in Payouts
. MS.fromList
<$> (traverse parsePayoutRecord =<< parseJSON (Object val))
p ver x = badVersion "Payouts" ver x

--
edit in lib/Aftok/Json.hs at line 163

[5.24820]→[5.70341:70410](∅→∅),[5.70410]→[5.36452:36522](∅→∅),[5.36452]→[5.36452:36522](∅→∅),[5.36522]→[5.70411:70465](∅→∅),[5.70465]→[5.36597:36631](∅→∅),[5.36597]→[5.36597:36631](∅→∅),[5.36631]→[5.70466:70506](∅→∅),[5.70506]→[5.36677:36742](∅→∅),[5.36677]→[5.36677:36742](∅→∅),[5.1264]→[5.2061:2094](∅→∅),[5.1625]→[5.2061:2094](∅→∅),[5.2201]→[5.2061:2094](∅→∅),[5.3969]→[5.2061:2094](∅→∅),[5.4602]→[5.2061:2094](∅→∅),[5.4849]→[5.2061:2094](∅→∅),[5.36570]→[5.2061:2094](∅→∅),[5.36742]→[5.2061:2094](∅→∅),[5.2061]→[5.2061:2094](∅→∅),[5.2094]→[5.2158:2198](∅→∅),[5.2198]→[5.130:131](∅→∅),[5.1799]→[5.130:131](∅→∅),[5.131]→[5.1405:1440](∅→∅),[5.1440]→[5.36571:36659](∅→∅),[5.1530]→[5.254:255](∅→∅),[5.36659]→[5.254:255](∅→∅),[5.254]→[5.254:255](∅→∅),[5.255]→[5.70507:70588](∅→∅),[5.70588]→[5.4909:4910](∅→∅),[5.4909]→[5.4909:4910](∅→∅),[5.4910]→[5.70589:70695](∅→∅),[5.70695]→[5.36783:36837](∅→∅),[5.36783]→[5.36783:36837](∅→∅),[5.36837]→[5.36800:36804](∅→∅),[5.36800]→[5.36800:36804](∅→∅),[5.5216]→[5.5216:5217](∅→∅),[5.5217]→[5.5560:5600](∅→∅),[5.5560]→[5.5560:5600](∅→∅),[5.5600]→[5.2199:2251](∅→∅),[5.2251]→[5.26623:26624](∅→∅)

workIndexJSON :: WorkIndex -> Value
workIndexJSON (WorkIndex widx) =
v2 $
obj ["workIndex" .= fmap widxRec (MS.assocs widx)]
where
widxRec :: (CreditTo, NonEmpty Interval) -> Value
widxRec (c, l) =
object
[ "creditTo" .= creditToJSON c,
"intervals" .= (intervalJSON <$> L.toList l)
]

eventIdJSON :: EventId -> Value
eventIdJSON = idJSON "eventId" _EventId

logEventJSON' :: LogEvent -> Value
logEventJSON' ev =
object [eventName ev .= object ["eventTime" .= (ev ^. eventTime)]]

logEntryJSON :: LogEntry -> Value
logEntryJSON le = v2 $ obj (logEntryFields le)

logEntryFields :: LogEntry -> [Pair]
logEntryFields (LogEntry c ev m) =
[ "creditTo" .= creditToJSON c,
"event" .= logEventJSON' ev,
"eventMeta" .= m
]

amendmentIdJSON :: AmendmentId -> Value
amendmentIdJSON = idJSON "amendmentId" _AmendmentId
edit in lib/Aftok/Json.hs at line 175

[4.6483]→[4.6483:6484](∅→∅),[4.6484]→[5.26624:26715](∅→∅),[5.70883]→[5.26624:26715](∅→∅),[5.26624]→[5.26624:26715](∅→∅)

billableIdJSON :: B.BillableId -> Value
billableIdJSON = idJSON "billableId" B._BillableId
replacement in lib/Aftok/Json.hs at line 192

[5.4621]→[5.4621:4686](∅→∅)

qdbJSON "billable" (_1 . B._BillableId) (_2 . to billableJSON)

[5.4621]

[5.1844]

identifiedJSON "billable" (_1 . B._BillableId) (_2 . to billableJSON)
edit in lib/Aftok/Json.hs at line 201

[5.5682]→[5.2309:2374](∅→∅),[5.2374]→[5.37381:37573](∅→∅),[5.37432]→[5.3189:3279](∅→∅),[5.37573]→[5.3189:3279](∅→∅),[5.629]→[5.3189:3279](∅→∅),[5.3279]→[5.629:630](∅→∅),[5.629]→[5.629:630](∅→∅),[5.630]→[5.3280:3359](∅→∅),[5.3359]→[5.37574:37769](∅→∅),[5.37564]→[5.3557:3562](∅→∅),[5.37769]→[5.3557:3562](∅→∅),[5.3557]→[5.3557:3562](∅→∅),[5.3562]→[5.26837:26949](∅→∅),[5.26949]→[5.71244:71680](∅→∅),[5.37921]→[5.26950:27033](∅→∅),[5.38380]→[5.26950:27033](∅→∅),[5.71680]→[5.26950:27033](∅→∅),[5.4377]→[5.26950:27033](∅→∅),[5.27033]→[5.4377:4378](∅→∅),[5.4377]→[5.4377:4378](∅→∅)

createSubscriptionJSON :: UserId -> B.BillableId -> Day -> Value
createSubscriptionJSON uid bid d =
v1 $
obj
[ "user_id" .= idValue _UserId uid,
"billable_id" .= idValue B._BillableId bid,
"start_date" .= showGregorian d
]

subscriptionJSON :: B.Subscription -> Value
subscriptionJSON = v1 . obj . subscriptionKV

subscriptionKV :: (KeyValue kv) => B.Subscription -> [kv]
subscriptionKV sub =
[ "user_id" .= idValue (B.customer . _UserId) sub,
"billable_id" .= idValue (B.billable . B._BillableId) sub,
"start_time" .= view B.startTime sub,
"end_time" .= view B.endTime sub
]

subscriptionIdJSON :: B.SubscriptionId -> Value
subscriptionIdJSON = idJSON "subscriptionId" B._SubscriptionId

-- paymentRequestDetailsJSON :: [PaymentRequestDetail Amount] -> Value
-- paymentRequestDetailsJSON r = v1 $ obj ["payment_requests" .= fmap paymentRequestDetailJSON r]
--
-- paymentRequestDetailJSON :: PaymentRequestDetail Amount -> Object
-- paymentRequestDetailJSON r = obj $ concat
-- [ ["payment_request_id" .= view () r]
-- , paymentRequestKV $ view _2 r
-- , subscriptionKV $ view _3 r
-- , billableKV $ view _4 r
-- ]

paymentIdJSON :: PaymentId -> Value
paymentIdJSON = idJSON "paymentId" _PaymentId
edit in lib/Aftok/Json.hs at line 212

[5.25424]→[5.5639:5640](∅→∅),[5.3752]→[5.5639:5640](∅→∅),[5.5640]→[5.38853:38876](∅→∅),[5.38893]→[5.38893:38917](∅→∅),[5.38917]→[5.71681:71760](∅→∅),[5.71760]→[5.39025:39033](∅→∅),[5.39025]→[5.39025:39033](∅→∅),[5.39033]→[5.71761:71807](∅→∅),[5.71807]→[5.39137:39181](∅→∅),[5.39137]→[5.39137:39181](∅→∅),[5.2211]→[5.1956:1957](∅→∅),[5.3983]→[5.1956:1957](∅→∅),[5.39181]→[5.1956:1957](∅→∅),[5.1956]→[5.1956:1957](∅→∅),[5.2513]→[5.39698:39723](∅→∅),[5.39740]→[5.39740:39765](∅→∅),[5.39765]→[5.71808:71906](∅→∅),[5.71906]→[5.39882:39944](∅→∅),[5.39882]→[5.39882:39944](∅→∅),[5.39944]→[5.71907:71978](∅→∅),[5.71978]→[5.40021:40217](∅→∅),[5.40021]→[5.40021:40217](∅→∅)

parseEventAmendment ::
ModTime ->
Value ->
Parser EventAmendment
parseEventAmendment t = unversion "EventAmendment" $ p
where
p (Version 2 0) = parseEventAmendmentV2 t
p ver = badVersion "EventAmendment" ver

parseEventAmendmentV2 ::
ModTime ->
Object ->
Parser EventAmendment
parseEventAmendmentV2 t o =
let parseA :: Text -> Parser EventAmendment
parseA "timeChange" = TimeChange t <$> o .: "eventTime"
parseA "creditToChange" = CreditToChange t <$> parseCreditToV2 o
parseA "metadataChange" = MetadataChange t <$> o .: "eventMeta"
parseA tid =
fail . T.unpack $ "Amendment type " <> tid <> " not recognized."
in o .: "amendment" >>= parseA
replacement in lib/Aftok/Json.hs at line 218

[5.72010]→[5.72010:72055](∅→∅)

parseLogEntry uid f = unversion "LogEntry" p

[5.72010]

[5.40407]

parseLogEntry uid f = withObject "LogEntry" p
replacement in lib/Aftok/Json.hs at line 220

[5.40415]→[5.40415:40442](∅→∅)

p (Version 2 0) o = do

[5.40415]

[5.72056]

p o = do
edit in lib/Aftok/Json.hs at line 224

[5.40673]→[5.40673:40715](∅→∅),[5.191]→[5.664:665](∅→∅),[5.407]→[5.664:665](∅→∅),[5.40715]→[5.664:665](∅→∅),[5.664]→[5.664:665](∅→∅),[5.3227]→[5.27467:27516](∅→∅),[5.27516]→[5.26796:26816](∅→∅),[5.26816]→[5.40716:41286](∅→∅),[5.28064]→[5.3264:3265](∅→∅),[5.39875]→[5.3264:3265](∅→∅),[5.41286]→[5.3264:3265](∅→∅),[5.988]→[5.3264:3265](∅→∅),[5.3265]→[5.28065:28114](∅→∅),[5.28114]→[4.6485:6609](∅→∅)

p ver o = badVersion "LogEntry" ver o

parseRecurrence :: Object -> Parser B.Recurrence
parseRecurrence o =
let parseAnnually o' = const (pure B.Annually) <$> O.lookup "annually" o'
parseMonthly o' = fmap B.Monthly . parseJSON <$> O.lookup "monthly" o'
parseWeekly o' = fmap B.Weekly . parseJSON <$> O.lookup "weekly" o'
parseOneTime o' = const (pure B.OneTime) <$> O.lookup "one-time" o'
notFound =
fail $ "Value " <> show o <> " does not represent a Recurrence value."
parseV val =
parseAnnually val
<|> parseMonthly val
<|> parseWeekly val
<|> parseOneTime val
in fromMaybe notFound $ parseV o

parseRecurrence' :: Value -> Parser B.Recurrence
parseRecurrence' = \case
(Object o) -> parseRecurrence o
val -> fail $ "Value " <> show val <> " is not a JSON object."
edit in lib/Aftok/TimeLog.hs at line 3

[5.50408]

[5.883]

{-# LANGUAGE ViewPatterns #-}
replacement in lib/Aftok/TimeLog.hs at line 7

[5.50428]→[5.50428:50468](∅→∅)

creditTo,
event,
eventMeta,

[5.50428]

[5.50468]

HasLogEntry (..),
edit in lib/Aftok/TimeLog.hs at line 13

[5.50588]

[5.50588]

_StartWork,
_StopWork,
edit in lib/Aftok/TimeLog.hs at line 40

[5.50972]→[5.50972:51001](∅→∅)

import Control.Arrow ((&&&))
edit in lib/Aftok/TimeLog.hs at line 44

[5.51094]→[5.51094:51183](∅→∅)

import Data.Either
( Either (..),
rights,
)
import Data.Eq
( (==),
Eq,
)
replacement in lib/Aftok/TimeLog.hs at line 45

[5.51209]→[5.51209:51506](∅→∅)

import Data.Function
( ($),
(.),
id,
)
import Data.Functor (fmap)
import Data.Heap as H
import Data.List.NonEmpty as L
import Data.Map.Strict as MS
import Data.Maybe (Maybe (..))
import Data.Ord
( Ord (..),
Ordering (..),
)
import Data.Ratio (Rational)
import Data.Text (Text)

[5.51209]

[5.51506]

import qualified Data.Map.Strict as MS
replacement in lib/Aftok/TimeLog.hs at line 47

[5.51535]→[5.51535:51637](∅→∅)

import Data.UUID
import Data.VectorSpace
import Text.Show (Show)
import Prelude
( (*),
(/),
)

[5.51535]

[5.31286]

import Data.UUID (UUID)
import Data.VectorSpace ((*^), Sum (..), (^+^), (^-^), getSum, zeroV)
import Prelude hiding (Sum, getSum)
replacement in lib/Aftok/TimeLog.hs at line 57

[5.51834]→[5.31510:31551](∅→∅),[5.31510]→[5.31510:31551](∅→∅)

type DepF = C.UTCTime -> Interval -> NDT

[5.51834]

[5.31551]

type DepF = C.UTCTime -> Interval C.UTCTime -> NDT
edit in lib/Aftok/TimeLog.hs at line 63

[5.51952]

[5.51952]

makePrisms ''LogEvent
replacement in lib/Aftok/TimeLog.hs at line 93

[5.52423]→[5.4239:4261](∅→∅),[5.637]→[5.4239:4261](∅→∅)

makeLenses ''LogEntry

[5.52423]

[5.213]

makeClassy ''LogEntry
replacement in lib/Aftok/TimeLog.hs at line 100

[5.1725]→[5.6669:6720](∅→∅)

newtype EventId = EventId UUID deriving (Show, Eq)

[5.1725]

[5.52465]

newtype EventId = EventId UUID deriving (Show, Eq, Ord)
replacement in lib/Aftok/TimeLog.hs at line 113

[5.6878]→[5.6878:6937](∅→∅)

newtype AmendmentId = AmendmentId UUID deriving (Show, Eq)

[5.6878]

[5.52469]

newtype AmendmentId = AmendmentId UUID deriving (Show, Eq, Ord)
replacement in lib/Aftok/TimeLog.hs at line 123

[5.90622]→[5.90622:90707](∅→∅)

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

[5.90622]

[5.52473]

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

[5.52658]→[5.16169:16238](∅→∅),[5.1422]→[5.16169:16238](∅→∅),[5.16238]→[5.9530:9600](∅→∅),[5.1502]→[5.9530:9600](∅→∅)

workCredit :: (Foldable f) => DepF -> C.UTCTime -> f Interval -> NDT
workCredit df ptime ivals = getSum $ F.foldMap (Sum . df ptime) ivals

[5.52658]

[5.1576]

workCredit :: (Foldable f, HasLogEntry le) => DepF -> C.UTCTime -> f (Interval le) -> NDT
workCredit df ptime ivals = getSum $ F.foldMap (Sum . df ptime . fmap (view $ event . eventTime)) ivals
replacement in lib/Aftok/TimeLog.hs at line 141

[5.90753]→[5.90753:90816](∅→∅)

payouts :: DepF -> C.UTCTime -> WorkIndex -> FractionalPayouts

[5.90753]

[5.4834]

payouts :: forall le. (HasLogEntry le) => DepF -> C.UTCTime -> WorkIndex le -> FractionalPayouts
replacement in lib/Aftok/TimeLog.hs at line 143

[5.4871]→[5.16239:16312](∅→∅)

let addIntervalDiff :: (Foldable f) => NDT -> f Interval -> (NDT, NDT)

[5.4871]

[5.12318]

let addIntervalDiff :: (Foldable f) => NDT -> f (Interval le) -> (NDT, NDT)
replacement in lib/Aftok/TimeLog.hs at line 149

[5.1582]→[5.90817:90868](∅→∅),[5.3156]→[5.4957:4980](∅→∅),[5.12496]→[5.4957:4980](∅→∅),[5.32225]→[5.4957:4980](∅→∅),[5.53058]→[5.4957:4980](∅→∅),[5.90868]→[5.4957:4980](∅→∅),[5.4396]→[5.4957:4980](∅→∅),[5.4980]→[5.1403:1461](∅→∅),[5.4420]→[5.1403:1461](∅→∅)

workIndex :: Foldable f => f LogEntry -> WorkIndex
workIndex logEntries =
let sortedEntries = F.foldr H.insert H.empty logEntries

[5.1582]

[5.53059]

workIndex :: (Foldable f, HasLogEntry le, Ord o) => (le -> o) -> f le -> WorkIndex le
workIndex cmp logEntries =
let sortedEntries = sortWith cmp $ toList logEntries
replacement in lib/Aftok/TimeLog.hs at line 155

[5.90889]→[5.53162:53200](∅→∅),[5.53162]→[5.53162:53200](∅→∅),[5.53200]→[5.90890:90975](∅→∅)

[Either LogEvent Interval] ->
Map CreditTo (NonEmpty Interval) ->
Map CreditTo (NonEmpty Interval)

[5.90889]

[5.4981]

[Either le (Interval le)] ->
Map CreditTo (NonEmpty (Interval le)) ->
Map CreditTo (NonEmpty (Interval le))
replacement in lib/Aftok/TimeLog.hs at line 167

[5.53573]→[5.90976:91032](∅→∅)

type RawIndex = Map CreditTo [Either LogEvent Interval]

[5.53573]

[5.2169]

type RawIndex le = Map CreditTo [Either le (Interval le)]
replacement in lib/Aftok/TimeLog.hs at line 169

[5.2170]→[5.91033:91084](∅→∅),[5.32357]→[5.5030:5069](∅→∅),[5.91084]→[5.5030:5069](∅→∅),[5.2117]→[5.5030:5069](∅→∅),[5.5069]→[5.12738:12804](∅→∅),[5.12804]→[5.53574:53649](∅→∅),[5.53649]→[5.12880:12978](∅→∅),[5.12880]→[5.12880:12978](∅→∅),[5.12978]→[5.53650:53773](∅→∅),[5.53773]→[5.2490:2655](∅→∅),[5.2490]→[5.2490:2655](∅→∅),[5.2655]→[5.53774:53846](∅→∅),[5.53846]→[5.13201:13244](∅→∅),[5.13201]→[5.13201:13244](∅→∅),[5.13244]→[5.2752:2782](∅→∅),[5.2752]→[5.2752:2782](∅→∅)

appendLogEntry :: RawIndex -> LogEntry -> RawIndex
appendLogEntry idx (LogEntry k ev _) =
let combine :: LogEvent -> LogEvent -> Either LogEvent Interval
combine (StartWork t) (StopWork t') | t' > t = Right $ Interval t t'
combine (e1@(StartWork _)) (e2@(StartWork _)) = Left $ max e1 e2 -- ignore redundant starts
combine (e1@(StopWork _)) (e2@(StopWork _)) = Left $ min e1 e2 -- ignore redundant ends
combine _ e2 = Left e2
-- if the interval includes the timestamp of a start event, then allow the extension of the interval
extension :: Interval -> LogEvent -> Maybe LogEvent
extension ival (StartWork t)
| containsInclusive t ival =
Just $ StartWork (ival ^. start)
extension _ _ = Nothing

[5.2170]

[5.1003]

appendLogEntry ::
forall le.
HasLogEntry le =>
RawIndex le ->
le ->
RawIndex le
appendLogEntry idx logEvent =
let k = logEvent ^. logEntry . creditTo
replacement in lib/Aftok/TimeLog.hs at line 180

[5.5126]→[5.2915:3056](∅→∅),[5.2915]→[5.2915:3056](∅→∅)

Just (Right ival : xs) -> case extension ival ev of
Just e' -> Left e' : xs
Nothing -> Left ev : Right ival : xs

[5.5126]

[5.3056]

Just (Right ival : xs) ->
case extension (view (event . eventTime) <$> ival) logEvent of
Just e' -> Left e' : xs
Nothing -> Left logEvent : Right ival : xs
replacement in lib/Aftok/TimeLog.hs at line 185

[5.3118]→[5.1041:1093](∅→∅),[5.1041]→[5.1041:1093](∅→∅),[5.1093]→[5.53847:53870](∅→∅)

Just (Left ev' : xs) -> combine ev' ev : xs
_ -> [Left ev]

[5.3118]

[5.53870]

Just (Left ev' : xs) ->
combine ev' logEvent : xs
_ -> [Left logEvent]
edit in lib/Aftok/TimeLog.hs at line 189

[5.53898]

[5.22]

where
combine :: le -> le -> Either le (Interval le)
combine e e' = case (e ^. event, e' ^. event) of
(StartWork t, StopWork t') | t' > t -> Right $ Interval e e' -- complete interval found
(StartWork t, StartWork t') -> Left $ if t > t' then e else e' -- ignore redundant starts
(StopWork t, StopWork t') -> Left $ if t <= t' then e else e' -- ignore redundant ends
_ -> Left e'
-- if the interval includes the timestamp of a start event, then allow the extension of the interval
extension :: (Interval C.UTCTime) -> le -> Maybe le
extension ival newEvent@(view event -> StartWork t)
| containsInclusive t ival =
Just newEvent -- replace the end of the interval with the new event
extension _ _ =
Nothing
file addition: 2021-01-16_05-04-32_event-replacement.txt (----------)

[94.1]

Description: (Describe migration here.)
Created: 2021-01-16 05:04:54.586280477 UTC
Depends: 2017-06-08_04-37-31_event-metadata-ids 2016-10-14_02-49-36_event-amendments
Apply: |
CREATE TYPE amendment_t AS ENUM ('amend_event_time', 'amend_credit_to', 'amend_metadata');
ALTER TABLE work_events ADD COLUMN replacement_id uuid REFERENCES work_events(id);
ALTER TABLE work_events ADD COLUMN amended_by_type amendment_t;
ALTER TABLE work_events ADD COLUMN amended_by_id uuid;
file addition: amend.sh (---r------)

[5.1220]

#!/bin/bash

if [ -f ".env" ]; then
source .env
fi

if [ -z "${AFTOK_HOST}" ]; then
AFTOK_HOST="aftok.com"
fi

if [ -z "${USER}" ]; then
read -p "Username: " USER
echo
fi

read -p "Event ID: " EID

while [ -z "${ATYPE}" ]
do
read -p "Amendment Type: " ATYPE
case $ATYPE in
# "CREDIT_TO")
# AVALUE="creditToChange"
# read -p "Raise amount, in Bitcoin satoshis: " AMOUNT
# ;;
"TIME")
AVALUE="timeChange"
read -p "Event Timestamp (yyyy-MM-ddTHH:mm:ssZ): " ATIME
;;
*)
echo "$ATYPE is not a amendment type. Please choose \"TIME\"" # or \"CREDIT_TO\""
ATYPE=""
;;
esac
done

BODY=$(cat <<END_BODY
{
"schemaVersion": "2.0",
"amendment": "timeChange",
"eventTime": "$ATIME"
}
END_BODY
)

curl --verbose \
${ALLOW_INSECURE} \
--user $USER \
--header "Content-Type: application/json" \
--request PUT \
--data "$BODY" \
"https://$AFTOK_HOST/api/events/$EID/amend"
file addition: create_auction.sh (---r------)

[5.1220]

#!/bin/bash

if [ -f ".env" ]; then
source .env
fi

if [ -z "${AFTOK_HOST}" ]; then
AFTOK_HOST="aftok.com"
fi

if [ -z "${PID}" ]; then
read -p "Project UUID: " PID
echo
fi

if [ -z "${USER}" ]; then
read -p "Username: " USER
echo
fi

read -p "Auction Name: " NAME
read -p "Description: " DESC
while [ -z "${CCY}" ]
do
read -p "Currency: " CCY
case $CCY in
"BTC")
CCY="satoshi"
read -p "Raise amount, in Bitcoin satoshis: " AMOUNT
;;
"ZEC")
CCY="zatoshi"
read -p "Raise amount, in Zcash zatoshis: " AMOUNT
;;
*)
echo "$CCY is not a supported currency. Please choose \"BTC\" or \"ZEC\""
CCY=""
;;
esac
done
echo
read -p "Auction start date (yyyy-MM-ddThh:mm:ssZ): " START
read -p "Auction end date (yyyy-MM-ddThh:mm:ssZ): " END

BODY=$(cat <<END_BODY
{
"auction_name": "$NAME",
"auction_desc": "$DESC",
"raise_amount": {
"$CCY": $AMOUNT
},
"auction_start": "$START",
"auction_end": "$END"
}
END_BODY
)

curl --verbose \
${ALLOW_INSECURE} \
--user $USER \
--header "Content-Type: application/json" \
--data "$BODY" \
"https://$AFTOK_HOST/api/projects/$PID/auctions"
edit in server/Aftok/Snaplet/Auctions.hs at line 8

[4.6932]

[5.45333]

auctionJSON,
bidIdJSON,
replacement in server/Aftok/Snaplet/Auctions.hs at line 14

[5.57395]→[5.57395:57413](∅→∅)

( Auction (..),

[5.57395]

[5.57413]

( Auction (Auction),
replacement in server/Aftok/Snaplet/Auctions.hs at line 16

[5.57428]→[5.57428:57442](∅→∅)

Bid (..),

[5.57428]

[5.57442]

Bid (Bid),
edit in server/Aftok/Snaplet/Auctions.hs at line 18

[5.57453]

[5.57453]

_BidId,
auctionEnd,
auctionStart,
description,
initiator,
name,
projectId,
raiseAmount,
replacement in server/Aftok/Snaplet/Auctions.hs at line 39

[4.7078]→[5.57599:57627](∅→∅),[5.57599]→[5.57599:57627](∅→∅)

import Aftok.Types (UserId)

[4.7078]

[5.57627]

import Aftok.Types (UserId, _ProjectId, _UserId)
edit in server/Aftok/Snaplet/Auctions.hs at line 41

[5.57658]

[5.57692]

import Control.Lens ((^.), to)
replacement in server/Aftok/Snaplet/Auctions.hs at line 51

[4.7112]→[4.7112:7267](∅→∅)

{ name :: Text,
description :: Maybe Text,
raiseAmount :: Amount,
auctionStart :: C.UTCTime,
auctionEnd :: C.UTCTime

[4.7112]

[4.7267]

{ acrName :: Text,
acrDescription :: Maybe Text,
acrRaiseAmount :: Amount,
acrAuctionStart :: C.UTCTime,
acrAuctionEnd :: C.UTCTime
replacement in server/Aftok/Snaplet/Auctions.hs at line 92

[4.7642]→[4.7642:7709](∅→∅),[4.7709]→[5.58549:58597](∅→∅),[5.58549]→[5.58549:58597](∅→∅)

(name req)
(description req)
(raiseAmount $ req)
(auctionStart req)
(auctionEnd req)

[4.7642]

[5.2809]

(acrName req)
(acrDescription req)
(acrRaiseAmount $ req)
(acrAuctionStart req)
(acrAuctionEnd req)
edit in server/Aftok/Snaplet/Auctions.hs at line 124

[5.1576]

auctionJSON :: Auction Amount -> Value
auctionJSON x =
v1 $
obj
[ "projectId" .= idValue (projectId . _ProjectId) x,
"initiator" .= idValue (initiator . _UserId) x,
"name" .= (x ^. name),
"description" .= (x ^. description),
"raiseAmount" .= (x ^. (raiseAmount . to amountJSON)),
"auctionStart" .= (x ^. auctionStart),
"auctionEnd" .= (x ^. auctionEnd)
]

bidIdJSON :: BidId -> Value
bidIdJSON pid = v1 $ obj ["bidId" .= (pid ^. _BidId)]
replacement in server/Aftok/Snaplet/Billing.hs at line 10

[5.33876]→[5.60129:60150](∅→∅)

import Aftok.Billing

[5.33876]

[5.100280]

import Aftok.Billing as B
edit in server/Aftok/Snaplet/Billing.hs at line 27

[5.60431]

[5.60431]

import qualified Data.HashMap.Strict as O
edit in server/Aftok/Snaplet/Billing.hs at line 76

[5.35830]

-- subscriptionJSON :: B.Subscription -> Value
-- subscriptionJSON = v1 . obj . subscriptionKV
--
-- subscriptionKV :: (KeyValue kv) => B.Subscription -> [kv]
-- subscriptionKV sub =
-- [ "user_id" .= idValue (B.customer . _UserId) sub,
-- "billable_id" .= idValue (B.billable . B._BillableId) sub,
-- "start_time" .= view B.startTime sub,
-- "end_time" .= view B.endTime sub
-- ]

-- paymentRequestDetailsJSON :: [PaymentRequestDetail Amount] -> Value
-- paymentRequestDetailsJSON r = v1 $ obj ["payment_requests" .= fmap paymentRequestDetailJSON r]
--
-- paymentRequestDetailJSON :: PaymentRequestDetail Amount -> Object
-- paymentRequestDetailJSON r = obj $ concat
-- [ ["payment_request_id" .= view () r]
-- , paymentRequestKV $ view _2 r
-- , subscriptionKV $ view _3 r
-- , billableKV $ view _4 r
-- ]

parseRecurrence :: Object -> Parser B.Recurrence
parseRecurrence o =
let parseAnnually o' = const (pure B.Annually) <$> O.lookup "annually" o'
parseMonthly o' = fmap B.Monthly . parseJSON <$> O.lookup "monthly" o'
parseWeekly o' = fmap B.Weekly . parseJSON <$> O.lookup "weekly" o'
parseOneTime o' = const (pure B.OneTime) <$> O.lookup "one-time" o'
notFound =
fail $ "Value " <> show o <> " does not represent a Recurrence value."
parseV val =
parseAnnually val
<|> parseMonthly val
<|> parseWeekly val
<|> parseOneTime val
in fromMaybe notFound $ parseV o

parseRecurrence' :: Value -> Parser B.Recurrence
parseRecurrence' = \case
(Object o) -> parseRecurrence o
val -> fail $ "Value " <> show val <> " is not a JSON object."
file addition: Json.hs (----------)

[5.2082]

module Aftok.Snaplet.Json
( idJSON,
)
where

import Aftok.Json (idValue, obj, v1)
import Control.Lens (Getter)
import Data.Aeson ((.=), Value)
import Data.UUID (UUID)

idJSON :: forall a. Text -> Getter a UUID -> a -> Value
idJSON t l a = v1 $ obj [t .= idValue l a]
edit in server/Aftok/Snaplet/Projects.hs at line 11

[3.1377]

[5.52743]

projectJSON,
qdbProjectJSON,
replacement in server/Aftok/Snaplet/Projects.hs at line 18

[5.63503]→[3.1378:1406](∅→∅)

import Aftok.Json (idValue)

[5.63503]

[5.63503]

import Aftok.Json (idValue, identifiedJSON, obj, v1)
replacement in server/Aftok/Snaplet/Projects.hs at line 26

[5.63698]→[3.1407:1434](∅→∅)

import Control.Lens ((^.))

[5.63698]

[5.63718]

import Control.Lens ((^.), _1, _2, to)
edit in server/Aftok/Snaplet/Projects.hs at line 140

[5.65787]

projectJSON :: Project -> Value
projectJSON p =
v1 $
obj
[ "projectName" .= (p ^. projectName),
"inceptionDate" .= (p ^. inceptionDate),
"initiator" .= (p ^. initiator . _UserId)
]

qdbProjectJSON :: (ProjectId, Project) -> Value
qdbProjectJSON = identifiedJSON "project" (_1 . _ProjectId) (_2 . to projectJSON)
edit in server/Aftok/Snaplet/WorkLog.hs at line 1

[5.5424]

[5.70182]

{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE TemplateHaskell #-}
edit in server/Aftok/Snaplet/WorkLog.hs at line 4

[5.70213]

[5.5728]

{-# LANGUAGE TypeApplications #-}
edit in server/Aftok/Snaplet/WorkLog.hs at line 9

[5.70358]

[5.70380]

import Aftok.Interval
( Interval (..),
intervalJSON,
)
edit in server/Aftok/Snaplet/WorkLog.hs at line 19

[5.70513]

[5.70513]

( AmendmentId,
EventAmendment (..),
EventId (..),
FractionalPayouts,
LogEntry (LogEntry),
LogEvent,
ModTime (..),
Payouts (..),
WorkIndex (..),
_AmendmentId,
_EventId,
eventName,
eventTime,
payouts,
toDepF,
workIndex,
)
replacement in server/Aftok/Snaplet/WorkLog.hs at line 37

[5.70532]→[5.70532:70548](∅→∅)

( _ProjectId,

[5.70532]

[5.70548]

( CreditTo (..),
UserId,
ProjectId,
_ProjectId,
replacement in server/Aftok/Snaplet/WorkLog.hs at line 44

[5.70596]→[5.70596:70623](∅→∅)

import Control.Lens ((^.))

[5.70596]

[5.70623]

import Control.Lens ((^.), view)
replacement in server/Aftok/Snaplet/WorkLog.hs at line 46

[5.70668]→[5.70668:70765](∅→∅)

import Data.Aeson ((.=))
import qualified Data.Aeson as A
import qualified Data.Aeson.Types as A

[5.70668]

[5.70765]

import Data.Aeson ((.:), (.=), Value (Object), eitherDecode, object)
import Data.Aeson.Types (Pair, Parser, parseEither)
import qualified Data.List.NonEmpty as L
import qualified Data.Map.Strict as MS
edit in server/Aftok/Snaplet/WorkLog.hs at line 56

[5.5831]

[5.70947]

----------------------
-- Handlers
----------------------
replacement in server/Aftok/Snaplet/WorkLog.hs at line 62

[5.70994]→[5.104017:104062](∅→∅)

S.Handler App App (EventId, KeyedLogEntry)

[5.70994]

[5.10122]

S.Handler App App (ProjectId, UserId, KeyedLogEntry)
replacement in server/Aftok/Snaplet/WorkLog.hs at line 68

[5.71162]→[5.104063:104146](∅→∅)

case (A.eitherDecode requestBody >>= A.parseEither (parseLogEntry uid evCtr)) of

[5.71162]

[5.71253]

case (eitherDecode requestBody >>= parseEither (parseLogEntry uid evCtr)) of
replacement in server/Aftok/Snaplet/WorkLog.hs at line 82

[5.71572]→[5.71572:71596](∅→∅)

(pure . (eid,))

[5.71572]

[5.71596]

pure
replacement in server/Aftok/Snaplet/WorkLog.hs at line 85

[5.6348]→[5.104147:104195](∅→∅)

projectWorkIndex :: S.Handler App App WorkIndex

[5.6348]

[5.14852]

amendEventHandler :: S.Handler App App (EventId, AmendmentId)
amendEventHandler = do
uid <- requireUserId
eventIdBytes <- getParam "eventId"
eventId <-
maybe
(snapError 400 "eventId parameter is required")
(pure . EventId)
(eventIdBytes >>= U.fromASCIIBytes)
modTime <- ModTime <$> liftIO C.getCurrentTime
requestJSON <- readRequestJSON 4096
either
(snapError 400 . T.pack)
(snapEval . amendEvent uid eventId)
(parseEither (parseEventAmendment modTime) requestJSON)

projectWorkIndex :: S.Handler App App (WorkIndex KeyedLogEntry)
replacement in server/Aftok/Snaplet/WorkLog.hs at line 107

[5.6632]→[5.104196:104239](∅→∅)

userEvents :: S.Handler App App [LogEntry]

[5.6632]

[5.4675]

userEvents :: S.Handler App App [KeyedLogEntry]
replacement in server/Aftok/Snaplet/WorkLog.hs at line 115

[5.8959]→[5.104240:104285](∅→∅),[5.104285]→[5.15904:15945](∅→∅),[5.15119]→[5.15904:15945](∅→∅)

userWorkIndex :: S.Handler App App WorkIndex
userWorkIndex = workIndex <$> userEvents

[5.8959]

[5.15166]

userWorkIndex :: S.Handler App App (WorkIndex KeyedLogEntry)
userWorkIndex = workIndex (view logEntry) <$> userEvents
replacement in server/Aftok/Snaplet/WorkLog.hs at line 130

[5.3782]→[5.18702:18753](∅→∅),[5.18753]→[5.8732:8755](∅→∅),[5.8732]→[5.8732:8755](∅→∅),[5.8755]→[5.72412:72435](∅→∅),[5.13339]→[5.8828:8865](∅→∅),[5.36174]→[5.8828:8865](∅→∅),[5.59594]→[5.8828:8865](∅→∅),[5.72461]→[5.8828:8865](∅→∅),[5.8828]→[5.8828:8865](∅→∅),[5.8865]→[5.72462:72653](∅→∅),[5.59821]→[5.9195:9233](∅→∅),[5.72653]→[5.9195:9233](∅→∅),[5.9195]→[5.9195:9233](∅→∅),[5.9233]→[5.72654:72732](∅→∅),[5.72732]→[5.104341:104403](∅→∅)

amendEventHandler :: S.Handler App App AmendmentId
amendEventHandler = do
uid <- requireUserId
eventIdBytes <- getParam "eventId"
eventId <-
maybe
(snapError 400 "eventId parameter is required")
(pure . EventId)
(eventIdBytes >>= U.fromASCIIBytes)
modTime <- ModTime <$> liftIO C.getCurrentTime
requestJSON <- readRequestJSON 4096
either
(snapError 400 . T.pack)
(snapEval . amendEvent uid eventId)
(A.parseEither (parseEventAmendment modTime) requestJSON)

[5.3782]

[5.269]

----------------------
-- Parsing
----------------------

parseEventAmendment ::
ModTime ->
Value ->
Parser EventAmendment
parseEventAmendment t = \case
Object o ->
let parseA :: Text -> Parser EventAmendment
parseA "timeChange" = TimeChange t <$> o .: "eventTime"
parseA "creditToChange" = CreditToChange t <$> parseCreditToV2 o
parseA "metadataChange" = MetadataChange t <$> o .: "eventMeta"
parseA tid =
fail . T.unpack $ "Amendment type " <> tid <> " not recognized."
in o .: "amendment" >>= parseA
val ->
fail $ "Value " <> show val <> " is not a JSON object."

----------------------
-- Rendering
----------------------

logEventJSON :: LogEvent -> Value
logEventJSON ev =
object [eventName ev .= object ["eventTime" .= (ev ^. eventTime)]]

logEntryFields :: LogEntry -> [Pair]
logEntryFields (LogEntry c ev m) =
[ "creditTo" .= creditToJSON c,
"event" .= logEventJSON ev,
"eventMeta" .= m
]

keyedLogEntryFields :: KeyedLogEntry -> [Pair]
keyedLogEntryFields (KeyedLogEntry eid le) =
["eventId" .= idValue _EventId eid] <> logEntryFields le

keyedLogEntryJSON :: KeyedLogEntry -> Value
keyedLogEntryJSON kle =
object (keyedLogEntryFields kle)
replacement in server/Aftok/Snaplet/WorkLog.hs at line 173

[5.270]→[5.104404:104503](∅→∅),[5.104503]→[5.16089:16094](∅→∅),[5.16089]→[5.16089:16094](∅→∅)

keyedLogEntryJSON :: (EventId, KeyedLogEntry) -> A.Value
keyedLogEntryJSON (eid, (pid, uid, ev)) =
v2

[5.270]

[5.72897]

extendedLogEntryJSON :: (ProjectId, UserId, KeyedLogEntry) -> Value
extendedLogEntryJSON (pid, uid, le) =
v1
replacement in server/Aftok/Snaplet/WorkLog.hs at line 177

[5.72907]→[5.72907:72997](∅→∅)

$ [ "eventId" .= idValue _EventId eid,
"projectId" .= idValue _ProjectId pid,

[5.72907]

[5.72997]

$ [ "projectId" .= idValue _ProjectId pid,
replacement in server/Aftok/Snaplet/WorkLog.hs at line 180

[5.73047]→[5.104504:104531](∅→∅)

<> logEntryFields ev

[5.73047]

<> keyedLogEntryFields le

payoutsJSON :: FractionalPayouts -> Value
payoutsJSON (Payouts m) =
v1 $
let payoutsRec :: (CreditTo, Rational) -> Value
payoutsRec (c, r) =
object ["creditTo" .= creditToJSON c,
"payoutRatio" .= r,
"payoutPercentage" .= (fromRational @Double r * 100)]
in obj $ ["payouts" .= fmap payoutsRec (MS.assocs m)]

workIndexJSON :: forall t. (t -> Value) -> WorkIndex t -> Value
workIndexJSON leJSON (WorkIndex widx) =
v1 $
obj ["workIndex" .= fmap widxRec (MS.assocs widx)]
where
widxRec :: (CreditTo, NonEmpty (Interval t)) -> Value
widxRec (c, l) =
object
[ "creditTo" .= creditToJSON c,
"intervals" .= (intervalJSON leJSON <$> L.toList l)
]

amendEventResultJSON :: (EventId, AmendmentId) -> Value
amendEventResultJSON (eid, aid) =
object
[ "replacement_event" .= idValue _EventId eid,
"amendment_id" .= idValue _AmendmentId aid
]
edit in server/Main.hs at line 5

[96.1461]

[5.75241]

import Aftok.Auction (_AuctionId)
import Aftok.Billing (_BillableId, _SubscriptionId)
edit in server/Main.hs at line 11

[5.75341]

[5.75341]

import Aftok.Payments.Types (_PaymentId)
edit in server/Main.hs at line 17

[5.75473]

[5.75473]

import Aftok.Snaplet.Json (idJSON)
edit in server/Main.hs at line 23

[5.75610]

[5.75610]

import Aftok.Types (_ProjectId)
replacement in server/Main.hs at line 87

[5.77251]→[5.77251:77318](∅→∅)

serveJSON projectIdJSON $ method POST projectCreateHandler

[5.77251]

[5.77318]

serveJSON (idJSON "projectId" _ProjectId) $ method POST projectCreateHandler
replacement in server/Main.hs at line 92

[5.77519]→[5.104589:104651](∅→∅)

serveJSON workIndexJSON $ method GET projectWorkIndex

[5.77519]

[5.77589]

serveJSON (workIndexJSON keyedLogEntryJSON) $ method GET projectWorkIndex
replacement in server/Main.hs at line 96

[5.77706]→[5.104711:104780](∅→∅),[5.104780]→[5.77881:77962](∅→∅),[5.77881]→[5.77881:77962](∅→∅)

serveJSON keyedLogEntryJSON $ method POST (logWorkHandler f)
amendEventRoute = serveJSON amendmentIdJSON $ method PUT amendEventHandler

[5.77706]

[5.77962]

serveJSON extendedLogEntryJSON $ method POST (logWorkHandler f)
amendEventRoute = serveJSON amendEventResultJSON $ method PUT amendEventHandler
replacement in server/Main.hs at line 99

[5.77986]→[5.104781:104843](∅→∅)

serveJSON (fmap logEntryJSON) $ method GET userEvents

[5.77986]

[5.78056]

serveJSON (fmap keyedLogEntryJSON) $ method GET userEvents
replacement in server/Main.hs at line 101

[5.78083]→[5.104844:104903](∅→∅)

serveJSON workIndexJSON $ method GET userWorkIndex

[5.78083]

[5.78150]

serveJSON (workIndexJSON keyedLogEntryJSON) $ method GET userWorkIndex
replacement in server/Main.hs at line 103

[5.78177]→[5.78177:78244](∅→∅)

serveJSON auctionIdJSON $ method POST auctionCreateHandler

[5.78177]

[5.2969]

serveJSON (idJSON "auctionId" _AuctionId) $ method POST auctionCreateHandler
replacement in server/Main.hs at line 109

[5.78422]→[5.78422:78491](∅→∅)

serveJSON billableIdJSON $ method POST billableCreateHandler

[5.78422]

[5.78491]

serveJSON (idJSON "billableId" _BillableId) $ method POST billableCreateHandler
replacement in server/Main.hs at line 113

[5.78614]→[5.78614:78682](∅→∅)

serveJSON subscriptionIdJSON $ method POST subscribeHandler

[5.78614]

[5.104904]

serveJSON (idJSON "subscriptionId" _SubscriptionId) $ method POST subscribeHandler
replacement in server/Main.hs at line 124

[5.105179]→[5.78959:78993](∅→∅),[5.78959]→[5.78959:78993](∅→∅)

serveJSON paymentIdJSON $

[5.105179]

[5.105180]

serveJSON (idJSON "paymentId" _PaymentId) $