babbage-examples/src/V2/ReferenceScript.hs at main · adrian1-dot/babbage-examples · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveAnyClass        #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE MultiParamTypeClasses #-}


module V2.ReferenceScript
  ( serializedScriptReferenceScript
  ) where

import           Prelude as Pr hiding (($), (.), (==), (&&), (-))

import           Cardano.Api.Shelley (PlutusScript (..), PlutusScriptV2)

import           Codec.Serialise
import qualified Data.ByteString.Lazy as LBS
import qualified Data.ByteString.Short as SBS

import qualified Plutus.Script.Utils.V2.Typed.Scripts as PUV2
import           Plutus.V2.Ledger.Contexts
import           Plutus.V2.Ledger.Api hiding (adaToken, adaSymbol)
import qualified PlutusTx
import           PlutusTx.Prelude hiding (Semigroup (..), unless)


data MyTypesReferenceScript

instance PUV2.ValidatorTypes MyTypesReferenceScript where
    type DatumType MyTypesReferenceScript = ()
    type RedeemerType MyTypesReferenceScript = ()

{-# INLINABLE mkValidatorReferenceScript #-}
mkValidatorReferenceScript :: () -> () -> ScriptContext -> Bool
mkValidatorReferenceScript _ _ ctx = traceIfFalse "reference script missing" outputHasRefScr
    where
        info :: TxInfo
        info = scriptContextTxInfo ctx

        ownValHashB :: BuiltinByteString
        ownValHashB = case ownHash ctx of
                        (ValidatorHash b) -> b

        outputHasRefScr :: Bool
        outputHasRefScr =
            let
                ins = [ i
                    | i <- txInfoOutputs info
                    , isJust (txOutReferenceScript i)
                    ]
            in
              case ins of
                [o] -> case txOutReferenceScript o of
                           Just ob -> getScriptHash ob == ownValHashB
                           Nothing -> traceError "failed BuiltinByteString"
                _   -> traceError "expected exactly one reference script in outputs"

typedValidatorReferenceScript :: PUV2.TypedValidator MyTypesReferenceScript
typedValidatorReferenceScript = PUV2.mkTypedValidator @MyTypesReferenceScript
    $$(PlutusTx.compile [||mkValidatorReferenceScript||])
    $$(PlutusTx.compile [|| wrap ||])
    where
        wrap = PUV2.mkUntypedValidator

validatorReferenceScript :: Validator
validatorReferenceScript = PUV2.validatorScript typedValidatorReferenceScript

scriptReferenceScript :: Script
scriptReferenceScript = unValidatorScript validatorReferenceScript

scriptShortBsReferenceScript :: SBS.ShortByteString
scriptShortBsReferenceScript = SBS.toShort . LBS.toStrict $ serialise scriptReferenceScript

serializedScriptReferenceScript :: PlutusScript PlutusScriptV2
serializedScriptReferenceScript = PlutusScriptSerialised scriptShortBsReferenceScript