{-# LANGUAGE DataKinds          #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE KindSignatures     #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE RecordWildCards    #-}

module PlutusTx.Blueprint.Validator where

import Prelude

import Data.Aeson (ToJSON (..))
import Data.Aeson.Extra (buildObject, optionalField, requiredField)
import Data.ByteString (ByteString)
import Data.ByteString.Base16 qualified as Base16
import Data.Kind (Type)
import Data.List.NonEmpty qualified as NE
import Data.Text (Text)
import Data.Text.Encoding qualified as Text
import PlutusCore.Crypto.Hash (blake2b_224)
import PlutusTx.Blueprint.Argument (ArgumentBlueprint)
import PlutusTx.Blueprint.Parameter (ParameterBlueprint)

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

The 'referencedTypes' phantom type parameter 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.
-}
data ValidatorBlueprint (referencedTypes :: [Type]) = MkValidatorBlueprint
  { forall (referencedTypes :: [*]).
ValidatorBlueprint referencedTypes -> Text
validatorTitle        :: Text
  -- ^ A short and descriptive name for the validator.
  , forall (referencedTypes :: [*]).
ValidatorBlueprint referencedTypes -> Maybe Text
validatorDescription  :: Maybe Text
  -- ^ An informative description of the validator.
  , forall (referencedTypes :: [*]).
ValidatorBlueprint referencedTypes
-> ArgumentBlueprint referencedTypes
validatorRedeemer     :: ArgumentBlueprint referencedTypes
  -- ^ A description of the redeemer format expected by this validator.
  , forall (referencedTypes :: [*]).
ValidatorBlueprint referencedTypes
-> Maybe (ArgumentBlueprint referencedTypes)
validatorDatum        :: Maybe (ArgumentBlueprint referencedTypes)
  -- ^ A description of the datum format expected by this validator.
  , forall (referencedTypes :: [*]).
ValidatorBlueprint referencedTypes
-> [ParameterBlueprint referencedTypes]
validatorParameters   :: [ParameterBlueprint referencedTypes]
  -- ^ A list of parameters required by the script.
  , forall (referencedTypes :: [*]).
ValidatorBlueprint referencedTypes -> Maybe ByteString
validatorCompiledCode :: Maybe ByteString
  -- ^ A full compiled and CBOR-encoded serialized flat script.
  }
  deriving stock (Int -> ValidatorBlueprint referencedTypes -> ShowS
[ValidatorBlueprint referencedTypes] -> ShowS
ValidatorBlueprint referencedTypes -> String
(Int -> ValidatorBlueprint referencedTypes -> ShowS)
-> (ValidatorBlueprint referencedTypes -> String)
-> ([ValidatorBlueprint referencedTypes] -> ShowS)
-> Show (ValidatorBlueprint referencedTypes)
forall (referencedTypes :: [*]).
Int -> ValidatorBlueprint referencedTypes -> ShowS
forall (referencedTypes :: [*]).
[ValidatorBlueprint referencedTypes] -> ShowS
forall (referencedTypes :: [*]).
ValidatorBlueprint referencedTypes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall (referencedTypes :: [*]).
Int -> ValidatorBlueprint referencedTypes -> ShowS
showsPrec :: Int -> ValidatorBlueprint referencedTypes -> ShowS
$cshow :: forall (referencedTypes :: [*]).
ValidatorBlueprint referencedTypes -> String
show :: ValidatorBlueprint referencedTypes -> String
$cshowList :: forall (referencedTypes :: [*]).
[ValidatorBlueprint referencedTypes] -> ShowS
showList :: [ValidatorBlueprint referencedTypes] -> ShowS
Show, ValidatorBlueprint referencedTypes
-> ValidatorBlueprint referencedTypes -> Bool
(ValidatorBlueprint referencedTypes
 -> ValidatorBlueprint referencedTypes -> Bool)
-> (ValidatorBlueprint referencedTypes
    -> ValidatorBlueprint referencedTypes -> Bool)
-> Eq (ValidatorBlueprint referencedTypes)
forall (referencedTypes :: [*]).
ValidatorBlueprint referencedTypes
-> ValidatorBlueprint referencedTypes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall (referencedTypes :: [*]).
ValidatorBlueprint referencedTypes
-> ValidatorBlueprint referencedTypes -> Bool
== :: ValidatorBlueprint referencedTypes
-> ValidatorBlueprint referencedTypes -> Bool
$c/= :: forall (referencedTypes :: [*]).
ValidatorBlueprint referencedTypes
-> ValidatorBlueprint referencedTypes -> Bool
/= :: ValidatorBlueprint referencedTypes
-> ValidatorBlueprint referencedTypes -> Bool
Eq, Eq (ValidatorBlueprint referencedTypes)
Eq (ValidatorBlueprint referencedTypes) =>
(ValidatorBlueprint referencedTypes
 -> ValidatorBlueprint referencedTypes -> Ordering)
-> (ValidatorBlueprint referencedTypes
    -> ValidatorBlueprint referencedTypes -> Bool)
-> (ValidatorBlueprint referencedTypes
    -> ValidatorBlueprint referencedTypes -> Bool)
-> (ValidatorBlueprint referencedTypes
    -> ValidatorBlueprint referencedTypes -> Bool)
-> (ValidatorBlueprint referencedTypes
    -> ValidatorBlueprint referencedTypes -> Bool)
-> (ValidatorBlueprint referencedTypes
    -> ValidatorBlueprint referencedTypes
    -> ValidatorBlueprint referencedTypes)
-> (ValidatorBlueprint referencedTypes
    -> ValidatorBlueprint referencedTypes
    -> ValidatorBlueprint referencedTypes)
-> Ord (ValidatorBlueprint referencedTypes)
ValidatorBlueprint referencedTypes
-> ValidatorBlueprint referencedTypes -> Bool
ValidatorBlueprint referencedTypes
-> ValidatorBlueprint referencedTypes -> Ordering
ValidatorBlueprint referencedTypes
-> ValidatorBlueprint referencedTypes
-> ValidatorBlueprint referencedTypes
forall (referencedTypes :: [*]).
Eq (ValidatorBlueprint referencedTypes)
forall (referencedTypes :: [*]).
ValidatorBlueprint referencedTypes
-> ValidatorBlueprint referencedTypes -> Bool
forall (referencedTypes :: [*]).
ValidatorBlueprint referencedTypes
-> ValidatorBlueprint referencedTypes -> Ordering
forall (referencedTypes :: [*]).
ValidatorBlueprint referencedTypes
-> ValidatorBlueprint referencedTypes
-> ValidatorBlueprint referencedTypes
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
$ccompare :: forall (referencedTypes :: [*]).
ValidatorBlueprint referencedTypes
-> ValidatorBlueprint referencedTypes -> Ordering
compare :: ValidatorBlueprint referencedTypes
-> ValidatorBlueprint referencedTypes -> Ordering
$c< :: forall (referencedTypes :: [*]).
ValidatorBlueprint referencedTypes
-> ValidatorBlueprint referencedTypes -> Bool
< :: ValidatorBlueprint referencedTypes
-> ValidatorBlueprint referencedTypes -> Bool
$c<= :: forall (referencedTypes :: [*]).
ValidatorBlueprint referencedTypes
-> ValidatorBlueprint referencedTypes -> Bool
<= :: ValidatorBlueprint referencedTypes
-> ValidatorBlueprint referencedTypes -> Bool
$c> :: forall (referencedTypes :: [*]).
ValidatorBlueprint referencedTypes
-> ValidatorBlueprint referencedTypes -> Bool
> :: ValidatorBlueprint referencedTypes
-> ValidatorBlueprint referencedTypes -> Bool
$c>= :: forall (referencedTypes :: [*]).
ValidatorBlueprint referencedTypes
-> ValidatorBlueprint referencedTypes -> Bool
>= :: ValidatorBlueprint referencedTypes
-> ValidatorBlueprint referencedTypes -> Bool
$cmax :: forall (referencedTypes :: [*]).
ValidatorBlueprint referencedTypes
-> ValidatorBlueprint referencedTypes
-> ValidatorBlueprint referencedTypes
max :: ValidatorBlueprint referencedTypes
-> ValidatorBlueprint referencedTypes
-> ValidatorBlueprint referencedTypes
$cmin :: forall (referencedTypes :: [*]).
ValidatorBlueprint referencedTypes
-> ValidatorBlueprint referencedTypes
-> ValidatorBlueprint referencedTypes
min :: ValidatorBlueprint referencedTypes
-> ValidatorBlueprint referencedTypes
-> ValidatorBlueprint referencedTypes
Ord)

