{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}

module Cardano.CLI.EraBased.Transaction.SubTransaction.Command
  ( SubTransactionCmds (..)
  , SubTransactionBuildRawCmdArgs (..)
  , SubTransactionSignCmdArgs (..)
  , SubTransactionTxIdCmdArgs (..)
  , Guard (..)
  , GuardScript (..)
  , TopLevelGuard (..)
  , renderSubTransactionCmds
  )
where

import Cardano.Api
import Cardano.Api.Ledger qualified as L

import Cardano.CLI.EraBased.Script.Type
import Cardano.CLI.Type.Common
import Cardano.CLI.Type.Governance
import Cardano.CLI.Type.Key (VerificationKeyOrHashOrFile)

import Vary (Vary)

-- | Commands for Dijkstra sub-transactions: the pieces a top-level
-- transaction embeds with @--signed-sub-tx-file@. Sub-transactions only exist in
-- Dijkstra, so these carry no era index.
data SubTransactionCmds
  = SubTransactionBuildRawCmd !SubTransactionBuildRawCmdArgs
  | SubTransactionSignCmd !SubTransactionSignCmdArgs
  | SubTransactionTxIdCmd !SubTransactionTxIdCmdArgs

-- | Like 'TransactionBuildRawCmdArgs' for a sub-transaction body. A
-- sub-transaction has no fee, collateral, required signers or script
-- validity flag; guards replace required signers.
data SubTransactionBuildRawCmdArgs = SubTransactionBuildRawCmdArgs
  { SubTransactionBuildRawCmdArgs -> [(TxIn, Maybe AnySpendScript)]
txIns :: ![(TxIn, Maybe AnySpendScript)]
  -- ^ Transaction inputs with optional spending scripts
  , SubTransactionBuildRawCmdArgs -> [TxIn]
readOnlyRefIns :: ![TxIn]
  -- ^ Read only reference inputs
  , SubTransactionBuildRawCmdArgs -> [TxOutAnyEra]
txouts :: ![TxOutAnyEra]
  , SubTransactionBuildRawCmdArgs
-> Maybe (MultiAsset, [AnyMintScript])
mMintedAssets :: !(Maybe (L.MultiAsset, [AnyMintScript]))
  -- ^ Multi-Asset minted value with script witness
  , SubTransactionBuildRawCmdArgs -> Maybe SlotNo
mValidityLowerBound :: !(Maybe SlotNo)
  -- ^ Transaction validity lower bound
  , SubTransactionBuildRawCmdArgs -> Maybe SlotNo
mValidityUpperBound :: !(Maybe SlotNo)
  -- ^ Transaction validity upper bound
  , SubTransactionBuildRawCmdArgs
-> [(CertificateFile, Maybe AnyNonAssetScript)]
certificates :: ![(CertificateFile, Maybe AnyNonAssetScript)]
  -- ^ Certificates with potential script witness
  , SubTransactionBuildRawCmdArgs
-> [(StakeAddress, Coin, Maybe AnyNonAssetScript)]
withdrawals :: ![(StakeAddress, Coin, Maybe AnyNonAssetScript)]
  , SubTransactionBuildRawCmdArgs -> TxMetadataJsonSchema
metadataSchema :: !TxMetadataJsonSchema
  , SubTransactionBuildRawCmdArgs -> [ScriptFile]
scriptFiles :: ![ScriptFile]
  -- ^ Auxiliary scripts
  , SubTransactionBuildRawCmdArgs -> [MetadataFile]
metadataFiles :: ![MetadataFile]
  , SubTransactionBuildRawCmdArgs -> Maybe ProtocolParamsFile
mProtocolParamsFile :: !(Maybe ProtocolParamsFile)
  , SubTransactionBuildRawCmdArgs
-> [(VoteFile 'In, Maybe AnyNonAssetScript)]
voteFiles :: ![(VoteFile In, Maybe AnyNonAssetScript)]
  , SubTransactionBuildRawCmdArgs
-> [(ProposalFile 'In, Maybe AnyNonAssetScript)]
proposalFiles :: ![(ProposalFile In, Maybe AnyNonAssetScript)]
  , SubTransactionBuildRawCmdArgs -> Maybe TxCurrentTreasuryValue
mCurrentTreasuryValue :: !(Maybe TxCurrentTreasuryValue)
  , SubTransactionBuildRawCmdArgs -> Maybe TxTreasuryDonation
mTreasuryDonation :: !(Maybe TxTreasuryDonation)
  , SubTransactionBuildRawCmdArgs -> [Guard]
guards :: ![Guard]
  -- ^ Credentials whose authorisation the sub-transaction requires
  , SubTransactionBuildRawCmdArgs -> [TopLevelGuard]
topLevelGuards :: ![TopLevelGuard]
  -- ^ Credentials required as guards in the enclosing transaction
  , SubTransactionBuildRawCmdArgs -> TxCborFormat
isCborOutCanonical :: !TxCborFormat
  , SubTransactionBuildRawCmdArgs -> UnsignedSubTxFile 'Out
outFile :: !(UnsignedSubTxFile Out)
  }
  deriving Int -> SubTransactionBuildRawCmdArgs -> ShowS
[SubTransactionBuildRawCmdArgs] -> ShowS
SubTransactionBuildRawCmdArgs -> String
(Int -> SubTransactionBuildRawCmdArgs -> ShowS)
-> (SubTransactionBuildRawCmdArgs -> String)
-> ([SubTransactionBuildRawCmdArgs] -> ShowS)
-> Show SubTransactionBuildRawCmdArgs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SubTransactionBuildRawCmdArgs -> ShowS
showsPrec :: Int -> SubTransactionBuildRawCmdArgs -> ShowS
$cshow :: SubTransactionBuildRawCmdArgs -> String
show :: SubTransactionBuildRawCmdArgs -> String
$cshowList :: [SubTransactionBuildRawCmdArgs] -> ShowS
showList :: [SubTransactionBuildRawCmdArgs] -> ShowS
Show

-- | A script guard may carry its guarding redeemer and execution budget.
-- They are required for Plutus scripts and forbidden for native scripts.
data Guard
  = KeyGuard (VerificationKeyOrHashOrFile PaymentKey)
  | ScriptGuard GuardScript (Maybe (ScriptDataOrFile, ExecutionUnits))
  deriving Int -> Guard -> ShowS
[Guard] -> ShowS
Guard -> String
(Int -> Guard -> ShowS)
-> (Guard -> String) -> ([Guard] -> ShowS) -> Show Guard
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Guard -> ShowS
showsPrec :: Int -> Guard -> ShowS
$cshow :: Guard -> String
show :: Guard -> String
$cshowList :: [Guard] -> ShowS
showList :: [Guard] -> ShowS
Show

data GuardScript
  = GuardScriptHash ScriptHash
  | GuardScriptFile ScriptFile
  deriving Int -> GuardScript -> ShowS
[GuardScript] -> ShowS
GuardScript -> String
(Int -> GuardScript -> ShowS)
-> (GuardScript -> String)
-> ([GuardScript] -> ShowS)
-> Show GuardScript
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GuardScript -> ShowS
showsPrec :: Int -> GuardScript -> ShowS
$cshow :: GuardScript -> String
show :: GuardScript -> String
$cshowList :: [GuardScript] -> ShowS
showList :: [GuardScript] -> ShowS
Show

-- | Only script requirements can carry a datum; key requirements never do.
data TopLevelGuard
  = TopLevelKeyGuard (VerificationKeyOrHashOrFile PaymentKey)
  | TopLevelScriptGuard GuardScript (Maybe ScriptDataOrFile)
  deriving Int -> TopLevelGuard -> ShowS
[TopLevelGuard] -> ShowS
TopLevelGuard -> String
(Int -> TopLevelGuard -> ShowS)
-> (TopLevelGuard -> String)
-> ([TopLevelGuard] -> ShowS)
-> Show TopLevelGuard
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TopLevelGuard -> ShowS
showsPrec :: Int -> TopLevelGuard -> ShowS
$cshow :: TopLevelGuard -> String
show :: TopLevelGuard -> String
$cshowList :: [TopLevelGuard] -> ShowS
showList :: [TopLevelGuard] -> ShowS
Show

data SubTransactionSignCmdArgs = SubTransactionSignCmdArgs
  { SubTransactionSignCmdArgs -> UnsignedSubTxFile 'In
subTxFile :: !(UnsignedSubTxFile In)
  , SubTransactionSignCmdArgs -> [WitnessSigningData]
witnessSigningData :: ![WitnessSigningData]
  , SubTransactionSignCmdArgs -> SignedSubTxFile 'Out
outFile :: !(SignedSubTxFile Out)
  }
  deriving Int -> SubTransactionSignCmdArgs -> ShowS
[SubTransactionSignCmdArgs] -> ShowS
SubTransactionSignCmdArgs -> String
(Int -> SubTransactionSignCmdArgs -> ShowS)
-> (SubTransactionSignCmdArgs -> String)
-> ([SubTransactionSignCmdArgs] -> ShowS)
-> Show SubTransactionSignCmdArgs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SubTransactionSignCmdArgs -> ShowS
showsPrec :: Int -> SubTransactionSignCmdArgs -> ShowS
$cshow :: SubTransactionSignCmdArgs -> String
show :: SubTransactionSignCmdArgs -> String
$cshowList :: [SubTransactionSignCmdArgs] -> ShowS
showList :: [SubTransactionSignCmdArgs] -> ShowS
Show

data SubTransactionTxIdCmdArgs = SubTransactionTxIdCmdArgs
  { SubTransactionTxIdCmdArgs -> InputSubTxFile
inputSubTxFile :: !InputSubTxFile
  , SubTransactionTxIdCmdArgs
-> Vary '[FormatJson, FormatText, FormatYaml]
outputFormat :: !(Vary [FormatJson, FormatText, FormatYaml])
  }
  deriving Int -> SubTransactionTxIdCmdArgs -> ShowS
[SubTransactionTxIdCmdArgs] -> ShowS
SubTransactionTxIdCmdArgs -> String
(Int -> SubTransactionTxIdCmdArgs -> ShowS)
-> (SubTransactionTxIdCmdArgs -> String)
-> ([SubTransactionTxIdCmdArgs] -> ShowS)
-> Show SubTransactionTxIdCmdArgs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SubTransactionTxIdCmdArgs -> ShowS
showsPrec :: Int -> SubTransactionTxIdCmdArgs -> ShowS
$cshow :: SubTransactionTxIdCmdArgs -> String
show :: SubTransactionTxIdCmdArgs -> String
$cshowList :: [SubTransactionTxIdCmdArgs] -> ShowS
showList :: [SubTransactionTxIdCmdArgs] -> ShowS
Show

renderSubTransactionCmds :: SubTransactionCmds -> Text
renderSubTransactionCmds :: SubTransactionCmds -> Text
renderSubTransactionCmds = \case
  SubTransactionBuildRawCmd{} -> Text
"sub-transaction build-raw"
  SubTransactionSignCmd{} -> Text
"sub-transaction sign"
  SubTransactionTxIdCmd{} -> Text
"sub-transaction txid"