{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-specialize #-}
{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:conservative-optimisation #-}
{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:defer-errors #-}
{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:optimize #-}
-- 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 (
  PlutusScript,
  pattern PlutusScriptSerialised,
 )
import Hydra.Contract.Commit (Commit (..))
import Hydra.Contract.Commit qualified as Commit
import Hydra.Contract.Deposit qualified as Deposit
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, hashPreSerializedCommits, hashTxOuts, mustBurnAllHeadTokens, mustNotMintOrBurn, (===))
import Hydra.Data.ContestationPeriod (ContestationPeriod, addContestationPeriod, milliseconds)
import Hydra.Data.Party (Party (vkey))
import Hydra.Plutus.Extras (ValidatorType, wrapValidator)
import PlutusLedgerApi.Common (serialiseCompiledCode)
import PlutusLedgerApi.V1.Time (fromMilliSeconds)
import PlutusLedgerApi.V1.Value (lovelaceValue)
import PlutusLedgerApi.V3 (
  Address,
  CurrencySymbol,
  Datum (..),
  Extended (Finite),
  Interval (..),
  LowerBound (LowerBound),
  OutputDatum (..),
  POSIXTime,
  PubKeyHash (getPubKeyHash),
  ScriptContext (..),
  TokenName (..),
  TxInInfo (..),
  TxInfo (..),
  TxOut (..),
  UpperBound (..),
  Value (Value),
 )
import PlutusLedgerApi.V3.Contexts (findOwnInput, findTxInByTxOutRef)
import PlutusTx (CompiledCode)
import PlutusTx qualified
import PlutusTx.AssocMap qualified as AssocMap
import PlutusTx.Builtins qualified as Builtins
import PlutusTx.Foldable qualified as F
import PlutusTx.List qualified as L

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{SnapshotVersion
numberOfFanoutOutputs :: SnapshotVersion
$sel:numberOfFanoutOutputs:CollectCom :: Input -> SnapshotVersion
numberOfFanoutOutputs, SnapshotVersion
numberOfCommitOutputs :: SnapshotVersion
$sel:numberOfCommitOutputs:CollectCom :: Input -> SnapshotVersion
numberOfCommitOutputs, SnapshotVersion
numberOfDecommitOutputs :: SnapshotVersion
$sel:numberOfDecommitOutputs:CollectCom :: Input -> SnapshotVersion
numberOfDecommitOutputs}) ->
      ScriptContext
-> ClosedDatum
-> SnapshotVersion
-> SnapshotVersion
-> SnapshotVersion
-> Bool
checkFanout ScriptContext
ctx ClosedDatum
closedDatum SnapshotVersion
numberOfFanoutOutputs SnapshotVersion
numberOfCommitOutputs SnapshotVersion
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 committed 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 =
  MintValue -> CurrencySymbol -> [Party] -> Bool
mustBurnAllHeadTokens MintValue
minted CurrencySymbol
headCurrencySymbol [Party]
parties
    Bool -> Bool -> Bool
&& ScriptContext -> CurrencySymbol -> Bool
mustBeSignedByParticipant ScriptContext
ctx CurrencySymbol
headCurrencySymbol
    Bool -> Bool -> Bool
&& Bool
mustReimburseCommittedUTxO
 where
  minted :: MintValue
minted = TxInfo -> MintValue
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
$ SnapshotVersion -> [TxOut] -> [TxOut]
forall a. SnapshotVersion -> [a] -> [a]
L.take ([Commit] -> SnapshotVersion
forall a. [a] -> SnapshotVersion
L.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
$
      SnapshotVersion
version' SnapshotVersion -> SnapshotVersion -> Bool
forall a. Eq a => a -> a -> Bool
== SnapshotVersion
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 -> SnapshotVersion
version = SnapshotVersion
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
$
      SnapshotVersion
nTotalCommits SnapshotVersion -> SnapshotVersion -> Bool
forall a. Eq a => a -> a -> Bool
== [Party] -> SnapshotVersion
forall a. [a] -> SnapshotVersion
L.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
F.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, SnapshotVersion
nTotalCommits, Value
notCollectedValueIn) =
    (TxInInfo
 -> ([Commit], SnapshotVersion, Value)
 -> ([Commit], SnapshotVersion, Value))
-> ([Commit], SnapshotVersion, Value)
-> [TxInInfo]
-> ([Commit], SnapshotVersion, Value)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr
      TxInInfo
-> ([Commit], SnapshotVersion, Value)
-> ([Commit], SnapshotVersion, Value)
extractAndCountCommits
      ([], SnapshotVersion
0, Value
forall a. Monoid a => a
mempty)
      (TxInfo -> [TxInInfo]
txInfoInputs TxInfo
txInfo)

  extractAndCountCommits :: TxInInfo
-> ([Commit], SnapshotVersion, Value)
-> ([Commit], SnapshotVersion, Value)
extractAndCountCommits TxInInfo{TxOut
txInInfoResolved :: TxInInfo -> TxOut
txInInfoResolved :: TxOut
txInInfoResolved} ([Commit]
commits, SnapshotVersion
nCommits, Value
notCollected)
    | TxOut -> Bool
isHeadOutput TxOut
txInInfoResolved =
        ([Commit]
commits, SnapshotVersion
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, SnapshotVersion -> SnapshotVersion
forall a. Enum a => a -> a
succ SnapshotVersion
nCommits, Value
notCollected)
    | Bool
otherwise =
        ([Commit]
commits, SnapshotVersion
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 #-}

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

-- | Verify a increment transaction.
checkIncrement ::
  ScriptContext ->
  -- | Open state before the increment
  OpenDatum ->
  IncrementRedeemer ->
  Bool
checkIncrement :: ScriptContext -> OpenDatum -> IncrementRedeemer -> Bool
checkIncrement ctx :: ScriptContext
ctx@ScriptContext{scriptContextTxInfo :: ScriptContext -> TxInfo
scriptContextTxInfo = TxInfo
txInfo} OpenDatum
openBefore IncrementRedeemer
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
mustIncreaseValue
    Bool -> Bool -> Bool
&& ScriptContext -> CurrencySymbol -> Bool
mustBeSignedByParticipant ScriptContext
ctx CurrencySymbol
prevHeadId
    Bool -> Bool -> Bool
&& Bool
checkSnapshotSignature
    Bool -> Bool -> Bool
&& Bool
claimedDepositIsSpent
 where
  inputs :: [TxInInfo]
inputs = TxInfo -> [TxInInfo]
txInfoInputs TxInfo
txInfo

  depositInput :: TxInInfo
depositInput =
    case TxOutRef -> TxInfo -> Maybe TxInInfo
findTxInByTxOutRef TxOutRef
increment TxInfo
txInfo of
      Maybe TxInInfo
Nothing -> BuiltinString -> TxInInfo
forall a. BuiltinString -> a
traceError $(errorCode DepositInputNotFound)
      Just TxInInfo
i -> TxInInfo
i

  commits :: [Commit]
commits = TxOut -> [Commit]
depositDatum (TxOut -> [Commit]) -> TxOut -> [Commit]
forall a b. (a -> b) -> a -> b
$ TxInInfo -> TxOut
txInInfoResolved TxInInfo
depositInput

  depositHash :: BuiltinByteString
depositHash = [Commit] -> BuiltinByteString
hashPreSerializedCommits [Commit]
commits

  depositValue :: Value
depositValue = TxOut -> Value
txOutValue (TxOut -> Value) -> TxOut -> Value
forall a b. (a -> b) -> a -> b
$ TxInInfo -> TxOut
txInInfoResolved TxInInfo
depositInput

  headInValue :: Value
headInValue =
    case (Value -> Bool) -> [Value] -> Maybe Value
forall a. (a -> Bool) -> [a] -> Maybe a
L.find (CurrencySymbol -> Value -> Bool
hasST CurrencySymbol
prevHeadId) ([Value] -> Maybe Value) -> [Value] -> Maybe Value
forall a b. (a -> b) -> a -> b
$ TxOut -> Value
txOutValue (TxOut -> Value) -> (TxInInfo -> TxOut) -> TxInInfo -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxInInfo -> TxOut
txInInfoResolved (TxInInfo -> Value) -> [TxInInfo] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxInInfo]
inputs of
      Maybe Value
Nothing -> BuiltinString -> Value
forall a. BuiltinString -> a
traceError $(errorCode HeadInputNotFound)
      Just Value
i -> Value
i

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

  IncrementRedeemer{[BuiltinByteString]
signature :: [BuiltinByteString]
$sel:signature:IncrementRedeemer :: IncrementRedeemer -> [BuiltinByteString]
signature, SnapshotVersion
snapshotNumber :: SnapshotVersion
$sel:snapshotNumber:IncrementRedeemer :: IncrementRedeemer -> SnapshotVersion
snapshotNumber, TxOutRef
increment :: TxOutRef
$sel:increment:IncrementRedeemer :: IncrementRedeemer -> TxOutRef
increment} = IncrementRedeemer
redeemer

  claimedDepositIsSpent :: Bool
claimedDepositIsSpent =
    BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode DepositNotSpent) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
      TxOutRef
increment TxOutRef -> [TxOutRef] -> Bool
forall a. Eq a => a -> [a] -> Bool
`L.elem` (TxInInfo -> TxOutRef
txInInfoOutRef (TxInInfo -> TxOutRef) -> [TxInInfo] -> [TxOutRef]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxInfo -> [TxInInfo]
txInfoInputs TxInfo
txInfo)

  checkSnapshotSignature :: Bool
checkSnapshotSignature =
    [Party]
-> (CurrencySymbol, SnapshotVersion, SnapshotVersion,
    BuiltinByteString, BuiltinByteString, BuiltinByteString)
-> [BuiltinByteString]
-> Bool
verifySnapshotSignature [Party]
nextParties (CurrencySymbol
nextHeadId, SnapshotVersion
prevVersion, SnapshotVersion
snapshotNumber, BuiltinByteString
nextUtxoHash, BuiltinByteString
depositHash, BuiltinByteString
emptyHash) [BuiltinByteString]
signature

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

  mustIncreaseValue :: Bool
mustIncreaseValue =
    BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode HeadValueIsNotPreserved) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
      Value
