{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DeriveGeneric #-}
module IOHK.Cicero.API.Action where

import Data.Coerce
import Data.Text
import Data.Aeson
import Data.Aeson.Encoding
import Data.Aeson.Types
import Data.Map
import Data.Time.LocalTime
import Data.UUID as UUID
import Data.String
import Servant.API
import Servant.API.Generic
import Servant.API.NamedRoutes

type API = NamedRoutes ActionRoutes

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

actionIdFromString :: String -> Maybe ActionID
actionIdFromString :: String -> Maybe ActionID
actionIdFromString = 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

-- | Action routes in the Cicero API
data ActionRoutes mode = ActionRoutes
  { forall mode.
ActionRoutes mode
-> mode
   :- (ReqBody '[JSON] CreateActionV1
       :> Post '[JSON] CreateActionResponseV2)
create :: mode :- ReqBody '[JSON] CreateActionV1 :> Post '[JSON] CreateActionResponseV2
  , forall mode.
ActionRoutes mode
-> mode :- (Capture "id" ActionID :> Get '[JSON] ActionV2)
get :: mode :- Capture "id" ActionID :> Get '[JSON] ActionV2
  } deriving stock forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall mode x. Rep (ActionRoutes mode) x -> ActionRoutes mode
forall mode x. ActionRoutes mode -> Rep (ActionRoutes mode) x
$cto :: forall mode x. Rep (ActionRoutes mode) x -> ActionRoutes mode
$cfrom :: forall mode x. ActionRoutes mode -> Rep (ActionRoutes mode) x
Generic

data CreateActionV1 = CreateAction
  { CreateActionV1 -> ActionNamesV1
names :: !ActionNamesV1
  , CreateActionV1 -> ActionSourceV1
source :: !ActionSourceV1
  }

instance ToJSON CreateActionV1 where
  toJSON :: CreateActionV1 -> Value
toJSON CreateActionV1
ca = [Pair] -> Value
object forall a b. (a -> b) -> a -> b
$ Key
"source" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= CreateActionV1
ca.source forall a. a -> [a] -> [a]
: case CreateActionV1
ca.names of
    Only Text
n -> [ Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
n ]
    ActionNamesV1
AllNames -> []
  toEncoding :: CreateActionV1 -> Encoding
toEncoding CreateActionV1
ca = Series -> Encoding
pairs forall a b. (a -> b) -> a -> b
$ Key
"source" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= CreateActionV1
ca.source forall a. Semigroup a => a -> a -> a
<> case CreateActionV1
ca.names of
    Only Text
n -> Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
n
    ActionNamesV1
AllNames -> forall a. Monoid a => a
mempty

data CreateActionResponseV2
  = -- | The specific action created
    --
    -- Returned if an 'Only' was set in 'names'
    CreateActionOnly !ActionV2
  | -- | All actions created
    --
    -- Returned if 'AllNames' was set in 'names'
    CreateActionAll !([ ActionV2 ])

instance FromJSON CreateActionResponseV2 where
  parseJSON :: Value -> Parser CreateActionResponseV2
parseJSON Value
v = forall a. String -> Parser a -> Parser a
prependFailure String
"parsing CreateActionResponseV2 failed, " forall a b. (a -> b) -> a -> b
$ case Value
v of
    Object Object
_ -> ActionV2 -> CreateActionResponseV2
CreateActionOnly forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    Array Array
_ -> [ActionV2] -> CreateActionResponseV2
CreateActionAll forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    Value
_ -> forall a. String -> Value -> Parser a
typeMismatch String
"Object or Array" Value
v

instance ToJSON CreateActionResponseV2 where
  toJSON :: CreateActionResponseV2 -> Value
toJSON (CreateActionOnly ActionV2
act) = forall a. ToJSON a => a -> Value
toJSON ActionV2
act
  toJSON (CreateActionAll [ActionV2]
acts) = forall a. ToJSON a => a -> Value
toJSON [ActionV2]
acts

  toEncoding :: CreateActionResponseV2 -> Encoding
toEncoding (CreateActionOnly ActionV2
act) = forall a. ToJSON a => a -> Encoding
toEncoding ActionV2
act
  toEncoding (CreateActionAll [ActionV2]
acts) = forall a. ToJSON a => a -> Encoding
toEncoding [ActionV2]
acts

-- | The source of an action, as a [go-getter URL](https://github.com/hashicorp/go-getter#url-format)
newtype ActionSourceV1 = ActionSource { ActionSourceV1 -> Text
unActionSource :: Text } deriving newtype (String -> ActionSourceV1
forall a. (String -> a) -> IsString a
fromString :: String -> ActionSourceV1
$cfromString :: String -> ActionSourceV1
IsString, Value -> Parser [ActionSourceV1]
Value -> Parser ActionSourceV1
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ActionSourceV1]
$cparseJSONList :: Value -> Parser [ActionSourceV1]
parseJSON :: Value -> Parser ActionSourceV1
$cparseJSON :: Value -> Parser ActionSourceV1
FromJSON, [ActionSourceV1] -> Encoding
[ActionSourceV1] -> Value
ActionSourceV1 -> Encoding
ActionSourceV1 -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ActionSourceV1] -> Encoding
$ctoEncodingList :: [ActionSourceV1] -> Encoding
toJSONList :: [ActionSourceV1] -> Value
$ctoJSONList :: [ActionSourceV1] -> Value
toEncoding :: ActionSourceV1 -> Encoding
$ctoEncoding :: ActionSourceV1 -> Encoding
toJSON :: ActionSourceV1 -> Value
$ctoJSON :: ActionSourceV1 -> Value
ToJSON)

-- | The action names to add from a given 'ActionSourceV1'
data ActionNamesV1
  = -- | Just add the action with the given name
    Only !Text
  | -- | Add all names exported by the source
    AllNames

-- | A [CUE lang](https://cuelang.org/) value
--
-- For now just a wrapper around 'Text' that we hope parses
newtype CUE = CUE { CUE -> Text
expr :: Text } deriving newtype (Value -> Parser [CUE]
Value -> Parser CUE
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [CUE]
$cparseJSONList :: Value -> Parser [CUE]
parseJSON :: Value -> Parser CUE
$cparseJSON :: Value -> Parser CUE
FromJSON, [CUE] -> Encoding
[CUE] -> Value
CUE -> Encoding
CUE -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [CUE] -> Encoding
$ctoEncodingList :: [CUE] -> Encoding
toJSONList :: [CUE] -> Value
$ctoJSONList :: [CUE] -> Value
toEncoding :: CUE -> Encoding
$ctoEncoding :: CUE -> Encoding
toJSON :: CUE -> Value
$ctoJSON :: CUE -> Value
ToJSON)

-- | An input to a job
data InputV2 = Input
  { -- | Negate the matching condition?
    InputV2 -> Bool
not :: !Bool
  , -- | Can this input be missing?
    InputV2 -> Bool
optional :: !Bool
  , -- | Which facts to match
    InputV2 -> CUE
match :: !CUE
  }

instance FromJSON InputV2 where
  parseJSON :: Value -> Parser InputV2
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"InputV2" \Object
o -> Bool -> Bool -> CUE -> InputV2
Input
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"not"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"optional"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"match"

instance ToJSON InputV2 where
  toJSON :: InputV2 -> Value
toJSON InputV2
i = [Pair] -> Value
object
    [ Key
"not" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= InputV2
i.not
    , Key
"optional" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= InputV2
i.optional
    , Key
"match" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= InputV2
i.match
    ]
  toEncoding :: InputV2 -> Encoding
toEncoding InputV2
i = Series -> Encoding
pairs
    ( Key
"not" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= InputV2
i.not
   forall a. Semigroup a => a -> a -> a
<> Key
"optional" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= InputV2
i.optional
   forall a. Semigroup a => a -> a -> a
<> Key
"match" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= InputV2
i.match
    )

-- | An action
data ActionV2 = Action
  { ActionV2 -> ActionID
id :: !ActionID
  , ActionV2 -> Text
name :: !Text
  , ActionV2 -> ActionSourceV1
source :: !ActionSourceV1
  , ActionV2 -> ZonedTime
createdAt :: !ZonedTime
  , ActionV2 -> Bool
active :: !Bool
  , ActionV2 -> Maybe (Map Text Value)
meta :: !(Maybe (Map Text Value))
  , ActionV2 -> Map Text InputV2
inputs :: !(Map Text InputV2)
  }

instance FromJSON ActionV2 where
  parseJSON :: Value -> Parser ActionV2
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ActionV2" \Object
o -> ActionID
-> Text
-> ActionSourceV1
-> ZonedTime
-> Bool
-> Maybe (Map Text Value)
-> Map Text InputV2
-> ActionV2
Action
    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
"name"
    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
"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
"active"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"meta"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"inputs"

instance ToJSON ActionV2 where
  toJSON :: ActionV2 -> Value
toJSON ActionV2
a = [Pair] -> Value
object
    [ Key
"id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ActionV2
a.id
    , Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ActionV2
a.name
    , Key
"source" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ActionV2
a.source
    , Key
"created_at" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ActionV2
a.createdAt
    , Key
"active" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ActionV2
a.active
    , Key
"meta" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ActionV2
a.meta
    , Key
"inputs" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ActionV2
a.inputs
    ]
  toEncoding :: ActionV2 -> Encoding
toEncoding ActionV2
a = Series -> Encoding
pairs
    ( Key
"id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ActionV2
a.id
   forall a. Semigroup a => a -> a -> a
<> Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ActionV2
a.name
   forall a. Semigroup a => a -> a -> a
<> Key
"source" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ActionV2
a.source
   forall a. Semigroup a => a -> a -> a
<> Key
"created_at" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ActionV2
a.createdAt
   forall a. Semigroup a => a -> a -> a
<> Key
"active" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ActionV2
a.active
   forall a. Semigroup a => a -> a -> a
<> Key
"meta" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ActionV2
a.meta
   forall a. Semigroup a => a -> a -> a
<> Key
"inputs" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ActionV2
a.inputs
    )