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 (addTxInsSpending, 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
defaultTxBodyContent
      TxBodyContent BuildTx
-> (TxBodyContent BuildTx -> TxBodyContent BuildTx)
-> TxBodyContent BuildTx
forall a b. a -> (a -> b) -> b
& [TxIn] -> TxBodyContent BuildTx -> TxBodyContent BuildTx
addTxInsSpending [TxIn
seedTxIn]
      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
        ( NetworkId -> TxIn -> HeadParameters -> TxOut CtxTx Era
mkHeadOutputInitial NetworkId
networkId TxIn
seedTxIn HeadParameters
parameters
            TxOut CtxTx Era -> [TxOut CtxTx Era] -> [TxOut CtxTx Era]
forall a. a -> [a] -> [a]
: (OnChainId -> TxOut CtxTx Era) -> [OnChainId] -> [TxOut CtxTx Era]
forall a b. (a -> b) -> [a] -> [b]
map (NetworkId -> TxIn -> OnChainId -> TxOut CtxTx Era
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
    (NetworkId -> PlutusScript -> AddressInEra
forall lang era.
(IsShelleyBasedEra era, IsPlutusScriptLanguage lang) =>
NetworkId -> PlutusScript lang -> AddressInEra era
mkScriptAddress NetworkId
networkId PlutusScript
Head.validatorScript)
    ([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

mkHeadOutputInitial :: NetworkId -> TxIn -> HeadParameters -> TxOut CtxTx
mkHeadOutputInitial :: NetworkId -> TxIn -> HeadParameters -> TxOut CtxTx Era
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 Era
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 Era
mkInitialOutput NetworkId
networkId TxIn
seedTxIn OnChainId
participant =
  AddressInEra
-> Value -> TxOutDatum CtxTx -> ReferenceScript -> TxOut CtxTx Era
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
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)