headInValue Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
depositValue Value -> Value -> Bool
=== Value
headOutValue

  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 -> SnapshotVersion
version = SnapshotVersion
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 -> SnapshotVersion
version = SnapshotVersion
nextVersion
    } = ScriptContext -> OpenDatum
decodeHeadOutputOpenDatum ScriptContext
ctx
{-# 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, SnapshotVersion, SnapshotVersion,
    BuiltinByteString, BuiltinByteString, BuiltinByteString)
-> [BuiltinByteString]
-> Bool
verifySnapshotSignature [Party]
nextParties (CurrencySymbol
nextHeadId, SnapshotVersion
prevVersion, SnapshotVersion
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
F.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
$
      SnapshotVersion
nextVersion SnapshotVersion -> SnapshotVersion -> Bool
forall a. Eq a => a -> a -> Bool
== SnapshotVersion
prevVersion SnapshotVersion -> SnapshotVersion -> SnapshotVersion
forall a. AdditiveSemigroup a => a -> a -> a
+ SnapshotVersion
1

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

  DecrementRedeemer{[BuiltinByteString]
signature :: [BuiltinByteString]
$sel:signature:DecrementRedeemer :: DecrementRedeemer -> [BuiltinByteString]
signature, SnapshotVersion
snapshotNumber :: SnapshotVersion
$sel:snapshotNumber:DecrementRedeemer :: DecrementRedeemer -> SnapshotVersion
snapshotNumber, SnapshotVersion
numberOfDecommitOutputs :: SnapshotVersion
$sel:numberOfDecommitOutputs:DecrementRedeemer :: DecrementRedeemer -> SnapshotVersion
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 -> SnapshotVersion
version = SnapshotVersion
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 -> SnapshotVersion
version = SnapshotVersion
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
L.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 = SnapshotVersion -> [TxOut] -> [TxOut]
forall a. SnapshotVersion -> [a] -> [a]
L.take SnapshotVersion
numberOfDecommitOutputs ([TxOut] -> [TxOut]
forall a. [a] -> [a]
L.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
    , SnapshotVersion
$sel:version:OpenDatum :: OpenDatum -> SnapshotVersion
version :: SnapshotVersion
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
L.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 -> SnapshotVersion
snapshotNumber = SnapshotVersion
snapshotNumber'
    , $sel:utxoHash:ClosedDatum :: ClosedDatum -> BuiltinByteString
utxoHash = BuiltinByteString
utxoHash'
    , $sel:alphaUTxOHash:ClosedDatum :: ClosedDatum -> BuiltinByteString
alphaUTxOHash = BuiltinByteString
alphaUTxOHash'
    , $sel:omegaUTxOHash:ClosedDatum :: ClosedDatum -> BuiltinByteString
omegaUTxOHash = BuiltinByteString
omegaUTxOHash'
    , $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 -> SnapshotVersion
version = SnapshotVersion
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
$
      SnapshotVersion
version' SnapshotVersion -> SnapshotVersion -> Bool
forall a. Eq a => a -> a -> Bool
== SnapshotVersion
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
$
          SnapshotVersion
version SnapshotVersion -> SnapshotVersion -> Bool
forall a. Eq a => a -> a -> Bool
== SnapshotVersion
0
            Bool -> Bool -> Bool
&& SnapshotVersion
snapshotNumber' SnapshotVersion -> SnapshotVersion -> Bool
forall a. Eq a => a -> a -> Bool
== SnapshotVersion
0
            Bool -> Bool -> Bool
&& BuiltinByteString
utxoHash' BuiltinByteString -> BuiltinByteString -> Bool
forall a. Eq a => a -> a -> Bool
== BuiltinByteString
initialUtxoHash
      CloseAny{[BuiltinByteString]
signature :: [BuiltinByteString]
$sel:signature:CloseInitial :: CloseRedeemer -> [BuiltinByteString]
signature} ->
        BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode FailedCloseAny) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
          SnapshotVersion
snapshotNumber' SnapshotVersion -> SnapshotVersion -> Bool
forall a. Ord a => a -> a -> Bool
> SnapshotVersion
0
            Bool -> Bool -> Bool
&& BuiltinByteString
alphaUTxOHash' BuiltinByteString -> BuiltinByteString -> Bool
forall a. Eq a => a -> a -> Bool
== BuiltinByteString
emptyHash
            Bool -> Bool -> Bool
&& BuiltinByteString
omegaUTxOHash' BuiltinByteString -> BuiltinByteString -> Bool
forall a. Eq a => a -> a -> Bool
== BuiltinByteString
emptyHash
            Bool -> Bool -> Bool
&& [Party]
-> (CurrencySymbol, SnapshotVersion, SnapshotVersion,
    BuiltinByteString, BuiltinByteString, BuiltinByteString)
-> [BuiltinByteString]
-> Bool
verifySnapshotSignature
              [Party]
parties
              (CurrencySymbol
headId, SnapshotVersion
version, SnapshotVersion
snapshotNumber', BuiltinByteString
utxoHash', BuiltinByteString
emptyHash, BuiltinByteString
emptyHash)
              [BuiltinByteString]
signature
      CloseUnusedDec{[BuiltinByteString]
$sel:signature:CloseInitial :: CloseRedeemer -> [BuiltinByteString]
signature :: [BuiltinByteString]
signature} ->
        BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode FailedCloseUnusedDec) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
          BuiltinByteString
alphaUTxOHash' BuiltinByteString -> BuiltinByteString -> Bool
forall a. Eq a => a -> a -> Bool
== BuiltinByteString
emptyHash
            Bool -> Bool -> Bool
&& BuiltinByteString
omegaUTxOHash' BuiltinByteString -> BuiltinByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= BuiltinByteString
emptyHash
            Bool -> Bool -> Bool
&& [Party]
-> (CurrencySymbol, SnapshotVersion, SnapshotVersion,
    BuiltinByteString, BuiltinByteString, BuiltinByteString)
-> [BuiltinByteString]
-> Bool
verifySnapshotSignature
              [Party]
parties
              (CurrencySymbol
headId, SnapshotVersion
version, SnapshotVersion
snapshotNumber', BuiltinByteString
utxoHash', BuiltinByteString
emptyHash, BuiltinByteString
omegaUTxOHash')
              [BuiltinByteString]
signature
      CloseUsedDec{[BuiltinByteString]
$sel:signature:CloseInitial :: CloseRedeemer -> [BuiltinByteString]
signature :: [BuiltinByteString]
signature, BuiltinByteString
alreadyDecommittedUTxOHash :: BuiltinByteString
$sel:alreadyDecommittedUTxOHash:CloseInitial :: CloseRedeemer -> BuiltinByteString
alreadyDecommittedUTxOHash} ->
        BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode FailedCloseUsedDec) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
          BuiltinByteString
alphaUTxOHash' BuiltinByteString -> BuiltinByteString -> Bool
forall a. Eq a => a -> a -> Bool
== BuiltinByteString
emptyHash
            Bool -> Bool -> Bool
&& BuiltinByteString
omegaUTxOHash' BuiltinByteString -> BuiltinByteString -> Bool
forall a. Eq a => a -> a -> Bool
== BuiltinByteString
emptyHash
            Bool -> Bool -> Bool
&& [Party]
-> (CurrencySymbol, SnapshotVersion, SnapshotVersion,
    BuiltinByteString, BuiltinByteString, BuiltinByteString)
-> [BuiltinByteString]
-> Bool
verifySnapshotSignature
              [Party]
parties
              (CurrencySymbol
headId, SnapshotVersion
version SnapshotVersion -> SnapshotVersion -> SnapshotVersion
forall a. AdditiveGroup a => a -> a -> a
- SnapshotVersion
1, SnapshotVersion
snapshotNumber', BuiltinByteString
utxoHash', BuiltinByteString
emptyHash, BuiltinByteString
alreadyDecommittedUTxOHash)
              [BuiltinByteString]
signature
      CloseUnusedInc{[BuiltinByteString]
$sel:signature:CloseInitial :: CloseRedeemer -> [BuiltinByteString]
signature :: [BuiltinByteString]
signature, BuiltinByteString
alreadyCommittedUTxOHash :: BuiltinByteString
$sel:alreadyCommittedUTxOHash:CloseInitial :: CloseRedeemer -> BuiltinByteString
alreadyCommittedUTxOHash} ->
        BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode FailedCloseUnusedInc) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
          BuiltinByteString
