{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# 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 qualified as BS
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)
import PlutusTx.Blueprint.PlutusVersion (PlutusVersion (..))
data ValidatorBlueprint (referencedTypes :: [Type]) = MkValidatorBlueprint
{ forall (referencedTypes :: [*]).
ValidatorBlueprint referencedTypes -> Text
validatorTitle :: Text
, forall (referencedTypes :: [*]).
ValidatorBlueprint referencedTypes -> Maybe Text
validatorDescription :: Maybe Text
, forall (referencedTypes :: [*]).
ValidatorBlueprint referencedTypes
-> ArgumentBlueprint referencedTypes
validatorRedeemer :: ArgumentBlueprint referencedTypes
, forall (referencedTypes :: [*]).
ValidatorBlueprint referencedTypes
-> Maybe (ArgumentBlueprint referencedTypes)
validatorDatum :: Maybe (ArgumentBlueprint referencedTypes)
, forall (referencedTypes :: [*]).
ValidatorBlueprint referencedTypes
-> [ParameterBlueprint referencedTypes]
validatorParameters :: [ParameterBlueprint referencedTypes]
, forall (referencedTypes :: [*]).
ValidatorBlueprint referencedTypes -> Maybe CompiledValidator
validatorCompiled :: Maybe CompiledValidator
}
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)
data CompiledValidator = MkCompiledValidator
{ CompiledValidator -> ByteString
compiledValidatorCode :: ByteString
, CompiledValidator -> ByteString
compiledValidatorHash :: ByteString
}
deriving stock (Int -> CompiledValidator -> ShowS
[CompiledValidator] -> ShowS
CompiledValidator -> String
(Int -> CompiledValidator -> ShowS)
-> (CompiledValidator -> String)
-> ([CompiledValidator] -> ShowS)
-> Show CompiledValidator
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompiledValidator -> ShowS
showsPrec :: Int -> CompiledValidator -> ShowS
$cshow :: CompiledValidator -> String
show :: CompiledValidator -> String
$cshowList :: [CompiledValidator] -> ShowS
showList :: [CompiledValidator] -> ShowS
Show, CompiledValidator -> CompiledValidator -> Bool
(CompiledValidator -> CompiledValidator -> Bool)
-> (CompiledValidator -> CompiledValidator -> Bool)
-> Eq CompiledValidator
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompiledValidator -> CompiledValidator -> Bool
== :: CompiledValidator -> CompiledValidator -> Bool
$c/= :: CompiledValidator -> CompiledValidator -> Bool
/= :: CompiledValidator -> CompiledValidator -> Bool
Eq, Eq CompiledValidator
Eq CompiledValidator =>
(CompiledValidator -> CompiledValidator -> Ordering)
-> (CompiledValidator -> CompiledValidator -> Bool)
-> (CompiledValidator -> CompiledValidator -> Bool)
-> (CompiledValidator -> CompiledValidator -> Bool)
-> (CompiledValidator -> CompiledValidator -> Bool)
-> (CompiledValidator -> CompiledValidator -> CompiledValidator)
-> (CompiledValidator -> CompiledValidator -> CompiledValidator)
-> Ord CompiledValidator
CompiledValidator -> CompiledValidator -> Bool
CompiledValidator -> CompiledValidator -> Ordering
CompiledValidator -> CompiledValidator -> CompiledValidator
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 :: CompiledValidator -> CompiledValidator -> Ordering
compare :: CompiledValidator -> CompiledValidator -> Ordering
$c< :: CompiledValidator -> CompiledValidator -> Bool
< :: CompiledValidator -> CompiledValidator -> Bool
$c<= :: CompiledValidator -> CompiledValidator -> Bool
<= :: CompiledValidator -> CompiledValidator -> Bool
$c> :: CompiledValidator -> CompiledValidator -> Bool
> :: CompiledValidator -> CompiledValidator -> Bool
$c>= :: CompiledValidator -> CompiledValidator -> Bool
>= :: CompiledValidator -> CompiledValidator -> Bool
$cmax :: CompiledValidator -> CompiledValidator -> CompiledValidator
max :: CompiledValidator -> CompiledValidator -> CompiledValidator
$cmin :: CompiledValidator -> CompiledValidator -> CompiledValidator
min :: CompiledValidator -> CompiledValidator -> CompiledValidator
Ord)
compiledValidator :: PlutusVersion -> ByteString -> CompiledValidator
compiledValidator :: PlutusVersion -> ByteString -> CompiledValidator
compiledValidator PlutusVersion
version ByteString
code =
MkCompiledValidator
{ compiledValidatorCode :: ByteString
compiledValidatorCode = ByteString
code
, compiledValidatorHash :: ByteString
compiledValidatorHash =
ByteString -> ByteString
blake2b_224 (Word8 -> ByteString
BS.singleton (PlutusVersion -> Word8
versionTag PlutusVersion
version) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
code)
}
where
versionTag :: PlutusVersion -> Word8
versionTag = \case
PlutusVersion
PlutusV1 -> Word8
0x1
PlutusVersion
PlutusV2 -> Word8
0x2
PlutusVersion
PlutusV3 -> Word8
0x3
instance ToJSON (ValidatorBlueprint referencedTypes) where
toJSON :: ValidatorBlueprint referencedTypes -> Value
toJSON MkValidatorBlueprint{[ParameterBlueprint referencedTypes]
Maybe Text
Maybe (ArgumentBlueprint referencedTypes)
Maybe CompiledValidator
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]
validatorCompiled :: forall (referencedTypes :: [*]).
ValidatorBlueprint referencedTypes -> Maybe CompiledValidator
validatorTitle :: Text
validatorDescription :: Maybe Text
validatorRedeemer :: ArgumentBlueprint referencedTypes
validatorDatum :: Maybe (ArgumentBlueprint referencedTypes)
validatorParameters :: [ParameterBlueprint referencedTypes]
validatorCompiled :: Maybe CompiledValidator
..} =
(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)
-> (CompiledValidator -> ByteString) -> CompiledValidator -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompiledValidator -> ByteString
compiledValidatorCode (CompiledValidator -> Text)
-> Maybe CompiledValidator -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CompiledValidator
validatorCompiled)
(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)
-> (CompiledValidator -> ByteString) -> CompiledValidator -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompiledValidator -> ByteString
compiledValidatorHash (CompiledValidator -> Text)
-> Maybe CompiledValidator -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CompiledValidator
validatorCompiled)
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