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

{- | 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 CompiledValidator
validatorCompiled    :: Maybe CompiledValidator
  -- ^ A full compiled and CBOR-encoded serialized flat script together with its hash.
  }
  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