{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-specialize #-}
{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:conservative-optimisation #-}
{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:defer-errors #-}
-- Plutus core version to compile to. In babbage era, that is Cardano protocol
-- version 7 and 8, only plutus-core version 1.0.0 is available.
{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:target-version=1.0.0 #-}

module Hydra.Contract.Head where

import PlutusTx.Prelude

import Hydra.Cardano.Api (PlutusScriptVersion (PlutusScriptV3))
import Hydra.Contract.Commit (Commit (..))
import Hydra.Contract.Commit qualified as Commit
import Hydra.Contract.HeadError (HeadError (..), errorCode)
import Hydra.Contract.HeadState (CloseRedeemer (..), ClosedDatum (..), ContestRedeemer (..), DecrementRedeemer (..), Hash, IncrementRedeemer, Input (..), OpenDatum (..), Signature, SnapshotNumber, SnapshotVersion, State (..))
import Hydra.Contract.Util (hasST, mustBurnAllHeadTokens, mustNotMintOrBurn, (===))
import Hydra.Data.ContestationPeriod (ContestationPeriod, addContestationPeriod, milliseconds)
import Hydra.Data.Party (Party (vkey))
import Hydra.Plutus.Extras (ValidatorType, scriptValidatorHash, wrapValidator)
import PlutusLedgerApi.Common (SerialisedScript, serialiseCompiledCode)
import PlutusLedgerApi.V1.Time (fromMilliSeconds)
import PlutusLedgerApi.V1.Value (lovelaceValue)
import PlutusLedgerApi.V3 (
  Address,
  CurrencySymbol,
  Datum (..),
  Extended (Finite),
  FromData (fromBuiltinData),
  Interval (..),
  LowerBound (LowerBound),
  OutputDatum (..),
  POSIXTime,
  PubKeyHash (getPubKeyHash),
  ScriptContext (..),
  ScriptHash,
  ToData (toBuiltinData),
  TokenName (..),
  TxInInfo (..),
  TxInfo (..),
  TxOut (..),
  TxOutRef (..),
  UpperBound (..),
  Value (Value),
 )
import PlutusLedgerApi.V3.Contexts (findOwnInput)
import PlutusTx (CompiledCode)
import PlutusTx qualified
import PlutusTx.AssocMap qualified as AssocMap
import PlutusTx.Builtins qualified as Builtins

type DatumType = State
type RedeemerType = Input

--------------------------------------------------------------------------------
-- Validators
--------------------------------------------------------------------------------

{-# INLINEABLE headValidator #-}
headValidator ::
  State ->
  Input ->
  ScriptContext ->
  Bool
headValidator :: DatumType -> Input -> ScriptContext -> Bool
headValidator DatumType
oldState Input
input ScriptContext
ctx =
  case (DatumType
oldState, Input
input) of
    (Initial{ContestationPeriod
contestationPeriod :: ContestationPeriod
$sel:contestationPeriod:Initial :: DatumType -> ContestationPeriod
contestationPeriod, [Party]
parties :: [Party]
$sel:parties:Initial :: DatumType -> [Party]
parties, CurrencySymbol
headId :: CurrencySymbol
$sel:headId:Initial :: DatumType -> CurrencySymbol
headId}, Input
CollectCom) ->
      ScriptContext
-> (ContestationPeriod, [Party], CurrencySymbol) -> Bool
checkCollectCom ScriptContext
ctx (ContestationPeriod
contestationPeriod, [Party]
parties, CurrencySymbol
headId)
    (Initial{[Party]
$sel:parties:Initial :: DatumType -> [Party]
parties :: [Party]
parties, CurrencySymbol
$sel:headId:Initial :: DatumType -> CurrencySymbol
headId :: CurrencySymbol
headId}, Input
Abort) ->
      ScriptContext -> CurrencySymbol -> [Party] -> Bool
checkAbort ScriptContext
ctx CurrencySymbol
headId [Party]
parties
    (Open OpenDatum
openDatum, Increment IncrementRedeemer
redeemer) ->
      ScriptContext -> OpenDatum -> IncrementRedeemer -> Bool
checkIncrement ScriptContext
ctx OpenDatum
openDatum IncrementRedeemer
redeemer
    (Open OpenDatum
openDatum, Decrement DecrementRedeemer
redeemer) ->
      ScriptContext -> OpenDatum -> DecrementRedeemer -> Bool
checkDecrement ScriptContext
ctx OpenDatum
openDatum DecrementRedeemer
redeemer
    (Open OpenDatum
openDatum, Close CloseRedeemer
redeemer) ->
      ScriptContext -> OpenDatum -> CloseRedeemer -> Bool
checkClose ScriptContext
ctx OpenDatum
openDatum CloseRedeemer
redeemer
    (Closed ClosedDatum
closedDatum, Contest ContestRedeemer
redeemer) ->
      ScriptContext -> ClosedDatum -> ContestRedeemer -> Bool
checkContest ScriptContext
ctx ClosedDatum
closedDatum ContestRedeemer
redeemer
    (Closed ClosedDatum
closedDatum, Fanout{Integer
numberOfFanoutOutputs :: Integer
$sel:numberOfFanoutOutputs:CollectCom :: Input -> Integer
numberOfFanoutOutputs, Integer
numberOfDecommitOutputs :: Integer
$sel:numberOfDecommitOutputs:CollectCom :: Input -> Integer
numberOfDecommitOutputs}) ->
      ScriptContext -> ClosedDatum -> Integer -> Integer -> Bool
checkFanout ScriptContext
ctx ClosedDatum
closedDatum Integer
numberOfFanoutOutputs Integer
numberOfDecommitOutputs
    (DatumType, Input)
_ ->
      BuiltinString -> Bool
forall a. BuiltinString -> a
traceError $(errorCode InvalidHeadStateTransition)

-- | On-Chain verification for 'Abort' transition. It verifies that:
--
--   * All PTs have been burnt: The right number of Head tokens with the correct
--     head id are burnt, one PT for each party and a state token ST.
--
--   * All committed funds have been redistributed. This is done via v_commit
--     and it only needs to ensure that we have spent all comitted outputs,
--     which follows from burning all the PTs.
checkAbort ::
  ScriptContext ->
  CurrencySymbol ->
  [Party] ->
  Bool
checkAbort :: ScriptContext -> CurrencySymbol -> [Party] -> Bool
checkAbort ctx :: ScriptContext
ctx@ScriptContext{scriptContextTxInfo :: ScriptContext -> TxInfo
scriptContextTxInfo = TxInfo
txInfo} CurrencySymbol
headCurrencySymbol [Party]
parties =
  Value -> CurrencySymbol -> [Party] -> Bool
mustBurnAllHeadTokens Value
minted CurrencySymbol
headCurrencySymbol [Party]
parties
    Bool -> Bool -> Bool
&& ScriptContext -> CurrencySymbol -> Bool
mustBeSignedByParticipant ScriptContext
ctx CurrencySymbol
headCurrencySymbol
    Bool -> Bool -> Bool
&& Bool
mustReimburseCommittedUTxO
 where
  minted :: Value
minted = TxInfo -> Value
txInfoMint TxInfo
txInfo

  mustReimburseCommittedUTxO :: Bool
mustReimburseCommittedUTxO =
    BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode ReimbursedOutputsDontMatch) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
      BuiltinByteString
hashOfCommittedUTxO BuiltinByteString -> BuiltinByteString -> Bool
forall a. Eq a => a -> a -> Bool
== BuiltinByteString
hashOfOutputs

  hashOfOutputs :: BuiltinByteString
hashOfOutputs =
    -- NOTE: It is enough to just _take_ the same number of outputs that
    -- correspond to the number of commit inputs to make sure everything is
    -- reimbursed because we assume the outputs are correctly sorted with
    -- reimbursed commits coming first
    [TxOut] -> BuiltinByteString
hashTxOuts ([TxOut] -> BuiltinByteString) -> [TxOut] -> BuiltinByteString
forall a b. (a -> b) -> a -> b
$ Integer -> [TxOut] -> [TxOut]
forall a. Integer -> [a] -> [a]
take ([Commit] -> Integer
forall (t :: * -> *) a. Foldable t => t a -> Integer
length [Commit]
committed) (TxInfo -> [TxOut]
txInfoOutputs TxInfo
txInfo)

  hashOfCommittedUTxO :: BuiltinByteString
hashOfCommittedUTxO =
    [Commit] -> BuiltinByteString
hashPreSerializedCommits [Commit]
committed

  committed :: [Commit]
committed = [Commit] -> [TxInInfo] -> [Commit]
committedUTxO [] (TxInfo -> [TxInInfo]
txInfoInputs TxInfo
txInfo)

  committedUTxO :: [Commit] -> [TxInInfo] -> [Commit]
committedUTxO [Commit]
commits = \case
    [] -> [Commit]
commits
    TxInInfo{txInInfoResolved :: TxInInfo -> TxOut
txInInfoResolved = TxOut
txOut} : [TxInInfo]
rest
      | CurrencySymbol -> TxOut -> Bool
hasPT CurrencySymbol
headCurrencySymbol TxOut
txOut ->
          [Commit] -> [TxInInfo] -> [Commit]
committedUTxO (TxOut -> [Commit]
commitDatum TxOut
txOut [Commit] -> [Commit] -> [Commit]
forall a. Semigroup a => a -> a -> a
<> [Commit]
commits) [TxInInfo]
rest
      | Bool
otherwise ->
          [Commit] -> [TxInInfo] -> [Commit]
committedUTxO [Commit]
commits [TxInInfo]
rest

-- | On-Chain verification for 'CollectCom' transition. It verifies that:
--
--   * All participants have committed (even empty commits)
--
--   * All commits are properly collected and locked into η as a hash
--     of serialized tx outputs in the same sequence as commit inputs!
--
--   * The transaction is performed (i.e. signed) by one of the head participants
--
--   * State token (ST) is present in the output
checkCollectCom ::
  -- | Script execution context
  ScriptContext ->
  (ContestationPeriod, [Party], CurrencySymbol) ->
  Bool
checkCollectCom :: ScriptContext
-> (ContestationPeriod, [Party], CurrencySymbol) -> Bool
checkCollectCom ctx :: ScriptContext
ctx@ScriptContext{scriptContextTxInfo :: ScriptContext -> TxInfo
scriptContextTxInfo = TxInfo
txInfo} (ContestationPeriod
contestationPeriod, [Party]
parties, CurrencySymbol
headId) =
  Bool
mustCollectUtxoHash
    Bool -> Bool -> Bool
&& Bool
mustInitVersion
    Bool -> Bool -> Bool
&& ([Party], [Party])
-> (ContestationPeriod, ContestationPeriod)
-> (CurrencySymbol, CurrencySymbol)
-> Bool
mustNotChangeParameters ([Party]
parties', [Party]
parties) (ContestationPeriod
contestationPeriod', ContestationPeriod
contestationPeriod) (CurrencySymbol
headId', CurrencySymbol
headId)
    Bool -> Bool -> Bool
&& Bool
mustCollectAllValue
    -- XXX: Is this really needed? If yes, why not check on the output?
    Bool -> Bool -> Bool
&& BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode STNotSpent) (CurrencySymbol -> Value -> Bool
hasST CurrencySymbol
headId Value
val)
    Bool -> Bool -> Bool
&& Bool
everyoneHasCommitted
    Bool -> Bool -> Bool
&& ScriptContext -> CurrencySymbol -> Bool
mustBeSignedByParticipant ScriptContext
ctx CurrencySymbol
headId
    Bool -> Bool -> Bool
&& TxInfo -> Bool
mustNotMintOrBurn TxInfo
txInfo
 where
  mustCollectUtxoHash :: Bool
mustCollectUtxoHash =
    BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode IncorrectUtxoHash) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
      BuiltinByteString
utxoHash BuiltinByteString -> BuiltinByteString -> Bool
forall a. Eq a => a -> a -> Bool
== [Commit] -> BuiltinByteString
hashPreSerializedCommits [Commit]
collectedCommits

  mustInitVersion :: Bool
mustInitVersion =
    BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode IncorrectVersion) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
      Integer
version' Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0

  mustCollectAllValue :: Bool
mustCollectAllValue =
    BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode NotAllValueCollected) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
      -- NOTE: Instead of checking the head output val' against all collected
      -- value, we do ensure the output value is all non collected value - fees.
      -- This makes the script not scale badly with number of participants as it
      -- would commonly only be a small number of inputs/outputs to pay fees.
      Value