alphaUTxOHash' BuiltinByteString -> BuiltinByteString -> Bool
forall a. Eq a => a -> a -> Bool
== BuiltinByteString
emptyHash
            Bool -> Bool -> Bool
&& BuiltinByteString
omegaUTxOHash' BuiltinByteString -> BuiltinByteString -> Bool
forall a. Eq a => a -> a -> Bool
== BuiltinByteString
emptyHash
            Bool -> Bool -> Bool
&& [Party]
-> (CurrencySymbol, SnapshotVersion, SnapshotVersion,
    BuiltinByteString, BuiltinByteString, BuiltinByteString)
-> [BuiltinByteString]
-> Bool
verifySnapshotSignature
              [Party]
parties
              (CurrencySymbol
headId, SnapshotVersion
version, SnapshotVersion
snapshotNumber', BuiltinByteString
utxoHash', BuiltinByteString
alreadyCommittedUTxOHash, BuiltinByteString
emptyHash)
              [BuiltinByteString]
signature
      CloseUsedInc{[BuiltinByteString]
$sel:signature:CloseInitial :: CloseRedeemer -> [BuiltinByteString]
signature :: [BuiltinByteString]
signature, BuiltinByteString
$sel:alreadyCommittedUTxOHash:CloseInitial :: CloseRedeemer -> BuiltinByteString
alreadyCommittedUTxOHash :: BuiltinByteString
alreadyCommittedUTxOHash} ->
        BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode FailedCloseUsedInc) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
          BuiltinByteString
