-- | This module introduces standard dummy validators to be used in attacks,
-- traces or tests. More precisely, it introduces the always True and always
-- False validators, which will respectively always succeed or always fail.
module Cooked.Validators
  ( alwaysTrueValidator,
    alwaysFalseValidator,
    alwaysFalseProposingValidator,
    alwaysTrueProposingValidator,
    mkScript,
    validatorToTypedValidator,
    validatorToTypedValidatorV2,
    MockContract,
  )
where

import Plutus.Script.Utils.Scripts qualified as Script
import Plutus.Script.Utils.Typed qualified as Script hiding (validatorHash)
import Plutus.Script.Utils.V3.Generators qualified as Script
import Plutus.Script.Utils.V3.Typed.Scripts.MonetaryPolicies qualified as Script
import PlutusLedgerApi.V3 qualified as Api
import PlutusTx.Code qualified as PlutusTx
import PlutusTx.Prelude qualified as PlutusTx
import PlutusTx.TH qualified as PlutusTx

validatorToTypedValidator :: Script.Validator -> Script.TypedValidator a
validatorToTypedValidator :: forall a. Validator -> TypedValidator a
validatorToTypedValidator Validator
val =
  Script.TypedValidator
    { tvValidator :: Versioned Validator
Script.tvValidator = Versioned Validator
vValidator,
      tvValidatorHash :: ValidatorHash
Script.tvValidatorHash = ValidatorHash
vValidatorHash,
      tvForwardingMPS :: Versioned MintingPolicy
Script.tvForwardingMPS = Versioned MintingPolicy
vMintingPolicy,
      tvForwardingMPSHash :: MintingPolicyHash
Script.tvForwardingMPSHash = Versioned MintingPolicy -> MintingPolicyHash
Script.mintingPolicyHash Versioned MintingPolicy
vMintingPolicy
    }
  where
    vValidator :: Versioned Validator
vValidator = Validator -> Language -> Versioned Validator
forall script. script -> Language -> Versioned script
Script.Versioned Validator
val Language
Script.PlutusV3
    vValidatorHash :: ValidatorHash
vValidatorHash = Versioned Validator -> ValidatorHash
Script.validatorHash Versioned Validator
vValidator
    forwardingPolicy :: MintingPolicy
forwardingPolicy = ValidatorHash -> MintingPolicy
Script.mkForwardingMintingPolicy ValidatorHash
vValidatorHash
    vMintingPolicy :: Versioned MintingPolicy
vMintingPolicy = MintingPolicy -> Language -> Versioned MintingPolicy
forall script. script -> Language -> Versioned script
Script.Versioned MintingPolicy
forwardingPolicy Language
Script.PlutusV3

validatorToTypedValidatorV2 :: Script.Validator -> Script.TypedValidator a
validatorToTypedValidatorV2 :: forall a. Validator -> TypedValidator a
validatorToTypedValidatorV2 Validator
val =
  Script.TypedValidator
    { tvValidator :: Versioned Validator
Script.tvValidator = Versioned Validator
vValidator,
      tvValidatorHash :: ValidatorHash
Script.tvValidatorHash = ValidatorHash
vValidatorHash,
      tvForwardingMPS :: Versioned MintingPolicy
Script.tvForwardingMPS = Versioned MintingPolicy
vMintingPolicy,
      tvForwardingMPSHash :: MintingPolicyHash
Script.tvForwardingMPSHash = Versioned MintingPolicy -> MintingPolicyHash
Script.mintingPolicyHash Versioned MintingPolicy
vMintingPolicy
    }
  where
    vValidator :: Versioned Validator
vValidator = Validator -> Language -> Versioned Validator
forall script. script -> Language -> Versioned script
Script.Versioned Validator
val Language
Script.PlutusV2
    vValidatorHash :: ValidatorHash
vValidatorHash = Versioned Validator -> ValidatorHash
Script.validatorHash Versioned Validator
vValidator
    forwardingPolicy :: MintingPolicy
forwardingPolicy = ValidatorHash -> MintingPolicy
Script.mkForwardingMintingPolicy ValidatorHash
vValidatorHash
    vMintingPolicy :: Versioned MintingPolicy
vMintingPolicy = MintingPolicy -> Language -> Versioned MintingPolicy
forall script. script -> Language -> Versioned script
Script.Versioned MintingPolicy
forwardingPolicy Language
Script.PlutusV2

-- | The trivial validator that always succeds; this is in particular a
-- sufficient target for the datum hijacking attack since we only want to show
-- feasibility of the attack.
alwaysTrueValidator :: forall a. Script.TypedValidator a
alwaysTrueValidator :: forall a. TypedValidator a
alwaysTrueValidator = forall a. Validator -> TypedValidator a
validatorToTypedValidator @a Validator
Script.alwaysSucceedValidator

-- | The trivial validator that always fails
alwaysFalseValidator :: forall a. Script.TypedValidator a
alwaysFalseValidator :: forall a. TypedValidator a
alwaysFalseValidator = forall a. Validator -> TypedValidator a
validatorToTypedValidator @a (Validator -> TypedValidator a) -> Validator -> TypedValidator a
forall a b. (a -> b) -> a -> b
$ CompiledCode (BuiltinData -> BuiltinData -> BuiltinData -> ())
-> Validator
Script.mkValidatorScript $$(PlutusTx.compile [||\_ _ _ -> PlutusTx.error ()||])

-- | A Mock contract type to instantiate validators with
data MockContract

instance Script.ValidatorTypes MockContract where
  type RedeemerType MockContract = ()
  type DatumType MockContract = ()

-- | A dummy false proposing validator
alwaysFalseProposingValidator :: Script.Versioned Script.Script
alwaysFalseProposingValidator :: Versioned Script
alwaysFalseProposingValidator =
  CompiledCode (BuiltinData -> BuiltinData -> ()) -> Versioned Script
mkScript $$(PlutusTx.compile [||PlutusTx.traceError "False proposing validator"||])

-- | A dummy true proposing validator
alwaysTrueProposingValidator :: Script.Versioned Script.Script
alwaysTrueProposingValidator :: Versioned Script
alwaysTrueProposingValidator =
  CompiledCode (BuiltinData -> BuiltinData -> ()) -> Versioned Script
mkScript $$(PlutusTx.compile [||\_ _ -> ()||])

-- | Helper to build a script. This should come from plutus-script-utils at some
-- point.
mkScript :: PlutusTx.CompiledCode (PlutusTx.BuiltinData -> PlutusTx.BuiltinData -> ()) -> Script.Versioned Script.Script
mkScript :: CompiledCode (BuiltinData -> BuiltinData -> ()) -> Versioned Script
mkScript CompiledCode (BuiltinData -> BuiltinData -> ())
code = Script -> Language -> Versioned Script
forall script. script -> Language -> Versioned script
Script.Versioned (SerialisedScript -> Script
Script.Script (SerialisedScript -> Script) -> SerialisedScript -> Script
forall a b. (a -> b) -> a -> b
$ CompiledCode (BuiltinData -> BuiltinData -> ()) -> SerialisedScript
forall a. CompiledCode a -> SerialisedScript
Api.serialiseCompiledCode CompiledCode (BuiltinData -> BuiltinData -> ())
code) Language
Script.PlutusV3