otherValueOut Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
notCollectedValueIn Value -> Value -> Value
forall a. AdditiveGroup a => a -> a -> a
- Lovelace -> Value
lovelaceValue (TxInfo -> Lovelace
txInfoFee TxInfo
txInfo)

  OpenDatum
    { BuiltinByteString
utxoHash :: BuiltinByteString
$sel:utxoHash:OpenDatum :: OpenDatum -> BuiltinByteString
utxoHash
    , $sel:parties:OpenDatum :: OpenDatum -> [Party]
parties = [Party]
parties'
    , $sel:contestationPeriod:OpenDatum :: OpenDatum -> ContestationPeriod
contestationPeriod = ContestationPeriod
contestationPeriod'
    , $sel:headId:OpenDatum :: OpenDatum -> CurrencySymbol
headId = CurrencySymbol
headId'
    , $sel:version:OpenDatum :: OpenDatum -> Integer
version = Integer
version'
    } = ScriptContext -> OpenDatum
decodeHeadOutputOpenDatum ScriptContext
ctx

  headAddress :: Address
headAddress = ScriptContext -> Address
getHeadAddress ScriptContext
ctx

  everyoneHasCommitted :: Bool
everyoneHasCommitted =
    BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode MissingCommits) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
      Integer
nTotalCommits Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== [Party] -> Integer
forall (t :: * -> *) a. Foldable t => t a -> Integer
length [Party]
parties

  val :: Value
val = Value -> (TxInInfo -> Value) -> Maybe TxInInfo -> Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Value
forall a. Monoid a => a
mempty (TxOut -> Value
txOutValue (TxOut -> Value) -> (TxInInfo -> TxOut) -> TxInInfo -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxInInfo -> TxOut
txInInfoResolved) (Maybe TxInInfo -> Value) -> Maybe TxInInfo -> Value
forall a b. (a -> b) -> a -> b
$ ScriptContext -> Maybe TxInInfo
findOwnInput ScriptContext
ctx

  otherValueOut :: Value
otherValueOut =
    case TxInfo -> [TxOut]
txInfoOutputs TxInfo
txInfo of
      -- NOTE: First output must be head output
      (TxOut
_ : [TxOut]
rest) -> (TxOut -> Value) -> [TxOut] -> Value
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap TxOut -> Value
txOutValue [TxOut]
rest
      [TxOut]
_ -> Value
forall a. Monoid a => a
mempty

  -- NOTE: We do keep track of the value we do not want to collect as this is
  -- typically less, ideally only a single other input with only ADA in it.
  ([Commit]
collectedCommits, Integer
nTotalCommits, Value
notCollectedValueIn) =
    (TxInInfo
 -> ([Commit], Integer, Value) -> ([Commit], Integer, Value))
-> ([Commit], Integer, Value)
-> [TxInInfo]
-> ([Commit], Integer, Value)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
      TxInInfo
-> ([Commit], Integer, Value) -> ([Commit], Integer, Value)
extractAndCountCommits
      ([], Integer
0, Value
forall a. Monoid a => a
mempty)
      (TxInfo -> [TxInInfo]
txInfoInputs TxInfo
txInfo)

  extractAndCountCommits :: TxInInfo
-> ([Commit], Integer, Value) -> ([Commit], Integer, Value)
extractAndCountCommits TxInInfo{TxOut
txInInfoResolved :: TxInInfo -> TxOut
txInInfoResolved :: TxOut
txInInfoResolved} ([Commit]
commits, Integer
nCommits, Value
notCollected)
    | TxOut -> Bool
isHeadOutput TxOut
txInInfoResolved =
        ([Commit]
commits, Integer
nCommits, Value
notCollected)
    | CurrencySymbol -> TxOut -> Bool
hasPT CurrencySymbol
headId TxOut
txInInfoResolved =
        (TxOut -> [Commit]
commitDatum TxOut
txInInfoResolved [Commit] -> [Commit] -> [Commit]
forall a. Semigroup a => a -> a -> a
<> [Commit]
commits, Integer -> Integer
forall a. Enum a => a -> a
succ Integer
nCommits, Value
notCollected)
    | Bool
otherwise =
        ([Commit]
commits, Integer
nCommits, Value
notCollected Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> TxOut -> Value
txOutValue TxOut
txInInfoResolved)

  isHeadOutput :: TxOut -> Bool
