{-# 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),
  FromData (fromBuiltinData),
  Interval (..),
  LowerBound (LowerBound),
  OutputDatum (..),
  POSIXTime,
  PubKeyHash (getPubKeyHash),
  ScriptContext (..),
  ToData (toBuiltinData),
  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

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 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
$ SnapshotVersion -> [TxOut] -> [TxOut]
forall a. SnapshotVersion -> [a] -> [a]
take ([Commit] -> SnapshotVersion
forall (t :: * -> *) a. Foldable t => t a -> SnapshotVersion
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 (t :: * -> *) a. Foldable t => t a -> SnapshotVersion
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, 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
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 =
  -- FIXME: spec is mentioning the n also needs to be unchanged - what is n here? utxo hash?
  -- "parameters cid, 𝑘̃ H , 𝑛, 𝑇 stay unchanged"
  ([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
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
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
`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
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
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]
take SnapshotVersion
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
    , 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
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
      -- FIXME: reflect the new CloseAny redeemer in the spec as well
      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
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
$
      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 (t :: * -> *) a. Foldable t => t a -> SnapshotVersion
length [PubKeyHash]
contesters' SnapshotVersion -> SnapshotVersion -> Bool
forall a. Eq a => a -> a -> Bool
== [Party] -> SnapshotVersion
forall (t :: * -> *) a. Foldable t => t a -> SnapshotVersion
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
`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 =
  Value -> CurrencySymbol -> [Party] -> Bool
mustBurnAllHeadTokens Value
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 :: 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

  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]
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]
take SnapshotVersion
numberOfCommitOutputs ([TxOut] -> [TxOut]) -> [TxOut] -> [TxOut]
forall a b. (a -> b) -> a -> b
$ SnapshotVersion -> [TxOut] -> [TxOut]
forall a. SnapshotVersion -> [a] -> [a]
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]
take SnapshotVersion
numberOfDecommitOutputs ([TxOut] -> [TxOut]) -> [TxOut] -> [TxOut]
forall a b. (a -> b) -> a -> b
$ SnapshotVersion -> [TxOut] -> [TxOut]
forall a. SnapshotVersion -> [a] -> [a]
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
`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 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 (t :: * -> *) a. Foldable t => t a -> SnapshotVersion
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 (t :: * -> *) a. Foldable t => t a -> SnapshotVersion
length [Party]
parties SnapshotVersion -> SnapshotVersion -> Bool
forall a. Eq a => a -> a -> Bool
== [BuiltinByteString] -> SnapshotVersion
forall (t :: * -> *) a. Foldable t => t a -> SnapshotVersion
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, 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)]
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 #-}