{-# 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 #-}
{-# 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
{-# 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)
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 =
[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
checkCollectCom ::
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
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
$
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
(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
([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 #-}
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 #-}
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 #-}
checkIncrement ::
ScriptContext ->
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 #-}
checkDecrement ::
ScriptContext ->
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
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
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 #-}
checkClose ::
ScriptContext ->
OpenDatum ->
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 #-}
checkContest ::
ScriptContext ->
ClosedDatum ->
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 #-}
checkFanout ::
ScriptContext ->
ClosedDatum ->
Integer ->
Integer ->
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 #-}
makeContestationDeadline :: ContestationPeriod -> ScriptContext -> POSIXTime
makeContestationDeadline :: ContestationPeriod -> ScriptContext -> POSIXTime
makeContestationDeadline ContestationPeriod
cperiod ScriptContext{TxInfo
scriptContextTxInfo :: ScriptContext -> TxInfo
scriptContextTxInfo :: TxInfo
scriptContextTxInfo} =
case Interval POSIXTime -> UpperBound POSIXTime
forall a. Interval a -> UpperBound a
ivTo (TxInfo -> Interval POSIXTime
txInfoValidRange TxInfo
scriptContextTxInfo) of
UpperBound (Finite POSIXTime
time) Bool
_ -> POSIXTime -> ContestationPeriod -> POSIXTime
addContestationPeriod POSIXTime
time ContestationPeriod
cperiod
UpperBound POSIXTime
_ -> BuiltinString -> POSIXTime
forall a. BuiltinString -> a
traceError $(errorCode CloseNoUpperBoundDefined)
{-# INLINEABLE makeContestationDeadline #-}
getHeadInput :: ScriptContext -> TxInInfo
getHeadInput :: ScriptContext -> TxInInfo
getHeadInput ScriptContext
ctx = case ScriptContext -> Maybe TxInInfo
findOwnInput ScriptContext
ctx of
Maybe TxInInfo
Nothing -> BuiltinString -> TxInInfo
forall a. BuiltinString -> a
traceError $(errorCode ScriptNotSpendingAHeadInput)
Just TxInInfo
x -> TxInInfo
x
{-# INLINEABLE getHeadInput #-}
getHeadAddress :: ScriptContext -> Address
getHeadAddress :: ScriptContext -> Address
getHeadAddress = TxOut -> Address
txOutAddress (TxOut -> Address)
-> (ScriptContext -> TxOut) -> ScriptContext -> Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxInInfo -> TxOut
txInInfoResolved (TxInInfo -> TxOut)
-> (ScriptContext -> TxInInfo) -> ScriptContext -> TxOut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptContext -> TxInInfo
getHeadInput
{-# INLINEABLE getHeadAddress #-}
mustNotChangeParameters ::
([Party], [Party]) ->
(ContestationPeriod, ContestationPeriod) ->
(CurrencySymbol, CurrencySymbol) ->
Bool
mustNotChangeParameters :: ([Party], [Party])
-> (ContestationPeriod, ContestationPeriod)
-> (CurrencySymbol, CurrencySymbol)
-> Bool
mustNotChangeParameters ([Party]
parties', [Party]
parties) (ContestationPeriod
contestationPeriod', ContestationPeriod
contestationPeriod) (CurrencySymbol
headId', CurrencySymbol
headId) =
BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode ChangedParameters) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
[Party]
parties' [Party] -> [Party] -> Bool
forall a. Eq a => a -> a -> Bool
== [Party]
parties
Bool -> Bool -> Bool
&& ContestationPeriod
contestationPeriod' ContestationPeriod -> ContestationPeriod -> Bool
forall a. Eq a => a -> a -> Bool
== ContestationPeriod
contestationPeriod
Bool -> Bool -> Bool
&& CurrencySymbol
headId' CurrencySymbol -> CurrencySymbol -> Bool
forall a. Eq a => a -> a -> Bool
== CurrencySymbol
headId
{-# INLINEABLE mustNotChangeParameters #-}
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 #-}
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 #-}
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 #-}
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 =
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 =
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 #-}