{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}

module Cardano.CLI.Legacy.Genesis.Run
  ( runLegacyGenesisCmds
  )
where

import Cardano.Api
import Cardano.Api.Experimental

import Cardano.CLI.Compatible.Exception
import Cardano.CLI.EraBased.Genesis.Command
  ( GenesisKeyGenGenesisCmdArgs (GenesisKeyGenGenesisCmdArgs)
  )
import Cardano.CLI.EraBased.Genesis.Command qualified as Cmd
import Cardano.CLI.EraBased.Genesis.CreateTestnetData.Run qualified as CreateTestnetData
import Cardano.CLI.EraBased.Genesis.Run
import Cardano.CLI.Legacy.Genesis.Command
import Cardano.CLI.Type.Common
import Cardano.Ledger.BaseTypes (NonZero)

import RIO

import Vary (Vary)

runLegacyGenesisCmds :: LegacyGenesisCmds -> CIO e ()
runLegacyGenesisCmds :: forall e. LegacyGenesisCmds -> CIO e ()
runLegacyGenesisCmds = \case
  GenesisKeyGenGenesis VerificationKeyFile 'Out
vk SigningKeyFile 'Out
sk ->
    VerificationKeyFile 'Out -> SigningKeyFile 'Out -> CIO e ()
forall e.
VerificationKeyFile 'Out -> SigningKeyFile 'Out -> CIO e ()
runLegacyGenesisKeyGenGenesisCmd VerificationKeyFile 'Out
vk SigningKeyFile 'Out
sk
  GenesisKeyGenDelegate VerificationKeyFile 'Out
vk SigningKeyFile 'Out
sk OpCertCounterFile 'Out
ctr ->
    VerificationKeyFile 'Out
-> SigningKeyFile 'Out -> OpCertCounterFile 'Out -> CIO e ()
forall e.
VerificationKeyFile 'Out
-> SigningKeyFile 'Out -> OpCertCounterFile 'Out -> CIO e ()
runLegacyGenesisKeyGenDelegateCmd VerificationKeyFile 'Out
vk SigningKeyFile 'Out
sk OpCertCounterFile 'Out
ctr
  GenesisKeyGenUTxO VerificationKeyFile 'Out
vk SigningKeyFile 'Out
sk ->
    VerificationKeyFile 'Out -> SigningKeyFile 'Out -> CIO e ()
forall e.
VerificationKeyFile 'Out -> SigningKeyFile 'Out -> CIO e ()
runLegacyGenesisKeyGenUTxOCmd VerificationKeyFile 'Out
vk SigningKeyFile 'Out
sk
  GenesisCmdKeyHash VerificationKeyFile 'In
vk ->
    VerificationKeyFile 'In -> CIO e ()
forall e. VerificationKeyFile 'In -> CIO e ()
runLegacyGenesisKeyHashCmd VerificationKeyFile 'In
vk
  GenesisVerKey VerificationKeyFile 'Out
vk SigningKeyFile 'In
sk ->
    VerificationKeyFile 'Out -> SigningKeyFile 'In -> CIO e ()
forall e.
VerificationKeyFile 'Out -> SigningKeyFile 'In -> CIO e ()
runLegacyGenesisVerKeyCmd VerificationKeyFile 'Out
vk SigningKeyFile 'In
sk
  GenesisTxIn VerificationKeyFile 'In