alphaUTxOHash' BuiltinByteString -> BuiltinByteString -> Bool
forall a. Eq a => a -> a -> Bool
== BuiltinByteString
alreadyCommittedUTxOHash
            Bool -> Bool -> Bool
&& BuiltinByteString
omegaUTxOHash' BuiltinByteString -> BuiltinByteString -> Bool
forall a. Eq a => a -> a -> Bool
== BuiltinByteString
emptyHash
            Bool -> Bool -> Bool
&& [Party]
-> (CurrencySymbol, SnapshotVersion, SnapshotVersion,
    BuiltinByteString, BuiltinByteString, BuiltinByteString)
-> [BuiltinByteString]
-> Bool
verifySnapshotSignature
              [Party]
parties
              (CurrencySymbol
headId, SnapshotVersion
version SnapshotVersion -> SnapshotVersion -> SnapshotVersion
forall a. AdditiveGroup a => a -> a -> a
- SnapshotVersion
1, SnapshotVersion
snapshotNumber', BuiltinByteString
utxoHash', BuiltinByteString
alreadyCommittedUTxOHash, BuiltinByteString
emptyHash)
              [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
L.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
L.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
$
      SnapshotVersion
snapshotNumber' SnapshotVersion -> SnapshotVersion -> Bool
forall a. Ord a => a -> a -> Bool
> SnapshotVersion
snapshotNumber

  mustNotChangeVersion :: Bool
mustNotChangeVersion =
    BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode MustNotChangeVersion) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
      SnapshotVersion
