{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE OverloadedStrings #-}
module IOHK.Cicero.API.Invocation where

import Data.Aeson
import Data.UUID as UUID
import Data.Coerce
import Data.Time.LocalTime
import Servant.API
import Servant.API.Generic
import Servant.API.NamedRoutes

import IOHK.Cicero.API.Action

newtype InvocationID = InvocationID { InvocationID -> UUID
uuid :: UUID } deriving newtype ([InvocationID] -> Encoding
[InvocationID] -> Value
InvocationID -> Encoding
InvocationID -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [InvocationID] -> Encoding
$ctoEncodingList :: [InvocationID] -> Encoding
toJSONList :: [InvocationID] -> Value
$ctoJSONList :: [InvocationID] -> Value
toEncoding :: InvocationID -> Encoding
$ctoEncoding :: InvocationID -> Encoding
toJSON :: InvocationID -> Value
$ctoJSON :: InvocationID -> Value
ToJSON, Value -> Parser [InvocationID]
Value -> Parser InvocationID
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [InvocationID]
$cparseJSONList :: Value -> Parser [InvocationID]
parseJSON :: Value -> Parser InvocationID
$cparseJSON :: Value -> Parser InvocationID
FromJSON, InvocationID -> ByteString
InvocationID -> Builder
InvocationID -> Text
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
toQueryParam :: InvocationID -> Text
$ctoQueryParam :: InvocationID -> Text
toHeader :: InvocationID -> ByteString
$ctoHeader :: InvocationID -> ByteString
toEncodedUrlPiece :: InvocationID -> Builder
$ctoEncodedUrlPiece :: InvocationID -> Builder
toUrlPiece :: InvocationID -> Text
$ctoUrlPiece :: InvocationID -> Text
ToHttpApiData, InvocationID -> InvocationID -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InvocationID -> InvocationID -> Bool
$c/= :: InvocationID -> InvocationID -> Bool
== :: InvocationID -> InvocationID -> Bool
$c== :: InvocationID -> InvocationID -> Bool
Eq, Eq InvocationID
InvocationID -> InvocationID -> Bool
InvocationID -> InvocationID -> Ordering
InvocationID -> InvocationID -> InvocationID
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: InvocationID -> InvocationID -> InvocationID
$cmin :: InvocationID -> InvocationID -> InvocationID
max :: InvocationID -> InvocationID -> InvocationID
$cmax :: InvocationID -> InvocationID -> InvocationID
>= :: InvocationID -> InvocationID -> Bool
$c>= :: InvocationID -> InvocationID -> Bool
> :: InvocationID -> InvocationID -> Bool
$c> :: InvocationID -> InvocationID -> Bool
<= :: InvocationID -> InvocationID -> Bool
$c<= :: InvocationID -> InvocationID -> Bool
< :: InvocationID -> InvocationID -> Bool
$c< :: InvocationID -> InvocationID -> Bool
compare :: InvocationID -> InvocationID -> Ordering
$ccompare :: InvocationID -> InvocationID -> Ordering
Ord)

invocationIdFromString :: String -> Maybe InvocationID
invocationIdFromString :: String -> Maybe InvocationID
invocationIdFromString = coerce :: forall a b. Coercible a b => a -> b
coerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe UUID
UUID.fromString

type API = NamedRoutes InvocationRoutes

data InvocationRoutes mode = InvocationRoutes
  { forall mode.
InvocationRoutes mode
-> mode :- (Capture "id" InvocationID :> Get '[JSON] InvocationV1)
get :: mode :- Capture "id" InvocationID :> Get '[JSON] InvocationV1
  } deriving stock forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall mode x.
Rep (InvocationRoutes mode) x -> InvocationRoutes mode
forall mode x.
InvocationRoutes mode -> Rep (InvocationRoutes mode) x
$cto :: forall mode x.
Rep (InvocationRoutes mode) x -> InvocationRoutes mode
$cfrom :: forall mode x.
InvocationRoutes mode -> Rep (InvocationRoutes mode) x
Generic

data InvocationV1 = Invocation
  { InvocationV1 -> InvocationID
id :: !InvocationID
  , InvocationV1 -> ActionID
actionId :: !ActionID
  , InvocationV1 -> ZonedTime
createdAt :: !ZonedTime
  , InvocationV1 -> Maybe ZonedTime
finishedAt :: !(Maybe ZonedTime)
  }

instance FromJSON InvocationV1 where
  parseJSON :: Value -> Parser InvocationV1
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"InvocationV1" \Object
o -> InvocationID
-> ActionID -> ZonedTime -> Maybe ZonedTime -> InvocationV1
Invocation
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"action_id"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"finished_at"

instance ToJSON InvocationV1 where
  toJSON :: InvocationV1 -> Value
toJSON InvocationV1
i = [Pair] -> Value
object
    [ Key
"id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= InvocationV1
i.id
    , Key
"action_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= InvocationV1
i.actionId
    , Key
"created_at" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= InvocationV1
i.createdAt
    , Key
"finished_at" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= InvocationV1
i.finishedAt
    ]
  toEncoding :: InvocationV1 -> Encoding
toEncoding InvocationV1
i = Series -> Encoding
pairs
    ( Key
"id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= InvocationV1
i.id
   forall a. Semigroup a => a -> a -> a
<> Key
"action_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= InvocationV1
i.actionId
   forall a. Semigroup a => a -> a -> a
<> Key
"created_at" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= InvocationV1
i.createdAt
   forall a. Semigroup a => a -> a -> a
<> Key
"finished_at" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= InvocationV1
i.finishedAt
    )