module Hydra.Tx.Contest where
import Hydra.Cardano.Api
import Hydra.Prelude
import Hydra.Contract.Head qualified as Head
import Hydra.Contract.HeadState qualified as Head
import Hydra.Data.ContestationPeriod (addContestationPeriod)
import Hydra.Ledger.Cardano.Builder (unsafeBuildTransaction)
import Hydra.Plutus.Extras (posixToUTCTime)
import Hydra.Tx.Close (ClosedThreadOutput (..), PointInTime)
import Hydra.Tx.ContestationPeriod (ContestationPeriod, toChain)
import Hydra.Tx.Crypto (MultiSignature (..), toPlutusSignatures)
import Hydra.Tx.HeadId (HeadId, headIdToCurrencySymbol)
import Hydra.Tx.IsTx (hashUTxO)
import Hydra.Tx.ScriptRegistry (ScriptRegistry, headReference)
import Hydra.Tx.Snapshot (Snapshot (..), SnapshotNumber, SnapshotVersion, fromChainSnapshotNumber)
import Hydra.Tx.Utils (IncrementalAction (..), findStateToken, mkHydraHeadV1TxName)
import PlutusLedgerApi.V3 (toBuiltin)
import PlutusLedgerApi.V3 qualified as Plutus
contestTx ::
ScriptRegistry ->
VerificationKey PaymentKey ->
HeadId ->
ContestationPeriod ->
SnapshotVersion ->
Snapshot Tx ->
MultiSignature (Snapshot Tx) ->
PointInTime ->
ClosedThreadOutput ->
IncrementalAction ->
Tx
contestTx :: ScriptRegistry
-> VerificationKey PaymentKey
-> HeadId
-> ContestationPeriod
-> SnapshotVersion
-> Snapshot Tx
-> MultiSignature (Snapshot Tx)
-> PointInTime
-> ClosedThreadOutput
-> IncrementalAction
-> Tx
contestTx ScriptRegistry
scriptRegistry VerificationKey PaymentKey
vk HeadId
headId ContestationPeriod
contestationPeriod SnapshotVersion
openVersion Snapshot Tx
snapshot MultiSignature (Snapshot Tx)
sig (SlotNo
slotNo, UTCTime
_) ClosedThreadOutput
closedThreadOutput IncrementalAction
incrementalAction =
HasCallStack => TxBodyContent BuildTx -> Tx
TxBodyContent BuildTx -> Tx
unsafeBuildTransaction (TxBodyContent BuildTx -> Tx) -> TxBodyContent BuildTx -> Tx
forall a b. (a -> b) -> a -> b
$
TxBodyContent BuildTx
defaultTxBodyContent
TxBodyContent BuildTx
-> (TxBodyContent BuildTx -> TxBodyContent BuildTx)
-> TxBodyContent BuildTx
forall a b. a -> (a -> b) -> b
& TxIns BuildTx Era -> TxBodyContent BuildTx -> TxBodyContent BuildTx
forall build era.
TxIns build era
-> TxBodyContent build era -> TxBodyContent build era
addTxIns [(TxIn
headInput, BuildTxWith BuildTx (Witness WitCtxTxIn)
headWitness)]
TxBodyContent BuildTx
-> (TxBodyContent BuildTx -> TxBodyContent BuildTx)
-> TxBodyContent BuildTx
forall a b. a -> (a -> b) -> b
& [TxIn] -> TxBodyContent BuildTx -> TxBodyContent BuildTx
forall era build.
IsBabbageBasedEra era =>
[TxIn] -> TxBodyContent build era -> TxBodyContent build era
addTxInsReference [TxIn
headScriptRef]
TxBodyContent BuildTx
-> (TxBodyContent BuildTx -> TxBodyContent BuildTx)
-> TxBodyContent BuildTx
forall a b. a -> (a -> b) -> b
& [TxOut CtxTx Era] -> TxBodyContent BuildTx -> TxBodyContent BuildTx
forall era build.
[TxOut CtxTx era]
-> TxBodyContent build era -> TxBodyContent build era
addTxOuts [TxOut CtxTx Era
headOutputAfter]
TxBodyContent BuildTx
-> (TxBodyContent BuildTx -> TxBodyContent BuildTx)
-> TxBodyContent BuildTx
forall a b. a -> (a -> b) -> b
& [Hash PaymentKey] -> TxBodyContent BuildTx -> TxBodyContent BuildTx
forall era build.
IsAlonzoBasedEra era =>
[Hash PaymentKey]
-> TxBodyContent build era -> TxBodyContent build era
addTxExtraKeyWits [VerificationKey PaymentKey -> Hash PaymentKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey PaymentKey
vk]
TxBodyContent BuildTx
-> (TxBodyContent BuildTx -> TxBodyContent BuildTx)
-> TxBodyContent BuildTx
forall a b. a -> (a -> b) -> b
& TxValidityUpperBound Era
-> TxBodyContent BuildTx -> TxBodyContent BuildTx
forall era build.
TxValidityUpperBound era
-> TxBodyContent build era -> TxBodyContent build era
setTxValidityUpperBound (SlotNo -> TxValidityUpperBound Era
TxValidityUpperBound SlotNo
slotNo)
TxBodyContent BuildTx
-> (TxBodyContent BuildTx -> TxBodyContent BuildTx)
-> TxBodyContent BuildTx
forall a b. a -> (a -> b) -> b
& TxMetadataInEra Era
-> TxBodyContent BuildTx -> TxBodyContent BuildTx
forall era build.
TxMetadataInEra era
-> TxBodyContent build era -> TxBodyContent build era
setTxMetadata (TxMetadata -> TxMetadataInEra Era
TxMetadataInEra (TxMetadata -> TxMetadataInEra Era)
-> TxMetadata -> TxMetadataInEra Era
forall a b. (a -> b) -> a -> b
$ Text -> TxMetadata
mkHydraHeadV1TxName Text
"ContestTx")
where
Snapshot{SnapshotNumber
number :: SnapshotNumber
$sel:number:Snapshot :: forall tx. Snapshot tx -> SnapshotNumber
number, SnapshotVersion
version :: SnapshotVersion
$sel:version:Snapshot :: forall tx. Snapshot tx -> SnapshotVersion
version, UTxOType Tx
utxo :: UTxOType Tx
$sel:utxo:Snapshot :: forall tx. Snapshot tx -> UTxOType tx
utxo, Maybe (UTxOType Tx)
utxoToCommit :: Maybe (UTxOType Tx)
$sel:utxoToCommit:Snapshot :: forall tx. Snapshot tx -> Maybe (UTxOType tx)
utxoToCommit, Maybe (UTxOType Tx)
utxoToDecommit :: Maybe (UTxOType Tx)
$sel:utxoToDecommit:Snapshot :: forall tx. Snapshot tx -> Maybe (UTxOType tx)
utxoToDecommit} = Snapshot Tx
snapshot
ClosedThreadOutput
{ $sel:closedThreadUTxO:ClosedThreadOutput :: ClosedThreadOutput -> (TxIn, TxOut CtxUTxO)
closedThreadUTxO = (TxIn
headInput, TxOut CtxUTxO
headOutputBefore)
, [Party]
closedParties :: [Party]
$sel:closedParties:ClosedThreadOutput :: ClosedThreadOutput -> [Party]
closedParties
, POSIXTime
closedContestationDeadline :: POSIXTime
$sel:closedContestationDeadline:ClosedThreadOutput :: ClosedThreadOutput -> POSIXTime
closedContestationDeadline
, [PubKeyHash]
closedContesters :: [PubKeyHash]
$sel:closedContesters:ClosedThreadOutput :: ClosedThreadOutput -> [PubKeyHash]
closedContesters
} = ClosedThreadOutput
closedThreadOutput
headWitness :: BuildTxWith BuildTx (Witness WitCtxTxIn)
headWitness =
Witness WitCtxTxIn -> BuildTxWith BuildTx (Witness WitCtxTxIn)
forall a. a -> BuildTxWith BuildTx a
BuildTxWith (Witness WitCtxTxIn -> BuildTxWith BuildTx (Witness WitCtxTxIn))
-> Witness WitCtxTxIn -> BuildTxWith BuildTx (Witness WitCtxTxIn)
forall a b. (a -> b) -> a -> b
$
ScriptWitnessInCtx WitCtxTxIn
-> ScriptWitness WitCtxTxIn -> Witness WitCtxTxIn
forall ctx.
ScriptWitnessInCtx ctx -> ScriptWitness ctx -> Witness ctx
ScriptWitness ScriptWitnessInCtx WitCtxTxIn
forall ctx. IsScriptWitnessInCtx ctx => ScriptWitnessInCtx ctx
scriptWitnessInCtx (ScriptWitness WitCtxTxIn -> Witness WitCtxTxIn)
-> ScriptWitness WitCtxTxIn -> Witness WitCtxTxIn
forall a b. (a -> b) -> a -> b
$
TxIn
-> PlutusScript PlutusScriptV3
-> ScriptDatum WitCtxTxIn
-> ScriptRedeemer
-> ScriptWitness WitCtxTxIn
forall ctx era lang.
(IsPlutusScriptLanguage lang, HasScriptLanguageInEra lang era) =>
TxIn
-> PlutusScript lang
-> ScriptDatum ctx
-> ScriptRedeemer
-> ScriptWitness ctx era
mkScriptReference TxIn
headScriptRef PlutusScript PlutusScriptV3
Head.validatorScript ScriptDatum WitCtxTxIn
InlineScriptDatum ScriptRedeemer
headRedeemer
headScriptRef :: TxIn
headScriptRef =
(TxIn, TxOut CtxUTxO) -> TxIn
forall a b. (a, b) -> a
fst (ScriptRegistry -> (TxIn, TxOut CtxUTxO)
headReference ScriptRegistry
scriptRegistry)
contestRedeemer :: ContestRedeemer
contestRedeemer =
case IncrementalAction
incrementalAction of
ToCommit UTxO
utxo' ->
if SnapshotVersion
version SnapshotVersion -> SnapshotVersion -> Bool
forall a. Eq a => a -> a -> Bool
== SnapshotVersion
openVersion
then
Head.ContestUnusedInc
{ $sel:signature:ContestCurrent :: [Signature]
signature = MultiSignature (Snapshot Tx) -> [Signature]
forall {k} (a :: k). MultiSignature a -> [Signature]
toPlutusSignatures MultiSignature (Snapshot Tx)
sig
, $sel:alreadyCommittedUTxOHash:ContestCurrent :: Signature
alreadyCommittedUTxOHash = ByteString -> ToBuiltin ByteString
forall a. HasToBuiltin a => a -> ToBuiltin a
toBuiltin (ByteString -> ToBuiltin ByteString)
-> ByteString -> ToBuiltin ByteString
forall a b. (a -> b) -> a -> b
$ UTxOType Tx -> ByteString
forall tx. IsTx tx => UTxOType tx -> ByteString
hashUTxO UTxO
UTxOType Tx
utxo'
}
else
Head.ContestUsedInc
{ $sel:signature:ContestCurrent :: [Signature]
signature = MultiSignature (Snapshot Tx) -> [Signature]
forall {k} (a :: k). MultiSignature a -> [Signature]
toPlutusSignatures MultiSignature (Snapshot Tx)
sig
}
ToDecommit UTxO
utxo' ->
if SnapshotVersion
version SnapshotVersion -> SnapshotVersion -> Bool
forall a. Eq a => a -> a -> Bool
== SnapshotVersion
openVersion
then
Head.ContestUnusedDec
{ $sel:signature:ContestCurrent :: [Signature]
signature = MultiSignature (Snapshot Tx) -> [Signature]
forall {k} (a :: k). MultiSignature a -> [Signature]
toPlutusSignatures MultiSignature (Snapshot Tx)
sig
}
else
Head.ContestUsedDec
{ $sel:signature:ContestCurrent :: [Signature]
signature = MultiSignature (Snapshot Tx) -> [Signature]
forall {k} (a :: k). MultiSignature a -> [Signature]
toPlutusSignatures MultiSignature (Snapshot Tx)
sig
, $sel:alreadyDecommittedUTxOHash:ContestCurrent :: Signature
alreadyDecommittedUTxOHash = ByteString -> ToBuiltin ByteString
forall a. HasToBuiltin a => a -> ToBuiltin a
toBuiltin (ByteString -> ToBuiltin ByteString)
-> ByteString -> ToBuiltin ByteString
forall a b. (a -> b) -> a -> b
$ UTxOType Tx -> ByteString
forall tx. IsTx tx => UTxOType tx -> ByteString
hashUTxO UTxO
UTxOType Tx
utxo'
}
IncrementalAction
NoThing -> Head.ContestCurrent{$sel:signature:ContestCurrent :: [Signature]
signature = MultiSignature (Snapshot Tx) -> [Signature]
forall {k} (a :: k). MultiSignature a -> [Signature]
toPlutusSignatures MultiSignature (Snapshot Tx)
sig}
headRedeemer :: ScriptRedeemer
headRedeemer = Input -> ScriptRedeemer
forall a. ToScriptData a => a -> ScriptRedeemer
toScriptData (Input -> ScriptRedeemer) -> Input -> ScriptRedeemer
forall a b. (a -> b) -> a -> b
$ ContestRedeemer -> Input
Head.Contest ContestRedeemer
contestRedeemer
headOutputAfter :: TxOut CtxTx Era
headOutputAfter =
(TxOutDatum CtxUTxO Era -> TxOutDatum CtxTx Era)
-> TxOut CtxUTxO -> TxOut CtxTx Era
forall ctx0 era ctx1.
(TxOutDatum ctx0 era -> TxOutDatum ctx1 era)
-> TxOut ctx0 era -> TxOut ctx1 era
modifyTxOutDatum (TxOutDatum CtxTx Era
-> TxOutDatum CtxUTxO Era -> TxOutDatum CtxTx Era
forall a b. a -> b -> a
const TxOutDatum CtxTx Era
headDatumAfter) TxOut CtxUTxO
headOutputBefore
contester :: PubKeyHash
contester = Hash PaymentKey -> PubKeyHash
toPlutusKeyHash (VerificationKey PaymentKey -> Hash PaymentKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey PaymentKey
vk)
onChainConstestationPeriod :: ContestationPeriod
onChainConstestationPeriod = ContestationPeriod -> ContestationPeriod
toChain ContestationPeriod
contestationPeriod
newContestationDeadline :: POSIXTime
newContestationDeadline =
if [PubKeyHash] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (PubKeyHash
contester PubKeyHash -> [PubKeyHash] -> [PubKeyHash]
forall a. a -> [a] -> [a]
: [PubKeyHash]
closedContesters) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Party] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Party]
closedParties
then POSIXTime
closedContestationDeadline
else POSIXTime -> ContestationPeriod -> POSIXTime
addContestationPeriod POSIXTime
closedContestationDeadline ContestationPeriod
onChainConstestationPeriod
headDatumAfter :: TxOutDatum CtxTx Era
headDatumAfter =
State -> TxOutDatum CtxTx Era
forall era a ctx.
(ToScriptData a, IsBabbageBasedEra era) =>
a -> TxOutDatum ctx era
mkTxOutDatumInline (State -> TxOutDatum CtxTx Era) -> State -> TxOutDatum CtxTx Era
forall a b. (a -> b) -> a -> b
$
ClosedDatum -> State
Head.Closed
Head.ClosedDatum
{ $sel:snapshotNumber:ClosedDatum :: SnapshotVersion
snapshotNumber = SnapshotNumber -> SnapshotVersion
forall a. Integral a => a -> SnapshotVersion
toInteger SnapshotNumber
number
, $sel:utxoHash:ClosedDatum :: Signature
utxoHash = ByteString -> ToBuiltin ByteString
forall a. HasToBuiltin a => a -> ToBuiltin a
toBuiltin (ByteString -> ToBuiltin ByteString)
-> ByteString -> ToBuiltin ByteString
forall a b. (a -> b) -> a -> b
$ forall tx. IsTx tx => UTxOType tx -> ByteString
hashUTxO @Tx UTxOType Tx
utxo
, $sel:alphaUTxOHash:ClosedDatum :: Signature
alphaUTxOHash =
case ContestRedeemer
contestRedeemer of
Head.ContestUsedInc{} ->
ByteString -> ToBuiltin ByteString
forall a. HasToBuiltin a => a -> ToBuiltin a
toBuiltin (ByteString -> ToBuiltin ByteString)
-> ByteString -> ToBuiltin ByteString
forall a b. (a -> b) -> a -> b
$ forall tx. IsTx tx => UTxOType tx -> ByteString
hashUTxO @Tx (UTxOType Tx -> ByteString) -> UTxOType Tx -> ByteString
forall a b. (a -> b) -> a -> b
$ UTxO -> Maybe UTxO -> UTxO
forall a. a -> Maybe a -> a
fromMaybe UTxO
forall a. Monoid a => a
mempty Maybe UTxO
Maybe (UTxOType Tx)
utxoToCommit
ContestRedeemer
_ -> ByteString -> ToBuiltin ByteString
forall a. HasToBuiltin a => a -> ToBuiltin a
toBuiltin (ByteString -> ToBuiltin ByteString)
-> ByteString -> ToBuiltin ByteString
forall a b. (a -> b) -> a -> b
$ forall tx. IsTx tx => UTxOType tx -> ByteString
hashUTxO @Tx UTxO
UTxOType Tx
forall a. Monoid a => a
mempty
, $sel:omegaUTxOHash:ClosedDatum :: Signature
omegaUTxOHash =
case ContestRedeemer
contestRedeemer of
Head.ContestUnusedDec{} ->
ByteString -> ToBuiltin ByteString
forall a. HasToBuiltin a => a -> ToBuiltin a
toBuiltin (ByteString -> ToBuiltin ByteString)
-> ByteString -> ToBuiltin ByteString
forall a b. (a -> b) -> a -> b
$ forall tx. IsTx tx => UTxOType tx -> ByteString
hashUTxO @Tx (UTxOType Tx -> ByteString) -> UTxOType Tx -> ByteString
forall a b. (a -> b) -> a -> b
$ UTxO -> Maybe UTxO -> UTxO
forall a. a -> Maybe a -> a
fromMaybe UTxO
forall a. Monoid a => a
mempty Maybe UTxO
Maybe (UTxOType Tx)
utxoToDecommit
ContestRedeemer
_ -> ByteString -> ToBuiltin ByteString
forall a. HasToBuiltin a => a -> ToBuiltin a
toBuiltin (ByteString -> ToBuiltin ByteString)
-> ByteString -> ToBuiltin ByteString
forall a b. (a -> b) -> a -> b
$ forall tx. IsTx tx => UTxOType tx -> ByteString
hashUTxO @Tx UTxO
UTxOType Tx
forall a. Monoid a => a
mempty
, $sel:parties:ClosedDatum :: [Party]
parties = [Party]
closedParties
, $sel:contestationDeadline:ClosedDatum :: POSIXTime
contestationDeadline = POSIXTime
newContestationDeadline
, $sel:contestationPeriod:ClosedDatum :: ContestationPeriod
contestationPeriod = ContestationPeriod
onChainConstestationPeriod
, $sel:headId:ClosedDatum :: CurrencySymbol
headId = HeadId -> CurrencySymbol
headIdToCurrencySymbol HeadId
headId
, $sel:contesters:ClosedDatum :: [PubKeyHash]
contesters = PubKeyHash
contester PubKeyHash -> [PubKeyHash] -> [PubKeyHash]
forall a. a -> [a] -> [a]
: [PubKeyHash]
closedContesters
, $sel:version:ClosedDatum :: SnapshotVersion
version = SnapshotVersion -> SnapshotVersion
forall a. Integral a => a -> SnapshotVersion
toInteger SnapshotVersion
openVersion
}
data ContestObservation = ContestObservation
{ ContestObservation -> (TxIn, TxOut CtxUTxO)
contestedThreadOutput :: (TxIn, TxOut CtxUTxO)
, ContestObservation -> HeadId
headId :: HeadId
, ContestObservation -> SnapshotNumber
snapshotNumber :: SnapshotNumber
, ContestObservation -> UTCTime
contestationDeadline :: UTCTime
, ContestObservation -> [PubKeyHash]
contesters :: [Plutus.PubKeyHash]
}
deriving stock (Int -> ContestObservation -> ShowS
[ContestObservation] -> ShowS
ContestObservation -> String
(Int -> ContestObservation -> ShowS)
-> (ContestObservation -> String)
-> ([ContestObservation] -> ShowS)
-> Show ContestObservation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ContestObservation -> ShowS
showsPrec :: Int -> ContestObservation -> ShowS
$cshow :: ContestObservation -> String
show :: ContestObservation -> String
$cshowList :: [ContestObservation] -> ShowS
showList :: [ContestObservation] -> ShowS
Show, ContestObservation -> ContestObservation -> Bool
(ContestObservation -> ContestObservation -> Bool)
-> (ContestObservation -> ContestObservation -> Bool)
-> Eq ContestObservation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ContestObservation -> ContestObservation -> Bool
== :: ContestObservation -> ContestObservation -> Bool
$c/= :: ContestObservation -> ContestObservation -> Bool
/= :: ContestObservation -> ContestObservation -> Bool
Eq, (forall x. ContestObservation -> Rep ContestObservation x)
-> (forall x. Rep ContestObservation x -> ContestObservation)
-> Generic ContestObservation
forall x. Rep ContestObservation x -> ContestObservation
forall x. ContestObservation -> Rep ContestObservation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ContestObservation -> Rep ContestObservation x
from :: forall x. ContestObservation -> Rep ContestObservation x
$cto :: forall x. Rep ContestObservation x -> ContestObservation
to :: forall x. Rep ContestObservation x -> ContestObservation
Generic)
observeContestTx ::
UTxO ->
Tx ->
Maybe ContestObservation
observeContestTx :: UTxO -> Tx -> Maybe ContestObservation
observeContestTx UTxO
utxo Tx
tx = do
let inputUTxO :: UTxO
inputUTxO = UTxO -> Tx -> UTxO
resolveInputsUTxO UTxO
utxo Tx
tx
(TxIn
headInput, TxOut CtxUTxO
headOutput) <- UTxO -> PlutusScript PlutusScriptV3 -> Maybe (TxIn, TxOut CtxUTxO)
forall lang.
IsPlutusScriptLanguage lang =>
UTxO -> PlutusScript lang -> Maybe (TxIn, TxOut CtxUTxO)
findTxOutByScript UTxO
inputUTxO PlutusScript PlutusScriptV3
Head.validatorScript
Input
redeemer <- Tx -> TxIn -> Maybe Input
forall a. FromData a => Tx -> TxIn -> Maybe a
findRedeemerSpending Tx
tx TxIn
headInput
ScriptRedeemer
oldHeadDatum <- TxOut CtxTx Era -> Maybe ScriptRedeemer
forall era. TxOut CtxTx era -> Maybe ScriptRedeemer
txOutScriptData (TxOut CtxTx Era -> Maybe ScriptRedeemer)
-> TxOut CtxTx Era -> Maybe ScriptRedeemer
forall a b. (a -> b) -> a -> b
$ TxOut CtxUTxO -> TxOut CtxTx Era
forall era. TxOut CtxUTxO era -> TxOut CtxTx era
forall {k} (f :: * -> k -> *) (era :: k).
ToTxContext f =>
f CtxUTxO era -> f CtxTx era
toTxContext TxOut CtxUTxO
headOutput
State
datum <- ScriptRedeemer -> Maybe State
forall a. FromScriptData a => ScriptRedeemer -> Maybe a
fromScriptData ScriptRedeemer
oldHeadDatum
HeadId
headId <- TxOut CtxUTxO -> Maybe HeadId
forall ctx. TxOut ctx -> Maybe HeadId
findStateToken TxOut CtxUTxO
headOutput
case (State
datum, Input
redeemer) of
(Head.Closed Head.ClosedDatum{}, Head.Contest{}) -> do
(TxIn
newHeadInput, TxOut CtxUTxO
newHeadOutput) <- UTxO -> PlutusScript PlutusScriptV3 -> Maybe (TxIn, TxOut CtxUTxO)
forall lang.
IsPlutusScriptLanguage lang =>
UTxO -> PlutusScript lang -> Maybe (TxIn, TxOut CtxUTxO)
findTxOutByScript (Tx -> UTxO
utxoFromTx Tx
tx) PlutusScript PlutusScriptV3
Head.validatorScript
ScriptRedeemer
newHeadDatum <- TxOut CtxTx Era -> Maybe ScriptRedeemer
forall era. TxOut CtxTx era -> Maybe ScriptRedeemer
txOutScriptData (TxOut CtxTx Era -> Maybe ScriptRedeemer)
-> TxOut CtxTx Era -> Maybe ScriptRedeemer
forall a b. (a -> b) -> a -> b
$ TxOut CtxUTxO -> TxOut CtxTx Era
forall era. TxOut CtxUTxO era -> TxOut CtxTx era
forall {k} (f :: * -> k -> *) (era :: k).
ToTxContext f =>
f CtxUTxO era -> f CtxTx era
toTxContext TxOut CtxUTxO
newHeadOutput
let (SnapshotVersion
onChainSnapshotNumber, POSIXTime
contestationDeadline, [PubKeyHash]
contesters) = ScriptRedeemer -> (SnapshotVersion, POSIXTime, [PubKeyHash])
decodeDatum ScriptRedeemer
newHeadDatum
ContestObservation -> Maybe ContestObservation
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
ContestObservation
{ $sel:contestedThreadOutput:ContestObservation :: (TxIn, TxOut CtxUTxO)
contestedThreadOutput = (TxIn
newHeadInput, TxOut CtxUTxO
newHeadOutput)
, HeadId
$sel:headId:ContestObservation :: HeadId
headId :: HeadId
headId
, $sel:snapshotNumber:ContestObservation :: SnapshotNumber
snapshotNumber = SnapshotVersion -> SnapshotNumber
fromChainSnapshotNumber SnapshotVersion
onChainSnapshotNumber
, $sel:contestationDeadline:ContestObservation :: UTCTime
contestationDeadline = POSIXTime -> UTCTime
posixToUTCTime POSIXTime
contestationDeadline
, [PubKeyHash]
$sel:contesters:ContestObservation :: [PubKeyHash]
contesters :: [PubKeyHash]
contesters
}
(State, Input)
_ -> Maybe ContestObservation
forall a. Maybe a
Nothing
where
decodeDatum :: ScriptRedeemer -> (SnapshotVersion, POSIXTime, [PubKeyHash])
decodeDatum ScriptRedeemer
headDatum =
case ScriptRedeemer -> Maybe State
forall a. FromScriptData a => ScriptRedeemer -> Maybe a
fromScriptData ScriptRedeemer
headDatum of
Just (Head.Closed Head.ClosedDatum{SnapshotVersion
$sel:snapshotNumber:ClosedDatum :: ClosedDatum -> SnapshotVersion
snapshotNumber :: SnapshotVersion
snapshotNumber, POSIXTime
$sel:contestationDeadline:ClosedDatum :: ClosedDatum -> POSIXTime
contestationDeadline :: POSIXTime
contestationDeadline, [PubKeyHash]
$sel:contesters:ClosedDatum :: ClosedDatum -> [PubKeyHash]
contesters :: [PubKeyHash]
contesters}) ->
(SnapshotVersion
snapshotNumber, POSIXTime
contestationDeadline, [PubKeyHash]
contesters)
Maybe State
_ -> Text -> (SnapshotVersion, POSIXTime, [PubKeyHash])
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"wrong state in output datum"