version' SnapshotVersion -> SnapshotVersion -> Bool
forall a. Eq a => a -> a -> Bool
== SnapshotVersion
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
$
          BuiltinByteString
alphaUTxOHash' BuiltinByteString -> BuiltinByteString -> Bool
forall a. Eq a => a -> a -> Bool
== BuiltinByteString
emptyHash
            Bool -> Bool -> Bool
&& BuiltinByteString
omegaUTxOHash' BuiltinByteString -> BuiltinByteString -> Bool
forall a. Eq a => a -> a -> Bool
== BuiltinByteString
emptyHash
            Bool -> Bool -> Bool
&& [Party]
-> (CurrencySymbol, SnapshotVersion, SnapshotVersion,
    BuiltinByteString, BuiltinByteString, BuiltinByteString)
-> [BuiltinByteString]
-> Bool
verifySnapshotSignature
              [Party]
parties
              (CurrencySymbol
headId, SnapshotVersion
version, SnapshotVersion
snapshotNumber', BuiltinByteString
utxoHash', BuiltinByteString
emptyHash, BuiltinByteString
emptyHash)
              [BuiltinByteString]
signature
      ContestUsedDec{[BuiltinByteString]
$sel:signature:ContestCurrent :: ContestRedeemer -> [BuiltinByteString]
signature :: [BuiltinByteString]
signature, BuiltinByteString
alreadyDecommittedUTxOHash :: BuiltinByteString
$sel:alreadyDecommittedUTxOHash:ContestCurrent :: ContestRedeemer -> BuiltinByteString
alreadyDecommittedUTxOHash} ->
        BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode FailedContestUsedDec) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
          BuiltinByteString
