module Hydra.Tx.Init where
import Hydra.Cardano.Api
import Hydra.Prelude
import Hydra.Contract.Head qualified as Head
import Hydra.Contract.HeadState qualified as Head
import Hydra.Contract.HeadTokens qualified as HeadTokens
import Hydra.Contract.Initial qualified as Initial
import Hydra.Contract.MintAction (MintAction (..))
import Hydra.Ledger.Cardano.Builder (addOutputs, addVkInputs, emptyTxBody, mintTokens, unsafeBuildTransaction)
import Hydra.Tx.ContestationPeriod (toChain)
import Hydra.Tx.HeadParameters (HeadParameters (..))
import Hydra.Tx.OnChainId (OnChainId (..))
import Hydra.Tx.Party (partyToChain)
import Hydra.Tx.Utils (hydraHeadV1AssetName, mkHydraHeadV1TxName, onChainIdToAssetName)
initTx ::
NetworkId ->
TxIn ->
[OnChainId] ->
HeadParameters ->
Tx
initTx :: NetworkId -> TxIn -> [OnChainId] -> HeadParameters -> Tx
initTx NetworkId
networkId TxIn
seedTxIn [OnChainId]
participants HeadParameters
parameters =
HasCallStack => TxBodyContent BuildTx -> Tx
TxBodyContent BuildTx -> Tx
unsafeBuildTransaction (TxBodyContent BuildTx -> Tx) -> TxBodyContent BuildTx -> Tx
forall a b. (a -> b) -> a -> b
$
TxBodyContent BuildTx
emptyTxBody
TxBodyContent BuildTx
-> (TxBodyContent BuildTx -> TxBodyContent BuildTx)
-> TxBodyContent BuildTx
forall a b. a -> (a -> b) -> b
& [TxIn] -> TxBodyContent BuildTx -> TxBodyContent BuildTx
addVkInputs [TxIn
seedTxIn]
TxBodyContent BuildTx
-> (TxBodyContent BuildTx -> TxBodyContent BuildTx)
-> TxBodyContent BuildTx
forall a b. a -> (a -> b) -> b
& [TxOut CtxTx] -> TxBodyContent BuildTx -> TxBodyContent BuildTx
addOutputs
( NetworkId -> TxIn -> HeadParameters -> TxOut CtxTx
mkHeadOutputInitial NetworkId
networkId TxIn
seedTxIn HeadParameters
parameters
TxOut CtxTx -> [TxOut CtxTx] -> [TxOut CtxTx]
forall a. a -> [a] -> [a]
: (OnChainId -> TxOut CtxTx) -> [OnChainId] -> [TxOut CtxTx]
forall a b. (a -> b) -> [a] -> [b]
map (NetworkId -> TxIn -> OnChainId -> TxOut CtxTx
mkInitialOutput NetworkId
networkId TxIn
seedTxIn) [OnChainId]
participants
)
TxBodyContent BuildTx
-> (TxBodyContent BuildTx -> TxBodyContent BuildTx)
-> TxBodyContent BuildTx
forall a b. a -> (a -> b) -> b
& PlutusScript
-> MintAction
-> [(AssetName, Quantity)]
-> TxBodyContent BuildTx
-> TxBodyContent BuildTx
forall redeemer.
ToScriptData redeemer =>
PlutusScript
-> redeemer
-> [(AssetName, Quantity)]
-> TxBodyContent BuildTx
-> TxBodyContent BuildTx
mintTokens (TxIn -> PlutusScript
HeadTokens.mkHeadTokenScript TxIn
seedTxIn) MintAction
Mint ((AssetName
hydraHeadV1AssetName, Quantity
1) (AssetName, Quantity)
-> [(AssetName, Quantity)] -> [(AssetName, Quantity)]
forall a. a -> [a] -> [a]
: [(AssetName, Quantity)]
participationTokens)
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
"InitTx")
where
participationTokens :: [(AssetName, Quantity)]
participationTokens =
[(OnChainId -> AssetName
onChainIdToAssetName OnChainId
oid, Quantity
1) | OnChainId
oid <- [OnChainId]
participants]
mkHeadOutput :: NetworkId -> PolicyId -> TxOutDatum ctx -> TxOut ctx
mkHeadOutput :: forall ctx. NetworkId -> PolicyId -> TxOutDatum ctx -> TxOut ctx
mkHeadOutput NetworkId
networkId PolicyId
tokenPolicyId TxOutDatum ctx
datum =
AddressInEra
-> Value -> TxOutDatum ctx -> ReferenceScript -> TxOut ctx
forall ctx.
AddressInEra
-> Value -> TxOutDatum ctx -> ReferenceScript -> TxOut ctx
TxOut
(forall lang era.
(IsShelleyBasedEra era, IsPlutusScriptLanguage lang) =>
NetworkId -> PlutusScript lang -> AddressInEra era
mkScriptAddress @PlutusScriptV2 NetworkId
networkId PlutusScript
forall {lang}. PlutusScript lang
headScript)
([(AssetId, Quantity)] -> Value
valueFromList [(PolicyId -> AssetName -> AssetId
AssetId PolicyId
tokenPolicyId AssetName
hydraHeadV1AssetName, Quantity
1)])
TxOutDatum ctx
datum
ReferenceScript
ReferenceScriptNone
where
headScript :: PlutusScript lang
headScript = SerialisedScript -> PlutusScript lang
forall lang. SerialisedScript -> PlutusScript lang
fromPlutusScript SerialisedScript
Head.validatorScript
mkHeadOutputInitial :: NetworkId -> TxIn -> HeadParameters -> TxOut CtxTx
mkHeadOutputInitial :: NetworkId -> TxIn -> HeadParameters -> TxOut CtxTx
mkHeadOutputInitial NetworkId
networkId TxIn
seedTxIn HeadParameters{ContestationPeriod
contestationPeriod :: ContestationPeriod
$sel:contestationPeriod:HeadParameters :: HeadParameters -> ContestationPeriod
contestationPeriod, [Party]
parties :: [Party]
$sel:parties:HeadParameters :: HeadParameters -> [Party]
parties} =
NetworkId -> PolicyId -> TxOutDatum CtxTx -> TxOut CtxTx
forall ctx. NetworkId -> PolicyId -> TxOutDatum ctx -> TxOut ctx
mkHeadOutput NetworkId
networkId PolicyId
tokenPolicyId TxOutDatum CtxTx
headDatum
where
tokenPolicyId :: PolicyId
tokenPolicyId = TxIn -> PolicyId
HeadTokens.headPolicyId TxIn
seedTxIn
headDatum :: TxOutDatum CtxTx
headDatum =
State -> TxOutDatum CtxTx
forall era a ctx.
(ToScriptData a, IsBabbageBasedEra era) =>
a -> TxOutDatum ctx era
mkTxOutDatumInline (State -> TxOutDatum CtxTx) -> State -> TxOutDatum CtxTx
forall a b. (a -> b) -> a -> b
$
Head.Initial
{ $sel:contestationPeriod:Initial :: ContestationPeriod
contestationPeriod = ContestationPeriod -> ContestationPeriod
toChain ContestationPeriod
contestationPeriod
, $sel:parties:Initial :: [Party]
parties = (Party -> Party) -> [Party] -> [Party]
forall a b. (a -> b) -> [a] -> [b]
map Party -> Party
partyToChain [Party]
parties
, $sel:headId:Initial :: CurrencySymbol
headId = PolicyId -> CurrencySymbol
toPlutusCurrencySymbol PolicyId
tokenPolicyId
, $sel:seed:Initial :: TxOutRef
seed = TxIn -> TxOutRef
toPlutusTxOutRef TxIn
seedTxIn
}
mkInitialOutput :: NetworkId -> TxIn -> OnChainId -> TxOut CtxTx
mkInitialOutput :: NetworkId -> TxIn -> OnChainId -> TxOut CtxTx
mkInitialOutput NetworkId
networkId TxIn
seedTxIn OnChainId
participant =
AddressInEra
-> Value -> TxOutDatum CtxTx -> ReferenceScript -> TxOut CtxTx
forall ctx.
AddressInEra
-> Value -> TxOutDatum ctx -> ReferenceScript -> TxOut ctx
TxOut AddressInEra
initialAddress Value
initialValue TxOutDatum CtxTx
initialDatum ReferenceScript
ReferenceScriptNone
where
tokenPolicyId :: PolicyId
tokenPolicyId = TxIn -> PolicyId
HeadTokens.headPolicyId TxIn
seedTxIn
initialValue :: Value
initialValue =
[(AssetId, Quantity)] -> Value
valueFromList [(PolicyId -> AssetName -> AssetId
AssetId PolicyId
tokenPolicyId (OnChainId -> AssetName
onChainIdToAssetName OnChainId
participant), Quantity
1)]
initialAddress :: AddressInEra
initialAddress =
forall lang era.
(IsShelleyBasedEra era, IsPlutusScriptLanguage lang) =>
NetworkId -> PlutusScript lang -> AddressInEra era
mkScriptAddress @PlutusScriptV2 NetworkId
networkId PlutusScript
forall {lang}. PlutusScript lang
initialScript
initialScript :: PlutusScript lang
initialScript =
SerialisedScript -> PlutusScript lang
forall lang. SerialisedScript -> PlutusScript lang
fromPlutusScript SerialisedScript
Initial.validatorScript
initialDatum :: TxOutDatum CtxTx
initialDatum =
Datum -> TxOutDatum CtxTx
forall era a ctx.
(ToScriptData a, IsBabbageBasedEra era) =>
a -> TxOutDatum ctx era
mkTxOutDatumInline (Datum -> TxOutDatum CtxTx) -> Datum -> TxOutDatum CtxTx
forall a b. (a -> b) -> a -> b
$ CurrencySymbol -> Datum
Initial.datum (PolicyId -> CurrencySymbol
toPlutusCurrencySymbol PolicyId
tokenPolicyId)