isHeadOutput TxOut
txOut = TxOut -> Address
txOutAddress TxOut
txOut Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
== Address
headAddress
{-# INLINEABLE checkCollectCom #-}

-- | Try to find the commit datum in the input and
-- if it is there return the committed utxo
commitDatum :: TxOut -> [Commit]
commitDatum :: TxOut -> [Commit]
commitDatum TxOut
input = do
  let datum :: Datum
datum = TxOut -> Datum
getTxOutDatum TxOut
input
  case forall a. FromData a => BuiltinData -> Maybe a
fromBuiltinData @Commit.DatumType (BuiltinData -> Maybe DatumType) -> BuiltinData -> Maybe DatumType
forall a b. (a -> b) -> a -> b
$ Datum -> BuiltinData
getDatum Datum
datum of
    Just (Party
_party, [Commit]
commits, CurrencySymbol
_headId) ->
      [Commit]
commits
    Maybe DatumType
Nothing -> []
{-# INLINEABLE commitDatum #-}

-- | Verify a increment transaction.
checkIncrement ::
  ScriptContext ->
  -- | Open state before the decrement
  OpenDatum ->
  IncrementRedeemer ->
  Bool
checkIncrement :: ScriptContext -> OpenDatum -> IncrementRedeemer -> Bool
checkIncrement ScriptContext
_ctx OpenDatum
_openBefore IncrementRedeemer
_redeemer =
  -- FIXME: Implement checkIncrement
  Bool
True
{-# INLINEABLE checkIncrement #-}

-- | Verify a decrement transaction.
checkDecrement ::
  ScriptContext ->
  -- | Open state before the decrement
  OpenDatum ->
  DecrementRedeemer ->
  Bool
checkDecrement :: ScriptContext -> OpenDatum -> DecrementRedeemer -> Bool
checkDecrement ScriptContext
ctx OpenDatum
openBefore DecrementRedeemer
redeemer =
  ([Party], [Party])
-> (ContestationPeriod, ContestationPeriod)
-> (CurrencySymbol, CurrencySymbol)
-> Bool
mustNotChangeParameters ([Party]
prevParties, [Party]
nextParties) (ContestationPeriod
prevCperiod, ContestationPeriod
nextCperiod) (CurrencySymbol
prevHeadId, CurrencySymbol
nextHeadId)
    Bool -> Bool -> Bool
&& Bool
mustIncreaseVersion
    Bool -> Bool -> Bool
&& Bool
checkSnapshotSignature
    Bool -> Bool -> Bool
&& Bool
mustDecreaseValue
    Bool -> Bool -> Bool
&& ScriptContext -> CurrencySymbol -> Bool
mustBeSignedByParticipant ScriptContext
ctx CurrencySymbol
prevHeadId
 where
  checkSnapshotSignature :: Bool
checkSnapshotSignature =
    [Party]
-> (CurrencySymbol, Integer, Integer, BuiltinByteString,
    BuiltinByteString, BuiltinByteString)
-> [BuiltinByteString]
-> Bool
verifySnapshotSignature [Party]
nextParties (CurrencySymbol
nextHeadId, Integer
prevVersion, Integer
snapshotNumber, BuiltinByteString
nextUtxoHash, BuiltinByteString
emptyHash, BuiltinByteString
decommitUtxoHash) [BuiltinByteString]
signature

  mustDecreaseValue :: Bool
mustDecreaseValue =
    BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode HeadValueIsNotPreserved) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
      Value
headInValue Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
headOutValue Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> (TxOut -> Value) -> [TxOut] -> Value
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap TxOut -> Value
txOutValue [TxOut]
decommitOutputs

  mustIncreaseVersion :: Bool
mustIncreaseVersion =
    BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode VersionNotIncremented) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
      Integer
nextVersion Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
prevVersion Integer -> Integer -> Integer
forall a. AdditiveSemigroup a => a -> a -> a
+ Integer
1

  decommitUtxoHash :: BuiltinByteString
decommitUtxoHash = [TxOut] -> BuiltinByteString
hashTxOuts [TxOut]
decommitOutputs

  DecrementRedeemer{[BuiltinByteString]
signature :: [BuiltinByteString]
$sel:signature:DecrementRedeemer :: DecrementRedeemer -> [BuiltinByteString]
signature, Integer
snapshotNumber :: Integer
$sel:snapshotNumber:DecrementRedeemer :: DecrementRedeemer -> Integer
snapshotNumber, Integer
numberOfDecommitOutputs :: Integer
$sel:numberOfDecommitOutputs:DecrementRedeemer :: DecrementRedeemer -> Integer
numberOfDecommitOutputs} = DecrementRedeemer
redeemer

  OpenDatum
    { $sel:parties:OpenDatum :: OpenDatum -> [Party]
parties = [Party]
prevParties
    , $sel:contestationPeriod:OpenDatum :: OpenDatum -> ContestationPeriod
contestationPeriod = ContestationPeriod
prevCperiod
    , $sel:headId:OpenDatum :: OpenDatum -> CurrencySymbol
headId = CurrencySymbol
prevHeadId
    , $sel:version:OpenDatum :: OpenDatum -> Integer
version = Integer
prevVersion
    } = OpenDatum
openBefore

  OpenDatum
    { $sel:utxoHash:OpenDatum :: OpenDatum -> BuiltinByteString
utxoHash = BuiltinByteString
nextUtxoHash
    , $sel:parties:OpenDatum :: OpenDatum -> [Party]
parties = [Party]
nextParties
    , $sel:contestationPeriod:OpenDatum :: OpenDatum -> ContestationPeriod
contestationPeriod = ContestationPeriod
nextCperiod
    , $sel:headId:OpenDatum :: OpenDatum -> CurrencySymbol
headId = CurrencySymbol
nextHeadId
    , $sel:version:OpenDatum :: OpenDatum -> Integer
version = Integer
nextVersion
    } = ScriptContext -> OpenDatum
decodeHeadOutputOpenDatum ScriptContext
ctx

  -- NOTE: head output + whatever is decommitted needs to be equal to the head input.
  headOutValue :: Value
headOutValue = TxOut -> Value
txOutValue (TxOut -> Value) -> TxOut -> Value
forall a b. (a -> b) -> a -> b
$ [TxOut] -> TxOut
forall a. [a] -> a
head [TxOut]
outputs
  headInValue :: Value
headInValue = Value -> (TxInInfo -> Value) -> Maybe TxInInfo -> Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Value
forall a. Monoid a => a
mempty (TxOut -> Value
txOutValue (TxOut -> Value) -> (TxInInfo -> TxOut) -> TxInInfo -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxInInfo -> TxOut
txInInfoResolved) (Maybe TxInInfo -> Value) -> Maybe TxInInfo -> Value
forall a b. (a -> b) -> a -> b
$ ScriptContext -> Maybe TxInInfo
findOwnInput ScriptContext
ctx

  -- NOTE: we always assume Head output is the first one so we pick all other
  -- outputs of a decommit tx to calculate the expected hash.
  decommitOutputs :: [TxOut]
decommitOutputs = Integer -> [TxOut] -> [TxOut]
forall a. Integer -> [a] -> [a]
take Integer
numberOfDecommitOutputs ([TxOut] -> [TxOut]
forall a. [a] -> [a]
tail [TxOut]
outputs)

  outputs :: [TxOut]
outputs = TxInfo -> [TxOut]
txInfoOutputs TxInfo
txInfo

  ScriptContext{scriptContextTxInfo :: ScriptContext -> TxInfo
scriptContextTxInfo = TxInfo
txInfo} = ScriptContext
ctx
{-# INLINEABLE checkDecrement #-}

-- | Verify a close transaction.
checkClose ::
  ScriptContext ->
  -- | Open state before the close
  OpenDatum ->
  -- | Type of close transition.
  CloseRedeemer ->
  Bool
checkClose :: ScriptContext -> OpenDatum -> CloseRedeemer -> Bool
checkClose ScriptContext
ctx OpenDatum
openBefore CloseRedeemer
redeemer =
  TxInfo -> Bool
mustNotMintOrBurn TxInfo
txInfo
    Bool -> Bool -> Bool
&& Bool
hasBoundedValidity
    Bool -> Bool -> Bool
&& Bool
checkDeadline
    Bool -> Bool -> Bool
&& ScriptContext -> CurrencySymbol -> Bool
mustBeSignedByParticipant ScriptContext
ctx CurrencySymbol
headId
    Bool -> Bool -> Bool
&& Bool
mustNotChangeVersion
    Bool -> Bool -> Bool
&& Bool
mustBeValidSnapshot
    Bool -> Bool -> Bool
&& Bool
mustInitializeContesters
    Bool -> Bool -> Bool
&& Bool
mustPreserveValue
    Bool -> Bool -> Bool
&& ([Party], [Party])
-> (ContestationPeriod, ContestationPeriod)
-> (CurrencySymbol, CurrencySymbol)
-> Bool
mustNotChangeParameters ([Party]
parties', [Party]
parties) (ContestationPeriod
cperiod', ContestationPeriod
cperiod) (CurrencySymbol
headId', CurrencySymbol
headId)
 where
  OpenDatum
    { [Party]
$sel:parties:OpenDatum :: OpenDatum -> [Party]
parties :: [Party]
parties
    , $sel:utxoHash:OpenDatum :: OpenDatum -> BuiltinByteString
utxoHash = BuiltinByteString
initialUtxoHash
    , $sel:contestationPeriod:OpenDatum :: OpenDatum -> ContestationPeriod
contestationPeriod = ContestationPeriod
cperiod
    , CurrencySymbol
$sel:headId:OpenDatum :: OpenDatum -> CurrencySymbol
headId :: CurrencySymbol
headId
    , Integer
$sel:version:OpenDatum :: OpenDatum -> Integer
version :: Integer
version
    } = OpenDatum
openBefore

  mustPreserveValue :: Bool
mustPreserveValue =
    BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode HeadValueIsNotPreserved) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
      Value
val Value -> Value -> Bool
=== Value
val'

  val' :: Value
val' = TxOut -> Value
txOutValue (TxOut -> Value) -> ([TxOut] -> TxOut) -> [TxOut] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TxOut] -> TxOut
forall a. [a] -> a
head ([TxOut] -> Value) -> [TxOut] -> Value
forall a b. (a -> b) -> a -> b
$ TxInfo -> [TxOut]
txInfoOutputs TxInfo
txInfo

  val :: Value