alphaUTxOHash' BuiltinByteString -> BuiltinByteString -> Bool
forall a. Eq a => a -> a -> Bool
== BuiltinByteString
emptyHash
            Bool -> Bool -> Bool
&& BuiltinByteString
omegaUTxOHash' BuiltinByteString -> BuiltinByteString -> Bool
forall a. Eq a => a -> a -> Bool
== BuiltinByteString
emptyHash
            Bool -> Bool -> Bool
&& [Party]
-> (CurrencySymbol, SnapshotVersion, SnapshotVersion,
    BuiltinByteString, BuiltinByteString, BuiltinByteString)
-> [BuiltinByteString]
-> Bool
verifySnapshotSignature
              [Party]
parties
              (CurrencySymbol
headId, SnapshotVersion
version SnapshotVersion -> SnapshotVersion -> SnapshotVersion
forall a. AdditiveGroup a => a -> a -> a
- SnapshotVersion
1, SnapshotVersion
snapshotNumber', BuiltinByteString
utxoHash', BuiltinByteString
emptyHash, BuiltinByteString
alreadyDecommittedUTxOHash)
              [BuiltinByteString]
signature
      ContestUnusedDec{[BuiltinByteString]
$sel:signature:ContestCurrent :: ContestRedeemer -> [BuiltinByteString]
signature :: [BuiltinByteString]
signature} ->
        BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode FailedContestUnusedDec) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
          BuiltinByteString
alphaUTxOHash' BuiltinByteString -> BuiltinByteString -> Bool
forall a. Eq a => a -> a -> Bool
== BuiltinByteString
emptyHash
            Bool -> Bool -> Bool
&& [Party]
-> (CurrencySymbol, SnapshotVersion, SnapshotVersion,
    BuiltinByteString, BuiltinByteString, BuiltinByteString)
-> [BuiltinByteString]
-> Bool
verifySnapshotSignature
              [Party]
parties
              (CurrencySymbol
headId, SnapshotVersion
version, SnapshotVersion
snapshotNumber', BuiltinByteString
utxoHash', BuiltinByteString
emptyHash, BuiltinByteString
omegaUTxOHash')
              [BuiltinByteString]
signature
      ContestUnusedInc{[BuiltinByteString]
$sel:signature:ContestCurrent :: ContestRedeemer -> [BuiltinByteString]
signature :: [BuiltinByteString]
signature, BuiltinByteString
alreadyCommittedUTxOHash :: BuiltinByteString
$sel:alreadyCommittedUTxOHash:ContestCurrent :: ContestRedeemer -> BuiltinByteString
alreadyCommittedUTxOHash} ->
        BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode FailedContestUnusedInc) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
          BuiltinByteString
omegaUTxOHash' BuiltinByteString -> BuiltinByteString -> Bool
forall a. Eq a => a -> a -> Bool
== BuiltinByteString
emptyHash
            Bool -> Bool -> Bool
&& [Party]
-> (CurrencySymbol, SnapshotVersion, SnapshotVersion,
    BuiltinByteString, BuiltinByteString, BuiltinByteString)
-> [BuiltinByteString]
-> Bool
verifySnapshotSignature
              [Party]
parties
              (CurrencySymbol
headId, SnapshotVersion
version SnapshotVersion -> SnapshotVersion -> SnapshotVersion
forall a. AdditiveGroup a => a -> a -> a
- SnapshotVersion
1, SnapshotVersion
snapshotNumber', BuiltinByteString
utxoHash', BuiltinByteString
alreadyCommittedUTxOHash, BuiltinByteString
emptyHash)
              [BuiltinByteString]
signature
      ContestUsedInc{[BuiltinByteString]
$sel:signature:ContestCurrent :: ContestRedeemer -> [BuiltinByteString]
signature :: [BuiltinByteString]
signature} ->
        BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode FailedContestUsedInc) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
          BuiltinByteString
