{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module PlutusTx.Blueprint.Contract where
import Prelude
import Data.Aeson (ToJSON (..), (.=))
import Data.Aeson qualified as Aeson
import Data.Aeson.Extra (optionalField, requiredField)
import Data.Aeson.Extra qualified as Aeson
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Set (Set)
import Data.Text (Text)
import PlutusPrelude (ensure)
import PlutusTx.Blueprint.Definition (DefinitionId, Definitions, definitionsToMap)
import PlutusTx.Blueprint.Preamble (Preamble)
import PlutusTx.Blueprint.Validator (ValidatorBlueprint)
data ContractBlueprint where
MkContractBlueprint ::
forall referencedTypes.
{ ContractBlueprint -> Maybe Text
contractId :: Maybe Text
, ContractBlueprint -> Preamble
contractPreamble :: Preamble
, ()
contractValidators :: Set (ValidatorBlueprint referencedTypes)
, ()
contractDefinitions :: Definitions referencedTypes
} ->
ContractBlueprint
instance ToJSON ContractBlueprint where
toJSON :: ContractBlueprint -> Value
toJSON MkContractBlueprint{Maybe Text
Set (ValidatorBlueprint referencedTypes)
Preamble
Definitions referencedTypes
contractId :: ContractBlueprint -> Maybe Text
contractPreamble :: ContractBlueprint -> Preamble
contractValidators :: ()
contractDefinitions :: ()
contractId :: Maybe Text
contractPreamble :: Preamble
contractValidators :: Set (ValidatorBlueprint referencedTypes)
contractDefinitions :: Definitions referencedTypes
..} =
(Object -> Object) -> Value
Aeson.buildObject ((Object -> Object) -> Value) -> (Object -> Object) -> Value
forall a b. (a -> b) -> a -> b
$
Key -> String -> Object -> Object
forall a. ToJSON a => Key -> a -> Object -> Object
requiredField Key
"$schema" String
schemaUrl
(Object -> Object) -> (Object -> Object) -> Object -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Value -> Object -> Object
forall a. ToJSON a => Key -> a -> Object -> Object
requiredField
Key
"$vocabulary"
( [Pair] -> Value
Aeson.object
[ Key
"https://json-schema.org/draft/2020-12/vocab/core" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool
True
, Key
"https://json-schema.org/draft/2020-12/vocab/applicator" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool
True
, Key
"https://json-schema.org/draft/2020-12/vocab/validation" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool
True
, Key
"https://cips.cardano.org/cips/cip57" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool
True
]
)
(Object -> Object) -> (Object -> Object) -> Object -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Preamble -> Object -> Object
forall a. ToJSON a => Key -> a -> Object -> Object
requiredField Key
"preamble" Preamble
contractPreamble
(Object -> Object) -> (Object -> Object) -> Object -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Set (ValidatorBlueprint referencedTypes) -> Object -> Object
forall a. ToJSON a => Key -> a -> Object -> Object
requiredField Key
"validators" Set (ValidatorBlueprint referencedTypes)
contractValidators
(Object -> Object) -> (Object -> Object) -> Object -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Maybe Text -> Object -> Object
forall a. ToJSON a => Key -> Maybe a -> Object -> Object
optionalField Key
"$id" Maybe Text
contractId
(Object -> Object) -> (Object -> Object) -> Object -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Maybe (Map DefinitionId Value) -> Object -> Object
forall a. ToJSON a => Key -> Maybe a -> Object -> Object
optionalField Key
"definitions" Maybe (Map DefinitionId Value)
definitions
where
schemaUrl :: String
schemaUrl :: String
schemaUrl = String
"https://cips.cardano.org/cips/cip57/schemas/plutus-blueprint.json"
definitions :: Maybe (Map DefinitionId Aeson.Value)
definitions :: Maybe (Map DefinitionId Value)
definitions = (Map DefinitionId Value -> Bool)
-> Map DefinitionId Value -> Maybe (Map DefinitionId Value)
forall (f :: * -> *) a. Alternative f => (a -> Bool) -> a -> f a
ensure (Bool -> Bool
not (Bool -> Bool)
-> (Map DefinitionId Value -> Bool)
-> Map DefinitionId Value
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map DefinitionId Value -> Bool
forall k a. Map k a -> Bool
Map.null) (Definitions referencedTypes
-> (forall (xs :: [*]). Schema xs -> Value)
-> Map DefinitionId Value
forall (ts :: [*]) v.
Definitions ts
-> (forall (xs :: [*]). Schema xs -> v) -> Map DefinitionId v
definitionsToMap Definitions referencedTypes
contractDefinitions Schema xs -> Value
forall (xs :: [*]). Schema xs -> Value
forall a. ToJSON a => a -> Value
toJSON)