val = Value -> (TxInInfo -> Value) -> Maybe TxInInfo -> Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Value
forall a. Monoid a => a
mempty (TxOut -> Value
txOutValue (TxOut -> Value) -> (TxInInfo -> TxOut) -> TxInInfo -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxInInfo -> TxOut
txInInfoResolved) (Maybe TxInInfo -> Value) -> Maybe TxInInfo -> Value
forall a b. (a -> b) -> a -> b
$ ScriptContext -> Maybe TxInInfo
findOwnInput ScriptContext
ctx

  hasBoundedValidity :: Bool
hasBoundedValidity =
    BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode HasBoundedValidityCheckFailed) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
      POSIXTime
tMax POSIXTime -> POSIXTime -> POSIXTime
forall a. AdditiveGroup a => a -> a -> a
- POSIXTime
tMin POSIXTime -> POSIXTime -> Bool
forall a. Ord a => a -> a -> Bool
<= POSIXTime
cp

  ClosedDatum
    { $sel:snapshotNumber:ClosedDatum :: ClosedDatum -> Integer
snapshotNumber = Integer
snapshotNumber'
    , $sel:utxoHash:ClosedDatum :: ClosedDatum -> BuiltinByteString
utxoHash = BuiltinByteString
utxoHash'
    , $sel:deltaUTxOHash:ClosedDatum :: ClosedDatum -> BuiltinByteString
deltaUTxOHash = BuiltinByteString
deltaUTxOHash'
    , $sel:parties:ClosedDatum :: ClosedDatum -> [Party]
parties = [Party]
parties'
    , $sel:contestationDeadline:ClosedDatum :: ClosedDatum -> POSIXTime
contestationDeadline = POSIXTime
deadline
    , $sel:contestationPeriod:ClosedDatum :: ClosedDatum -> ContestationPeriod
contestationPeriod = ContestationPeriod
cperiod'
    , $sel:headId:ClosedDatum :: ClosedDatum -> CurrencySymbol
headId = CurrencySymbol
headId'
    , $sel:contesters:ClosedDatum :: ClosedDatum -> [PubKeyHash]
contesters = [PubKeyHash]
contesters'
    , $sel:version:ClosedDatum :: ClosedDatum -> Integer
version = Integer
version'
    } = ScriptContext -> ClosedDatum
decodeHeadOutputClosedDatum ScriptContext
ctx

  mustNotChangeVersion :: Bool
mustNotChangeVersion =
    BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode MustNotChangeVersion) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
      Integer
version' Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
version

  mustBeValidSnapshot :: Bool
mustBeValidSnapshot =
    case CloseRedeemer
redeemer of
      CloseRedeemer
CloseInitial ->
        BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode FailedCloseInitial) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
          Integer
version Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0
            Bool -> Bool -> Bool
&& Integer
snapshotNumber' Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0
            Bool -> Bool -> Bool
&& BuiltinByteString
utxoHash' BuiltinByteString -> BuiltinByteString -> Bool
forall a. Eq a => a -> a -> Bool
== BuiltinByteString
initialUtxoHash
      CloseUnused{[BuiltinByteString]
signature :: [BuiltinByteString]
$sel:signature:CloseInitial :: CloseRedeemer -> [BuiltinByteString]
signature} ->
        BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode FailedCloseCurrent) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
          [Party]
-> (CurrencySymbol, Integer, Integer, BuiltinByteString,
    BuiltinByteString, BuiltinByteString)
-> [BuiltinByteString]
-> Bool
verifySnapshotSignature
            [Party]
parties
            (CurrencySymbol
headId, Integer
version, Integer
snapshotNumber', BuiltinByteString
utxoHash', BuiltinByteString
emptyHash, BuiltinByteString
deltaUTxOHash')
            [BuiltinByteString]
signature
      CloseUsed{[BuiltinByteString]
$sel:signature:CloseInitial :: CloseRedeemer -> [BuiltinByteString]
signature :: [BuiltinByteString]
signature, BuiltinByteString
alreadyDecommittedUTxOHash :: BuiltinByteString
$sel:alreadyDecommittedUTxOHash:CloseInitial :: CloseRedeemer -> BuiltinByteString
alreadyDecommittedUTxOHash} ->
        BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode FailedCloseOutdated) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
          BuiltinByteString
deltaUTxOHash' BuiltinByteString -> BuiltinByteString -> Bool
forall a. Eq a => a -> a -> Bool
== BuiltinByteString
emptyHash
            Bool -> Bool -> Bool
&& [Party]
-> (CurrencySymbol, Integer, Integer, BuiltinByteString,
    BuiltinByteString, BuiltinByteString)
-> [BuiltinByteString]
-> Bool
verifySnapshotSignature
              [Party]
parties
              (CurrencySymbol
headId, Integer
version Integer -> Integer -> Integer
forall a. AdditiveGroup a => a -> a -> a
- Integer
1, Integer
snapshotNumber', BuiltinByteString
utxoHash', BuiltinByteString
emptyHash, BuiltinByteString
alreadyDecommittedUTxOHash)
              [BuiltinByteString]
signature

  checkDeadline :: Bool
checkDeadline =
    BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode IncorrectClosedContestationDeadline) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
      POSIXTime
deadline POSIXTime -> POSIXTime -> Bool
forall a. Eq a => a -> a -> Bool
== ContestationPeriod -> ScriptContext -> POSIXTime
makeContestationDeadline ContestationPeriod
cperiod ScriptContext
ctx

  cp :: POSIXTime
cp = DiffMilliSeconds -> POSIXTime
fromMilliSeconds (ContestationPeriod -> DiffMilliSeconds
milliseconds ContestationPeriod
cperiod)

  tMax :: POSIXTime
tMax = case Interval POSIXTime -> UpperBound POSIXTime
forall a. Interval a -> UpperBound a
ivTo (Interval POSIXTime -> UpperBound POSIXTime)
-> Interval POSIXTime -> UpperBound POSIXTime
forall a b. (a -> b) -> a -> b
$ TxInfo -> Interval POSIXTime
txInfoValidRange TxInfo
txInfo of
    UpperBound (Finite POSIXTime
t) Bool
_ -> POSIXTime
t
    UpperBound POSIXTime
_InfiniteBound -> BuiltinString -> POSIXTime
forall a. BuiltinString -> a
traceError $(errorCode InfiniteUpperBound)

  tMin :: POSIXTime
tMin = case Interval POSIXTime -> LowerBound POSIXTime
forall a. Interval a -> LowerBound a
ivFrom (Interval POSIXTime -> LowerBound POSIXTime)
-> Interval POSIXTime -> LowerBound POSIXTime
forall a b. (a -> b) -> a -> b
$ TxInfo -> Interval POSIXTime
txInfoValidRange TxInfo
txInfo of
    LowerBound (Finite POSIXTime
t) Bool
_ -> POSIXTime
t
    LowerBound POSIXTime
_InfiniteBound -> BuiltinString -> POSIXTime
forall a. BuiltinString -> a
traceError $(errorCode InfiniteLowerBound)

  mustInitializeContesters :: Bool
mustInitializeContesters =
    BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode ContestersNonEmpty) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
      [PubKeyHash] -> Bool
forall a. [a] -> Bool
null [PubKeyHash]
contesters'

  ScriptContext{scriptContextTxInfo :: ScriptContext -> TxInfo
scriptContextTxInfo = TxInfo
txInfo} = ScriptContext
ctx
{-# INLINEABLE checkClose #-}

-- | Verify a contest transaction.
checkContest ::
  ScriptContext ->
  -- | Closed state before the close
  ClosedDatum ->
  -- | Type of contest transition.
  ContestRedeemer ->
  Bool
checkContest :: ScriptContext -> ClosedDatum -> ContestRedeemer -> Bool
checkContest ScriptContext
ctx ClosedDatum
closedDatum ContestRedeemer
redeemer =
  TxInfo -> Bool
mustNotMintOrBurn TxInfo
txInfo
    Bool -> Bool -> Bool
&& Bool
mustNotChangeVersion
    Bool -> Bool -> Bool
&& Bool
mustBeNewer
    Bool -> Bool -> Bool
&& Bool
mustBeValidSnapshot
    Bool -> Bool -> Bool
&& ScriptContext -> CurrencySymbol -> Bool
mustBeSignedByParticipant ScriptContext
ctx CurrencySymbol
headId
    Bool -> Bool -> Bool
&& Bool
checkSignedParticipantContestOnlyOnce
    Bool -> Bool -> Bool
&& Bool
mustBeWithinContestationPeriod
    Bool -> Bool -> Bool
&& Bool
mustUpdateContesters
    Bool -> Bool -> Bool
&& Bool
mustPushDeadline
    Bool -> Bool -> Bool
&& ([Party], [Party])
-> (ContestationPeriod, ContestationPeriod)
-> (CurrencySymbol, CurrencySymbol)
-> Bool
mustNotChangeParameters ([Party]
parties', [Party]
parties) (ContestationPeriod
contestationPeriod', ContestationPeriod
contestationPeriod) (CurrencySymbol
headId', CurrencySymbol
headId)
    Bool -> Bool -> Bool
&& Bool
mustPreserveValue
 where
  mustPreserveValue :: Bool
mustPreserveValue =
    BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode HeadValueIsNotPreserved) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
      Value