omegaUTxOHash' BuiltinByteString -> BuiltinByteString -> Bool
forall a. Eq a => a -> a -> Bool
== BuiltinByteString
emptyHash
            Bool -> Bool -> Bool
&& [Party]
-> (CurrencySymbol, SnapshotVersion, SnapshotVersion,
    BuiltinByteString, BuiltinByteString, BuiltinByteString)
-> [BuiltinByteString]
-> Bool
verifySnapshotSignature
              [Party]
parties
              (CurrencySymbol
headId, SnapshotVersion
version, SnapshotVersion
snapshotNumber', BuiltinByteString
utxoHash', BuiltinByteString
alphaUTxOHash', BuiltinByteString
emptyHash)
              [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] -> SnapshotVersion
forall a. [a] -> SnapshotVersion
L.length [PubKeyHash]
contesters' SnapshotVersion -> SnapshotVersion -> Bool
forall a. Eq a => a -> a -> Bool
== [Party] -> SnapshotVersion
forall a. [a] -> SnapshotVersion
L.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
    , SnapshotVersion
$sel:snapshotNumber:ClosedDatum :: ClosedDatum -> SnapshotVersion
snapshotNumber :: SnapshotVersion
snapshotNumber
    , [PubKeyHash]
$sel:contesters:ClosedDatum :: ClosedDatum -> [PubKeyHash]
contesters :: [PubKeyHash]
contesters
    , CurrencySymbol
$sel:headId:ClosedDatum :: ClosedDatum -> CurrencySymbol
headId :: CurrencySymbol
headId
    , SnapshotVersion
$sel:version:ClosedDatum :: ClosedDatum -> SnapshotVersion
version :: SnapshotVersion
version
    } = ClosedDatum
closedDatum

  ClosedDatum
    { $sel:snapshotNumber:ClosedDatum :: ClosedDatum -> SnapshotVersion
snapshotNumber = SnapshotVersion
snapshotNumber'
    , $sel:utxoHash:ClosedDatum :: ClosedDatum -> BuiltinByteString
utxoHash = BuiltinByteString
utxoHash'
    , $sel:alphaUTxOHash:ClosedDatum :: ClosedDatum -> BuiltinByteString
alphaUTxOHash = BuiltinByteString
alphaUTxOHash'
    , $sel:omegaUTxOHash:ClosedDatum :: ClosedDatum -> BuiltinByteString
omegaUTxOHash = BuiltinByteString
omegaUTxOHash'
    , $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 -> SnapshotVersion
version = SnapshotVersion
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
`L.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 alpha outputs to fanout
  Integer ->
  -- | Number of delta outputs to fanout
  Integer ->
  Bool
checkFanout :: ScriptContext
-> ClosedDatum
-> SnapshotVersion
-> SnapshotVersion
-> SnapshotVersion
-> Bool
checkFanout ScriptContext{scriptContextTxInfo :: ScriptContext -> TxInfo
scriptContextTxInfo = TxInfo
txInfo} ClosedDatum
closedDatum SnapshotVersion
numberOfFanoutOutputs SnapshotVersion
numberOfCommitOutputs SnapshotVersion
numberOfDecommitOutputs =
  MintValue -> CurrencySymbol -> [Party] -> Bool
mustBurnAllHeadTokens MintValue
minted CurrencySymbol
headId [Party]
parties
    Bool -> Bool -> Bool
&& Bool
hasSameUTxOHash
    Bool -> Bool -> Bool
&& Bool
hasSameCommitUTxOHash
    Bool -> Bool -> Bool
&& Bool
hasSameDecommitUTxOHash
    Bool -> Bool -> Bool
&& Bool
afterContestationDeadline
 where
  minted :: MintValue
minted = TxInfo -> MintValue
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

  hasSameCommitUTxOHash :: Bool
hasSameCommitUTxOHash =
    BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode FanoutUTxOToCommitHashMismatch) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
      BuiltinByteString
alphaUTxOHash BuiltinByteString -> BuiltinByteString -> Bool
forall a. Eq a => a -> a -> Bool
== BuiltinByteString
commitUtxoHash

  hasSameDecommitUTxOHash :: Bool
hasSameDecommitUTxOHash =
    BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode FanoutUTxOToDecommitHashMismatch) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
      BuiltinByteString
omegaUTxOHash 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
$ SnapshotVersion -> [TxOut] -> [TxOut]
forall a. SnapshotVersion -> [a] -> [a]
L.take SnapshotVersion
numberOfFanoutOutputs [TxOut]
txInfoOutputs

  commitUtxoHash :: BuiltinByteString
commitUtxoHash = [TxOut] -> BuiltinByteString
hashTxOuts ([TxOut] -> BuiltinByteString) -> [TxOut] -> BuiltinByteString
forall a b. (a -> b) -> a -> b
$ SnapshotVersion -> [TxOut] -> [TxOut]
forall a. SnapshotVersion -> [a] -> [a]
L.take SnapshotVersion
numberOfCommitOutputs ([TxOut] -> [TxOut]) -> [TxOut] -> [TxOut]
forall a b. (a -> b) -> a -> b
$ SnapshotVersion -> [TxOut] -> [TxOut]
forall a. SnapshotVersion -> [a] -> [a]
L.drop SnapshotVersion
numberOfFanoutOutputs [TxOut]
txInfoOutputs

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

  ClosedDatum{BuiltinByteString
$sel:utxoHash:ClosedDatum :: ClosedDatum -> BuiltinByteString
utxoHash :: BuiltinByteString
utxoHash, BuiltinByteString
$sel:alphaUTxOHash:ClosedDatum :: ClosedDatum -> BuiltinByteString
alphaUTxOHash :: BuiltinByteString
alphaUTxOHash, BuiltinByteString
$sel:omegaUTxOHash:ClosedDatum :: ClosedDatum -> BuiltinByteString
omegaUTxOHash :: BuiltinByteString
omegaUTxOHash, [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 #-}

-- | This is safe only because usually Head transaction only consume one input.
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
`L.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]
L.++ [TxInInfo] -> [TokenName]
loop [TxInInfo]
rest
{-# INLINEABLE mustBeSignedByParticipant #-}

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

-- | 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] -> SnapshotVersion
forall a. [a] -> SnapshotVersion
L.length [TokenName]
pts SnapshotVersion -> SnapshotVersion -> Bool
forall a. Eq a => a -> a -> Bool
== SnapshotVersion
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, SnapshotVersion, SnapshotVersion,
    BuiltinByteString, BuiltinByteString, BuiltinByteString)
