{-# LANGUAGE OverloadedLists #-}

{- |
Module      : Cardano.YTxP
Description : Yielding Transaction Pattern Library (ytxp-lib)

This module provides the blueprint for the Yielding Transaction Pattern Library (ytxp-lib).
-}
module Cardano.YTxP (
  ytxpBlueprint,
) where

import Cardano.Binary qualified as CBOR
import Cardano.YTxP.Control.Yielding.Scripts (yielding)
import Cardano.YTxP.SDK.SdkParameters (
  AuthorisedScriptsSTCS (AuthorisedScriptsSTCS),
  SdkParameters (
    SdkParameters
  ),
 )
import Data.ByteString.Short qualified as SBS
import Data.Coerce (coerce)
import Data.Data (Proxy (Proxy))
import Data.Maybe (isJust)
import Data.Set qualified as Set
import Data.Text qualified as T
import GHC.Natural (naturalToInteger)
import Plutarch.Internal.Term (Config, compile, tracingMode)
import Plutarch.LedgerApi.V3 (PScriptContext, scriptHash)
import Plutarch.Script (serialiseScript)
import PlutusLedgerApi.V3 (ScriptHash (ScriptHash))
import PlutusTx.Blueprint (
  ArgumentBlueprint (
    MkArgumentBlueprint,
    argumentDescription,
    argumentPurpose,
    argumentSchema,
    argumentTitle
  ),
  CompiledValidator (
    MkCompiledValidator,
    compiledValidatorCode,
    compiledValidatorHash
  ),
  ContractBlueprint (
    MkContractBlueprint,
    contractDefinitions,
    contractId,
    contractPreamble,
    contractValidators
  ),
  ParameterBlueprint (
    MkParameterBlueprint,
    parameterDescription,
    parameterPurpose,
    parameterSchema,
    parameterTitle
  ),
  Preamble (
    MkPreamble,
    preambleDescription,
    preambleLicense,
    preamblePlutusVersion,
    preambleTitle,
    preambleVersion
  ),
  ValidatorBlueprint (
    MkValidatorBlueprint,
    validatorCompiled,
    validatorDatum,
    validatorDescription,
    validatorParameters,
    validatorRedeemer,
    validatorTitle
  ),
  definitionRef,
 )
import PlutusTx.Builtins qualified as PlutusTx
import Ply (reifyVersion)
import Ply.Plutarch (
  ParamsOf,
  PlyArgOf,
  ReferencedTypesOf,
  VersionOf,
  derivePDefinitions,
  mkParamSchemas,
 )

{- |
Type alias for the Plutarch type.
-}
type PType = PScriptContext :--> PUnit

{- |
Type alias for the referenced types.
-}
type YieldingReferenceTypes = ReferencedTypesOf (PData ': ParamsOf PType)

{- |
Generates the blueprint for the Yielding Transaction Pattern Library.

@since 0.1.0
-}
ytxpBlueprint :: Config -> SdkParameters -> ContractBlueprint
ytxpBlueprint :: Config -> SdkParameters -> ContractBlueprint
ytxpBlueprint Config
config SdkParameters
params =
  MkContractBlueprint
    { contractId :: Maybe Text
contractId = Maybe Text
forall a. Maybe a
Nothing
    , contractPreamble :: Preamble
contractPreamble =
        MkPreamble
          { preambleTitle :: Text
preambleTitle = Text
"Yielding Transaction Pattern Library (ytxp-lib)"
          , preambleDescription :: Maybe Text
preambleDescription = Maybe Text
forall a. Maybe a
Nothing
          , preambleVersion :: Text
preambleVersion = Text
"1.0.0"
          , preamblePlutusVersion :: PlutusVersion
preamblePlutusVersion =
              Proxy @PlutusVersion 'PlutusV3 -> PlutusVersion
forall (v :: PlutusVersion).
ReifyVersion v =>
Proxy @PlutusVersion v -> PlutusVersion
reifyVersion (Proxy @PlutusVersion 'PlutusV3 -> PlutusVersion)
-> Proxy @PlutusVersion 'PlutusV3 -> PlutusVersion
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy @k t
forall (t :: PlutusVersion). Proxy @PlutusVersion t
Proxy @(VersionOf PType)
          , preambleLicense :: Maybe Text
preambleLicense = Maybe Text
forall a. Maybe a
Nothing
          }
    , contractValidators :: Set (ValidatorBlueprint ((':) @Type BuiltinData ('[] @Type)))
contractValidators =
        [ValidatorBlueprint YieldingReferenceTypes]
-> Set (ValidatorBlueprint YieldingReferenceTypes)
forall a. Ord a => [a] -> Set a
Set.fromList ([ValidatorBlueprint YieldingReferenceTypes]
 -> Set (ValidatorBlueprint YieldingReferenceTypes))
-> [ValidatorBlueprint YieldingReferenceTypes]
-> Set (ValidatorBlueprint YieldingReferenceTypes)
forall a b. (a -> b) -> a -> b
$ Config
-> SdkParameters -> [ValidatorBlueprint YieldingReferenceTypes]
yieldingBlueprints Config
config SdkParameters
params
    , contractDefinitions :: Definitions ((':) @Type BuiltinData ('[] @Type))
contractDefinitions =
        -- Note (see Ply example): We have to manually prepend datum/redeemer to the types because it does not exist on the Plutarch type.
        forall (ptypes :: [PType]).
HasDefinitions ptypes =>
Definitions (ReferencedTypesOf ptypes)
derivePDefinitions @(PData ': ParamsOf PType)
    }

{- |
Generates the validator blueprints.

@since 0.1.0
-}
yieldingBlueprints ::
  Config -> SdkParameters -> [ValidatorBlueprint YieldingReferenceTypes]
yieldingBlueprints :: Config
-> SdkParameters -> [ValidatorBlueprint YieldingReferenceTypes]
yieldingBlueprints Config
config (SdkParameters [Natural]
svNonces [Natural]
mpNonces [Natural]
cvNonces [Natural]
vvNonces [Natural]
pvNonces AuthorisedScriptsSTCS
stcs) =
  Config
-> Text
-> ClosedTerm PType
-> ValidatorBlueprint YieldingReferenceTypes
mkYieldingBlueprint
    Config
config
    Text
"Yielding Spending"
    (Term s (PCurrencySymbol :--> (PAsData PInteger :--> PType))
forall (s :: S).
Term s (PCurrencySymbol :--> (PAsData PInteger :--> PType))
yielding Term s (PCurrencySymbol :--> (PAsData PInteger :--> PType))
-> Term s PCurrencySymbol -> Term s (PAsData PInteger :--> PType)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# AsHaskell PCurrencySymbol -> Term s PCurrencySymbol
forall (a :: PType) (s :: S).
PLiftable a =>
AsHaskell a -> Term s a
pconstant (AuthorisedScriptsSTCS -> CurrencySymbol
forall a b. Coercible @Type a b => a -> b
coerce AuthorisedScriptsSTCS
stcs) Term s (PAsData PInteger :--> PType)
-> Term s (PAsData PInteger) -> Term s PType
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger -> Term s (PAsData PInteger)
forall (a :: PType) (s :: S).
PIsData a =>
Term s a -> Term s (PAsData a)
pdata Term s PInteger
forall (s :: S). Term s PInteger
forall (a :: PType) (s :: S). PAdditiveMonoid a => Term s a
pzero)
    ValidatorBlueprint ((':) @Type BuiltinData ('[] @Type))
-> [ValidatorBlueprint ((':) @Type BuiltinData ('[] @Type))]
-> [ValidatorBlueprint ((':) @Type BuiltinData ('[] @Type))]
forall a. a -> [a] -> [a]
: (Natural
 -> ValidatorBlueprint ((':) @Type BuiltinData ('[] @Type)))
-> [Natural]
-> [ValidatorBlueprint ((':) @Type BuiltinData ('[] @Type))]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap
      ( \Natural
nonce ->
          Config
-> Text
-> ClosedTerm PType
-> ValidatorBlueprint YieldingReferenceTypes
mkYieldingBlueprint Config
config Text
"Yielding Rewarding" (ClosedTerm PType -> ValidatorBlueprint YieldingReferenceTypes)
-> ClosedTerm PType -> ValidatorBlueprint YieldingReferenceTypes
forall a b. (a -> b) -> a -> b
$
            Term s (PCurrencySymbol :--> (PAsData PInteger :--> PType))
forall (s :: S).
Term s (PCurrencySymbol :--> (PAsData PInteger :--> PType))
yielding Term s (PCurrencySymbol :--> (PAsData PInteger :--> PType))
-> Term s PCurrencySymbol -> Term s (PAsData PInteger :--> PType)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# AsHaskell PCurrencySymbol -> Term s PCurrencySymbol
forall (a :: PType) (s :: S).
PLiftable a =>
AsHaskell a -> Term s a
pconstant (AuthorisedScriptsSTCS -> CurrencySymbol
forall a b. Coercible @Type a b => a -> b
coerce AuthorisedScriptsSTCS
stcs) Term s (PAsData PInteger :--> PType)
-> Term s (PAsData PInteger) -> Term s PType
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger -> Term s (PAsData PInteger)
forall (a :: PType) (s :: S).
PIsData a =>
Term s a -> Term s (PAsData a)
pdata (AsHaskell PInteger -> Term s PInteger
forall (a :: PType) (s :: S).
PLiftable a =>
AsHaskell a -> Term s a
pconstant (AsHaskell PInteger -> Term s PInteger)
-> AsHaskell PInteger -> Term s PInteger
forall a b. (a -> b) -> a -> b
$ Natural -> Integer
naturalToInteger Natural
nonce)
      )
      [Natural]
svNonces
      [ValidatorBlueprint ((':) @Type BuiltinData ('[] @Type))]
-> [ValidatorBlueprint ((':) @Type BuiltinData ('[] @Type))]
-> [ValidatorBlueprint ((':) @Type BuiltinData ('[] @Type))]
forall a. Semigroup a => a -> a -> a
<> (Natural
 -> ValidatorBlueprint ((':) @Type BuiltinData ('[] @Type)))
-> [Natural]
-> [ValidatorBlueprint ((':) @Type BuiltinData ('[] @Type))]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap
        ( \Natural
nonce ->
            Config
-> Text
-> ClosedTerm PType
-> ValidatorBlueprint YieldingReferenceTypes
mkYieldingBlueprint Config
config Text
"Yielding Minting" (ClosedTerm PType -> ValidatorBlueprint YieldingReferenceTypes)
-> ClosedTerm PType -> ValidatorBlueprint YieldingReferenceTypes
forall a b. (a -> b) -> a -> b
$
              Term s (PCurrencySymbol :--> (PAsData PInteger :--> PType))
forall (s :: S).
Term s (PCurrencySymbol :--> (PAsData PInteger :--> PType))
yielding Term s (PCurrencySymbol :--> (PAsData PInteger :--> PType))
-> Term s PCurrencySymbol -> Term s (PAsData PInteger :--> PType)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# AsHaskell PCurrencySymbol -> Term s PCurrencySymbol
forall (a :: PType) (s :: S).
PLiftable a =>
AsHaskell a -> Term s a
pconstant (AuthorisedScriptsSTCS -> CurrencySymbol
forall a b. Coercible @Type a b => a -> b
coerce AuthorisedScriptsSTCS
stcs) Term s (PAsData PInteger :--> PType)
-> Term s (PAsData PInteger) -> Term s PType
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger -> Term s (PAsData PInteger)
forall (a :: PType) (s :: S).
PIsData a =>
Term s a -> Term s (PAsData a)
pdata (AsHaskell PInteger -> Term s PInteger
forall (a :: PType) (s :: S).
PLiftable a =>
AsHaskell a -> Term s a
pconstant (AsHaskell PInteger -> Term s PInteger)
-> AsHaskell PInteger -> Term s PInteger
forall a b. (a -> b) -> a -> b
$ Natural -> Integer
naturalToInteger Natural
nonce)
        )
        [Natural]
mpNonces
      [ValidatorBlueprint ((':) @Type BuiltinData ('[] @Type))]
-> [ValidatorBlueprint ((':) @Type BuiltinData ('[] @Type))]
-> [ValidatorBlueprint ((':) @Type BuiltinData ('[] @Type))]
forall a. Semigroup a => a -> a -> a
<> (Natural
 -> ValidatorBlueprint ((':) @Type BuiltinData ('[] @Type)))
-> [Natural]
-> [ValidatorBlueprint ((':) @Type BuiltinData ('[] @Type))]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap
        ( \Natural
nonce ->
            Config
-> Text
-> ClosedTerm PType
-> ValidatorBlueprint YieldingReferenceTypes
mkYieldingBlueprint Config
config Text
"Yielding Certifying" (ClosedTerm PType -> ValidatorBlueprint YieldingReferenceTypes)
-> ClosedTerm PType -> ValidatorBlueprint YieldingReferenceTypes
forall a b. (a -> b) -> a -> b
$
              Term s (PCurrencySymbol :--> (PAsData PInteger :--> PType))
forall (s :: S).
Term s (PCurrencySymbol :--> (PAsData PInteger :--> PType))
yielding Term s (PCurrencySymbol :--> (PAsData PInteger :--> PType))
-> Term s PCurrencySymbol -> Term s (PAsData PInteger :--> PType)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# AsHaskell PCurrencySymbol -> Term s PCurrencySymbol
forall (a :: PType) (s :: S).
PLiftable a =>
AsHaskell a -> Term s a
pconstant (AuthorisedScriptsSTCS -> CurrencySymbol
forall a b. Coercible @Type a b => a -> b
coerce AuthorisedScriptsSTCS
stcs) Term s (PAsData PInteger :--> PType)
-> Term s (PAsData PInteger) -> Term s PType
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger -> Term s (PAsData PInteger)
forall (a :: PType) (s :: S).
PIsData a =>
Term s a -> Term s (PAsData a)
pdata (AsHaskell PInteger -> Term s PInteger
forall (a :: PType) (s :: S).
PLiftable a =>
AsHaskell a -> Term s a
pconstant (AsHaskell PInteger -> Term s PInteger)
-> AsHaskell PInteger -> Term s PInteger
forall a b. (a -> b) -> a -> b
$ Natural -> Integer
naturalToInteger Natural
nonce)
        )
        [Natural]
cvNonces
      [ValidatorBlueprint ((':) @Type BuiltinData ('[] @Type))]
-> [ValidatorBlueprint ((':) @Type BuiltinData ('[] @Type))]
-> [ValidatorBlueprint ((':) @Type BuiltinData ('[] @Type))]
forall a. Semigroup a => a -> a -> a
<> (Natural
 -> ValidatorBlueprint ((':) @Type BuiltinData ('[] @Type)))
-> [Natural]
-> [ValidatorBlueprint ((':) @Type BuiltinData ('[] @Type))]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap
        ( \Natural
nonce ->
            Config
-> Text
-> ClosedTerm PType
-> ValidatorBlueprint YieldingReferenceTypes
mkYieldingBlueprint Config
config Text
"Yielding Voting" (ClosedTerm PType -> ValidatorBlueprint YieldingReferenceTypes)
-> ClosedTerm PType -> ValidatorBlueprint YieldingReferenceTypes
forall a b. (a -> b) -> a -> b
$
              Term s (PCurrencySymbol :--> (PAsData PInteger :--> PType))
forall (s :: S).
Term s (PCurrencySymbol :--> (PAsData PInteger :--> PType))
yielding Term s (PCurrencySymbol :--> (PAsData PInteger :--> PType))
-> Term s PCurrencySymbol -> Term s (PAsData PInteger :--> PType)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# AsHaskell PCurrencySymbol -> Term s PCurrencySymbol
forall (a :: PType) (s :: S).
PLiftable a =>
AsHaskell a -> Term s a
pconstant (AuthorisedScriptsSTCS -> CurrencySymbol
forall a b. Coercible @Type a b => a -> b
coerce AuthorisedScriptsSTCS
stcs) Term s (PAsData PInteger :--> PType)
-> Term s (PAsData PInteger) -> Term s PType
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger -> Term s (PAsData PInteger)
forall (a :: PType) (s :: S).
PIsData a =>
Term s a -> Term s (PAsData a)
pdata (AsHaskell PInteger -> Term s PInteger
forall (a :: PType) (s :: S).
PLiftable a =>
AsHaskell a -> Term s a
pconstant (AsHaskell PInteger -> Term s PInteger)
-> AsHaskell PInteger -> Term s PInteger
forall a b. (a -> b) -> a -> b
$ Natural -> Integer
naturalToInteger Natural
nonce)
        )
        [Natural]
vvNonces
      [ValidatorBlueprint ((':) @Type BuiltinData ('[] @Type))]
-> [ValidatorBlueprint ((':) @Type BuiltinData ('[] @Type))]
-> [ValidatorBlueprint ((':) @Type BuiltinData ('[] @Type))]
forall a. Semigroup a => a -> a -> a
<> (Natural
 -> ValidatorBlueprint ((':) @Type BuiltinData ('[] @Type)))
-> [Natural]
-> [ValidatorBlueprint ((':) @Type BuiltinData ('[] @Type))]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap
        ( \Natural
nonce ->
            Config
-> Text
-> ClosedTerm PType
-> ValidatorBlueprint YieldingReferenceTypes
mkYieldingBlueprint Config
config Text
"Yielding Proposing" (ClosedTerm PType -> ValidatorBlueprint YieldingReferenceTypes)
-> ClosedTerm PType -> ValidatorBlueprint YieldingReferenceTypes
forall a b. (a -> b) -> a -> b
$
              Term s (PCurrencySymbol :--> (PAsData PInteger :--> PType))
forall (s :: S).
Term s (PCurrencySymbol :--> (PAsData PInteger :--> PType))
yielding Term s (PCurrencySymbol :--> (PAsData PInteger :--> PType))
-> Term s PCurrencySymbol -> Term s (PAsData PInteger :--> PType)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# AsHaskell PCurrencySymbol -> Term s PCurrencySymbol
forall (a :: PType) (s :: S).
PLiftable a =>
AsHaskell a -> Term s a
pconstant (AuthorisedScriptsSTCS -> CurrencySymbol
forall a b. Coercible @Type a b => a -> b
coerce AuthorisedScriptsSTCS
stcs) Term s (PAsData PInteger :--> PType)
-> Term s (PAsData PInteger) -> Term s PType
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger -> Term s (PAsData PInteger)
forall (a :: PType) (s :: S).
PIsData a =>
Term s a -> Term s (PAsData a)
pdata (AsHaskell PInteger -> Term s PInteger
forall (a :: PType) (s :: S).
PLiftable a =>
AsHaskell a -> Term s a
pconstant (AsHaskell PInteger -> Term s PInteger)
-> AsHaskell PInteger -> Term s PInteger
forall a b. (a -> b) -> a -> b
$ Natural -> Integer
naturalToInteger Natural
nonce)
        )
        [Natural]
pvNonces

{- |
Creates a validator blueprint.

@since 0.1.0
-}
mkYieldingBlueprint ::
  Config ->
  T.Text ->
  ClosedTerm PType ->
  ValidatorBlueprint YieldingReferenceTypes
mkYieldingBlueprint :: Config
-> Text
-> ClosedTerm PType
-> ValidatorBlueprint YieldingReferenceTypes
mkYieldingBlueprint Config
config Text
title ClosedTerm PType
ct =
  MkValidatorBlueprint
    { validatorTitle :: Text
validatorTitle = Text
title
    , validatorDescription :: Maybe Text
validatorDescription =
        Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$
          if Maybe TracingMode -> Bool
forall a. Maybe a -> Bool
isJust (Config -> Maybe TracingMode
tracingMode Config
config)
            then Text
"Compiled with traces"
            else Text
"Compiled without traces"
    , validatorParameters :: [ParameterBlueprint ((':) @Type BuiltinData ('[] @Type))]
validatorParameters =
        (Schema YieldingReferenceTypes
 -> ParameterBlueprint ((':) @Type BuiltinData ('[] @Type)))
-> [Schema YieldingReferenceTypes]
-> [ParameterBlueprint ((':) @Type BuiltinData ('[] @Type))]
forall a b. (a -> b) -> [a] -> [b]
map
          ( \Schema YieldingReferenceTypes
sch ->
              MkParameterBlueprint
                { parameterTitle :: Maybe Text
parameterTitle = Maybe Text
forall a. Maybe a
Nothing
                , parameterDescription :: Maybe Text
parameterDescription = Maybe Text
forall a. Maybe a
Nothing
                , parameterPurpose :: Set Purpose
parameterPurpose = []
                , parameterSchema :: Schema ((':) @Type BuiltinData ('[] @Type))
parameterSchema = Schema ((':) @Type BuiltinData ('[] @Type))
Schema YieldingReferenceTypes
sch
                }
          )
          -- Note (see Ply example): When using 'mkParamSchemas', the second type argument should only contain the params (i.e from 'ParamsOf'), not the datum/redeemer.
          ([Schema YieldingReferenceTypes]
 -> [ParameterBlueprint ((':) @Type BuiltinData ('[] @Type))])
-> [Schema YieldingReferenceTypes]
-> [ParameterBlueprint ((':) @Type BuiltinData ('[] @Type))]
forall a b. (a -> b) -> a -> b
$ forall (referencedTypes :: [Type]) (ptypes :: [PType]).
All @PType (HasArgDefinition referencedTypes) ptypes =>
[Schema referencedTypes]
mkParamSchemas @YieldingReferenceTypes @(ParamsOf PType)
    , validatorRedeemer :: ArgumentBlueprint ((':) @Type BuiltinData ('[] @Type))
validatorRedeemer =
        MkArgumentBlueprint
          { argumentTitle :: Maybe Text
argumentTitle = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Yielding redeemer"
          , argumentDescription :: Maybe Text
argumentDescription = Maybe Text
forall a. Maybe a
Nothing
          , argumentPurpose :: Set Purpose
argumentPurpose = []
          , argumentSchema :: Schema ((':) @Type BuiltinData ('[] @Type))
argumentSchema = forall t (ts :: [Type]). HasBlueprintDefinition t => Schema ts
definitionRef @(PlyArgOf PData) -- TODO PYieldingRedeemer
          }
    , validatorDatum :: Maybe (ArgumentBlueprint ((':) @Type BuiltinData ('[] @Type)))
validatorDatum = Maybe (ArgumentBlueprint ((':) @Type BuiltinData ('[] @Type)))
forall a. Maybe a
Nothing
    , validatorCompiled :: Maybe CompiledValidator
validatorCompiled =
        CompiledValidator -> Maybe CompiledValidator
forall a. a -> Maybe a
Just
          MkCompiledValidator
            { compiledValidatorHash :: ByteString
compiledValidatorHash = BuiltinByteString -> FromBuiltin BuiltinByteString
forall arep. HasFromBuiltin arep => arep -> FromBuiltin arep
PlutusTx.fromBuiltin BuiltinByteString
hash
            , compiledValidatorCode :: ByteString
compiledValidatorCode = ByteString -> ByteString
forall a. ToCBOR a => a -> ByteString
CBOR.serialize' (ByteString -> ByteString)
-> (ShortByteString -> ByteString) -> ShortByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteString
SBS.fromShort (ShortByteString -> ByteString) -> ShortByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Script -> ShortByteString
serialiseScript Script
script
            }
    }
  where
    script :: Script
script = (Text -> Script)
-> (Script -> Script) -> Either Text Script -> Script
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> Script
forall a. HasCallStack => [Char] -> a
error ([Char] -> Script) -> (Text -> [Char]) -> Text -> Script
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack) Script -> Script
forall a. a -> a
id (Either Text Script -> Script) -> Either Text Script -> Script
forall a b. (a -> b) -> a -> b
$ Config -> ClosedTerm PType -> Either Text Script
forall (a :: PType). Config -> ClosedTerm a -> Either Text Script
compile Config
config Term s PType
ClosedTerm PType
ct
    ScriptHash BuiltinByteString
hash = Script -> ScriptHash
scriptHash Script
script