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

import Data.Aeson
import Data.Coerce
import Data.Text
import Data.Time.LocalTime
import Data.UUID
import Numeric.Natural
import Servant.API
import Servant.API.Generic
import Servant.API.NamedRoutes

import IOHK.Cicero.API.Fact
import IOHK.Cicero.API.Invocation

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

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


type API = NamedRoutes RunRoutes

-- | Run routes in the Cicero API
data RunRoutes mode = RunRoutes
  { forall mode.
RunRoutes mode
-> mode
   :- (QueryFlag "recursive"
       :> (QueryParams "input" FactID
           :> (QueryParam "offset" Natural
               :> (QueryParam "limit" Natural :> Get '[JSON] [RunV2]))))
getAll :: mode
           :- QueryFlag "recursive"
           :> QueryParams "input" FactID
           :> QueryParam "offset" Natural
           :> QueryParam "limit" Natural
           :> Get '[JSON] [RunV2]
  , forall mode.
RunRoutes mode
-> mode
   :- (Capture "id" RunID
       :> ("fact"
           :> (ReqBody '[OctetStream] CreateFactV1 :> Post '[JSON] FactV1)))
createFact :: mode
               :- Capture "id" RunID
               :> "fact"
               :> ReqBody '[OctetStream] CreateFactV1
               :> Post '[JSON] FactV1
  , forall mode.
RunRoutes mode
-> mode
   :- (Capture "id" RunID :> ("logs" :> Get '[JSON] RunLogsV1))
getLogs :: mode
            :- Capture "id" RunID
            :> "logs"
            :> Get '[JSON] RunLogsV1
  , forall mode.
RunRoutes mode -> mode :- (Capture "id" RunID :> DeleteNoContent)
abort :: mode
          :- Capture "id" RunID
          :> DeleteNoContent
  } deriving stock forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall mode x. Rep (RunRoutes mode) x -> RunRoutes mode
forall mode x. RunRoutes mode -> Rep (RunRoutes mode) x
$cto :: forall mode x. Rep (RunRoutes mode) x -> RunRoutes mode
$cfrom :: forall mode x. RunRoutes mode -> Rep (RunRoutes mode) x
Generic

data RunV2 = Run
  { RunV2 -> RunID
nomadJobId :: !RunID
  , RunV2 -> InvocationID
invocationId :: !InvocationID
  , RunV2 -> ZonedTime
createdAt :: !ZonedTime
  , RunV2 -> Maybe ZonedTime
finishedAt :: !(Maybe ZonedTime)
  }

instance FromJSON RunV2 where
  parseJSON :: Value -> Parser RunV2
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"RunV2" \Object
o -> RunID -> InvocationID -> ZonedTime -> Maybe ZonedTime -> RunV2
Run
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"nomad_job_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
"invocation_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 a
.: Key
"finished_at"

instance ToJSON RunV2 where
  toJSON :: RunV2 -> Value
toJSON RunV2
r = [Pair] -> Value
object
    [ Key
"nomad_job_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= RunV2
r.nomadJobId
    , Key
"invocation_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= RunV2
r.invocationId
    , Key
"created_at" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= RunV2
r.createdAt
    , Key
"finished_at" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= RunV2
r.finishedAt
    ]
  toEncoding :: RunV2 -> Encoding
toEncoding RunV2
r = Series -> Encoding
pairs
    ( Key
"nomad_job_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= RunV2
r.nomadJobId
   forall a. Semigroup a => a -> a -> a
<> Key
"invocation_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= RunV2
r.invocationId
   forall a. Semigroup a => a -> a -> a
<> Key
"created_at" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= RunV2
r.createdAt
   forall a. Semigroup a => a -> a -> a
<> Key
"finished_at" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= RunV2
r.finishedAt
    )

newtype RunLogsV1 = RunLogs [RunLog]

instance FromJSON RunLogsV1 where
  parseJSON :: Value -> Parser RunLogsV1
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"RunLogsV1" \Object
o ->
    [RunLog] -> RunLogsV1
RunLogs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"logs"

instance ToJSON RunLogsV1 where
  toJSON :: RunLogsV1 -> Value
toJSON (RunLogs [RunLog]
logs) = [Pair] -> Value
object
    [ Key
"logs" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [RunLog]
logs
    ]
  toEncoding :: RunLogsV1 -> Encoding
toEncoding (RunLogs [RunLog]
logs) = Series -> Encoding
pairs
    ( Key
"logs" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [RunLog]
logs
    )

data RunLog = RunLog
  { RunLog -> ZonedTime
time :: !ZonedTime
  , RunLog -> Text
source :: !Text
  , RunLog -> Text
text :: !Text
  }

instance FromJSON RunLog where
  parseJSON :: Value -> Parser RunLog
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"RunLog" \Object
o -> ZonedTime -> Text -> Text -> RunLog
RunLog
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"Time"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"Source"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"Text"

instance ToJSON RunLog where
  toJSON :: RunLog -> Value
toJSON RunLog
r = [Pair] -> Value
object
    [ Key
"Time" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= RunLog
r.time
    , Key
"Source" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= RunLog
r.source
    , Key
"Text" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= RunLog
r.text
    ]
  toEncoding :: RunLog -> Encoding
toEncoding RunLog
r = Series -> Encoding
pairs
    ( Key
"Time" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= RunLog
r.time
   forall a. Semigroup a => a -> a -> a
<> Key
"Source" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= RunLog
r.source
   forall a. Semigroup a => a -> a -> a
<> Key
"Text" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= RunLog
r.text
    )