-> [BuiltinByteString]
-> Bool
verifySnapshotSignature [Party]
parties (CurrencySymbol, SnapshotVersion, SnapshotVersion,
 BuiltinByteString, BuiltinByteString, BuiltinByteString)
msg [BuiltinByteString]
sigs =
  BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode SignatureVerificationFailed) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
    [Party] -> SnapshotVersion
forall a. [a] -> SnapshotVersion
L.length [Party]
parties SnapshotVersion -> SnapshotVersion -> Bool
forall a. Eq a => a -> a -> Bool
== [BuiltinByteString] -> SnapshotVersion
forall a. [a] -> SnapshotVersion
L.length [BuiltinByteString]
sigs
      Bool -> Bool -> Bool
&& ((Party, BuiltinByteString) -> Bool)
-> [(Party, BuiltinByteString)] -> Bool
forall a. (a -> Bool) -> [a] -> Bool
L.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, SnapshotVersion, SnapshotVersion,
 BuiltinByteString, BuiltinByteString, BuiltinByteString)
-> Party -> BuiltinByteString -> Bool
verifyPartySignature (CurrencySymbol, SnapshotVersion, SnapshotVersion,
 BuiltinByteString, BuiltinByteString, BuiltinByteString)
msg) ([Party] -> [BuiltinByteString] -> [(Party, BuiltinByteString)]
forall a b. [a] -> [b] -> [(a, b)]
L.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, SnapshotVersion, SnapshotVersion,
 BuiltinByteString, BuiltinByteString, BuiltinByteString)
-> Party -> BuiltinByteString -> Bool
verifyPartySignature (CurrencySymbol
headId, SnapshotVersion
snapshotVersion, SnapshotVersion
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 (SnapshotVersion -> BuiltinData
forall a. ToData a => a -> BuiltinData
toBuiltinData SnapshotVersion
snapshotVersion)
      BuiltinByteString -> BuiltinByteString -> BuiltinByteString
forall a. Semigroup a => a -> a -> a
<> BuiltinData -> BuiltinByteString
Builtins.serialiseData (SnapshotVersion -> BuiltinData
forall a. ToData a => a -> BuiltinData
toBuiltinData SnapshotVersion
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 #-}

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 :: PlutusScript
validatorScript :: PlutusScript
validatorScript = ShortByteString -> PlutusScript
PlutusScriptSerialised (ShortByteString -> PlutusScript)
-> ShortByteString -> PlutusScript
forall a b. (a -> b) -> a -> b
$ CompiledCode ValidatorType -> ShortByteString
forall a. CompiledCode a -> ShortByteString
serialiseCompiledCode CompiledCode ValidatorType
compiledValidator

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 #-}