Check for an open interval on project switch.

[?]

Aug 27, 2020, 12:42 AM

2J37EVJMX255K3XEJHTZGRPEIRMAQ62JQWOA7JU3YTZUB6PUPWVQC

Dependencies

[2] OUR4PAOT Use local dates for display of intervals.
[3] SFWL5626 Initial release of UI.
[4] IPG33FAW Add billing daemon
[5] BROSTG5K Beginning of modularization of server.
[6] 2G3GNDDU Event logging is now functioning in postgres.
[7] GCVQD44V Create amends endpoint, switch to UUID primary keys
[8] HMDM3B55 Implement core of payments/billing infrastructure.
[9] G4BS4NND Add simple shell script demonstrating how to invite a companion.
[10] AL37SVTC Implement payments service endpoints.
[11] B6HWAPDP Modularize & update to recent haskoin.
[12] ZIG57EE6 Fix project selection, end log end on project switch.
[13] 5XFJNUAZ Start of addition of project infrastructure.
[14] XTBSG4C7 Adding serveJSON combinator to eliminate some boilerplate from handlers.
[15] EQXRXRZD Changed to use tasty instead of test-framework
[16] EZQG2APB Update task list.
[17] QU5FW67R Add project selection to time tracker.
[18] NEDDHXUK Reformat via stylish-haskell
[19] MGOF7IUF Update TASKS list to reflect completed projects.
[20] Z7KS5XHH Very WIP. Wow.
[21] 7HPY3QPF Fix linting errors. (yay hlint!)
[22] PBD7LZYQ Postgres & auth are beginning to function.
[23] 7XN3I3QJ Add 'loggedIntervals' endpoint.
[24] HO2PFRAB Client login now handles response correctly.
[25] JXG3FCXY Upgrade ps + halogen versions.
[26] NJNMO72S Add zcash.com submodule and update client to modern halogen.
[27] CDHZL3RP Add a couple of other CLI utilities for interacing with the service.
[28] EFSXYZPO Autoformat everything with brittany.
[29] I2KHGVD4 Require project permissions for access to most data.
[30] 7DBNV3GV Initial, stack-based impl of time log event reduction.
[31] 73NDXDEZ Begin implementation of billing event persistence.
[32] AWWC6P5Z Add migration to include payment network with addresses.
[33] RSF6UAJK Break out api module for timeline.
[34] A6HKMINB Attempting to improve JSON handling.
[35] RPAJLHMT Change to use UUIDs instead of ints for primary keys.
[36] SCXG6TJW Make log reduction safer in presence of overlapping events.
[37] O5FVTOM6 Undo JSON silliness, enable a couple more routes.
[38] QMRKFEPG Refactor QDB to use a free monad algebra instead.
[39] QMEYU4MW Add display for prior intervals.
[*] BFZN4SUA Make timeline component work.
[*] IZEVQF62 Work in progress replacing sqlite with postgres.
[*] 64C6AWH6 Rename Ananke -> Quixotic, project reboot.
[*] ADMKQQGC Initial empty Snap project.

Change contents

edit in client/src/Aftok/Api/Timeline.purs at line 9

[4.202]

[4.202]

import Data.Array (head)
replacement in client/src/Aftok/Api/Timeline.purs at line 187

[4.6040]→[4.6040:6186](∅→∅)

Before t -> ["before=" <> t]
During (Interval x) -> ["after=" <> x.start, "before=" <> x.end]
After t -> ["after=" <> t]

[4.6040]

[4.6186]

Before t -> ["before=" <> t, "limit=100"]
During (Interval x) -> ["after=" <> x.start, "before=" <> x.end, "limit=100"]
After t -> ["after=" <> t, "limit=100"]
edit in client/src/Aftok/Api/Timeline.purs at line 198

[4.6499]

apiLatestEvent :: ProjectId -> Aff (Either TimelineError (Maybe Event))
apiLatestEvent pid = do
response <- get RF.json ("/api/user/projects/" <> pidStr pid <> "/events")
liftEffect
<<< runExceptT
<<< map head
<<< map decompose
<<< withExceptT LogFailure
$ parseDatedResponse response
replacement in client/src/Aftok/Timeline.purs at line 54

[4.2907]→[2.925:989](∅→∅)