val Value -> Value -> Bool
=== Value
val'

  val' :: Value
val' = TxOut -> Value
txOutValue (TxOut -> Value) -> ([TxOut] -> TxOut) -> [TxOut] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TxOut] -> TxOut
forall a. [a] -> a
head ([TxOut] -> Value) -> [TxOut] -> Value
forall a b. (a -> b) -> a -> b
$ TxInfo -> [TxOut]
txInfoOutputs TxInfo
txInfo

  val :: Value
val = Value -> (TxInInfo -> Value) -> Maybe TxInInfo -> Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Value
forall a. Monoid a => a
mempty (TxOut -> Value
txOutValue (TxOut -> Value) -> (TxInInfo -> TxOut) -> TxInInfo -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxInInfo -> TxOut
txInInfoResolved) (Maybe TxInInfo -> Value) -> Maybe TxInInfo -> Value
forall a b. (a -> b) -> a -> b
$ ScriptContext -> Maybe TxInInfo
findOwnInput ScriptContext
ctx

  mustBeNewer :: Bool
mustBeNewer =
    BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode TooOldSnapshot) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
      Integer
snapshotNumber' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
snapshotNumber

  mustNotChangeVersion :: Bool
mustNotChangeVersion =
    BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode MustNotChangeVersion) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
      Integer
version' Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
version

  mustBeValidSnapshot :: Bool
mustBeValidSnapshot =
    case ContestRedeemer
redeemer of
      ContestCurrent{[BuiltinByteString]
signature :: [BuiltinByteString]
$sel:signature:ContestCurrent :: ContestRedeemer -> [BuiltinByteString]
signature} ->
        BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode FailedContestCurrent) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
          [Party]
-> (CurrencySymbol, Integer, Integer, BuiltinByteString,
    BuiltinByteString, BuiltinByteString)
-> [BuiltinByteString]
-> Bool
verifySnapshotSignature
            [Party]
parties
            (CurrencySymbol
headId, Integer
version, Integer
snapshotNumber', BuiltinByteString
utxoHash', BuiltinByteString
emptyHash, BuiltinByteString
deltaUTxOHash')
            [BuiltinByteString]
signature
      ContestOutdated{[BuiltinByteString]
$sel:signature:ContestCurrent :: ContestRedeemer -> [BuiltinByteString]
signature :: [BuiltinByteString]
signature, BuiltinByteString
alreadyDecommittedUTxOHash :: BuiltinByteString
$sel:alreadyDecommittedUTxOHash:ContestCurrent :: ContestRedeemer -> BuiltinByteString
alreadyDecommittedUTxOHash} ->
        BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode FailedContestOutdated) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
          BuiltinByteString
deltaUTxOHash' BuiltinByteString -> BuiltinByteString -> Bool
forall a. Eq a => a -> a -> Bool
== BuiltinByteString
emptyHash
            Bool -> Bool -> Bool
&& [Party]
-> (CurrencySymbol, Integer, Integer, BuiltinByteString,
    BuiltinByteString, BuiltinByteString)
-> [BuiltinByteString]
-> Bool
verifySnapshotSignature
              [Party]
parties
              (CurrencySymbol
headId, Integer
version Integer -> Integer -> Integer
forall a. AdditiveGroup a => a -> a -> a
- Integer
1, Integer
snapshotNumber', BuiltinByteString
utxoHash', BuiltinByteString
emptyHash, BuiltinByteString
alreadyDecommittedUTxOHash)
              [BuiltinByteString]
signature

  mustBeWithinContestationPeriod :: Bool
mustBeWithinContestationPeriod =
    case Interval POSIXTime -> UpperBound POSIXTime
forall a. Interval a -> UpperBound a
ivTo (TxInfo -> Interval POSIXTime
txInfoValidRange TxInfo
txInfo) of
      UpperBound (Finite POSIXTime
time) Bool
_ ->
        BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode UpperBoundBeyondContestationDeadline) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
          POSIXTime
time POSIXTime -> POSIXTime -> Bool
forall a. Ord a => a -> a -> Bool
<= POSIXTime
contestationDeadline
      UpperBound POSIXTime
_ -> BuiltinString -> Bool
forall a. BuiltinString -> a
traceError $(errorCode ContestNoUpperBoundDefined)

  mustPushDeadline :: Bool
mustPushDeadline =
    if [PubKeyHash] -> Integer
forall (t :: * -> *) a. Foldable t => t a -> Integer
length [PubKeyHash]
contesters' Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== [Party] -> Integer
forall (t :: * -> *) a. Foldable t => t a -> Integer
length [Party]
parties'
      then
        BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode MustNotPushDeadline) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
          POSIXTime
contestationDeadline' POSIXTime -> POSIXTime -> Bool
forall a. Eq a => a -> a -> Bool
== POSIXTime
contestationDeadline
      else
        BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode MustPushDeadline) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
          POSIXTime
contestationDeadline' POSIXTime -> POSIXTime -> Bool
forall a. Eq a => a -> a -> Bool
== POSIXTime -> ContestationPeriod -> POSIXTime
addContestationPeriod POSIXTime
contestationDeadline ContestationPeriod
contestationPeriod

  mustUpdateContesters :: Bool
mustUpdateContesters =
    BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode ContesterNotIncluded) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
      [PubKeyHash]
contesters' [PubKeyHash] -> [PubKeyHash] -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyHash
contester PubKeyHash -> [PubKeyHash] -> [PubKeyHash]
forall a. a -> [a] -> [a]
: [PubKeyHash]
contesters

  ClosedDatum
    { POSIXTime
$sel:contestationDeadline:ClosedDatum :: ClosedDatum -> POSIXTime
contestationDeadline :: POSIXTime
contestationDeadline
    , ContestationPeriod
$sel:contestationPeriod:ClosedDatum :: ClosedDatum -> ContestationPeriod
contestationPeriod :: ContestationPeriod
contestationPeriod
    , [Party]
$sel:parties:ClosedDatum :: ClosedDatum -> [Party]
parties :: [Party]
parties
    , Integer
$sel:snapshotNumber:ClosedDatum :: ClosedDatum -> Integer
snapshotNumber :: Integer
snapshotNumber
    , [PubKeyHash]
$sel:contesters:ClosedDatum :: ClosedDatum -> [PubKeyHash]
contesters :: [PubKeyHash]
contesters
    , CurrencySymbol
$sel:headId:ClosedDatum :: ClosedDatum -> CurrencySymbol
headId :: CurrencySymbol
headId
    , Integer
$sel:version:ClosedDatum :: ClosedDatum -> Integer
version :: Integer
version
    } = ClosedDatum
closedDatum

  ClosedDatum
    { $sel:snapshotNumber:ClosedDatum :: ClosedDatum -> Integer
snapshotNumber = Integer
snapshotNumber'
    , $sel:utxoHash:ClosedDatum :: ClosedDatum -> BuiltinByteString
utxoHash = BuiltinByteString
utxoHash'
    , $sel:deltaUTxOHash:ClosedDatum :: ClosedDatum -> BuiltinByteString
deltaUTxOHash = BuiltinByteString
deltaUTxOHash'
    , $sel:parties:ClosedDatum :: ClosedDatum -> [Party]
parties = [Party]
parties'
    , $sel:contestationDeadline:ClosedDatum :: ClosedDatum -> POSIXTime
contestationDeadline = POSIXTime
contestationDeadline'
    , $sel:contestationPeriod:ClosedDatum :: ClosedDatum -> ContestationPeriod
contestationPeriod = ContestationPeriod
contestationPeriod'
    , $sel:headId:ClosedDatum :: ClosedDatum -> CurrencySymbol
headId = CurrencySymbol
headId'
    , $sel:contesters:ClosedDatum :: ClosedDatum -> [PubKeyHash]
contesters = [PubKeyHash]
contesters'
    , $sel:version:ClosedDatum :: ClosedDatum -> Integer
version = Integer
version'
    } = ScriptContext -> ClosedDatum
decodeHeadOutputClosedDatum ScriptContext
ctx

  ScriptContext{scriptContextTxInfo :: ScriptContext -> TxInfo
scriptContextTxInfo = TxInfo
txInfo} = ScriptContext
ctx

  contester :: PubKeyHash
contester =
    case TxInfo -> [PubKeyHash]