instance ToJSON (ValidatorBlueprint referencedTypes) where
  toJSON :: ValidatorBlueprint referencedTypes -> Value
toJSON MkValidatorBlueprint{[ParameterBlueprint referencedTypes]
Maybe ByteString
Maybe Text
Maybe (ArgumentBlueprint referencedTypes)
Text
ArgumentBlueprint referencedTypes
validatorTitle :: forall (referencedTypes :: [*]).
ValidatorBlueprint referencedTypes -> Text
validatorDescription :: forall (referencedTypes :: [*]).
ValidatorBlueprint referencedTypes -> Maybe Text
validatorRedeemer :: forall (referencedTypes :: [*]).
ValidatorBlueprint referencedTypes
-> ArgumentBlueprint referencedTypes
validatorDatum :: forall (referencedTypes :: [*]).
ValidatorBlueprint referencedTypes
-> Maybe (ArgumentBlueprint referencedTypes)
validatorParameters :: forall (referencedTypes :: [*]).
ValidatorBlueprint referencedTypes
-> [ParameterBlueprint referencedTypes]
validatorCompiledCode :: forall (referencedTypes :: [*]).
ValidatorBlueprint referencedTypes -> Maybe ByteString
validatorTitle :: Text
validatorDescription :: Maybe Text
validatorRedeemer :: ArgumentBlueprint referencedTypes
validatorDatum :: Maybe (ArgumentBlueprint referencedTypes)
validatorParameters :: [ParameterBlueprint referencedTypes]
validatorCompiledCode :: Maybe ByteString
..} =
    (Object -> Object) -> Value