import Aftok.Project (Project, Project'(..), ProjectId, pidStr)

[4.2907]

[4.6844]

import Aftok.Project (Project, Project'(..), ProjectId) --, pidStr)
edit in client/src/Aftok/Timeline.purs at line 96

[4.4296]

[41.254]

, getLatestEvent :: ProjectId -> m (Either TimelineError (Maybe TL.Event))
replacement in client/src/Aftok/Timeline.purs at line 164

[2.1571]→[2.1571:1620](∅→∅)

active <- isJust <$> H.gets (_.active)

[2.1571]

[2.1620]

oldActive <- isJust <$> H.gets (_.active)
replacement in client/src/Aftok/Timeline.purs at line 166

[2.1675]→[2.1675:1776](∅→∅)

when (active && any (\p' -> (unwrap p').projectId /= (unwrap p).projectId) currentProject)

[2.1675]

[2.1776]

-- End any active intervals when switching projects.
when (oldActive && any (\p' -> (unwrap p').projectId /= (unwrap p).projectId) currentProject)
edit in client/src/Aftok/Timeline.purs at line 170

[2.1825]

[2.1825]
replacement in client/src/Aftok/Timeline.purs at line 175

[2.2085]→[2.2085:2156](∅→∅)

(system.log $ "Error occurred listing intervals") *>

[2.2085]

[2.2156]

(system.log $ "Error occurred listing intervals" <> show err ) *>
replacement in client/src/Aftok/Timeline.purs at line 178

[2.2215]→[2.2215:2348](∅→∅)

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

[2.2215]

[2.2348]

--(system.log $ "Got " <> show (length ivals :: Int) <> " intervals for project " <> pidStr (unwrap p).projectId) *>
edit in client/src/Aftok/Timeline.purs at line 180

[2.2377]

[2.2377]
replacement in client/src/Aftok/Timeline.purs at line 185

[2.2601]→[2.2601:2670](∅→∅)

H.modify_ (_ { selectedProject = Just p, history = hist })

[2.2601]

[4.5264]

latestEventResponse <- lift $ caps.getLatestEvent (unwrap p).projectId
now <- lift $ system.now
active <- lift $ case latestEventResponse of
Left err ->
(system.log $ "Error occurred retrieving the latest event: " <> show err) *>
pure Nothing
Right latestEvent -> do
let activeInterval :: TL.Event -> m (Maybe Interval)
activeInterval ev = case ev of
TL.StartEvent i ->
(system.log $ "Project has an open active interval starting " <> show i) *>
(Just <<< interval i <$> system.now)
TL.StopEvent _ ->
pure Nothing
join <$> traverse activeInterval latestEvent
edit in client/src/Aftok/Timeline.purs at line 202

[4.5265]

[2.2671]

H.modify_ (_ { selectedProject = Just p, history = hist, active = active })
edit in client/src/Aftok/Timeline.purs at line 342

[4.7427]

[4.10402]

, getLatestEvent: TL.apiLatestEvent
edit in client/src/Aftok/Timeline.purs at line 351

[4.10515]

[41.1540]

, getLatestEvent: \_ -> Right <$> pure Nothing
replacement in client/src/Aftok/Timeline.purs at line 385

[2.6013]→[2.6013:6069](∅→∅)

lift <<< system.log $ "Splitting interval " <> show i

[2.6013]

[2.6069]

--lift <<< system.log $ "Splitting interval " <> show i
replacement in client/src/Aftok/Timeline.purs at line 395

[2.6523]→[2.6523:6578](∅→∅)

lift <<< system.log $ "Split result: " <> show split

[2.6523]

[2.6578]

--lift <<< system.log $ "Split result: " <> show split
replacement in lib/Aftok/Database/PostgreSQL.hs at line 378

[4.1084]→[4.11131:11190](∅→∅)

pgEval (FindEvents (ProjectId pid) (UserId uid) ival) = do

[4.1084]

[4.11190]

pgEval (FindEvents (ProjectId pid) (UserId uid) rquery limit) = do
replacement in lib/Aftok/Database/PostgreSQL.hs at line 380

[4.11215]→[4.19829:19861](∅→∅)

let
q (Before e) = pquery

[4.11215]

[4.19861]

case rquery of
(Before e) -> pquery
replacement in lib/Aftok/Database/PostgreSQL.hs at line 388

[4.11474]→[4.15631:15705](∅→∅),[4.15631]→[4.15631:15705](∅→∅),[4.15705]→[4.19985:20043](∅→∅)

WHERE project_id = ? AND user_id = ? AND event_time <= ? |]
(pid, uid, fromThyme e)
q (During s e) = pquery

[4.11474]

[4.20043]

WHERE project_id = ? AND user_id = ? AND event_time <= ?
ORDER BY event_time DESC
LIMIT ?
|]
(pid, uid, fromThyme e, limit)
(During s e) -> pquery
replacement in lib/Aftok/Database/PostgreSQL.hs at line 400