vk NetworkId
nw Maybe (File () 'Out)
mOutFile ->
    VerificationKeyFile 'In
-> NetworkId -> Maybe (File () 'Out) -> CIO e ()
forall e.
VerificationKeyFile 'In
-> NetworkId -> Maybe (File () 'Out) -> CIO e ()
runLegacyGenesisTxInCmd VerificationKeyFile 'In
vk NetworkId
nw Maybe (File () 'Out)
mOutFile
  GenesisAddr VerificationKeyFile 'In
vk NetworkId
nw Maybe (File () 'Out)
mOutFile ->
    VerificationKeyFile 'In
-> NetworkId -> Maybe (File () 'Out) -> CIO e ()
forall e.
VerificationKeyFile 'In
-> NetworkId -> Maybe (File () 'Out) -> CIO e ()
runLegacyGenesisAddrCmd VerificationKeyFile 'In
vk NetworkId
nw Maybe (File () 'Out)
mOutFile
  GenesisCreate AnyShelleyBasedEra
eSbe Vary '[FormatBech32, FormatTextEnvelope]
fmt GenesisDir
gd Word
gn Word
un Maybe SystemStart
ms Maybe Coin
am NetworkId
nw ->
    AnyShelleyBasedEra
-> Vary '[FormatBech32, FormatTextEnvelope]
-> GenesisDir
-> Word
-> Word
-> Maybe SystemStart
-> Maybe Coin
-> NetworkId
-> CIO e ()
forall e.
AnyShelleyBasedEra
-> Vary '[FormatBech32, FormatTextEnvelope]
-> GenesisDir
-> Word
-> Word
-> Maybe SystemStart
-> Maybe Coin
-> NetworkId
-> CIO e ()
runLegacyGenesisCreateCmd AnyShelleyBasedEra
eSbe Vary '[FormatBech32, FormatTextEnvelope]
fmt GenesisDir
gd Word
gn Word
un Maybe SystemStart
ms Maybe Coin
am NetworkId
nw
  GenesisCreateCardano Era era
eSbe GenesisDir
gd Word
gn Word
un Maybe SystemStart
ms Maybe Coin
am NonZero Word64
k Word
slotLength Rational
sc NetworkId
nw FilePath
bg FilePath
sg FilePath
ag FilePath
cg Maybe FilePath
mNodeCfg ->
    Era era
-> GenesisDir
-> Word
-> Word
-> Maybe SystemStart
-> Maybe Coin
-> NonZero Word64
-> Word
-> Rational
-> NetworkId
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> Maybe FilePath
-> CIO e ()
forall era e.
Era era
-> GenesisDir
-> Word
-> Word
-> Maybe SystemStart
-> Maybe Coin
-> NonZero Word64
-> Word
-> Rational
-> NetworkId
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> Maybe FilePath
-> CIO e ()
runLegacyGenesisCreateCardanoCmd Era era
eSbe GenesisDir
gd Word
gn Word
un Maybe SystemStart
ms Maybe Coin
am NonZero Word64
k Word
slotLength Rational
sc NetworkId
nw FilePath
bg FilePath
sg FilePath
ag FilePath
cg Maybe FilePath
mNodeCfg
  GenesisCreateStaked Era era
eSbe Vary '[FormatBech32, FormatTextEnvelope]
fmt GenesisDir
gd Word
gn Word
gp Word
gl Word
un Maybe SystemStart
ms Maybe Coin
am Coin
ds NetworkId
nw Word
bf Word
bp Word
su Maybe FilePath
relayJsonFp ->
    Era era
-> Vary '[FormatBech32, FormatTextEnvelope]
-> GenesisDir
-> Word
-> Word
-> Word
-> Word
-> Maybe SystemStart
-> Maybe Coin
-> Coin
-> NetworkId
-> Word
-> Word
-> Word
-> Maybe FilePath
-> CIO e ()
forall era e.
Era era
-> Vary '[FormatBech32, FormatTextEnvelope]
-> GenesisDir
-> Word
-> Word
-> Word
-> Word
-> Maybe SystemStart
-> Maybe Coin
-> Coin
-> NetworkId
-> Word
-> Word
-> Word
-> Maybe FilePath
-> CIO e ()
runLegacyGenesisCreateStakedCmd Era era
eSbe Vary '[FormatBech32, FormatTextEnvelope]
fmt GenesisDir
gd Word
gn Word
gp Word
gl Word
un Maybe SystemStart
ms Maybe Coin
am Coin
ds NetworkId
nw Word
bf Word
bp Word
su Maybe FilePath
relayJsonFp
  GenesisHashFile GenesisFile
gf ->
    GenesisFile -> CIO e ()
forall e. GenesisFile -> CIO e ()
runLegacyGenesisHashFileCmd GenesisFile
gf

runLegacyGenesisKeyGenGenesisCmd
  :: ()
  => VerificationKeyFile Out
  -> SigningKeyFile Out
  -> CIO e ()
runLegacyGenesisKeyGenGenesisCmd :: forall e.
VerificationKeyFile 'Out -> SigningKeyFile 'Out -> CIO e ()
runLegacyGenesisKeyGenGenesisCmd VerificationKeyFile 'Out
vk SigningKeyFile 'Out
sk = GenesisKeyGenGenesisCmdArgs -> CIO e ()
forall e. GenesisKeyGenGenesisCmdArgs -> CIO e ()
CreateTestnetData.runGenesisKeyGenGenesisCmd (GenesisKeyGenGenesisCmdArgs -> CIO e ())
-> GenesisKeyGenGenesisCmdArgs -> CIO e ()
forall a b. (a -> b) -> a -> b
$ VerificationKeyFile 'Out
-> SigningKeyFile 'Out -> GenesisKeyGenGenesisCmdArgs
GenesisKeyGenGenesisCmdArgs VerificationKeyFile 'Out
vk SigningKeyFile 'Out
sk

runLegacyGenesisKeyGenDelegateCmd
  :: ()
  => VerificationKeyFile Out
  -> SigningKeyFile Out
  -> OpCertCounterFile Out
  -> CIO e ()
runLegacyGenesisKeyGenDelegateCmd :: forall e.
VerificationKeyFile 'Out
-> SigningKeyFile 'Out -> OpCertCounterFile 'Out -> CIO e ()
runLegacyGenesisKeyGenDelegateCmd VerificationKeyFile 'Out
vkf SigningKeyFile 'Out
skf OpCertCounterFile 'Out
okf =
  GenesisKeyGenDelegateCmdArgs -> CIO e ()
forall e. GenesisKeyGenDelegateCmdArgs -> CIO e ()
CreateTestnetData.runGenesisKeyGenDelegateCmd
    Cmd.GenesisKeyGenDelegateCmdArgs
      { verificationKeyPath :: VerificationKeyFile 'Out
Cmd.verificationKeyPath = VerificationKeyFile 'Out
vkf
      , signingKeyPath :: SigningKeyFile 'Out
Cmd.signingKeyPath = SigningKeyFile 'Out
skf
      , opCertCounterPath :: OpCertCounterFile 'Out
Cmd.opCertCounterPath = OpCertCounterFile 'Out
okf
      }

runLegacyGenesisKeyGenUTxOCmd
  :: ()
  => VerificationKeyFile Out
  -> SigningKeyFile Out
  -> CIO e ()
runLegacyGenesisKeyGenUTxOCmd :: forall e.
VerificationKeyFile 'Out -> SigningKeyFile 'Out -> CIO e ()
runLegacyGenesisKeyGenUTxOCmd VerificationKeyFile 'Out
vk SigningKeyFile 'Out
sk =
  GenesisKeyGenUTxOCmdArgs -> CIO e ()
forall e. GenesisKeyGenUTxOCmdArgs -> CIO e ()
CreateTestnetData.runGenesisKeyGenUTxOCmd
    Cmd.GenesisKeyGenUTxOCmdArgs
      { verificationKeyPath :: VerificationKeyFile 'Out
Cmd.verificationKeyPath = VerificationKeyFile 'Out
vk
      , signingKeyPath :: SigningKeyFile 'Out
Cmd.signingKeyPath = SigningKeyFile 'Out
sk
      }

runLegacyGenesisKeyHashCmd :: VerificationKeyFile In -> CIO e ()
runLegacyGenesisKeyHashCmd :: forall e. VerificationKeyFile 'In -> CIO e ()
runLegacyGenesisKeyHashCmd = VerificationKeyFile 'In -> RIO e ()
VerificationKeyFile 'In -> CIO e ()
forall e. VerificationKeyFile 'In -> CIO e ()
runGenesisKeyHashCmd

runLegacyGenesisVerKeyCmd
  :: VerificationKeyFile Out
  -> SigningKeyFile In
  -> CIO e ()
runLegacyGenesisVerKeyCmd :: forall e.
VerificationKeyFile 'Out -> SigningKeyFile 'In -> CIO e ()
runLegacyGenesisVerKeyCmd VerificationKeyFile 'Out
vk SigningKeyFile 'In
sk =
  GenesisVerKeyCmdArgs -> CIO e ()
forall e. GenesisVerKeyCmdArgs -> CIO e ()
runGenesisVerKeyCmd
    Cmd.GenesisVerKeyCmdArgs
      { verificationKeyPath :: VerificationKeyFile 'Out
Cmd.verificationKeyPath = VerificationKeyFile 'Out
vk
      , signingKeyPath :: SigningKeyFile 'In
Cmd.signingKeyPath = SigningKeyFile 'In
sk
      }

runLegacyGenesisTxInCmd
  :: ()
  => VerificationKeyFile In
  -> NetworkId
  -> Maybe (File () Out)
  -> CIO e ()
runLegacyGenesisTxInCmd :: forall e.
VerificationKeyFile 'In
-> NetworkId -> Maybe (File () 'Out) -> CIO e ()
runLegacyGenesisTxInCmd VerificationKeyFile 'In
vkt NetworkId
nid Maybe (File () 'Out)
mOf =
  GenesisTxInCmdArgs -> CIO e ()
forall e. GenesisTxInCmdArgs -> CIO e ()
runGenesisTxInCmd
    Cmd.GenesisTxInCmdArgs
      { verificationKeyPath :: VerificationKeyFile 'In
Cmd.verificationKeyPath = VerificationKeyFile 'In
vkt
      , network :: NetworkId
Cmd.network = NetworkId
nid
      , mOutFile :: Maybe (File () 'Out)
Cmd.mOutFile = Maybe (File () 'Out)
mOf
      }

runLegacyGenesisAddrCmd
  :: ()
  => VerificationKeyFile In
  -> NetworkId
  -> Maybe (File () Out)
  -> CIO e ()
runLegacyGenesisAddrCmd :: forall e.
VerificationKeyFile 'In
-> NetworkId -> Maybe (File () 'Out) -> CIO e ()
runLegacyGenesisAddrCmd VerificationKeyFile 'In
vkf NetworkId
nid Maybe (File () 'Out)
mOf =
  GenesisAddrCmdArgs -> CIO e ()
forall e. GenesisAddrCmdArgs -> CIO e ()
runGenesisAddrCmd
    Cmd.GenesisAddrCmdArgs
      { verificationKeyPath :: VerificationKeyFile 'In
Cmd.verificationKeyPath = VerificationKeyFile 'In
vkf
      , network :: NetworkId
Cmd.network = NetworkId
nid
      , mOutFile :: Maybe (File () 'Out)
Cmd.mOutFile = Maybe (File () 'Out)
mOf
      }

runLegacyGenesisCreateCmd
  :: ()
  => AnyShelleyBasedEra
  -> Vary [FormatBech32, FormatTextEnvelope]
  -> GenesisDir
  -> Word
  -- ^ num genesis & delegate keys to make
  -> Word
  -- ^ num utxo keys to make
  -> Maybe SystemStart
  -> Maybe Coin
  -> NetworkId
  -> CIO e ()
runLegacyGenesisCreateCmd :: forall e.
AnyShelleyBasedEra
-> Vary '[FormatBech32, FormatTextEnvelope]
-> GenesisDir
-> Word
-> Word
-> Maybe SystemStart
-> Maybe Coin
-> NetworkId
-> CIO e ()
runLegacyGenesisCreateCmd AnyShelleyBasedEra
era Vary '[FormatBech32, FormatTextEnvelope]
fmt GenesisDir
genDir Word
nGenKeys Word
nUTxOKeys Maybe SystemStart
mStart Maybe Coin
mSupply NetworkId
network =
  GenesisCreateCmdArgs Any -> CIO e ()
forall era e. GenesisCreateCmdArgs era -> CIO e ()
runGenesisCreateCmd
    Cmd.GenesisCreateCmdArgs
      { eon :: AnyShelleyBasedEra
Cmd.eon = AnyShelleyBasedEra
era
      , keyOutputFormat :: Vary '[FormatBech32, FormatTextEnvelope]
Cmd.keyOutputFormat = Vary '[FormatBech32, FormatTextEnvelope]
fmt
      , genesisDir :: GenesisDir
Cmd.genesisDir = GenesisDir
genDir
      , numGenesisKeys :: Word
Cmd.numGenesisKeys = Word
nGenKeys
      , numUTxOKeys :: Word
Cmd.numUTxOKeys = Word
nUTxOKeys
      , mSystemStart :: Maybe SystemStart
Cmd.mSystemStart = Maybe SystemStart
mStart
      , mSupply :: Maybe Coin
Cmd.mSupply = Maybe Coin
mSupply
      , network :: NetworkId
Cmd.network = NetworkId
network
      }

runLegacyGenesisCreateCardanoCmd
  :: ()
  => Era era
  -> GenesisDir
  -> Word
  -- ^ num genesis & delegate keys to make
  -> Word
  -- ^ num utxo keys to make
  -> Maybe SystemStart
  -> Maybe Coin
  -> NonZero Word64
  -> Word
  -- ^ slot length in ms
  -> Rational
  -> NetworkId
  -> FilePath
  -- ^ Byron Genesis
  -> FilePath
  -- ^ Shelley Genesis
  -> FilePath
  -- ^ Alonzo Genesis
  -> FilePath
  -- ^ Conway Genesis
  -> Maybe FilePath
  -> CIO e ()
runLegacyGenesisCreateCardanoCmd :: forall era e.
Era era
-> GenesisDir
-> Word
-> Word
-> Maybe SystemStart
-> Maybe Coin
-> NonZero Word64
-> Word
-> Rational
-> NetworkId
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> Maybe FilePath
-> CIO e ()
runLegacyGenesisCreateCardanoCmd
  Era era
era
  GenesisDir
genDir
  Word
nGenKeys
  Word
nUTxOKeys
  Maybe SystemStart
mStart
  Maybe Coin
mSupply
  NonZero Word64
security
  Word
slotLength
  Rational
slotCoeff
  NetworkId
network
  FilePath
byronGenesis
  FilePath
shelleyGenesis
  FilePath
alonzoGenesis
  FilePath
conwayGenesis
  Maybe FilePath
mNodeCfg =
    GenesisCreateCardanoCmdArgs era -> CIO e ()
forall era e. GenesisCreateCardanoCmdArgs era -> CIO e ()
runGenesisCreateCardanoCmd
      Cmd.GenesisCreateCardanoCmdArgs
        { eon :: Era era
Cmd.eon = Era era
era
        , genesisDir :: GenesisDir
Cmd.genesisDir = GenesisDir
genDir
        , numGenesisKeys :: Word
Cmd.numGenesisKeys = Word
nGenKeys
        , numUTxOKeys :: Word
Cmd.numUTxOKeys = Word
nUTxOKeys
        , mSystemStart :: Maybe SystemStart
Cmd.mSystemStart = Maybe SystemStart
mStart
        , mSupply :: Maybe Coin
Cmd.mSupply = Maybe Coin
mSupply
        , security :: NonZero Word64
Cmd.security = NonZero Word64
security
        , slotLength :: Word
Cmd.slotLength = Word
slotLength
        , slotCoeff :: Rational
Cmd.slotCoeff = Rational
slotCoeff
        , network :: NetworkId
Cmd.network = NetworkId
network
        , byronGenesisTemplate :: FilePath
Cmd.byronGenesisTemplate = FilePath
byronGenesis
        , shelleyGenesisTemplate :: FilePath
Cmd.shelleyGenesisTemplate = FilePath
shelleyGenesis
        , alonzoGenesisTemplate :: FilePath
Cmd.alonzoGenesisTemplate = FilePath
alonzoGenesis
        , conwayGenesisTemplate :: FilePath
Cmd.conwayGenesisTemplate = FilePath
conwayGenesis
        , mNodeConfigTemplate :: Maybe FilePath
Cmd.mNodeConfigTemplate = Maybe FilePath
mNodeCfg
        }

runLegacyGenesisCreateStakedCmd
  :: ()
  => Era era
  -> Vary [FormatBech32, FormatTextEnvelope]
  -- ^ key output format
  -> GenesisDir
  -> Word
  -- ^ num genesis & delegate keys to make
  -> Word
  -- ^ num utxo keys to make
  -> Word
  -- ^ num pools to make
  -> Word
  -- ^ num delegators to make
  -> Maybe SystemStart
  -> Maybe Coin
  -- ^ supply going to non-delegators
  -> Coin
  -- ^ supply going to delegators
  -> NetworkId
  -> Word
  -- ^ bulk credential files to write
  -> Word
  -- ^ pool credentials per bulk file
  -> Word
  -- ^ num stuffed UTxO entries
  -> Maybe FilePath
  -- ^ Specified stake pool relays
  -> CIO e ()
runLegacyGenesisCreateStakedCmd :: forall era e.
Era era
-> Vary '[FormatBech32, FormatTextEnvelope]
-> GenesisDir
-> Word
-> Word
-> Word
-> Word
-> Maybe SystemStart
-> Maybe Coin
-> Coin
-> NetworkId
-> Word
-> Word
-> Word
-> Maybe FilePath
-> CIO e ()
runLegacyGenesisCreateStakedCmd
  Era era
era
  Vary '[FormatBech32, FormatTextEnvelope]
keyOutputFormat
  GenesisDir
genesisDir
  Word
numGenesisKeys
  Word
numUTxOKeys
  Word
numPools
  Word
numStakeDelegators
  Maybe SystemStart
mSystemStart
  Maybe Coin
mNonDelegatedSupply
  Coin
delegatedSupply
  NetworkId
network
  Word
numBulkPoolCredFiles
  Word
numBulkPoolsPerFile
  Word
numStuffedUtxo
  Maybe FilePath
mStakePoolRelaySpecFile =
    GenesisCreateStakedCmdArgs era -> CIO e ()
forall era e. GenesisCreateStakedCmdArgs era -> CIO e ()
runGenesisCreateStakedCmd
      Cmd.GenesisCreateStakedCmdArgs
        { eon :: Era era
Cmd.eon = Era era
era
        , keyOutputFormat :: Vary '[FormatBech32, FormatTextEnvelope]
Cmd.keyOutputFormat = Vary '[FormatBech32, FormatTextEnvelope]
keyOutputFormat
        , genesisDir :: GenesisDir
Cmd.genesisDir = GenesisDir
genesisDir
        , numGenesisKeys :: Word
Cmd.numGenesisKeys = Word
numGenesisKeys
        , numUTxOKeys :: Word
Cmd.numUTxOKeys = Word
numUTxOKeys
        , numPools :: Word
Cmd.numPools = Word
numPools
        , numStakeDelegators :: Word
Cmd.numStakeDelegators = Word
numStakeDelegators
        , mSystemStart :: Maybe SystemStart
Cmd.mSystemStart = Maybe SystemStart
mSystemStart
        , mNonDelegatedSupply :: Maybe Coin
Cmd.mNonDelegatedSupply = Maybe Coin
mNonDelegatedSupply
        , delegatedSupply :: Coin
Cmd.delegatedSupply = Coin
delegatedSupply
        , network :: NetworkId
Cmd.network = NetworkId
network
        , numBulkPoolCredFiles :: Word
Cmd.numBulkPoolCredFiles = Word
numBulkPoolCredFiles
        , numBulkPoolsPerFile :: Word
Cmd.numBulkPoolsPerFile = Word
numBulkPoolsPerFile
        , numStuffedUtxo :: Word
Cmd.numStuffedUtxo = Word
numStuffedUtxo
        , mStakePoolRelaySpecFile :: Maybe FilePath
Cmd.mStakePoolRelaySpecFile = Maybe FilePath
mStakePoolRelaySpecFile
        }

-- | Hash a genesis file
runLegacyGenesisHashFileCmd
  :: ()
  => GenesisFile
  -> CIO e ()
runLegacyGenesisHashFileCmd :: forall e. GenesisFile -> CIO e ()
runLegacyGenesisHashFileCmd = GenesisFile -> RIO e ()
GenesisFile -> CIO e ()
forall e. GenesisFile -> CIO e ()
runGenesisHashFileCmd