{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-specialize #-}
{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:defer-errors #-}
{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:no-simplifier-inline #-}
{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:target-version=1.0.0 #-}
module Hydra.Contract.Head where
import PlutusTx.Prelude
import Hydra.Cardano.Api (PlutusScriptVersion (PlutusScriptV2))
import Hydra.Contract.Commit (Commit (..))
import Hydra.Contract.Commit qualified as Commit
import Hydra.Contract.HeadError (HeadError (..), errorCode)
import Hydra.Contract.HeadState (Input (..), Signature, SnapshotNumber, State (..))
import Hydra.Contract.Util (hasST, mustBurnAllHeadTokens, mustNotMintOrBurn, (===))
import Hydra.Data.ContestationPeriod (ContestationPeriod, addContestationPeriod, milliseconds)
import Hydra.Data.Party (Party (vkey))
import Hydra.Plutus.Extras (ValidatorType, scriptValidatorHash, wrapValidator)
import PlutusLedgerApi.Common (SerialisedScript, serialiseCompiledCode)
import PlutusLedgerApi.V1.Time (fromMilliSeconds)
import PlutusLedgerApi.V1.Value (valueOf)
import PlutusLedgerApi.V2 (
Address,
CurrencySymbol,
Datum (..),
Extended (Finite),
FromData (fromBuiltinData),
Interval (..),
LowerBound (LowerBound),
OutputDatum (..),
POSIXTime,
PubKeyHash (getPubKeyHash),
ScriptContext (..),
ScriptHash,
ToData (toBuiltinData),
TokenName (..),
TxInInfo (..),
TxInfo (..),
TxOut (..),
TxOutRef (..),
UpperBound (..),
Value (Value),
adaSymbol,
adaToken,
)
import PlutusLedgerApi.V2.Contexts (findOwnInput)
import PlutusTx (CompiledCode)
import PlutusTx qualified
import PlutusTx.AssocMap qualified as AssocMap
import PlutusTx.Builtins qualified as Builtins
type DatumType = State
type RedeemerType = Input
{-# 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{[Party]
$sel:parties:Initial :: DatumType -> [Party]
parties :: [Party]
parties, $sel:utxoHash:Initial :: DatumType -> BuiltinByteString
utxoHash = BuiltinByteString
initialUtxoHash, ContestationPeriod
$sel:contestationPeriod:Initial :: DatumType -> ContestationPeriod
contestationPeriod :: ContestationPeriod
contestationPeriod, CurrencySymbol
$sel:headId:Initial :: DatumType -> CurrencySymbol
headId :: CurrencySymbol
headId}, Close{[BuiltinByteString]
signature :: [BuiltinByteString]
$sel:signature:CollectCom :: Input -> [BuiltinByteString]
signature}) ->
ScriptContext
-> [Party]
-> BuiltinByteString
-> [BuiltinByteString]
-> ContestationPeriod
-> CurrencySymbol
-> Bool
checkClose ScriptContext
ctx [Party]
parties BuiltinByteString
initialUtxoHash [BuiltinByteString]
signature ContestationPeriod
contestationPeriod CurrencySymbol
headId
(Closed{[Party]
$sel:parties:Initial :: DatumType -> [Party]
parties :: [Party]
parties, $sel:snapshotNumber:Initial :: DatumType -> Integer
snapshotNumber = Integer
closedSnapshotNumber, POSIXTime
contestationDeadline :: POSIXTime
$sel:contestationDeadline:Initial :: DatumType -> POSIXTime
contestationDeadline, ContestationPeriod
$sel:contestationPeriod:Initial :: DatumType -> ContestationPeriod
contestationPeriod :: ContestationPeriod
contestationPeriod, CurrencySymbol
$sel:headId:Initial :: DatumType -> CurrencySymbol
headId :: CurrencySymbol
headId, [PubKeyHash]
contesters :: [PubKeyHash]
$sel:contesters:Initial :: DatumType -> [PubKeyHash]
contesters}, Contest{[BuiltinByteString]
$sel:signature:CollectCom :: Input -> [BuiltinByteString]
signature :: [BuiltinByteString]
signature}) ->
ScriptContext
-> POSIXTime
-> ContestationPeriod
-> [Party]
-> Integer
-> [BuiltinByteString]
-> [PubKeyHash]
-> CurrencySymbol
-> Bool
checkContest ScriptContext
ctx POSIXTime
contestationDeadline ContestationPeriod
contestationPeriod [Party]
parties Integer
closedSnapshotNumber [BuiltinByteString]
signature [PubKeyHash]
contesters CurrencySymbol
headId
(Closed{[Party]
$sel:parties:Initial :: DatumType -> [Party]
parties :: [Party]
parties, BuiltinByteString
$sel:utxoHash:Initial :: DatumType -> BuiltinByteString
utxoHash :: BuiltinByteString
utxoHash, POSIXTime
$sel:contestationDeadline:Initial :: DatumType -> POSIXTime
contestationDeadline :: POSIXTime
contestationDeadline, CurrencySymbol
$sel:headId:Initial :: DatumType -> CurrencySymbol
headId :: CurrencySymbol
headId}, Fanout{Integer
numberOfFanoutOutputs :: Integer
$sel:numberOfFanoutOutputs:CollectCom :: Input -> Integer
numberOfFanoutOutputs}) ->
BuiltinByteString
-> POSIXTime
-> Integer
-> ScriptContext
-> CurrencySymbol
-> [Party]
-> Bool
checkFanout BuiltinByteString
utxoHash POSIXTime
contestationDeadline Integer
numberOfFanoutOutputs ScriptContext
ctx CurrencySymbol
headId [Party]
parties
(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 =
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 =
[TxOut] -> BuiltinByteString
hashTxOuts ([TxOut] -> BuiltinByteString) -> [TxOut] -> BuiltinByteString
forall a b. (a -> b) -> a -> b
$ Integer -> [TxOut] -> [TxOut]
forall a. Integer -> [a] -> [a]
take ([Commit] -> Integer
forall (t :: * -> *) a. Foldable t => t a -> Integer
length [Commit]
committed) (TxInfo -> [TxOut]
txInfoOutputs TxInfo
txInfo)
hashOfCommittedUTxO :: BuiltinByteString
hashOfCommittedUTxO =
[Commit] -> BuiltinByteString
hashPreSerializedCommits [Commit]
committed
committed :: [Commit]
committed = [Commit] -> [TxInInfo] -> [Commit]
committedUTxO [] (TxInfo -> [TxInInfo]
txInfoInputs TxInfo
txInfo)
committedUTxO :: [Commit] -> [TxInInfo] -> [Commit]
committedUTxO [Commit]
commits = \case
[] -> [Commit]
commits
TxInInfo{txInInfoResolved :: TxInInfo -> TxOut
txInInfoResolved = TxOut
txOut} : [TxInInfo]
rest
| CurrencySymbol -> TxOut -> Bool
hasPT CurrencySymbol
headCurrencySymbol TxOut
txOut ->
[Commit] -> [TxInInfo] -> [Commit]
committedUTxO (TxOut -> [Commit]
commitDatum TxOut
txOut [Commit] -> [Commit] -> [Commit]
forall a. Semigroup a => a -> a -> a
<> [Commit]
commits) [TxInInfo]
rest
| Bool
otherwise ->
[Commit] -> [TxInInfo] -> [Commit]
committedUTxO [Commit]
commits [TxInInfo]
rest
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
mustNotChangeParameters
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
mustNotChangeParameters :: Bool
mustNotChangeParameters =
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
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
- TxInfo -> Value
txInfoFee TxInfo
txInfo
([Party]
parties', BuiltinByteString
utxoHash, ContestationPeriod
contestationPeriod', CurrencySymbol
headId') =
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
{ $sel:parties:Initial :: DatumType -> [Party]
parties = [Party]
p
, $sel:utxoHash:Initial :: DatumType -> BuiltinByteString
utxoHash = BuiltinByteString
h
, $sel:contestationPeriod:Initial :: DatumType -> ContestationPeriod
contestationPeriod = ContestationPeriod
cp
, $sel:headId:Initial :: DatumType -> CurrencySymbol
headId = CurrencySymbol
hId
} ->
([Party]
p, BuiltinByteString
h, ContestationPeriod
cp, CurrencySymbol
hId)
Maybe DatumType
_ -> BuiltinString
-> ([Party], BuiltinByteString, ContestationPeriod, CurrencySymbol)
forall a. BuiltinString -> a
traceError $(errorCode WrongStateInOutputDatum)
headAddress :: Address
headAddress = ScriptContext -> Address
getHeadAddress ScriptContext
ctx
everyoneHasCommitted :: Bool
everyoneHasCommitted =
BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode MissingCommits) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
Integer
nTotalCommits Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== [Party] -> Integer
forall (t :: * -> *) a. Foldable t => t a -> Integer
length [Party]
parties
val :: Value
val = Value -> (TxInInfo -> Value) -> Maybe TxInInfo -> Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Value
forall a. Monoid a => a
mempty (TxOut -> Value
txOutValue (TxOut -> Value) -> (TxInInfo -> TxOut) -> TxInInfo -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxInInfo -> TxOut
txInInfoResolved) (Maybe TxInInfo -> Value) -> Maybe TxInInfo -> Value
forall a b. (a -> b) -> a -> b
$ ScriptContext -> Maybe TxInInfo
findOwnInput ScriptContext
ctx
otherValueOut :: Value
otherValueOut =
case TxInfo -> [TxOut]
txInfoOutputs TxInfo
txInfo of
(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
([Commit]
collectedCommits, Integer
nTotalCommits, Value
notCollectedValueIn) =
(TxInInfo
-> ([Commit], Integer, Value) -> ([Commit], Integer, Value))
-> ([Commit], Integer, Value)
-> [TxInInfo]
-> ([Commit], Integer, Value)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
TxInInfo
-> ([Commit], Integer, Value) -> ([Commit], Integer, Value)
extractAndCountCommits
([], Integer
0, Value
forall a. Monoid a => a
mempty)
(TxInfo -> [TxInInfo]
txInfoInputs TxInfo
txInfo)
extractAndCountCommits :: TxInInfo
-> ([Commit], Integer, Value) -> ([Commit], Integer, Value)
extractAndCountCommits TxInInfo{TxOut
txInInfoResolved :: TxInInfo -> TxOut
txInInfoResolved :: TxOut
txInInfoResolved} ([Commit]
commits, Integer
nCommits, Value
notCollected)
| TxOut -> Bool
isHeadOutput TxOut
txInInfoResolved =
([Commit]
commits, Integer
nCommits, Value
notCollected)
| CurrencySymbol -> TxOut -> Bool
hasPT CurrencySymbol
headId TxOut
txInInfoResolved =
(TxOut -> [Commit]
commitDatum TxOut
txInInfoResolved [Commit] -> [Commit] -> [Commit]
forall a. Semigroup a => a -> a -> a
<> [Commit]
commits, Integer -> Integer
forall a. Enum a => a -> a
succ Integer
nCommits, Value
notCollected)
| Bool
otherwise =
([Commit]
commits, Integer
nCommits, Value
notCollected Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> TxOut -> Value
txOutValue TxOut
txInInfoResolved)
isHeadOutput :: TxOut -> Bool
isHeadOutput TxOut
txOut = TxOut -> Address
txOutAddress TxOut
txOut Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
== Address
headAddress
{-# INLINEABLE checkCollectCom #-}
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 #-}
checkClose ::
ScriptContext ->
[Party] ->
BuiltinByteString ->
[Signature] ->
ContestationPeriod ->
CurrencySymbol ->
Bool
checkClose :: ScriptContext
-> [Party]
-> BuiltinByteString
-> [BuiltinByteString]
-> ContestationPeriod
-> CurrencySymbol
-> Bool
checkClose ScriptContext
ctx [Party]
parties BuiltinByteString
initialUtxoHash [BuiltinByteString]
sig ContestationPeriod
cperiod CurrencySymbol
headPolicyId =
TxInfo -> Bool
mustNotMintOrBurn TxInfo
txInfo
Bool -> Bool -> Bool
&& Bool
hasBoundedValidity
Bool -> Bool -> Bool
&& Bool
checkDeadline
Bool -> Bool -> Bool
&& Bool
checkSnapshot
Bool -> Bool -> Bool
&& ScriptContext -> CurrencySymbol -> Bool
mustBeSignedByParticipant ScriptContext
ctx CurrencySymbol
headPolicyId
Bool -> Bool -> Bool
&& Bool
mustInitializeContesters
Bool -> Bool -> Bool
&& Bool
mustPreserveValue
Bool -> Bool -> Bool
&& Bool
mustNotChangeParameters
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
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
(Integer
closedSnapshotNumber, BuiltinByteString
closedUtxoHash, [Party]
parties', POSIXTime
closedContestationDeadline, ContestationPeriod
cperiod', CurrencySymbol
headId', [PubKeyHash]
contesters') =
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
{ Integer
$sel:snapshotNumber:Initial :: DatumType -> Integer
snapshotNumber :: Integer
snapshotNumber
, BuiltinByteString
$sel:utxoHash:Initial :: DatumType -> BuiltinByteString
utxoHash :: BuiltinByteString
utxoHash
, $sel:parties:Initial :: DatumType -> [Party]
parties = [Party]
p
, POSIXTime
$sel:contestationDeadline:Initial :: DatumType -> POSIXTime
contestationDeadline :: POSIXTime
contestationDeadline
, CurrencySymbol
$sel:headId:Initial :: DatumType -> CurrencySymbol
headId :: CurrencySymbol
headId
, [PubKeyHash]
$sel:contesters:Initial :: DatumType -> [PubKeyHash]
contesters :: [PubKeyHash]
contesters
, ContestationPeriod
$sel:contestationPeriod:Initial :: DatumType -> ContestationPeriod
contestationPeriod :: ContestationPeriod
contestationPeriod
} -> (Integer
snapshotNumber, BuiltinByteString
utxoHash, [Party]
p, POSIXTime
contestationDeadline, ContestationPeriod
contestationPeriod, CurrencySymbol
headId, [PubKeyHash]
contesters)
Maybe DatumType
_ -> BuiltinString
-> (Integer, BuiltinByteString, [Party], POSIXTime,
ContestationPeriod, CurrencySymbol, [PubKeyHash])
forall a. BuiltinString -> a
traceError $(errorCode WrongStateInOutputDatum)
checkSnapshot :: Bool
checkSnapshot
| Integer
closedSnapshotNumber Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 =
[Party]
-> CurrencySymbol
-> Integer
-> BuiltinByteString
-> [BuiltinByteString]
-> Bool
verifySnapshotSignature [Party]
parties CurrencySymbol
headPolicyId Integer
closedSnapshotNumber BuiltinByteString
closedUtxoHash [BuiltinByteString]
sig
| Bool
otherwise =
BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode ClosedWithNonInitialHash) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
BuiltinByteString
closedUtxoHash BuiltinByteString -> BuiltinByteString -> Bool
forall a. Eq a => a -> a -> Bool
== BuiltinByteString
initialUtxoHash
checkDeadline :: Bool
checkDeadline =
BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode IncorrectClosedContestationDeadline) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
POSIXTime
closedContestationDeadline 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)
mustNotChangeParameters :: Bool
mustNotChangeParameters =
BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode ChangedParameters) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
CurrencySymbol
headId' CurrencySymbol -> CurrencySymbol -> Bool
forall a. Eq a => a -> a -> Bool
== CurrencySymbol
headPolicyId
Bool -> Bool -> Bool
&& [Party]
parties' [Party] -> [Party] -> Bool
forall a. Eq a => a -> a -> Bool
== [Party]
parties
Bool -> Bool -> Bool
&& ContestationPeriod
cperiod' ContestationPeriod -> ContestationPeriod -> Bool
forall a. Eq a => a -> a -> Bool
== ContestationPeriod
cperiod
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 #-}
checkContest ::
ScriptContext ->
POSIXTime ->
ContestationPeriod ->
[Party] ->
SnapshotNumber ->
[Signature] ->
[PubKeyHash] ->
CurrencySymbol ->
Bool
checkContest :: ScriptContext
-> POSIXTime
-> ContestationPeriod
-> [Party]
-> Integer
-> [BuiltinByteString]
-> [PubKeyHash]
-> CurrencySymbol
-> Bool
checkContest ScriptContext
ctx POSIXTime
contestationDeadline ContestationPeriod
contestationPeriod [Party]
parties Integer
closedSnapshotNumber [BuiltinByteString]
sig [PubKeyHash]
contesters CurrencySymbol
headId =
TxInfo -> Bool
mustNotMintOrBurn TxInfo
txInfo
Bool -> Bool -> Bool
&& Bool
mustBeNewer
Bool -> Bool -> Bool
&& Bool
mustBeMultiSigned
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
&& Bool
mustNotChangeParameters
Bool -> Bool -> Bool
&& Bool
mustPreserveValue
where
mustPreserveValue :: Bool
mustPreserveValue =
BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode HeadValueIsNotPreserved) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
Value
val Value -> Value -> Bool
=== Value
val'
val' :: Value
val' = TxOut -> Value
txOutValue (TxOut -> Value) -> ([TxOut] -> TxOut) -> [TxOut] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TxOut] -> TxOut
forall a. [a] -> a
head ([TxOut] -> Value) -> [TxOut] -> Value
forall a b. (a -> b) -> a -> b
$ TxInfo -> [TxOut]
txInfoOutputs TxInfo
txInfo
val :: Value
val = Value -> (TxInInfo -> Value) -> Maybe TxInInfo -> Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Value
forall a. Monoid a => a
mempty (TxOut -> Value
txOutValue (TxOut -> Value) -> (TxInInfo -> TxOut) -> TxInInfo -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxInInfo -> TxOut
txInInfoResolved) (Maybe TxInInfo -> Value) -> Maybe TxInInfo -> Value
forall a b. (a -> b) -> a -> b
$ ScriptContext -> Maybe TxInInfo
findOwnInput ScriptContext
ctx
mustBeNewer :: Bool
mustBeNewer =
BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode TooOldSnapshot) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
Integer
contestSnapshotNumber Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
closedSnapshotNumber
mustBeMultiSigned :: Bool
mustBeMultiSigned =
[Party]
-> CurrencySymbol
-> Integer
-> BuiltinByteString
-> [BuiltinByteString]
-> Bool
verifySnapshotSignature [Party]
parties CurrencySymbol
headId Integer
contestSnapshotNumber BuiltinByteString
contestUtxoHash [BuiltinByteString]
sig
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)
mustNotChangeParameters :: Bool
mustNotChangeParameters =
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
&& CurrencySymbol
headId' CurrencySymbol -> CurrencySymbol -> Bool
forall a. Eq a => a -> a -> Bool
== CurrencySymbol
headId
Bool -> Bool -> Bool
&& ContestationPeriod
contestationPeriod' ContestationPeriod -> ContestationPeriod -> Bool
forall a. Eq a => a -> a -> Bool
== ContestationPeriod
contestationPeriod
mustPushDeadline :: Bool
mustPushDeadline =
if [PubKeyHash] -> Integer
forall (t :: * -> *) a. Foldable t => t a -> Integer
length [PubKeyHash]
contesters' Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== [Party] -> Integer
forall (t :: * -> *) a. Foldable t => t a -> Integer
length [Party]
parties'
then
BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode MustNotPushDeadline) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
POSIXTime
contestationDeadline' POSIXTime -> POSIXTime -> Bool
forall a. Eq a => a -> a -> Bool
== POSIXTime
contestationDeadline
else
BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode MustPushDeadline) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
POSIXTime
contestationDeadline' POSIXTime -> POSIXTime -> Bool
forall a. Eq a => a -> a -> Bool
== POSIXTime -> ContestationPeriod -> POSIXTime
addContestationPeriod POSIXTime
contestationDeadline ContestationPeriod
contestationPeriod
mustUpdateContesters :: Bool
mustUpdateContesters =
BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode ContesterNotIncluded) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
[PubKeyHash]
contesters' [PubKeyHash] -> [PubKeyHash] -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyHash
contester PubKeyHash -> [PubKeyHash] -> [PubKeyHash]
forall a. a -> [a] -> [a]
: [PubKeyHash]
contesters
(Integer
contestSnapshotNumber, BuiltinByteString
contestUtxoHash, [Party]
parties', POSIXTime
contestationDeadline', ContestationPeriod
contestationPeriod', CurrencySymbol
headId', [PubKeyHash]
contesters') =
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
{ Integer
$sel:snapshotNumber:Initial :: DatumType -> Integer
snapshotNumber :: Integer
snapshotNumber
, BuiltinByteString
$sel:utxoHash:Initial :: DatumType -> BuiltinByteString
utxoHash :: BuiltinByteString
utxoHash
, $sel:parties:Initial :: DatumType -> [Party]
parties = [Party]
p
, $sel:contestationDeadline:Initial :: DatumType -> POSIXTime
contestationDeadline = POSIXTime
dl
, $sel:contestationPeriod:Initial :: DatumType -> ContestationPeriod
contestationPeriod = ContestationPeriod
cp
, $sel:headId:Initial :: DatumType -> CurrencySymbol
headId = CurrencySymbol
hid
, $sel:contesters:Initial :: DatumType -> [PubKeyHash]
contesters = [PubKeyHash]
cs
} -> (Integer
snapshotNumber, BuiltinByteString
utxoHash, [Party]
p, POSIXTime
dl, ContestationPeriod
cp, CurrencySymbol
hid, [PubKeyHash]
cs)
Maybe DatumType
_ -> BuiltinString
-> (Integer, BuiltinByteString, [Party], POSIXTime,
ContestationPeriod, CurrencySymbol, [PubKeyHash])
forall a. BuiltinString -> a
traceError $(errorCode WrongStateInOutputDatum)
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 #-}
checkFanout ::
BuiltinByteString ->
POSIXTime ->
Integer ->
ScriptContext ->
CurrencySymbol ->
[Party] ->
Bool
checkFanout :: BuiltinByteString
-> POSIXTime
-> Integer
-> ScriptContext
-> CurrencySymbol
-> [Party]
-> Bool
checkFanout BuiltinByteString
utxoHash POSIXTime
contestationDeadline Integer
numberOfFanoutOutputs ScriptContext{scriptContextTxInfo :: ScriptContext -> TxInfo
scriptContextTxInfo = TxInfo
txInfo} CurrencySymbol
currencySymbol [Party]
parties =
Value -> CurrencySymbol -> [Party] -> Bool
mustBurnAllHeadTokens Value
minted CurrencySymbol
currencySymbol [Party]
parties
Bool -> Bool -> Bool
&& Bool
hasSameUTxOHash
Bool -> Bool -> Bool
&& Bool
afterContestationDeadline
where
minted :: Value
minted = TxInfo -> Value
txInfoMint TxInfo
txInfo
hasSameUTxOHash :: Bool
hasSameUTxOHash =
BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode FannedOutUtxoHashNotEqualToClosedUtxoHash) (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
fannedOutUtxoHash :: BuiltinByteString
fannedOutUtxoHash = [TxOut] -> BuiltinByteString
hashTxOuts ([TxOut] -> BuiltinByteString) -> [TxOut] -> BuiltinByteString
forall a b. (a -> b) -> a -> b
$ Integer -> [TxOut] -> [TxOut]
forall a. Integer -> [a] -> [a]
take Integer
numberOfFanoutOutputs [TxOut]
txInfoOutputs
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 #-}
(&) :: a -> (a -> b) -> b
& :: forall a b. a -> (a -> b) -> b
(&) = ((a -> b) -> a -> b) -> a -> (a -> b) -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
($)
{-# INLINEABLE (&) #-}
txOutAdaValue :: TxOut -> Integer
txOutAdaValue :: TxOut -> Integer
txOutAdaValue TxOut
o = Value -> CurrencySymbol -> TokenName -> Integer
valueOf (TxOut -> Value
txOutValue TxOut
o) CurrencySymbol
adaSymbol TokenName
adaToken
{-# INLINEABLE txOutAdaValue #-}
txInfoAdaFee :: TxInfo -> Integer
txInfoAdaFee :: TxInfo -> Integer
txInfoAdaFee TxInfo
tx = Value -> CurrencySymbol -> TokenName -> Integer
valueOf (TxInfo -> Value
txInfoFee TxInfo
tx) CurrencySymbol
adaSymbol TokenName
adaToken
{-# INLINEABLE txInfoAdaFee #-}
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 #-}
mustBeSignedByParticipant ::
ScriptContext ->
CurrencySymbol ->
Bool
mustBeSignedByParticipant :: ScriptContext -> CurrencySymbol -> Bool
mustBeSignedByParticipant ScriptContext{scriptContextTxInfo :: ScriptContext -> TxInfo
scriptContextTxInfo = TxInfo
txInfo} CurrencySymbol
headCurrencySymbol =
case PubKeyHash -> BuiltinByteString
getPubKeyHash (PubKeyHash -> BuiltinByteString)
-> [PubKeyHash] -> [BuiltinByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxInfo -> [PubKeyHash]
txInfoSignatories TxInfo
txInfo of
[BuiltinByteString
signer] ->
BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode SignerIsNotAParticipant) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
BuiltinByteString
signer BuiltinByteString -> [BuiltinByteString] -> Bool
forall a. Eq a => a -> [a] -> Bool
`elem` (TokenName -> BuiltinByteString
unTokenName (TokenName -> BuiltinByteString)
-> [TokenName] -> [BuiltinByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TokenName]
participationTokens)
[] ->
BuiltinString -> Bool
forall a. BuiltinString -> a
traceError $(errorCode NoSigners)
[BuiltinByteString]
_ ->
BuiltinString -> Bool
forall a. BuiltinString -> a
traceError $(errorCode TooManySigners)
where
participationTokens :: [TokenName]
participationTokens = [TxInInfo] -> [TokenName]
loop (TxInfo -> [TxInInfo]
txInfoInputs TxInfo
txInfo)
loop :: [TxInInfo] -> [TokenName]
loop = \case
[] -> []
(TxInInfo{TxOut
txInInfoResolved :: TxInInfo -> TxOut
txInInfoResolved :: TxOut
txInInfoResolved} : [TxInInfo]
rest) ->
CurrencySymbol -> Value -> [TokenName]
findParticipationTokens CurrencySymbol
headCurrencySymbol (TxOut -> Value
txOutValue TxOut
txInInfoResolved) [TokenName] -> [TokenName] -> [TokenName]
forall a. [a] -> [a] -> [a]
++ [TxInInfo] -> [TokenName]
loop [TxInInfo]
rest
{-# INLINEABLE mustBeSignedByParticipant #-}
findParticipationTokens :: CurrencySymbol -> Value -> [TokenName]
findParticipationTokens :: CurrencySymbol -> Value -> [TokenName]
findParticipationTokens CurrencySymbol
headCurrency (Value Map CurrencySymbol (Map TokenName Integer)
val) =
case Map TokenName Integer -> [(TokenName, Integer)]
forall k v. Map k v -> [(k, v)]
AssocMap.toList (Map TokenName Integer -> [(TokenName, Integer)])
-> Maybe (Map TokenName Integer) -> Maybe [(TokenName, Integer)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CurrencySymbol
-> Map CurrencySymbol (Map TokenName Integer)
-> Maybe (Map TokenName Integer)
forall k v. Eq k => k -> Map k v -> Maybe v
AssocMap.lookup CurrencySymbol
headCurrency Map CurrencySymbol (Map TokenName Integer)
val of
Just [(TokenName, Integer)]
tokens ->
((TokenName, Integer) -> Maybe TokenName)
-> [(TokenName, Integer)] -> [TokenName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(TokenName
tokenName, Integer
n) -> if Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 then TokenName -> Maybe TokenName
forall a. a -> Maybe a
Just TokenName
tokenName else Maybe TokenName
forall a. Maybe a
Nothing) [(TokenName, Integer)]
tokens
Maybe [(TokenName, Integer)]
_ ->
[]
{-# INLINEABLE findParticipationTokens #-}
headOutputDatum :: ScriptContext -> Datum
headOutputDatum :: ScriptContext -> Datum
headOutputDatum ScriptContext
ctx =
case TxInfo -> [TxOut]
txInfoOutputs TxInfo
txInfo of
(TxOut
o : [TxOut]
_)
| TxOut -> Address
txOutAddress TxOut
o Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
== Address
headAddress -> TxOut -> Datum
getTxOutDatum TxOut
o
[TxOut]
_ -> BuiltinString -> Datum
forall a. BuiltinString -> a
traceError $(errorCode NotPayingToHead)
where
headAddress :: Address
headAddress = ScriptContext -> Address
getHeadAddress ScriptContext
ctx
ScriptContext{scriptContextTxInfo :: ScriptContext -> TxInfo
scriptContextTxInfo = TxInfo
txInfo} = ScriptContext
ctx
{-# INLINEABLE headOutputDatum #-}
getTxOutDatum :: TxOut -> Datum
getTxOutDatum :: TxOut -> Datum
getTxOutDatum TxOut
o =
case TxOut -> OutputDatum
txOutDatum TxOut
o of
OutputDatum
NoOutputDatum -> BuiltinString -> Datum
forall a. BuiltinString -> a
traceError $(errorCode NoOutputDatumError)
OutputDatumHash DatumHash
_dh -> BuiltinString -> Datum
forall a. BuiltinString -> a
traceError $(errorCode UnexpectedNonInlineDatum)
OutputDatum Datum
d -> Datum
d
{-# INLINEABLE getTxOutDatum #-}
hashPreSerializedCommits :: [Commit] -> BuiltinByteString
hashPreSerializedCommits :: [Commit] -> BuiltinByteString
hashPreSerializedCommits [Commit]
commits =
BuiltinByteString -> BuiltinByteString
sha2_256 (BuiltinByteString -> BuiltinByteString)
-> ([Commit] -> BuiltinByteString) -> [Commit] -> BuiltinByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Commit -> BuiltinByteString) -> [Commit] -> BuiltinByteString
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Commit -> BuiltinByteString
preSerializedOutput ([Commit] -> BuiltinByteString) -> [Commit] -> BuiltinByteString
forall a b. (a -> b) -> a -> b
$
(Commit -> Commit -> Ordering) -> [Commit] -> [Commit]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\Commit
a Commit
b -> TxOutRef -> TxOutRef -> Ordering
compareRef (Commit -> TxOutRef
input Commit
a) (Commit -> TxOutRef
input Commit
b)) [Commit]
commits
{-# INLINEABLE hashPreSerializedCommits #-}
hashTxOuts :: [TxOut] -> BuiltinByteString
hashTxOuts :: [TxOut] -> BuiltinByteString
hashTxOuts =
BuiltinByteString -> BuiltinByteString
sha2_256 (BuiltinByteString -> BuiltinByteString)
-> ([TxOut] -> BuiltinByteString) -> [TxOut] -> BuiltinByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOut -> BuiltinByteString) -> [TxOut] -> BuiltinByteString
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (BuiltinData -> BuiltinByteString
Builtins.serialiseData (BuiltinData -> BuiltinByteString)
-> (TxOut -> BuiltinData) -> TxOut -> BuiltinByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut -> BuiltinData
forall a. ToData a => a -> BuiltinData
toBuiltinData)
{-# INLINEABLE hashTxOuts #-}
hasPT :: CurrencySymbol -> TxOut -> Bool
hasPT :: CurrencySymbol -> TxOut -> Bool
hasPT CurrencySymbol
headCurrencySymbol TxOut
txOut =
let pts :: [TokenName]
pts = CurrencySymbol -> Value -> [TokenName]
findParticipationTokens CurrencySymbol
headCurrencySymbol (TxOut -> Value
txOutValue TxOut
txOut)
in [TokenName] -> Integer
forall (t :: * -> *) a. Foldable t => t a -> Integer
length [TokenName]
pts Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1
{-# INLINEABLE hasPT #-}
verifySnapshotSignature :: [Party] -> CurrencySymbol -> SnapshotNumber -> BuiltinByteString -> [Signature] -> Bool
verifySnapshotSignature :: [Party]
-> CurrencySymbol
-> Integer
-> BuiltinByteString
-> [BuiltinByteString]
-> Bool
verifySnapshotSignature [Party]
parties CurrencySymbol
headId Integer
snapshotNumber BuiltinByteString
utxoHash [BuiltinByteString]
sigs =
BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode SignatureVerificationFailed) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
[Party] -> Integer
forall (t :: * -> *) a. Foldable t => t a -> Integer
length [Party]
parties
Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== [BuiltinByteString] -> Integer
forall (t :: * -> *) a. Foldable t => t a -> Integer
length [BuiltinByteString]
sigs
Bool -> Bool -> Bool
&& ((Party, BuiltinByteString) -> Bool)
-> [(Party, BuiltinByteString)] -> Bool
forall a. (a -> Bool) -> [a] -> Bool
all ((Party -> BuiltinByteString -> Bool)
-> (Party, BuiltinByteString) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Party -> BuiltinByteString -> Bool)
-> (Party, BuiltinByteString) -> Bool)
-> (Party -> BuiltinByteString -> Bool)
-> (Party, BuiltinByteString)
-> Bool
forall a b. (a -> b) -> a -> b
$ CurrencySymbol
-> Integer
-> BuiltinByteString
-> Party
-> BuiltinByteString
-> Bool
verifyPartySignature CurrencySymbol
headId Integer
snapshotNumber BuiltinByteString
utxoHash) ([Party] -> [BuiltinByteString] -> [(Party, BuiltinByteString)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Party]
parties [BuiltinByteString]
sigs)
{-# INLINEABLE verifySnapshotSignature #-}
verifyPartySignature :: CurrencySymbol -> SnapshotNumber -> BuiltinByteString -> Party -> Signature -> Bool
verifyPartySignature :: CurrencySymbol
-> Integer
-> BuiltinByteString
-> Party
-> BuiltinByteString
-> Bool
verifyPartySignature CurrencySymbol
headId Integer
snapshotNumber BuiltinByteString
utxoHash Party
party BuiltinByteString
signed =
BuiltinString -> Bool -> Bool
traceIfFalse $(errorCode PartySignatureVerificationFailed) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
BuiltinByteString -> BuiltinByteString -> BuiltinByteString -> Bool
verifyEd25519Signature (Party -> BuiltinByteString
vkey Party
party) BuiltinByteString
message BuiltinByteString
signed
where
message :: BuiltinByteString
message =
BuiltinData -> BuiltinByteString
Builtins.serialiseData (CurrencySymbol -> BuiltinData
forall a. ToData a => a -> BuiltinData
toBuiltinData CurrencySymbol
headId)
BuiltinByteString -> BuiltinByteString -> BuiltinByteString
forall a. Semigroup a => a -> a -> a
<> BuiltinData -> BuiltinByteString
Builtins.serialiseData (Integer -> BuiltinData
forall a. ToData a => a -> BuiltinData
toBuiltinData Integer
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)
{-# INLINEABLE verifyPartySignature #-}
compareRef :: TxOutRef -> TxOutRef -> Ordering
TxOutRef{TxId
txOutRefId :: TxId
txOutRefId :: TxOutRef -> TxId
txOutRefId, Integer
txOutRefIdx :: Integer
txOutRefIdx :: TxOutRef -> Integer
txOutRefIdx} compareRef :: TxOutRef -> TxOutRef -> Ordering
`compareRef` TxOutRef{txOutRefId :: TxOutRef -> TxId
txOutRefId = TxId
id', txOutRefIdx :: TxOutRef -> Integer
txOutRefIdx = Integer
idx'} =
case TxId -> TxId -> Ordering
forall a. Ord a => a -> a -> Ordering
compare TxId
txOutRefId TxId
id' of
Ordering
EQ -> Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Integer
txOutRefIdx Integer
idx'
Ordering
ord -> Ordering
ord
{-# INLINEABLE compareRef #-}
compiledValidator :: CompiledCode ValidatorType
compiledValidator :: CompiledCode ValidatorType
compiledValidator =
$$(PlutusTx.compile [||wrap headValidator||])
where
wrap :: (DatumType -> Input -> ScriptContext -> Bool) -> ValidatorType
wrap = forall datum redeemer context.
(UnsafeFromData datum, UnsafeFromData redeemer,
UnsafeFromData context) =>
(datum -> redeemer -> context -> Bool) -> ValidatorType
wrapValidator @DatumType @RedeemerType
validatorScript :: SerialisedScript
validatorScript :: SerialisedScript
validatorScript = CompiledCode ValidatorType -> SerialisedScript
forall a. CompiledCode a -> SerialisedScript
serialiseCompiledCode CompiledCode ValidatorType
compiledValidator
validatorHash :: ScriptHash
validatorHash :: ScriptHash
validatorHash = PlutusScriptVersion PlutusScriptV2
-> SerialisedScript -> ScriptHash
forall lang.
PlutusScriptVersion lang -> SerialisedScript -> ScriptHash
scriptValidatorHash PlutusScriptVersion PlutusScriptV2
PlutusScriptV2 SerialisedScript
validatorScript