[4.11766]→[4.15995:16052](∅→∅),[4.15995]→[4.15995:16052](∅→∅),[4.16052]→[4.20167:20235](∅→∅)

AND event_time >= ? AND event_time <= ? |]
(pid, uid, fromThyme s, fromThyme e)
q (After s) = pquery

[4.11766]

[4.20235]

AND event_time >= ? AND event_time <= ?
ORDER BY event_time DESC
LIMIT ?
|]
(pid, uid, fromThyme s, fromThyme e, limit)
(After s) -> pquery
replacement in lib/Aftok/Database/PostgreSQL.hs at line 411

[4.7617]→[4.7617:7689](∅→∅),[4.7689]→[4.20359:20389](∅→∅),[4.16361]→[4.20359:20389](∅→∅),[4.20389]→[4.12005:12014](∅→∅),[4.6342]→[4.12005:12014](∅→∅),[4.12014]→[4.7690:8155](∅→∅)

WHERE project_id = ? AND user_id = ? AND event_time >= ? |]
(pid, uid, fromThyme s)
q ival

pgEval (FindLatestEvents (ProjectId pid) (UserId uid) i) = do
mode <- askNetworkMode
pquery
(logEntryParser mode)
[sql| SELECT credit_to_type,
credit_to_network, credit_to_address, 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 ?|]
(pid, uid, i)

[4.7617]

[4.1951]

WHERE project_id = ? AND user_id = ? AND event_time >= ?
ORDER BY event_time DESC
LIMIT ?
|]
(pid, uid, fromThyme s, limit)
(Always) -> pquery
(logEntryParser mode)
[sql| SELECT credit_to_type,
credit_to_network, credit_to_address, 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 ?
|]
(pid, uid, limit)
edit in lib/Aftok/Database.hs at line 21

[4.25908]

[4.25908]

import Data.Word ( Word32 )
replacement in lib/Aftok/Database.hs at line 61

[4.27224]→[4.27224:27304](∅→∅),[4.27304]→[4.8157:8231](∅→∅)

FindEvents ::ProjectId -> UserId -> Interval' -> DBOp [LogEntry BTCNet]
FindLatestEvents ::ProjectId -> UserId -> Int -> DBOp [LogEntry BTCNet]

[4.27224]

[4.27304]

FindEvents ::ProjectId -> UserId -> RangeQuery -> Word32 -> DBOp [LogEntry BTCNet]
replacement in lib/Aftok/Database.hs at line 222

[4.29294]→[4.29294:29370](∅→∅),[4.20200]→[4.8854:8899](∅→∅),[4.29370]→[4.8854:8899](∅→∅),[4.8854]→[4.8854:8899](∅→∅)

:: (MonadDB m) => ProjectId -> UserId -> Interval' -> m [LogEntry BTCNet]
findEvents p u i = liftdb $ FindEvents p u i

[4.29294]

[4.8232]

:: (MonadDB m) => ProjectId -> UserId -> RangeQuery -> Word32 -> m [LogEntry BTCNet]
findEvents p u i l = liftdb $ FindEvents p u i l
edit in lib/Aftok/Database.hs at line 225

[4.8233]→[4.8233:8375](∅→∅),[4.8375]→[4.1303:1304](∅→∅),[4.8899]→[4.1303:1304](∅→∅),[4.9207]→[4.1303:1304](∅→∅),[4.1640]→[4.1303:1304](∅→∅)

findLatestEvents :: (MonadDB m) => ProjectId -> UserId -> Int -> m [LogEntry BTCNet]
findLatestEvents p u i = liftdb $ FindLatestEvents p u i
replacement in lib/Aftok/Interval.hs at line 9

[4.30426]→[4.30426:30458](∅→∅)

, Interval'(..)
, interval'

[4.30426]

[4.30458]

, RangeQuery(..)
, rangeQuery
edit in lib/Aftok/Interval.hs at line 34

[4.130]

[4.1360]

makeLenses ''Interval
replacement in lib/Aftok/Interval.hs at line 36

[4.1361]→[4.4029:4076](∅→∅),[4.4076]→[4.1410:1529](∅→∅),[4.1410]→[4.1410:1529](∅→∅),[4.1529]→[4.4077:4099](∅→∅),[4.4099]→[4.1530:1553](∅→∅),[4.1887]→[4.1530:1553](∅→∅)

