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.Plutus (initialValidatorScript)
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)

-- | Create the init transaction from some 'HeadParameters' and a single TxIn
-- which will be used as unique parameter for minting NFTs.
initTx ::
  NetworkId ->
  -- | Seed input.
  TxIn ->
  -- | Verification key hashes of all participants.
  [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 @PlutusScriptV3 NetworkId
networkId PlutusScript
forall {lang}. PlutusScript lang
headScript)
    ([Item Value] -> Value
forall l. IsList l => [Item l] -> l
fromList [(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 =
    [Item Value] -> Value
forall l. IsList l => [Item l] -> l
fromList [(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 @PlutusScriptV3 NetworkId
networkId PlutusScript
initialScript
  initialScript :: PlutusScript
initialScript =
    forall lang. SerialisedScript -> PlutusScript lang
fromPlutusScript @PlutusScriptV3 SerialisedScript
initialValidatorScript
  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)