RSF6UAJKG7CEKILSVXI6C4YZXY7PIYZM2EMA2IXKQ7SADKNVSH7QC
QMEYU4MWLTSWPWEEOFRLK2IKE64BY3V5X73323WPLCGPP3TPDYGAC
EA5BFM5GMM7KNMDLTVOSUKVKMSIDD72TAFVHDVGEOUY5VELECU3QC
JXG3FCXYBDKMUD77DOM7RCIJYKB7BILC43OHHDZBE7YQRGAMUCCAC
J6S23MDGHVSCVVIRB6XRNSY3EGTDNWFJHV7RYLIEHBUK5KU63CFQC
ZIG57EE6RB22JGB3CT33EN2HVYCHCXBT5GROBTBMBLEMDTGQOOBQC
QU5FW67RGCWOWT2YFM4NYMJFFHWIRPQANQBBAHBKZUY7UYMCSIMQC
BFZN4SUAGYNFFYVAP36BAX32DMO622PK4EPEVQQEAGC2IHTEAAPQC
NJNMO72S7VIUV22JXB4IFPZMHWTJAOTP6EC6Z4QSKYIROSXT52MQC
AWWC6P5ZVFDQHX3EAYDG4DKTUZ6A5LHQAV3NIUO3VP6FM7JKPK5AC
IZEVQF627FA7VV25KJAWYWGGC35LZUUBBQRPN5ZAINTQLPEDRTEAC
B6HWAPDPXIWH7CHK5VLMWLL6EQN6NOFZEFYO47BPUY2ZO4SL7VDAC
EFSXYZPOGA5M4DN65IEIDO7JK6U34DMQELAPHOIL2UAT6HRC66BAC
IPG33FAWXGEQ2PO6OXRT2PWWXHRNMPVUKKADL6UKKN5GD2CNZ25AC
A6HKMINBNGQLLX4QJMYWKQ4JAEHVJ4HIRVDKPPDI3FJUO2AAB7OQC
64C6AWH66FDKU6UE6Z6JPX2J2GBM2JOPTH2GL6LHKAIUBGNGDZ5AC
HMDM3B557TO5RYP2IGFFC2C2VN6HYZTDQ47CJY2O37BW55DSMFZAC
O5FVTOM6YFBLEPF3S576K6IMT6ZZ5VQCSB3YVXNS4CKBITKCRZ7AC
4U7F3CPIDTK6JSEDMNMHVKSR7HOQDLZQD2PPVMDLHO5SFSIMUXZAC
RPAJLHMTUJU4AYNBOHVGHGGB4NY2NLY3BVPYN5FMWB3ZIMAUQHCQC
4R7XIYK3BP664CO3YJ2VM64ES2JYN27UTQG5KS34OTEPAIODSZLQC
BROSTG5KP3NUNLSYPVQID254TE47E5RKQAKLPIY7PGWETE6JNMTAC
HO2PFRABW6BBTE4MUKUTEGXCMJS46WGVBCNWOHO4OL52DVAB4YDAC
ADMKQQGCGVSHHIMVQ4XFRDCG544SBJCYALSKZV45CQQBZ4ACUH2AC
O722AOKEWXWJPRHGJREU6QPW7HEFPPRETZIAADZ2RMAXHARCNEKAC
GCVQD44VRPQVKPZEPIC4AOIXLJIG2ZMV3QI2Y7KALUT6NVUBSGSAC
GMYPBCWEB6NKURRILAHR3TJUKDOGR2ZMK5I6MS6P5G2LAGH36P3QC
MGOF7IUFGXYQKZOKMM2GGULFFVAULEHLZDSHMUW6B5DBKVXXR74AC
module Aftok.Api.Timeline where
import Prelude
import Control.Alt ((<|>))
import Control.Monad.Error.Class (throwError)
import Control.Monad.Except.Trans (withExceptT, runExceptT)
import Data.Argonaut.Decode (class DecodeJson, decodeJson, (.:), (.:?))
import Data.DateTime (DateTime)
import Data.DateTime.Instant (Instant)
import Data.Either (Either, note)
import Data.Foldable (class Foldable, foldMapDefaultR, intercalate, foldr, foldl)
import Data.JSDate as JD
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype)
import Data.Traversable (class Traversable, traverse)
import Data.UUID as UUID
import Type.Proxy (Proxy(..))
-- import Text.Format as F -- (format, zeroFill, width)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Affjax (get, post)
import Affjax.RequestBody as RB
import Affjax.ResponseFormat as RF
import Data.Argonaut.Encode (encodeJson)
import Aftok.Project (ProjectId(..), pidStr)
import Aftok.Types (APIError, JsonCompose, decompose, parseDatedResponse)
data TimelineError
= LogFailure (APIError)
| Unexpected String
instance showTimelineError :: Show TimelineError where
show = case _ of
LogFailure e -> show e
Unexpected t -> t
data Event' i
= StartEvent i
| StopEvent i
type Event = Event' Instant
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')
newtype Interval' i = Interval
{ start :: i
, end :: i
}
derive instance intervalEq :: (Eq i) => Eq (Interval' i)
derive instance intervalNewtype :: Newtype (Interval' i) _
type Interval = Interval' Instant
derive instance intervalFunctor :: Functor Interval'
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
foldMap = foldMapDefaultR
instance intervalTraversable :: Traversable Interval' where
traverse f (Interval i) = interval <$> f i.start <*> f i.end
sequence = traverse identity
instance decodeJsonInterval :: DecodeJson (Interval' String) where
decodeJson json = do
obj <- decodeJson json
interval <$> obj .: "start" <*> obj .: "end"
interval :: forall i. i -> i -> Interval' i
interval s e = Interval { start: s, end: e }
data TimeSpan' t
= Before t
| During (Interval' t)
| After t
type TimeSpan = TimeSpan' DateTime
derive instance timeSpanFunctor :: Functor TimeSpan'
instance timeSpanFoldable :: Foldable TimeSpan' where
foldr f b = case _ of
Before a -> f a b
During x -> foldr f b x
After a -> f a b
foldl f b = case _ of
Before a -> f b a
During x -> foldl f b x
After a -> f b a
foldMap = foldMapDefaultR
instance timeSpanTraversable :: Traversable TimeSpan' where
traverse f = case _ of
Before a -> Before <$> f a
During x -> During <$> traverse f x
After a -> After <$> f a
sequence = traverse identity
apiLogStart :: ProjectId -> Aff (Either TimelineError Instant)
apiLogStart (ProjectId pid) = do
let requestBody = Just <<< RB.Json <<< encodeJson $ { schemaVersion: "2.0" }
response <- post RF.json ("/api/user/projects/" <> UUID.toString pid <> "/logStart") requestBody
liftEffect <<< runExceptT $ do
event <- withExceptT LogFailure $ parseDatedResponse response
case event of
StartEvent t -> pure t
StopEvent _ -> throwError <<< Unexpected $ "Expected start event, got stop."
apiLogEnd :: ProjectId -> Aff (Either TimelineError Instant)
apiLogEnd (ProjectId pid) = do
let requestBody = Just <<< RB.Json <<< encodeJson $ { schemaVersion: "2.0" }
response <- post RF.json ("/api/user/projects/" <> UUID.toString pid <> "/logEnd") requestBody
liftEffect <<< runExceptT $ do
event <- withExceptT LogFailure $ parseDatedResponse response
case event of
StartEvent _ -> throwError <<< Unexpected $ "Expected stop event, got start."
StopEvent t -> pure t
newtype ListIntervalsResponse a = ListIntervalsResponse
{ workIndex :: Array ({ intervals :: Array a })
}
derive instance listIntervalsResponseNewtype :: Newtype (ListIntervalsResponse a) _
derive instance listIntervalsResponseFunctor :: Functor ListIntervalsResponse
instance listIntervalsResponseFoldable :: Foldable ListIntervalsResponse where
foldr f b (ListIntervalsResponse r) = foldr f b (r.workIndex >>= _.intervals)
foldl f b (ListIntervalsResponse r) = foldl f b (r.workIndex >>= _.intervals)
foldMap = foldMapDefaultR
instance listIntervalsResponseTraversable :: Traversable ListIntervalsResponse where
traverse f (ListIntervalsResponse r) =
let traverseCreditRow r' = ({ intervals: _ }) <$> traverse f r'.intervals
in (ListIntervalsResponse <<< ({ workIndex: _ })) <$> traverse traverseCreditRow r.workIndex
sequence = traverse identity
instance listIntervalsResponseDecodeJson :: DecodeJson a => DecodeJson (ListIntervalsResponse a) where
decodeJson = map ListIntervalsResponse <<< decodeJson
_ListIntervalsResponse :: Proxy (JsonCompose ListIntervalsResponse Interval' String)
_ListIntervalsResponse = Proxy
apiListIntervals :: ProjectId -> TimeSpan -> Aff (Either TimelineError (Array Interval))
apiListIntervals pid ts = do
ts' <- liftEffect $ traverse (JD.toISOString <<< JD.fromDateTime) ts
let queryElements = case ts' of
Before t -> ["before=" <> t]
During (Interval x) -> ["after=" <> x.start, "before=" <> x.end]
After t -> ["after=" <> t]
response <- get RF.json ("/api/user/projects/" <> pidStr pid <> "/workIndex?" <> intercalate "&" queryElements)
liftEffect
<<< runExceptT
<<< map (\(ListIntervalsResponse r) -> r.workIndex >>= (_.intervals))
<<< map decompose
<<< withExceptT LogFailure
$ parseDatedResponse response
import Aftok.Project (Project, Project'(..), ProjectId(..), pidStr)
import Aftok.Types (APIError, System, JsonCompose, decompose, parseDatedResponse)
data Event' i
= StartEvent i
| StopEvent i
type Event = Event' Instant
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')
newtype Interval' i = Interval
{ start :: i
, end :: i
}
derive instance intervalEq :: (Eq i) => Eq (Interval' i)
derive instance intervalNewtype :: Newtype (Interval' i) _
type Interval = Interval' Instant
derive instance intervalFunctor :: Functor Interval'
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
foldMap = foldMapDefaultR
instance intervalTraversable :: Traversable Interval' where
traverse f (Interval i) = interval <$> f i.start <*> f i.end
sequence = traverse identity
import Aftok.Project (Project, Project'(..), ProjectId)
import Aftok.Types (System)
instance decodeJsonInterval :: DecodeJson (Interval' String) where
decodeJson json = do
obj <- decodeJson json
interval <$> obj .: "start" <*> obj .: "end"
interval :: forall i. i -> i -> Interval' i
interval s e = Interval { start: s, end: e }
data TimeSpan' t
= Before t
| During (Interval' t)
| After t
type TimeSpan = TimeSpan' DateTime
derive instance timeSpanFunctor :: Functor TimeSpan'
instance timeSpanFoldable :: Foldable TimeSpan' where
foldr f b = case _ of
Before a -> f a b
During x -> foldr f b x
After a -> f a b
foldl f b = case _ of
Before a -> f b a
During x -> foldl f b x
After a -> f b a
foldMap = foldMapDefaultR
instance timeSpanTraversable :: Traversable TimeSpan' where
traverse f = case _ of
Before a -> Before <$> f a
During x -> During <$> traverse f x
After a -> After <$> f a
sequence = traverse identity
data TimelineError
= LogFailure (APIError)
| Unexpected String
instance showTimelineError :: Show TimelineError where
show = case _ of
LogFailure e -> show e
Unexpected t -> t
apiLogStart :: ProjectId -> Aff (Either TimelineError Instant)
apiLogStart (ProjectId pid) = do
let requestBody = Just <<< RB.Json <<< encodeJson $ { schemaVersion: "2.0" }
response <- post RF.json ("/api/user/projects/" <> UUID.toString pid <> "/logStart") requestBody
liftEffect <<< runExceptT $ do
event <- withExceptT LogFailure $ parseDatedResponse response
case event of
StartEvent t -> pure t
StopEvent _ -> throwError <<< Unexpected $ "Expected start event, got stop."
apiLogEnd :: ProjectId -> Aff (Either TimelineError Instant)
apiLogEnd (ProjectId pid) = do
let requestBody = Just <<< RB.Json <<< encodeJson $ { schemaVersion: "2.0" }
response <- post RF.json ("/api/user/projects/" <> UUID.toString pid <> "/logEnd") requestBody
liftEffect <<< runExceptT $ do
event <- withExceptT LogFailure $ parseDatedResponse response
case event of
StartEvent _ -> throwError <<< Unexpected $ "Expected stop event, got start."
StopEvent t -> pure t
newtype ListIntervalsResponse a = ListIntervalsResponse
{ workIndex :: Array ({ intervals :: Array a })
}
derive instance listIntervalsResponseNewtype :: Newtype (ListIntervalsResponse a) _
derive instance listIntervalsResponseFunctor :: Functor ListIntervalsResponse
instance listIntervalsResponseFoldable :: Foldable ListIntervalsResponse where
foldr f b (ListIntervalsResponse r) = foldr f b (r.workIndex >>= _.intervals)
foldl f b (ListIntervalsResponse r) = foldl f b (r.workIndex >>= _.intervals)
foldMap = foldMapDefaultR
instance listIntervalsResponseTraversable :: Traversable ListIntervalsResponse where
traverse f (ListIntervalsResponse r) =
let traverseCreditRow r' = ({ intervals: _ }) <$> traverse f r'.intervals
in (ListIntervalsResponse <<< ({ workIndex: _ })) <$> traverse traverseCreditRow r.workIndex
sequence = traverse identity
instance listIntervalsResponseDecodeJson :: DecodeJson a => DecodeJson (ListIntervalsResponse a) where
decodeJson = map ListIntervalsResponse <<< decodeJson
_ListIntervalsResponse :: Proxy (JsonCompose ListIntervalsResponse Interval' String)
_ListIntervalsResponse = Proxy
apiListIntervals :: ProjectId -> TimeSpan -> Aff (Either TimelineError (Array Interval))
apiListIntervals pid ts = do
ts' <- liftEffect $ traverse (JD.toISOString <<< JD.fromDateTime) ts
let queryElements = case ts' of
Before t -> ["before=" <> t]
During (Interval x) -> ["after=" <> x.start, "before=" <> x.end]
After t -> ["after=" <> t]
response <- get RF.json ("/api/user/projects/" <> pidStr pid <> "/workIndex?" <> intercalate "&" queryElements)
liftEffect
<<< runExceptT
<<< map (\(ListIntervalsResponse r) -> r.workIndex >>= (_.intervals))
<<< map decompose
<<< withExceptT LogFailure
$ parseDatedResponse response
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 = ? AND event_time >= ? |]
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 = ? AND event_time >= ? |]
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)
decimalParam :: (Integral i, MonadSnap m) => ByteString -> m (Maybe i)
decimalParam k = runMaybeT $ do
bs <- MaybeT $ getParam k
MaybeT . pure . either (const Nothing) Just $ parseOnly decimal bs
projectPayoutsRoute = serveJSON (payoutsJSON nmode) $ method GET payoutsHandler
auctionRoute = serveJSON auctionJSON $ method GET auctionGetHandler
auctionBidRoute = serveJSON bidIdJSON $ method POST auctionBidHandler
auctionRoute =
serveJSON auctionJSON $ method GET auctionGetHandler
auctionBidRoute =
serveJSON bidIdJSON $ method POST auctionBidHandler