buildObject ((Object -> Object) -> Value) -> (Object -> Object) -> Value
forall a b. (a -> b) -> a -> b
$
      Key -> Text -> Object -> Object
forall a. ToJSON a => Key -> a -> Object -> Object
requiredField Key
"title" Text
validatorTitle
        (Object -> Object) -> (Object -> Object) -> Object -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> ArgumentBlueprint referencedTypes -> Object -> Object
forall a. ToJSON a => Key -> a -> Object -> Object
requiredField Key
"redeemer" ArgumentBlueprint referencedTypes
validatorRedeemer
        (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
"description" Maybe Text
validatorDescription
        (Object -> Object) -> (Object -> Object) -> Object -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key
-> Maybe (ArgumentBlueprint referencedTypes) -> Object -> Object
forall a. ToJSON a => Key -> Maybe a -> Object -> Object
optionalField Key
"datum" Maybe (ArgumentBlueprint referencedTypes)
validatorDatum
        (Object -> Object) -> (Object -> Object) -> Object -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key
-> Maybe (NonEmpty (ParameterBlueprint referencedTypes))
-> Object
-> Object
forall a. ToJSON a => Key -> Maybe a -> Object -> Object
optionalField Key
"parameters" ([ParameterBlueprint referencedTypes]
-> Maybe (NonEmpty (ParameterBlueprint referencedTypes))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [ParameterBlueprint referencedTypes]
validatorParameters)
        (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
"compiledCode" (ByteString -> Text
toHex (ByteString -> Text) -> Maybe ByteString -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
validatorCompiledCode)
        (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
"hash" (ByteString -> Text
toHex (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
blake2b_224 (ByteString -> Text) -> Maybe ByteString -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
validatorCompiledCode)
   where
    toHex :: ByteString -> Text
    toHex :: ByteString -> Text
toHex = ByteString -> Text
Text.decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base16.encode