txInfoSignatories TxInfo
txInfo of
      [PubKeyHash
signer] -> PubKeyHash
signer
      [PubKeyHash]
_ -> BuiltinString -> PubKeyHash
forall a. BuiltinString -> a
traceError $(errorCode WrongNumberOfSigners)

  checkSignedParticipantContestOnlyOnce :: Bool
checkSignedParticipantContestOnlyOnce =
    BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode SignerAlreadyContested) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
      PubKeyHash
contester PubKeyHash -> [PubKeyHash] -> Bool
forall a. Eq a => a -> [a] -> Bool
`notElem` [PubKeyHash]
contesters
{-# INLINEABLE checkContest #-}

-- | Verify a fanout transaction.
checkFanout ::
  ScriptContext ->
  -- | Closed state before the fanout
  ClosedDatum ->
  -- | Number of normal outputs to fanout
  Integer ->
  -- | Number of delta outputs to fanout
  Integer ->
  Bool
checkFanout :: ScriptContext -> ClosedDatum -> Integer -> Integer -> Bool
checkFanout ScriptContext{scriptContextTxInfo :: ScriptContext -> TxInfo
scriptContextTxInfo = TxInfo
txInfo} ClosedDatum
closedDatum Integer
numberOfFanoutOutputs Integer
numberOfDecommitOutputs =
  Value -> CurrencySymbol -> [Party] -> Bool
mustBurnAllHeadTokens Value
minted CurrencySymbol
headId [Party]
parties
    Bool -> Bool -> Bool
&& Bool
hasSameUTxOHash
    Bool -> Bool -> Bool
&& Bool
hasSameUTxOToDecommitHash
    Bool -> Bool -> Bool
&& Bool
afterContestationDeadline
 where
  minted :: Value
minted = TxInfo -> Value
txInfoMint TxInfo
txInfo

  hasSameUTxOHash :: Bool
hasSameUTxOHash =
    BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode FanoutUTxOHashMismatch) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
      BuiltinByteString
fannedOutUtxoHash BuiltinByteString -> BuiltinByteString -> Bool
forall a. Eq a => a -> a -> Bool
== BuiltinByteString
utxoHash

  hasSameUTxOToDecommitHash :: Bool
hasSameUTxOToDecommitHash =
    BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode FanoutUTxOToDecommitHashMismatch) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
      BuiltinByteString
deltaUTxOHash BuiltinByteString -> BuiltinByteString -> Bool
forall a. Eq a => a -> a -> Bool
== BuiltinByteString
decommitUtxoHash

  fannedOutUtxoHash :: BuiltinByteString
fannedOutUtxoHash = [TxOut] -> BuiltinByteString
hashTxOuts ([TxOut] -> BuiltinByteString) -> [TxOut] -> BuiltinByteString
forall a b. (a -> b) -> a -> b
$ Integer -> [TxOut] -> [TxOut]
forall a. Integer -> [a] -> [a]
take Integer
numberOfFanoutOutputs [TxOut]
txInfoOutputs

  decommitUtxoHash :: BuiltinByteString
decommitUtxoHash = [TxOut] -> BuiltinByteString
hashTxOuts ([TxOut] -> BuiltinByteString) -> [TxOut] -> BuiltinByteString
forall a b. (a -> b) -> a -> b
$ Integer -> [TxOut] -> [TxOut]
forall a. Integer -> [a] -> [a]
take Integer
numberOfDecommitOutputs ([TxOut] -> [TxOut]) -> [TxOut] -> [TxOut]
forall a b. (a -> b) -> a -> b
$ Integer -> [TxOut] -> [TxOut]
forall a. Integer -> [a] -> [a]
drop Integer
numberOfFanoutOutputs [TxOut]
txInfoOutputs

  ClosedDatum{BuiltinByteString
$sel:utxoHash:ClosedDatum :: ClosedDatum -> BuiltinByteString
utxoHash :: BuiltinByteString
utxoHash, BuiltinByteString
$sel:deltaUTxOHash:ClosedDatum :: ClosedDatum -> BuiltinByteString
deltaUTxOHash :: BuiltinByteString
deltaUTxOHash, [Party]
$sel:parties:ClosedDatum :: ClosedDatum -> [Party]
parties :: [Party]
parties, CurrencySymbol
$sel:headId:ClosedDatum :: ClosedDatum -> CurrencySymbol
headId :: CurrencySymbol
headId, POSIXTime
$sel:contestationDeadline:ClosedDatum :: ClosedDatum -> POSIXTime
contestationDeadline :: POSIXTime
contestationDeadline} = ClosedDatum
closedDatum

  TxInfo{[TxOut]
txInfoOutputs :: TxInfo -> [TxOut]
txInfoOutputs :: [TxOut]
txInfoOutputs} = TxInfo
txInfo

  afterContestationDeadline :: Bool
afterContestationDeadline =
    case Interval POSIXTime -> LowerBound POSIXTime
forall a. Interval a -> LowerBound a
ivFrom (TxInfo -> Interval POSIXTime
txInfoValidRange TxInfo
txInfo) of
      LowerBound (Finite POSIXTime
time) Bool
_ ->
        BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode LowerBoundBeforeContestationDeadline) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
          POSIXTime
time POSIXTime -> POSIXTime -> Bool
forall a. Ord a => a -> a -> Bool
> POSIXTime
contestationDeadline
      LowerBound POSIXTime
