{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Cardano.CLI.Options.Node
  ( pNodeCmds
  )
where

import           Cardano.Api hiding (QueryInShelleyBasedEra (..))

import           Cardano.CLI.Commands.Node
import qualified Cardano.CLI.Commands.Node as Cmd
import           Cardano.CLI.EraBased.Options.Common

import           Data.Foldable
import           Options.Applicative hiding (help, str)
import qualified Options.Applicative as Opt

{- HLINT ignore "Use <$>" -}
{- HLINT ignore "Move brackets to avoid $" -}

pNodeCmds :: Parser NodeCmds
pNodeCmds :: Parser NodeCmds
pNodeCmds =
  let nodeCmdParsers :: Parser NodeCmds
nodeCmdParsers =
        [Parser NodeCmds] -> Parser NodeCmds
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
          [ String -> ParserInfo NodeCmds -> Parser NodeCmds
forall a. String -> ParserInfo a -> Parser a
subParser String
"key-gen" (ParserInfo NodeCmds -> Parser NodeCmds)
-> ParserInfo NodeCmds -> Parser NodeCmds
forall a b. (a -> b) -> a -> b
$
              Parser NodeCmds -> InfoMod NodeCmds -> ParserInfo NodeCmds
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser NodeCmds
pKeyGenOperator (InfoMod NodeCmds -> ParserInfo NodeCmds)
-> InfoMod NodeCmds -> ParserInfo NodeCmds
forall a b. (a -> b) -> a -> b
$
                String -> InfoMod NodeCmds
forall a. String -> InfoMod a
Opt.progDesc (String -> InfoMod NodeCmds) -> String -> InfoMod NodeCmds
forall a b. (a -> b) -> a -> b
$
                  [String] -> String
forall a. Monoid a => [a] -> a
mconcat
                    [ String
"Create a key pair for a node operator's offline "
                    , String
"key and a new certificate issue counter"
                    ]
          , String -> ParserInfo NodeCmds -> Parser NodeCmds
forall a. String -> ParserInfo a -> Parser a
subParser String
"key-gen-KES" (ParserInfo NodeCmds -> Parser NodeCmds)
-> ParserInfo NodeCmds -> Parser NodeCmds
forall a b. (a -> b) -> a -> b
$
              Parser NodeCmds -> InfoMod NodeCmds -> ParserInfo NodeCmds
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser NodeCmds
pKeyGenKES (InfoMod NodeCmds -> ParserInfo NodeCmds)
-> InfoMod NodeCmds -> ParserInfo NodeCmds
forall a b. (a -> b) -> a -> b
$
                String -> InfoMod NodeCmds
forall a. String -> InfoMod a
Opt.progDesc (String -> InfoMod NodeCmds) -> String -> InfoMod NodeCmds
forall a b. (a -> b) -> a -> b
$
                  [String] -> String
forall a. Monoid a => [a] -> a
mconcat
                    [ String
"Create a key pair for a node KES operational key"
                    ]
          , String -> ParserInfo NodeCmds -> Parser NodeCmds
forall a. String -> ParserInfo a -> Parser a
subParser String
"key-gen-VRF" (ParserInfo NodeCmds -> Parser NodeCmds)
-> ParserInfo NodeCmds -> Parser NodeCmds
forall a b. (a -> b) -> a -> b
$
              Parser NodeCmds -> InfoMod NodeCmds -> ParserInfo NodeCmds
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser NodeCmds
pKeyGenVRF (InfoMod NodeCmds -> ParserInfo NodeCmds)
-> InfoMod NodeCmds -> ParserInfo NodeCmds
forall a b. (a -> b) -> a -> b
$
                String -> InfoMod NodeCmds
forall a. String -> InfoMod a
Opt.progDesc (String -> InfoMod NodeCmds) -> String -> InfoMod NodeCmds
forall a b. (a -> b) -> a -> b
$
                  [String] -> String
forall a. Monoid a => [a] -> a
mconcat
                    [ String
"Create a key pair for a node VRF operational key"
                    ]
          , String -> ParserInfo NodeCmds -> Parser NodeCmds
forall a. String -> ParserInfo a -> Parser a
subParser String
"key-hash-VRF" (ParserInfo NodeCmds -> Parser NodeCmds)
-> (InfoMod NodeCmds -> ParserInfo NodeCmds)
-> InfoMod NodeCmds
-> Parser NodeCmds
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser NodeCmds -> InfoMod NodeCmds -> ParserInfo NodeCmds
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser NodeCmds
pKeyHashVRF (InfoMod NodeCmds -> Parser NodeCmds)
-> InfoMod NodeCmds -> Parser NodeCmds
forall a b. (a -> b) -> a -> b
$
              String -> InfoMod NodeCmds
forall a. String -> InfoMod a
Opt.progDesc (String -> InfoMod NodeCmds) -> String -> InfoMod NodeCmds
forall a b. (a -> b) -> a -> b
$
                [String] -> String
forall a. Monoid a => [a] -> a
mconcat
                  [ String
"Print hash of a node's operational VRF key."
                  ]
          , String -> ParserInfo NodeCmds -> Parser NodeCmds
forall a. String -> ParserInfo a -> Parser a
subParser String
"new-counter" (ParserInfo NodeCmds -> Parser NodeCmds)
-> ParserInfo NodeCmds -> Parser NodeCmds
forall a b. (a -> b) -> a -> b
$
              Parser NodeCmds -> InfoMod NodeCmds -> ParserInfo NodeCmds
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser NodeCmds
pNewCounter (InfoMod NodeCmds -> ParserInfo NodeCmds)
-> InfoMod NodeCmds -> ParserInfo NodeCmds
forall a b. (a -> b) -> a -> b
$
                String -> InfoMod NodeCmds
forall a. String -> InfoMod a
Opt.progDesc (String -> InfoMod NodeCmds) -> String -> InfoMod NodeCmds
forall a b. (a -> b) -> a -> b
$
                  [String] -> String
forall a. Monoid a => [a] -> a
mconcat
                    [ String
"Create a new certificate issue counter"
                    ]
          , String -> ParserInfo NodeCmds -> Parser NodeCmds
forall a. String -> ParserInfo a -> Parser a
subParser String
"issue-op-cert" (ParserInfo NodeCmds -> Parser NodeCmds)
-> ParserInfo NodeCmds -> Parser NodeCmds
forall a b. (a -> b) -> a -> b
$
              Parser NodeCmds -> InfoMod NodeCmds -> ParserInfo NodeCmds
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser NodeCmds
pIssueOpCert (InfoMod NodeCmds -> ParserInfo NodeCmds)
-> InfoMod NodeCmds -> ParserInfo NodeCmds
forall a b. (a -> b) -> a -> b
$
                String -> InfoMod NodeCmds
forall a. String -> InfoMod a
Opt.progDesc (String -> InfoMod NodeCmds) -> String -> InfoMod NodeCmds
forall a b. (a -> b) -> a -> b
$
                  [String] -> String
forall a. Monoid a => [a] -> a
mconcat
                    [ String
"Issue a node operational certificate"
                    ]
          ]
   in String -> ParserInfo NodeCmds -> Parser NodeCmds
forall a. String -> ParserInfo a -> Parser a
subParser
        String
"node"
        (ParserInfo NodeCmds -> Parser NodeCmds)
-> ParserInfo NodeCmds -> Parser NodeCmds
forall a b. (a -> b) -> a -> b
$ Parser NodeCmds -> InfoMod NodeCmds -> ParserInfo NodeCmds
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info
          Parser NodeCmds
nodeCmdParsers
          ( String -> InfoMod NodeCmds
forall a. String -> InfoMod a
Opt.progDesc (String -> InfoMod NodeCmds) -> String -> InfoMod NodeCmds
forall a b. (a -> b) -> a -> b
$
              [String] -> String
forall a. Monoid a => [a] -> a
mconcat
                [ String
"Node operation commands."
                ]
          )

pKeyGenOperator :: Parser NodeCmds
pKeyGenOperator :: Parser NodeCmds
pKeyGenOperator =
  (NodeKeyGenColdCmdArgs -> NodeCmds)
-> Parser NodeKeyGenColdCmdArgs -> Parser NodeCmds
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NodeKeyGenColdCmdArgs -> NodeCmds
Cmd.NodeKeyGenColdCmd (Parser NodeKeyGenColdCmdArgs -> Parser NodeCmds)
-> Parser NodeKeyGenColdCmdArgs -> Parser NodeCmds
forall a b. (a -> b) -> a -> b
$
    KeyOutputFormat
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> OpCertCounterFile 'Out
-> NodeKeyGenColdCmdArgs
Cmd.NodeKeyGenColdCmdArgs
      (KeyOutputFormat
 -> VerificationKeyFile 'Out
 -> SigningKeyFile 'Out
 -> OpCertCounterFile 'Out
 -> NodeKeyGenColdCmdArgs)
-> Parser KeyOutputFormat
-> Parser
     (VerificationKeyFile 'Out
      -> SigningKeyFile 'Out
      -> OpCertCounterFile 'Out
      -> NodeKeyGenColdCmdArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser KeyOutputFormat
pKeyOutputFormat
      Parser
  (VerificationKeyFile 'Out
   -> SigningKeyFile 'Out
   -> OpCertCounterFile 'Out
   -> NodeKeyGenColdCmdArgs)
-> Parser (VerificationKeyFile 'Out)
-> Parser
     (SigningKeyFile 'Out
      -> OpCertCounterFile 'Out -> NodeKeyGenColdCmdArgs)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (VerificationKeyFile 'Out)
forall (direction :: FileDirection).
Parser (VerificationKeyFile direction)
pColdVerificationKeyFile
      Parser
  (SigningKeyFile 'Out
   -> OpCertCounterFile 'Out -> NodeKeyGenColdCmdArgs)
-> Parser (SigningKeyFile 'Out)
-> Parser (OpCertCounterFile 'Out -> NodeKeyGenColdCmdArgs)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (SigningKeyFile 'Out)
forall keyrole (direction :: FileDirection).
Parser (File (SigningKey keyrole) direction)
pColdSigningKeyFile
      Parser (OpCertCounterFile 'Out -> NodeKeyGenColdCmdArgs)
-> Parser (OpCertCounterFile 'Out) -> Parser NodeKeyGenColdCmdArgs
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (OpCertCounterFile 'Out)
forall (direction :: FileDirection).
Parser (File OpCertCounter direction)
pOperatorCertIssueCounterFile

pKeyGenKES :: Parser NodeCmds
pKeyGenKES :: Parser NodeCmds
pKeyGenKES =
  (NodeKeyGenKESCmdArgs -> NodeCmds)
-> Parser NodeKeyGenKESCmdArgs -> Parser NodeCmds
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NodeKeyGenKESCmdArgs -> NodeCmds
Cmd.NodeKeyGenKESCmd (Parser NodeKeyGenKESCmdArgs -> Parser NodeCmds)
-> Parser NodeKeyGenKESCmdArgs -> Parser NodeCmds
forall a b. (a -> b) -> a -> b
$
    KeyOutputFormat
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> NodeKeyGenKESCmdArgs
Cmd.NodeKeyGenKESCmdArgs
      (KeyOutputFormat
 -> VerificationKeyFile 'Out
 -> SigningKeyFile 'Out
 -> NodeKeyGenKESCmdArgs)
-> Parser KeyOutputFormat
-> Parser
     (VerificationKeyFile 'Out
      -> SigningKeyFile 'Out -> NodeKeyGenKESCmdArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser KeyOutputFormat
pKeyOutputFormat
      Parser
  (VerificationKeyFile 'Out
   -> SigningKeyFile 'Out -> NodeKeyGenKESCmdArgs)
-> Parser (VerificationKeyFile 'Out)
-> Parser (SigningKeyFile 'Out -> NodeKeyGenKESCmdArgs)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (VerificationKeyFile 'Out)
forall keyrole. Parser (File (VerificationKey keyrole) 'Out)
pVerificationKeyFileOut
      Parser (SigningKeyFile 'Out -> NodeKeyGenKESCmdArgs)
-> Parser (SigningKeyFile 'Out) -> Parser NodeKeyGenKESCmdArgs
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (SigningKeyFile 'Out)
forall keyrole. Parser (File (SigningKey keyrole) 'Out)
pSigningKeyFileOut

pKeyGenVRF :: Parser NodeCmds
pKeyGenVRF :: Parser NodeCmds
pKeyGenVRF =
  (NodeKeyGenVRFCmdArgs -> NodeCmds)
-> Parser NodeKeyGenVRFCmdArgs -> Parser NodeCmds
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NodeKeyGenVRFCmdArgs -> NodeCmds
Cmd.NodeKeyGenVRFCmd (Parser NodeKeyGenVRFCmdArgs -> Parser NodeCmds)
-> Parser NodeKeyGenVRFCmdArgs -> Parser NodeCmds
forall a b. (a -> b) -> a -> b
$
    KeyOutputFormat
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> NodeKeyGenVRFCmdArgs
Cmd.NodeKeyGenVRFCmdArgs
      (KeyOutputFormat
 -> VerificationKeyFile 'Out
 -> SigningKeyFile 'Out
 -> NodeKeyGenVRFCmdArgs)
-> Parser KeyOutputFormat
-> Parser
     (VerificationKeyFile 'Out
      -> SigningKeyFile 'Out -> NodeKeyGenVRFCmdArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser KeyOutputFormat
pKeyOutputFormat
      Parser
  (VerificationKeyFile 'Out
   -> SigningKeyFile 'Out -> NodeKeyGenVRFCmdArgs)
-> Parser (VerificationKeyFile 'Out)
-> Parser (SigningKeyFile 'Out -> NodeKeyGenVRFCmdArgs)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (VerificationKeyFile 'Out)
forall keyrole. Parser (File (VerificationKey keyrole) 'Out)
pVerificationKeyFileOut
      Parser (SigningKeyFile 'Out -> NodeKeyGenVRFCmdArgs)
-> Parser (SigningKeyFile 'Out) -> Parser NodeKeyGenVRFCmdArgs
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (SigningKeyFile 'Out)
forall keyrole. Parser (File (SigningKey keyrole) 'Out)
pSigningKeyFileOut

pKeyHashVRF :: Parser NodeCmds
pKeyHashVRF :: Parser NodeCmds
pKeyHashVRF =
  (NodeKeyHashVRFCmdArgs -> NodeCmds)
-> Parser NodeKeyHashVRFCmdArgs -> Parser NodeCmds
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NodeKeyHashVRFCmdArgs -> NodeCmds
Cmd.NodeKeyHashVRFCmd (Parser NodeKeyHashVRFCmdArgs -> Parser NodeCmds)
-> Parser NodeKeyHashVRFCmdArgs -> Parser NodeCmds
forall a b. (a -> b) -> a -> b
$
    VerificationKeyOrFile VrfKey
-> Maybe (File () 'Out) -> NodeKeyHashVRFCmdArgs
Cmd.NodeKeyHashVRFCmdArgs
      (VerificationKeyOrFile VrfKey
 -> Maybe (File () 'Out) -> NodeKeyHashVRFCmdArgs)
-> Parser (VerificationKeyOrFile VrfKey)
-> Parser (Maybe (File () 'Out) -> NodeKeyHashVRFCmdArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AsType VrfKey -> Parser (VerificationKeyOrFile VrfKey)
forall keyrole.
SerialiseAsBech32 (VerificationKey keyrole) =>
AsType keyrole -> Parser (VerificationKeyOrFile keyrole)
pVerificationKeyOrFileIn AsType VrfKey
AsVrfKey
      Parser (Maybe (File () 'Out) -> NodeKeyHashVRFCmdArgs)
-> Parser (Maybe (File () 'Out)) -> Parser NodeKeyHashVRFCmdArgs
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe (File () 'Out))
forall content. Parser (Maybe (File content 'Out))
pMaybeOutputFile

pNewCounter :: Parser NodeCmds
pNewCounter :: Parser NodeCmds
pNewCounter =
  (NodeNewCounterCmdArgs -> NodeCmds)
-> Parser NodeNewCounterCmdArgs -> Parser NodeCmds
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NodeNewCounterCmdArgs -> NodeCmds
Cmd.NodeNewCounterCmd (Parser NodeNewCounterCmdArgs -> Parser NodeCmds)
-> Parser NodeNewCounterCmdArgs -> Parser NodeCmds
forall a b. (a -> b) -> a -> b
$
    ColdVerificationKeyOrFile
-> Word -> OpCertCounterFile 'InOut -> NodeNewCounterCmdArgs
Cmd.NodeNewCounterCmdArgs
      (ColdVerificationKeyOrFile
 -> Word -> OpCertCounterFile 'InOut -> NodeNewCounterCmdArgs)
-> Parser ColdVerificationKeyOrFile
-> Parser
     (Word -> OpCertCounterFile 'InOut -> NodeNewCounterCmdArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String -> Parser ColdVerificationKeyOrFile
pColdVerificationKeyOrFile Maybe String
forall a. Maybe a
Nothing
      Parser (Word -> OpCertCounterFile 'InOut -> NodeNewCounterCmdArgs)
-> Parser Word
-> Parser (OpCertCounterFile 'InOut -> NodeNewCounterCmdArgs)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word
pCounterValue
      Parser (OpCertCounterFile 'InOut -> NodeNewCounterCmdArgs)
-> Parser (OpCertCounterFile 'InOut)
-> Parser NodeNewCounterCmdArgs
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (OpCertCounterFile 'InOut)
forall (direction :: FileDirection).
Parser (File OpCertCounter direction)
pOperatorCertIssueCounterFile

pCounterValue :: Parser Word
pCounterValue :: Parser Word
pCounterValue =
  ReadM Word -> Mod OptionFields Word -> Parser Word
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Word
forall a. (Typeable a, Integral a, Bits a) => ReadM a
integralReader (Mod OptionFields Word -> Parser Word)
-> Mod OptionFields Word -> Parser Word
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields Word] -> Mod OptionFields Word
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields Word
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"counter-value"
      , String -> Mod OptionFields Word
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"INT"
      , String -> Mod OptionFields Word
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"The next certificate issue counter value to use."
      ]

pIssueOpCert :: Parser NodeCmds
pIssueOpCert :: Parser NodeCmds
pIssueOpCert =
  (NodeIssueOpCertCmdArgs -> NodeCmds)
-> Parser NodeIssueOpCertCmdArgs -> Parser NodeCmds
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NodeIssueOpCertCmdArgs -> NodeCmds
Cmd.NodeIssueOpCertCmd (Parser NodeIssueOpCertCmdArgs -> Parser NodeCmds)
-> Parser NodeIssueOpCertCmdArgs -> Parser NodeCmds
forall a b. (a -> b) -> a -> b
$
    VerificationKeyOrFile KesKey
-> SigningKeyFile 'In
-> OpCertCounterFile 'InOut
-> KESPeriod
-> File () 'Out
-> NodeIssueOpCertCmdArgs
Cmd.NodeIssueOpCertCmdArgs
      (VerificationKeyOrFile KesKey
 -> SigningKeyFile 'In
 -> OpCertCounterFile 'InOut
 -> KESPeriod
 -> File () 'Out
 -> NodeIssueOpCertCmdArgs)
-> Parser (VerificationKeyOrFile KesKey)
-> Parser
     (SigningKeyFile 'In
      -> OpCertCounterFile 'InOut
      -> KESPeriod
      -> File () 'Out
      -> NodeIssueOpCertCmdArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyOrFile KesKey)
pKesVerificationKeyOrFile
      Parser
  (SigningKeyFile 'In
   -> OpCertCounterFile 'InOut
   -> KESPeriod
   -> File () 'Out
   -> NodeIssueOpCertCmdArgs)
-> Parser (SigningKeyFile 'In)
-> Parser
     (OpCertCounterFile 'InOut
      -> KESPeriod -> File () 'Out -> NodeIssueOpCertCmdArgs)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (SigningKeyFile 'In)
forall keyrole (direction :: FileDirection).
Parser (File (SigningKey keyrole) direction)
pColdSigningKeyFile
      Parser
  (OpCertCounterFile 'InOut
   -> KESPeriod -> File () 'Out -> NodeIssueOpCertCmdArgs)
-> Parser (OpCertCounterFile 'InOut)
-> Parser (KESPeriod -> File () 'Out -> NodeIssueOpCertCmdArgs)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (OpCertCounterFile 'InOut)
forall (direction :: FileDirection).
Parser (File OpCertCounter direction)
pOperatorCertIssueCounterFile
      Parser (KESPeriod -> File () 'Out -> NodeIssueOpCertCmdArgs)
-> Parser KESPeriod
-> Parser (File () 'Out -> NodeIssueOpCertCmdArgs)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser KESPeriod
pKesPeriod
      Parser (File () 'Out -> NodeIssueOpCertCmdArgs)
-> Parser (File () 'Out) -> Parser NodeIssueOpCertCmdArgs
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (File () 'Out)
forall content. Parser (File content 'Out)
pOutputFile