{-# 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)

{- | A blueprint of a smart contract, as defined by the CIP-0057

The 'referencedTypes' type variable is used to track the types used in the contract
making sure their schemas are included in the blueprint and that they are referenced
in a type-safe way. See Note ["Unrolling" types] for more details.
-}
data ContractBlueprint where
  MkContractBlueprint ::
    forall referencedTypes.
    { ContractBlueprint -> Maybe Text
contractId :: Maybe Text
    -- ^ An optional identifier for the contract.
    , ContractBlueprint -> Preamble
contractPreamble :: Preamble
    -- ^ An object with meta-information about the contract.
    , ()
contractValidators :: Set (ValidatorBlueprint referencedTypes)
    -- ^ A set of validator blueprints that are part of the contract.
    , ()
contractDefinitions :: Definitions referencedTypes
    -- ^ A registry of schema definitions used across the blueprint.
    } ->
    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)