Use server timestamps for interval start and end.

[?]

Aug 20, 2020, 4:15 AM

J6S23MDGHVSCVVIRB6XRNSY3EGTDNWFJHV7RYLIEHBUK5KU63CFQC

Dependencies

[2] ZIG57EE6 Fix project selection, end log end on project switch.
[3] JXG3FCXY Upgrade ps + halogen versions.
[4] Y3LIJ5US Add handler for CreatePaymentRequest
[5] B6HWAPDP Modularize & update to recent haskoin.
[6] EFSXYZPO Autoformat everything with brittany.
[7] WRPIYG3E Use project listing functionality to check for whether we have a cookie.
[8] BFZN4SUA Make timeline component work.
[9] QU5FW67R Add project selection to time tracker.
[10] NJNMO72S Add zcash.com submodule and update client to modern halogen.
[11] RN7EI6IN Update database layer to use CreditTo
[*] IZEVQF62 Work in progress replacing sqlite with postgres.

Change contents

replacement in client/src/Aftok/Project.purs at line 6

[3.617]→[3.617:681](∅→∅)

import Control.Monad.Except.Trans (ExceptT, runExceptT, except)

[3.617]

[3.681]

import Control.Monad.Except.Trans (ExceptT, runExceptT, except, withExceptT)
edit in client/src/Aftok/Project.purs at line 15

[3.954]→[2.4:33](∅→∅)

import Data.JSDate as JSDate
replacement in client/src/Aftok/Project.purs at line 27

[3.1287]→[3.182:216](∅→∅)

import Aftok.Types (APIError(..))

[3.1287]

[3.216]

import Aftok.Types (APIError(..), parseDate)
replacement in client/src/Aftok/Project.purs at line 149

[3.2951]→[3.2951:3130](∅→∅)

jsDate <- lift $ JSDate.parse p.inceptionDate
pdate <- except $ note (ParseFailure json "Could not parse inception date")
(JSDate.toDateTime jsDate)

[3.2951]

[3.3130]

pdate <- withExceptT (ParseFailure json) $ parseDate p.inceptionDate
edit in client/src/Aftok/Timeline.purs at line 6

[3.2520]

[3.301236]

import Control.Monad.Error.Class (throwError)
import Control.Monad.Except.Trans (except, withExceptT, runExceptT)
edit in client/src/Aftok/Timeline.purs at line 12

[3.2546]

[3.301278]

import Data.Argonaut.Decode (class DecodeJson, decodeJson, (.:), (.:?))
replacement in client/src/Aftok/Timeline.purs at line 15

[3.2739]→[3.2462:2494](∅→∅),[3.2494]→[2.971:998](∅→∅)

import Data.Either (Either(..))
import Data.Foldable (any)

[3.2739]

[2.998]

import Data.Either (Either(..), note)
import Data.Foldable (class Foldable, any, foldMapDefaultR)
replacement in client/src/Aftok/Timeline.purs at line 21

[3.2626]→[3.2626:2662](∅→∅)

import Data.Traversable (traverse_)

[3.2626]

[3.45]

import Data.Traversable (class Traversable, traverse_, traverse)
replacement in client/src/Aftok/Timeline.purs at line 57

[3.2967]→[3.2967:3001](∅→∅)

import Aftok.Types (APIError(..))

[3.2967]

[3.3001]

import Aftok.Types (APIError(..), parseDate)
replacement in client/src/Aftok/Timeline.purs at line 59

[3.3002]→[3.3002:3036](∅→∅)

import Effect.Class.Console (log)

[3.3002]

[3.3220]

import Effect.Class.Console as C
edit in client/src/Aftok/Timeline.purs at line 88

[3.3157]

[3.3157]

instance showTimelineError :: Show TimelineError where
show = case _ of
LogFailure e -> show e
edit in client/src/Aftok/Timeline.purs at line 187

[2.2334]→[2.2334:2506](∅→∅)

