{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module IOHK.Cicero.API.Fact where
import Data.Coerce
import Data.Text
import Data.Aeson
import Data.Time.LocalTime
import Data.UUID
import Data.ByteString.Lazy
import Data.Binary.Builder
import Servant.API
import Servant.API.Generic
import Servant.API.NamedRoutes
import {-# SOURCE #-} IOHK.Cicero.API.Run (RunID)
newtype FactID = FactID { FactID -> UUID
uuid :: UUID } deriving newtype ([FactID] -> Encoding
[FactID] -> Value
FactID -> Encoding
FactID -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [FactID] -> Encoding
$ctoEncodingList :: [FactID] -> Encoding
toJSONList :: [FactID] -> Value
$ctoJSONList :: [FactID] -> Value
toEncoding :: FactID -> Encoding
$ctoEncoding :: FactID -> Encoding
toJSON :: FactID -> Value
$ctoJSON :: FactID -> Value
ToJSON, Value -> Parser [FactID]
Value -> Parser FactID
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [FactID]
$cparseJSONList :: Value -> Parser [FactID]
parseJSON :: Value -> Parser FactID
$cparseJSON :: Value -> Parser FactID
FromJSON, FactID -> ByteString
FactID -> Builder
FactID -> Text
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
toQueryParam :: FactID -> Text
$ctoQueryParam :: FactID -> Text
toHeader :: FactID -> ByteString
$ctoHeader :: FactID -> ByteString
toEncodedUrlPiece :: FactID -> Builder
$ctoEncodedUrlPiece :: FactID -> Builder
toUrlPiece :: FactID -> Text
$ctoUrlPiece :: FactID -> Text
ToHttpApiData, FactID -> FactID -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FactID -> FactID -> Bool
$c/= :: FactID -> FactID -> Bool
== :: FactID -> FactID -> Bool
$c== :: FactID -> FactID -> Bool
Eq, Eq FactID
FactID -> FactID -> Bool
FactID -> FactID -> Ordering
FactID -> FactID -> FactID
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 :: FactID -> FactID -> FactID
$cmin :: FactID -> FactID -> FactID
max :: FactID -> FactID -> FactID
$cmax :: FactID -> FactID -> FactID
>= :: FactID -> FactID -> Bool
$c>= :: FactID -> FactID -> Bool
> :: FactID -> FactID -> Bool
$c> :: FactID -> FactID -> Bool
<= :: FactID -> FactID -> Bool
$c<= :: FactID -> FactID -> Bool
< :: FactID -> FactID -> Bool
$c< :: FactID -> FactID -> Bool
compare :: FactID -> FactID -> Ordering
$ccompare :: FactID -> FactID -> Ordering
Ord)
factIdFromString :: String -> Maybe FactID
factIdFromString :: String -> Maybe FactID
factIdFromString = 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 FactRoutes
data FactRoutes mode = FactRoutes
{ forall mode.
FactRoutes mode
-> mode
:- (ReqBody '[OctetStream] CreateFactV1 :> Post '[JSON] FactV1)
create :: mode :- ReqBody '[OctetStream] CreateFactV1 :> Post '[JSON] FactV1
, forall mode.
FactRoutes mode
-> mode
:- (QueryParam' '[Required, Strict] "run" RunID
:> Get '[JSON] [FactV1])
getAll :: mode :- QueryParam' '[Required, Strict] "run" RunID :> Get '[JSON] [FactV1]
} deriving stock forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall mode x. Rep (FactRoutes mode) x -> FactRoutes mode
forall mode x. FactRoutes mode -> Rep (FactRoutes mode) x
$cto :: forall mode x. Rep (FactRoutes mode) x -> FactRoutes mode
$cfrom :: forall mode x. FactRoutes mode -> Rep (FactRoutes mode) x
Generic
data CreateFactV1 = CreateFact
{
CreateFactV1 -> Value
fact :: !Value
,
CreateFactV1 -> Maybe ByteString
artifact :: !(Maybe ByteString)
}
instance MimeRender OctetStream CreateFactV1 where
mimeRender :: Proxy OctetStream -> CreateFactV1 -> ByteString
mimeRender Proxy OctetStream
_ CreateFactV1
cf = Builder -> ByteString
toLazyByteString forall a b. (a -> b) -> a -> b
$ Builder
factBuilt forall a. Semigroup a => a -> a -> a
<> Builder
artifactBuilt
where
factBuilt :: Builder
factBuilt = forall tag. Encoding' tag -> Builder
fromEncoding forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Encoding
toEncoding CreateFactV1
cf.fact
artifactBuilt :: Builder
artifactBuilt = case CreateFactV1
cf.artifact of
Just ByteString
a -> ByteString -> Builder
fromLazyByteString ByteString
a
Maybe ByteString
Nothing -> forall a. Monoid a => a
mempty
data FactV1 = Fact
{ FactV1 -> FactID
id :: !FactID
, FactV1 -> Maybe RunID
runId :: !(Maybe RunID)
, FactV1 -> ZonedTime
createdAt :: !ZonedTime
, FactV1 -> Value
value :: !Value
,
FactV1 -> Maybe Text
binaryHash :: !(Maybe Text)
}
instance FromJSON FactV1 where
parseJSON :: Value -> Parser FactV1
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"FactV1" \Object
o -> FactID -> Maybe RunID -> ZonedTime -> Value -> Maybe Text -> FactV1
Fact
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 (Maybe a)
.:? Key
"run_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
"value"
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
"binary_hash"
instance ToJSON FactV1 where
toJSON :: FactV1 -> Value
toJSON FactV1
f = [Pair] -> Value
object forall a b. (a -> b) -> a -> b
$
[ Key
"id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FactV1
f.id
, Key
"created_at" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FactV1
f.createdAt
, Key
"value" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FactV1
f.value
] forall a. [a] -> [a] -> [a]
++ [Pair]
runIdFields forall a. [a] -> [a] -> [a]
++ [Pair]
binaryHashFields
where
runIdFields :: [Pair]
runIdFields = case FactV1
f.runId of
Just RunID
rid -> [ Key
"run_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= RunID
rid ]
Maybe RunID
Nothing -> []
binaryHashFields :: [Pair]
binaryHashFields = case FactV1
f.binaryHash of
Just Text
hash -> [ Key
"binary_hash" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
hash ]
Maybe Text
Nothing -> []
toEncoding :: FactV1 -> Encoding
toEncoding FactV1
f = Series -> Encoding
pairs forall a b. (a -> b) -> a -> b
$
( Key
"id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FactV1
f.id
forall a. Semigroup a => a -> a -> a
<> Key
"created_at" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FactV1
f.createdAt
forall a. Semigroup a => a -> a -> a
<> Key
"value" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FactV1
f.value
) forall a. Semigroup a => a -> a -> a
<> Series
runIdFields forall a. Semigroup a => a -> a -> a
<> Series
binaryHashFields
where
runIdFields :: Series
runIdFields = case FactV1
f.runId of
Just RunID
rid -> Key
"run_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= RunID
rid
Maybe RunID
Nothing -> forall a. Monoid a => a
mempty
binaryHashFields :: Series
binaryHashFields = case FactV1
f.binaryHash of
Just Text
hash -> Key
"binary_hash" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
hash
Maybe Text
Nothing -> forall a. Monoid a => a
mempty