data Interval' = Before { _end' :: C.UTCTime }
| During { _start' :: C.UTCTime, _end' :: C.UTCTime }
| After { _start' :: C.UTCTime }

makeLenses ''Interval
makeLenses ''Interval'

[4.1361]

[4.115]

data RangeQuery
= Before { _end' :: C.UTCTime }
| During { _start' :: C.UTCTime, _end' :: C.UTCTime }
| After { _start' :: C.UTCTime }
| Always
makeLenses ''RangeQuery
replacement in lib/Aftok/Interval.hs at line 46

[4.132]→[4.1554:1660](∅→∅)

interval' :: C.UTCTime -> C.UTCTime -> Interval'
interval' s e = if s < e then During s e else During e s

[4.132]

[4.1660]

rangeQuery :: C.UTCTime -> C.UTCTime -> RangeQuery
rangeQuery s e = if s < e then During s e else During e s
file move: list_entries.sh (---r------) → latest_events.sh (---r------)

[4.1220]

[3.2]
replacement in scripts/latest_events.sh at line 23

[3.311]→[3.311:391](∅→∅)

"https://$AFTOK_HOST/api/projects/$PID/logEntries?after=2020-01-01T00:00:00Z"

[3.311]

"https://$AFTOK_HOST/api/projects/$PID/events?after=2020-01-01T00:00:00Z"
file addition: list_events.sh (---r------)

[4.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

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

curl --verbose --insecure --user $USER \
--request GET \
"https://$AFTOK_HOST/api/projects/$PID/events?after=2020-01-01T00:00:00Z"
replacement in server/Aftok/Snaplet/WorkLog.hs at line 87

[4.6632]→[4.14875:14963](∅→∅)

userLogEntries :: S.Handler App App [LogEntry (NetworkId, Address)]
userLogEntries = do

[4.6632]

[4.59080]

userEvents :: S.Handler App App [LogEntry (NetworkId, Address)]
userEvents = do
replacement in server/Aftok/Snaplet/WorkLog.hs at line 92

[4.5069]→[4.59142:59348](∅→∅),[4.59348]→[4.14964:15050](∅→∅),[4.15050]→[4.12987:13024](∅→∅),[4.59425]→[4.12987:13024](∅→∅),[4.8589]→[4.12987:13024](∅→∅),[4.13024]→[4.5385:5386](∅→∅),[4.5385]→[4.5385:5386](∅→∅),[4.5386]→[4.8707:8862](∅→∅)

ival <- case endpoints of
(Just s , Just e ) -> pure $ During s e
(Nothing, Just e ) -> pure $ Before e
(Just s , Nothing) -> pure $ After s
(Nothing, Nothing) -> snapError
400
"You must specify at least one of the \"after\" or \"before\" query parameters"
snapEval $ findEvents pid uid ival

userLatestEntries :: S.Handler App App [LogEntry (NetworkId, Address)]
userLatestEntries = do
uid <- requireUserId
pid <- requireProjectId

[4.5069]

[4.8862]

let ival = case endpoints of
(Just s , Just e ) -> During s e
(Nothing, Just e ) -> Before e
(Just s , Nothing) -> After s
(Nothing, Nothing) -> Always
replacement in server/Aftok/Snaplet/WorkLog.hs at line 98

[4.8914]→[4.8914:8958](∅→∅)

snapEval $ findLatestEvents pid uid limit

[4.8914]

[4.8958]

snapEval $ findEvents pid uid ival limit
replacement in server/Aftok/Snaplet/WorkLog.hs at line 102

[4.15135]→[4.15135:15166](∅→∅)

workIndex <$> userLogEntries

[4.15135]

[4.15166]

workIndex <$> userEvents
replacement in server/Main.hs at line 74

[4.15275]→[4.15275:15343](∅→∅)

serveJSON (workIndexJSON nmode) $ method GET projectWorkIndex

[4.15275]

[4.8961]

serveJSON (workIndexJSON nmode) (method GET projectWorkIndex)
replacement in server/Main.hs at line 84

[4.15608]→[4.15608:15706](∅→∅)

userLogEntriesRoute =
serveJSON (fmap $ logEntryJSON nmode) $ method GET userLogEntries

[4.15608]

[4.15706]

userEventsRoute =
serveJSON (fmap $ logEntryJSON nmode) $ method GET userEvents
replacement in server/Main.hs at line 126

[4.16099]→[4.16099:16169](∅→∅)

, ("user/projects/:projectId/logEntries" , userLogEntriesRoute)

[4.16099]

[4.16169]

, ("user/projects/:projectId/events" , userEventsRoute)