log $ "Active: " <> show active <> "; " <> show ((_.projectName) <<< unwrap <$> currentProject)
log $ "Selected: " <> show ((_.projectName) <<< unwrap $ p)
replacement in client/src/Aftok/Timeline.purs at line 189

[2.2652]→[3.5213:5264](∅→∅),[3.5213]→[3.5213:5264](∅→∅)

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

[2.2652]

[3.5264]

H.modify_ (_ { selectedProject = Just p, history = [] })
replacement in client/src/Aftok/Timeline.purs at line 207

[2.2973]→[2.2973:3020](∅→∅)

Left _ -> log "Failed to start timer."

[2.2973]

[2.3020]

Left err -> C.log $ "Failed to start timer: " <> show err
replacement in client/src/Aftok/Timeline.purs at line 214

[2.3244]→[2.3244:3290](∅→∅)

Left _ -> log "Failed to stop timer."

[2.3244]

[2.3290]

Left err -> C.log $ "Failed to stop timer: " <> show err
replacement in client/src/Aftok/Timeline.purs at line 242

[3.3565]→[3.3565:3608](∅→∅)

toPct n = pct (100.0 * n / maxWidth)

[3.3565]

[3.305220]

toPct n = 100.0 * n / maxWidth
replacement in client/src/Aftok/Timeline.purs at line 248

[3.3636]→[3.1290:1346](∅→∅),[3.1290]→[3.1290:1346](∅→∅)

left (toPct ileft)
width (toPct iwidth)

[3.3636]

[3.305417]

left (pct $ toPct ileft)
width (pct $ max (toPct iwidth) 0.5)
edit in client/src/Aftok/Timeline.purs at line 262

[3.305763]

[3.6222]

data Event i
= StartEvent i
| StopEvent i

derive instance eventFunctor :: Functor Event

instance eventFoldable :: Foldable Event where
foldr f b = case _ of
StartEvent a -> f a b
StopEvent a -> f a b
foldl f b = case _ of
StartEvent a -> f b a
StopEvent a -> f b a
foldMap = foldMapDefaultR

instance eventTraversable :: Traversable Event where
traverse f = case _ of
StartEvent a -> StartEvent <$> f a
StopEvent a -> StopEvent <$> f a
sequence = traverse identity

instance decodeJsonEvent :: DecodeJson (Event String) where
decodeJson json = do
obj <- decodeJson json
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')
replacement in client/src/Aftok/Timeline.purs at line 319

[3.6263]→[3.6263:6378](∅→∅)

case result of
Left err -> pure <<< Left <<< LogFailure $ Error { status: Nothing, message: printError err }

[3.6263]

[3.6378]

liftEffect <<< runExceptT $ case result of
Left err -> throwError <<< LogFailure $ Error { status: Nothing, message: printError err }
replacement in client/src/Aftok/Timeline.purs at line 322

[3.6410]→[3.6410:6622](∅→∅)

StatusCode 403 -> pure <<< Left <<< LogFailure $ Forbidden
StatusCode 200 -> Right <$> liftEffect now
other -> pure <<< Left <<< LogFailure $ Error { status: Just other, message: r.statusText }

[3.6410]

[3.6622]

StatusCode 403 ->
throwError $ LogFailure Forbidden
StatusCode 200 ->
withExceptT (LogFailure <<< ParseFailure r.body) $ do
event <- except $ decodeJson r.body
timeEvent <- traverse parseDate event
case timeEvent of
StartEvent t -> pure $ fromDateTime t
StopEvent _ -> throwError $ "Expected start event, got stop."
other ->
throwError <<< LogFailure $ Error { status: Just other, message: r.statusText }
replacement in client/src/Aftok/Timeline.purs at line 338

[3.6878]→[3.6878:6993](∅→∅)

case result of
Left err -> pure <<< Left <<< LogFailure $ Error { status: Nothing, message: printError err }

[3.6878]

[3.6993]

liftEffect <<< runExceptT $ case result of
Left err -> throwError <<< LogFailure $ Error { status: Nothing, message: printError err }
replacement in client/src/Aftok/Timeline.purs at line 341