_ -> BuiltinString -> Bool
forall a. BuiltinString -> a
traceError $(errorCode FanoutNoLowerBoundDefined)
{-# INLINEABLE checkFanout #-}

--------------------------------------------------------------------------------
-- Helpers
--------------------------------------------------------------------------------

makeContestationDeadline :: ContestationPeriod -> ScriptContext -> POSIXTime
makeContestationDeadline :: ContestationPeriod -> ScriptContext -> POSIXTime
makeContestationDeadline ContestationPeriod
cperiod ScriptContext{TxInfo
scriptContextTxInfo :: ScriptContext -> TxInfo
scriptContextTxInfo :: TxInfo
scriptContextTxInfo} =
  case Interval POSIXTime -> UpperBound POSIXTime
forall a. Interval a -> UpperBound a
ivTo (TxInfo -> Interval POSIXTime
txInfoValidRange TxInfo
scriptContextTxInfo) of
    UpperBound (Finite POSIXTime
time) Bool
_ -> POSIXTime -> ContestationPeriod -> POSIXTime
addContestationPeriod POSIXTime
time ContestationPeriod
cperiod
    UpperBound POSIXTime
_ -> BuiltinString -> POSIXTime
forall a. BuiltinString -> a
traceError $(errorCode CloseNoUpperBoundDefined)
{-# INLINEABLE makeContestationDeadline #-}

getHeadInput :: ScriptContext -> TxInInfo
getHeadInput :: ScriptContext -> TxInInfo
getHeadInput ScriptContext
ctx = case ScriptContext -> Maybe TxInInfo
findOwnInput ScriptContext
ctx of
  Maybe TxInInfo
Nothing -> BuiltinString -> TxInInfo
forall a. BuiltinString -> a
traceError $(errorCode ScriptNotSpendingAHeadInput)
  Just TxInInfo
x -> TxInInfo
x
{-# INLINEABLE getHeadInput #-}

getHeadAddress :: ScriptContext -> Address
getHeadAddress :: ScriptContext -> Address
getHeadAddress = TxOut -> Address
txOutAddress (TxOut -> Address)
-> (ScriptContext -> TxOut) -> ScriptContext -> Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxInInfo -> TxOut
txInInfoResolved (TxInInfo -> TxOut)
-> (ScriptContext -> TxInInfo) -> ScriptContext -> TxOut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptContext -> TxInInfo
getHeadInput
{-# INLINEABLE getHeadAddress #-}

mustNotChangeParameters ::
  ([Party], [Party]) ->
  (ContestationPeriod, ContestationPeriod) ->
  (CurrencySymbol, CurrencySymbol) ->
  Bool
mustNotChangeParameters :: ([Party], [Party])
-> (ContestationPeriod, ContestationPeriod)
-> (CurrencySymbol, CurrencySymbol)
-> Bool
mustNotChangeParameters ([Party]
parties', [Party]
parties) (ContestationPeriod
contestationPeriod', ContestationPeriod
contestationPeriod) (CurrencySymbol
headId', CurrencySymbol
headId) =
  BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode ChangedParameters) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
    [Party]
parties' [Party] -> [Party] -> Bool
forall a. Eq a => a -> a -> Bool
== [Party]
parties
      Bool -> Bool -> Bool
&& ContestationPeriod
contestationPeriod' ContestationPeriod -> ContestationPeriod -> Bool
forall a. Eq a => a -> a -> Bool
== ContestationPeriod
contestationPeriod
      Bool -> Bool -> Bool
&& CurrencySymbol
headId' CurrencySymbol -> CurrencySymbol -> Bool
forall a. Eq a => a -> a -> Bool
== CurrencySymbol
headId
{-# INLINEABLE mustNotChangeParameters #-}

-- XXX: We might not need to distinguish between the three cases here.
mustBeSignedByParticipant ::
  ScriptContext ->
  CurrencySymbol ->
  Bool
mustBeSignedByParticipant :: ScriptContext -> CurrencySymbol -> Bool
mustBeSignedByParticipant ScriptContext{scriptContextTxInfo :: ScriptContext -> TxInfo
scriptContextTxInfo = TxInfo
txInfo} CurrencySymbol
headCurrencySymbol =
  case PubKeyHash -> BuiltinByteString
getPubKeyHash (PubKeyHash -> BuiltinByteString)
-> [PubKeyHash] -> [BuiltinByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxInfo -> [PubKeyHash]
txInfoSignatories TxInfo
txInfo of
    [BuiltinByteString
signer] ->
      BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode SignerIsNotAParticipant) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
        BuiltinByteString
signer BuiltinByteString -> [BuiltinByteString] -> Bool
forall a. Eq a => a -> [a] -> Bool
`elem` (TokenName -> BuiltinByteString
unTokenName (TokenName -> BuiltinByteString)
-> [TokenName] -> [BuiltinByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TokenName]
participationTokens)
    [] ->
      BuiltinString -> Bool
forall a. BuiltinString -> a
traceError $(errorCode NoSigners)
    [BuiltinByteString]
_ ->
      BuiltinString -> Bool
forall a. BuiltinString -> a
traceError $(errorCode TooManySigners)
 where
  participationTokens :: [TokenName]
participationTokens = [TxInInfo] -> [TokenName]
loop (TxInfo -> [TxInInfo]
txInfoInputs TxInfo
txInfo)
  loop :: [TxInInfo] -> [TokenName]
loop = \case
    [] -> []
    (TxInInfo{TxOut
txInInfoResolved :: TxInInfo -> TxOut
txInInfoResolved :: TxOut
txInInfoResolved} : [TxInInfo]
rest) ->
      CurrencySymbol -> Value -> [TokenName]
findParticipationTokens CurrencySymbol
headCurrencySymbol (TxOut -> Value
txOutValue TxOut
txInInfoResolved) [TokenName] -> [TokenName] -> [TokenName]
forall a. [a] -> [a] -> [a]
++ [TxInInfo] -> [TokenName]
loop [TxInInfo]
rest
{-# INLINEABLE mustBeSignedByParticipant #-}

findParticipationTokens :: CurrencySymbol -> Value -> [TokenName]
findParticipationTokens :: CurrencySymbol -> Value -> [TokenName]
findParticipationTokens CurrencySymbol
headCurrency (Value Map CurrencySymbol (Map TokenName Integer)
val) =
  case Map TokenName Integer -> [(TokenName, Integer)]
forall k v. Map k v -> [(k, v)]
AssocMap.toList (Map TokenName Integer -> [(TokenName, Integer)])
-> Maybe (Map TokenName Integer) -> Maybe [(TokenName, Integer)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CurrencySymbol
-> Map CurrencySymbol (Map TokenName Integer)
-> Maybe (Map TokenName Integer)
forall k v. Eq k => k -> Map k v -> Maybe v
AssocMap.lookup CurrencySymbol
headCurrency Map CurrencySymbol (Map TokenName Integer)
val of
    Just [(TokenName, Integer)]
tokens ->
      ((TokenName, Integer) -> Maybe TokenName)
-> [(TokenName, Integer)] -> [TokenName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(TokenName
tokenName, Integer
n) -> if Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 then TokenName -> Maybe TokenName
forall a. a -> Maybe a
Just TokenName
tokenName else Maybe TokenName
forall a. Maybe a
Nothing) [(TokenName, Integer)]
tokens
    Maybe [(TokenName, Integer)]
_ ->
      []
{-# INLINEABLE findParticipationTokens #-}

headOutputDatum :: ScriptContext -> Datum
headOutputDatum :: ScriptContext -> Datum
headOutputDatum ScriptContext
ctx =
  case TxInfo -> [TxOut]
txInfoOutputs TxInfo
txInfo of
    (TxOut
o : [TxOut]
_)
      | TxOut -> Address
txOutAddress TxOut
o Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
== Address
headAddress -> TxOut -> Datum
getTxOutDatum TxOut
o
    [TxOut]
_ -> BuiltinString -> Datum
forall a. BuiltinString -> a
traceError $(errorCode NotPayingToHead)
 where
  headAddress :: Address
headAddress = ScriptContext -> Address
getHeadAddress ScriptContext
ctx

  ScriptContext{scriptContextTxInfo :: ScriptContext -> TxInfo
scriptContextTxInfo = TxInfo
txInfo} = ScriptContext
ctx
{-# INLINEABLE headOutputDatum #-}

getTxOutDatum :: TxOut -> Datum
getTxOutDatum :: TxOut -> Datum
getTxOutDatum TxOut
o =
  case TxOut -> OutputDatum
txOutDatum TxOut
o of
    OutputDatum
NoOutputDatum -> BuiltinString -> Datum
forall a. BuiltinString -> a
traceError $(errorCode NoOutputDatumError)
    OutputDatumHash DatumHash
_dh -> BuiltinString -> Datum
forall a. BuiltinString -> a
traceError $(errorCode UnexpectedNonInlineDatum)
    OutputDatum Datum
d -> Datum
d
{-# INLINEABLE getTxOutDatum #-}

-- | Hash a potentially unordered list of commits by sorting them, concatenating
-- their 'preSerializedOutput' bytes and creating a SHA2_256 digest over that.
--
-- NOTE: See note from `hashTxOuts`.
hashPreSerializedCommits :: [Commit] -> BuiltinByteString
hashPreSerializedCommits :: [Commit] -> BuiltinByteString
hashPreSerializedCommits [Commit]
commits =
  BuiltinByteString -> BuiltinByteString
sha2_256 (BuiltinByteString -> BuiltinByteString)
-> ([Commit] -> BuiltinByteString) -> [Commit] -> BuiltinByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Commit -> BuiltinByteString) -> [Commit] -> BuiltinByteString
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Commit -> BuiltinByteString
preSerializedOutput ([Commit] -> BuiltinByteString) -> [Commit] -> BuiltinByteString
forall a b. (a -> b) -> a -> b
$
    (Commit -> Commit -> Ordering) -> [Commit] -> [Commit]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\Commit
a Commit
b -> TxOutRef -> TxOutRef -> Ordering
compareRef (Commit -> TxOutRef
input Commit
a) (Commit -> TxOutRef
input Commit
b)) [Commit]
commits
{-# INLINEABLE hashPreSerializedCommits #-}

-- | Hash a pre-ordered list of transaction outputs by serializing each
-- individual 'TxOut', concatenating all bytes together and creating a SHA2_256
-- digest over that.
--
-- NOTE: In general, from asserting that `hash(x || y) = hash (x' || y')` it is
-- not safe to conclude that `(x,y) = (x', y')` as the same hash could be
-- obtained by moving one or more bytes from the end of `x` to the beginning of
-- `y`, but in the context of Hydra validators it seems impossible to exploit
-- this property without breaking other logic or verification (eg. producing a
-- valid and meaningful `TxOut`).
hashTxOuts :: [TxOut] -> BuiltinByteString
hashTxOuts :: [TxOut] -> BuiltinByteString
hashTxOuts =
  BuiltinByteString -> BuiltinByteString
sha2_256 (BuiltinByteString -> BuiltinByteString)
-> ([TxOut] -> BuiltinByteString) -> [TxOut] -> BuiltinByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOut -> BuiltinByteString) -> [TxOut] -> BuiltinByteString
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (BuiltinData -> BuiltinByteString
Builtins.serialiseData (BuiltinData -> BuiltinByteString)
-> (TxOut -> BuiltinData) -> TxOut -> BuiltinByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut -> BuiltinData
forall a. ToData a => a -> BuiltinData
toBuiltinData)
{-# INLINEABLE hashTxOuts #-}

-- | Check if 'TxOut' contains the PT token.
hasPT :: CurrencySymbol -> TxOut -> Bool
hasPT :: CurrencySymbol -> TxOut -> Bool
hasPT CurrencySymbol
headCurrencySymbol TxOut
txOut =
  let pts :: [TokenName]
pts = CurrencySymbol -> Value -> [TokenName]
findParticipationTokens CurrencySymbol
headCurrencySymbol (TxOut -> Value
txOutValue TxOut
txOut)
   in [TokenName] -> Integer
forall (t :: * -> *) a. Foldable t => t a -> Integer
length [TokenName]
pts Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1
{-# INLINEABLE hasPT #-}

-- | Verify the multi-signature of a snapshot using given constituents 'headId',
-- 'version', 'number', 'utxoHash' and 'utxoToDecommitHash'. See
-- 'SignableRepresentation Snapshot' for more details.
verifySnapshotSignature :: [Party] -> (CurrencySymbol, SnapshotVersion, SnapshotNumber, Hash, Hash, Hash) -> [Signature] -> Bool
verifySnapshotSignature :: [Party]
-> (CurrencySymbol, Integer, Integer, BuiltinByteString,
    BuiltinByteString, BuiltinByteString)
-> [BuiltinByteString]
-> Bool
verifySnapshotSignature [Party]
parties (CurrencySymbol, Integer, Integer, BuiltinByteString,
 BuiltinByteString, BuiltinByteString)
msg [BuiltinByteString]
sigs =
  BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode SignatureVerificationFailed) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
    [Party] -> Integer
forall (t :: * -> *) a. Foldable t => t a -> Integer
length [Party]
parties Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== [BuiltinByteString] -> Integer
forall (t :: * -> *) a. Foldable t => t a -> Integer
length [BuiltinByteString]
sigs
      Bool -> Bool -> Bool
&& ((Party, BuiltinByteString) -> Bool)
-> [(Party, BuiltinByteString)] -> Bool
forall a. (a -> Bool) -> [a] -> Bool
all ((Party -> BuiltinByteString -> Bool)
-> (Party, BuiltinByteString) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Party -> BuiltinByteString -> Bool)
 -> (Party, BuiltinByteString) -> Bool)
-> (Party -> BuiltinByteString -> Bool)
-> (Party, BuiltinByteString)
-> Bool
forall a b. (a -> b) -> a -> b
$ (CurrencySymbol, Integer, Integer, BuiltinByteString,
 BuiltinByteString, BuiltinByteString)
-> Party -> BuiltinByteString -> Bool
verifyPartySignature (CurrencySymbol, Integer, Integer, BuiltinByteString,
 BuiltinByteString, BuiltinByteString)
msg) ([Party] -> [BuiltinByteString] -> [(Party, BuiltinByteString)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Party]
parties [BuiltinByteString]
sigs)
{-# INLINEABLE verifySnapshotSignature #-}

-- | Verify individual party signature of a snapshot. See
-- 'SignableRepresentation Snapshot' for more details.
verifyPartySignature :: (CurrencySymbol, SnapshotVersion, SnapshotNumber, Hash, Hash, Hash) -> Party -> Signature -> Bool
verifyPartySignature :: (CurrencySymbol, Integer, Integer, BuiltinByteString,
 BuiltinByteString, BuiltinByteString)
-> Party -> BuiltinByteString -> Bool
verifyPartySignature (CurrencySymbol
headId, Integer
snapshotVersion, Integer
snapshotNumber, BuiltinByteString
utxoHash, BuiltinByteString
utxoToCommitHash, BuiltinByteString
utxoToDecommitHash) Party
party =
  BuiltinByteString -> BuiltinByteString -> BuiltinByteString -> Bool
verifyEd25519Signature (Party -> BuiltinByteString
vkey Party
party) BuiltinByteString
message
 where
  message :: BuiltinByteString
message =
    BuiltinData -> BuiltinByteString
Builtins.serialiseData (CurrencySymbol -> BuiltinData
forall a. ToData a => a -> BuiltinData
toBuiltinData CurrencySymbol
headId)
      BuiltinByteString -> BuiltinByteString -> BuiltinByteString
forall a. Semigroup a => a -> a -> a
<> BuiltinData -> BuiltinByteString
Builtins.serialiseData (Integer -> BuiltinData
forall a. ToData a => a -> BuiltinData
toBuiltinData Integer
snapshotVersion)
      BuiltinByteString -> BuiltinByteString -> BuiltinByteString
forall a. Semigroup a => a -> a -> a
<> BuiltinData -> BuiltinByteString
Builtins.serialiseData (Integer -> BuiltinData
forall a. ToData a => a -> BuiltinData
toBuiltinData Integer
snapshotNumber)
      BuiltinByteString -> BuiltinByteString -> BuiltinByteString
forall a. Semigroup a => a -> a -> a
<> BuiltinData -> BuiltinByteString
Builtins.serialiseData (BuiltinByteString -> BuiltinData
forall a. ToData a => a -> BuiltinData
toBuiltinData BuiltinByteString
utxoHash)
      BuiltinByteString -> BuiltinByteString -> BuiltinByteString
forall a. Semigroup a => a -> a -> a
<> BuiltinData -> BuiltinByteString
Builtins.serialiseData (BuiltinByteString -> BuiltinData
forall a. ToData a => a -> BuiltinData
toBuiltinData BuiltinByteString
utxoToCommitHash)
      BuiltinByteString -> BuiltinByteString -> BuiltinByteString
forall a. Semigroup a => a -> a -> a
<> BuiltinData -> BuiltinByteString
Builtins.serialiseData (BuiltinByteString -> BuiltinData
forall a. ToData a => a -> BuiltinData
toBuiltinData BuiltinByteString
utxoToDecommitHash)
{-# INLINEABLE verifyPartySignature #-}

compareRef :: TxOutRef -> TxOutRef -> Ordering
TxOutRef{TxId
txOutRefId :: TxId
txOutRefId :: TxOutRef -> TxId
txOutRefId, Integer
txOutRefIdx :: Integer
txOutRefIdx :: TxOutRef -> Integer
txOutRefIdx} compareRef :: TxOutRef -> TxOutRef -> Ordering
`compareRef` TxOutRef{txOutRefId :: TxOutRef -> TxId
txOutRefId = TxId
id', txOutRefIdx :: TxOutRef -> Integer
txOutRefIdx = Integer
idx'} =
  case TxId -> TxId -> Ordering
forall a. Ord a => a -> a -> Ordering
compare TxId
txOutRefId TxId
id' of
    Ordering
EQ -> Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Integer
txOutRefIdx Integer
idx'
    Ordering
ord -> Ordering
ord
{-# INLINEABLE compareRef #-}

compiledValidator :: CompiledCode ValidatorType
compiledValidator :: CompiledCode ValidatorType
compiledValidator =
  $$(PlutusTx.compile [||wrap headValidator||])
 where
  wrap :: (DatumType -> Input -> ScriptContext -> Bool) -> ValidatorType
wrap = forall datum redeemer.
(UnsafeFromData datum, UnsafeFromData redeemer) =>
(datum -> redeemer -> ScriptContext -> Bool) -> ValidatorType
wrapValidator @DatumType @RedeemerType

validatorScript :: SerialisedScript
validatorScript :: SerialisedScript
validatorScript = CompiledCode ValidatorType -> SerialisedScript
forall a. CompiledCode a -> SerialisedScript
serialiseCompiledCode CompiledCode ValidatorType
compiledValidator

validatorHash :: ScriptHash
validatorHash :: ScriptHash
validatorHash = PlutusScriptVersion PlutusScriptV3
-> SerialisedScript -> ScriptHash
forall lang.
PlutusScriptVersion lang -> SerialisedScript -> ScriptHash
scriptValidatorHash PlutusScriptVersion PlutusScriptV3
PlutusScriptV3 SerialisedScript
validatorScript

decodeHeadOutputClosedDatum :: ScriptContext -> ClosedDatum
decodeHeadOutputClosedDatum :: ScriptContext -> ClosedDatum
decodeHeadOutputClosedDatum ScriptContext
ctx =
  -- XXX: fromBuiltinData is super big (and also expensive?)
  case forall a. FromData a => BuiltinData -> Maybe a
fromBuiltinData @DatumType (BuiltinData -> Maybe DatumType) -> BuiltinData -> Maybe DatumType
forall a b. (a -> b) -> a -> b
$ Datum -> BuiltinData
getDatum (ScriptContext -> Datum
headOutputDatum ScriptContext
ctx) of
    Just (Closed ClosedDatum
closedDatum) -> ClosedDatum
closedDatum
    Maybe DatumType
_ -> BuiltinString -> ClosedDatum
forall a. BuiltinString -> a
traceError $(errorCode WrongStateInOutputDatum)
{-# INLINEABLE decodeHeadOutputClosedDatum #-}

decodeHeadOutputOpenDatum :: ScriptContext -> OpenDatum
decodeHeadOutputOpenDatum :: ScriptContext -> OpenDatum
decodeHeadOutputOpenDatum ScriptContext
ctx =
  -- XXX: fromBuiltinData is super big (and also expensive?)
  case forall a. FromData a => BuiltinData -> Maybe a
fromBuiltinData @DatumType (BuiltinData -> Maybe DatumType) -> BuiltinData -> Maybe DatumType
forall a b. (a -> b) -> a -> b
$ Datum -> BuiltinData
getDatum (ScriptContext -> Datum
headOutputDatum ScriptContext
ctx) of
    Just (Open OpenDatum
openDatum) -> OpenDatum
openDatum
    Maybe DatumType
_ -> BuiltinString -> OpenDatum
forall a. BuiltinString -> a
traceError $(errorCode WrongStateInOutputDatum)
{-# INLINEABLE decodeHeadOutputOpenDatum #-}

emptyHash :: Hash
emptyHash :: BuiltinByteString
emptyHash = [TxOut] -> BuiltinByteString
hashTxOuts []
{-# INLINEABLE emptyHash #-}