[3.7025]→[3.7025:7237](∅→∅)

StatusCode 403 -> pure <<< Left <<< LogFailure $ Forbidden
StatusCode 200 -> Right <$> liftEffect now
other -> pure <<< Left <<< LogFailure $ Error { status: Just other, message: r.statusText }

[3.7025]

[3.7237]

StatusCode 403 ->
throwError $ LogFailure Forbidden
StatusCode 200 ->
withExceptT (LogFailure <<< ParseFailure r.body) $ do
event <- except $ decodeJson r.body
timeEvent <- traverse parseDate event
case timeEvent of
StartEvent _ -> throwError $ "Expected stop event, got start."
StopEvent t -> pure $ fromDateTime t
other ->
throwError <<< LogFailure $ Error { status: Just other, message: r.statusText }
edit in client/src/Aftok/Types.purs at line 2

[3.7426]

[3.7426]

import Prelude

import Control.Monad.Trans.Class (lift)
import Control.Monad.Except.Trans (ExceptT, except)
replacement in client/src/Aftok/Types.purs at line 8

[3.7427]→[3.7427:7460](∅→∅)

import Data.Argonaut.Core (Json)

[3.7427]

[3.7460]

import Data.Argonaut.Core (Json, stringify)
import Data.Argonaut.Decode (decodeJson)
import Data.DateTime (DateTime)
import Data.Either (note)
import Data.JSDate as JSDate
edit in client/src/Aftok/Types.purs at line 14

[3.7486]

[3.7486]

import Effect (Effect)
edit in client/src/Aftok/Types.purs at line 23

[3.7644]

[3.7644]

instance showAPIError :: Show APIError where
show = case _ of
Forbidden -> "Forbidden"
ParseFailure js e -> "ParseFailure (" <> show (stringify js) <> ") " <> show e
Error r -> "Error { status: " <> show r.status <> ", message: " <> r.message <> "}"

parseJsonDate :: Json -> ExceptT String Effect DateTime
parseJsonDate json = do
str <- except $ decodeJson json
parseDate str
edit in client/src/Aftok/Types.purs at line 34

[3.7645]

parseDate :: String -> ExceptT String Effect DateTime
parseDate str = do
jsDate <- lift $ JSDate.parse str
except $ note ("Unable to convert date " <> show jsDate <> " to a valid DateTime value.")
(JSDate.toDateTime jsDate)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 145

[3.16405]→[3.8417:8444](∅→∅),[3.8417]→[3.8417:8444](∅→∅),[3.8444]→[3.16406:16412](∅→∅)

creditToParser' mode f v =
let

[3.16405]

[3.16412]

creditToParser' mode f v = do
tn <- typename f
if tn /= "credit_to_t"
then returnError Incompatible f "column was not of type credit_to_t"
else maybe empty (pure . parser . decodeUtf8) v
where
replacement in lib/Aftok/Database/PostgreSQL.hs at line 152

[3.16476]→[3.16476:17038](∅→∅)

parser "credit_to_address" =
CreditToCurrency <$> (addressParser mode <* nullField <* nullField)
parser "credit_to_user" =
CreditToUser <$> (nullField *> nullField *> idParser UserId <* nullField)
parser "credit_to_project" =
CreditToProject
<$> (nullField *> nullField *> nullField *> idParser ProjectId)
parser _ = empty
in
do
tn <- typename f
if tn /= "credit_to_t"
then returnError Incompatible f "column was not of type credit_to_t"
else maybe empty (pure . parser . decodeUtf8) v

[3.16476]

[3.1409]

parser = \case
"credit_to_address" -> CreditToCurrency <$> (addressParser mode <* nullField <* nullField)
"credit_to_user" -> CreditToUser <$> (nullField *> nullField *> idParser UserId <* nullField)
"credit_to_project" -> CreditToProject <$> (nullField *> nullField *> nullField *> idParser ProjectId)
_ -> empty