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

module Cardano.CLI.Run.Node
  ( runNodeCmds
  , runNodeIssueOpCertCmd
  , runNodeKeyGenColdCmd
  , runNodeKeyGenKesCmd
  , runNodeKeyGenVrfCmd
  , runNodeKeyHashVrfCmd
  , runNodeNewCounterCmd
  )
where

import           Cardano.Api
import           Cardano.Api.Shelley

import qualified Cardano.CLI.Commands.Node as Cmd
import           Cardano.CLI.Types.Common
import           Cardano.CLI.Types.Errors.NodeCmdError
import           Cardano.CLI.Types.Key

import qualified Data.ByteString.Char8 as BS
import           Data.String (fromString)
import           Data.Word (Word64)

{- HLINT ignore "Reduce duplication" -}

runNodeCmds
  :: ()
  => Cmd.NodeCmds
  -> ExceptT NodeCmdError IO ()
runNodeCmds :: NodeCmds -> ExceptT NodeCmdError IO ()
runNodeCmds = \case
  Cmd.NodeKeyGenColdCmd NodeKeyGenColdCmdArgs
args -> NodeKeyGenColdCmdArgs -> ExceptT NodeCmdError IO ()
runNodeKeyGenColdCmd NodeKeyGenColdCmdArgs
args
  Cmd.NodeKeyGenKESCmd NodeKeyGenKESCmdArgs
args -> NodeKeyGenKESCmdArgs -> ExceptT NodeCmdError IO ()
runNodeKeyGenKesCmd NodeKeyGenKESCmdArgs
args
  Cmd.NodeKeyGenVRFCmd NodeKeyGenVRFCmdArgs
args -> NodeKeyGenVRFCmdArgs -> ExceptT NodeCmdError IO ()
runNodeKeyGenVrfCmd NodeKeyGenVRFCmdArgs
args
  Cmd.NodeKeyHashVRFCmd NodeKeyHashVRFCmdArgs
args -> NodeKeyHashVRFCmdArgs -> ExceptT NodeCmdError IO ()
runNodeKeyHashVrfCmd NodeKeyHashVRFCmdArgs
args
  Cmd.NodeNewCounterCmd NodeNewCounterCmdArgs
args -> NodeNewCounterCmdArgs -> ExceptT NodeCmdError IO ()
runNodeNewCounterCmd NodeNewCounterCmdArgs
args
  Cmd.NodeIssueOpCertCmd NodeIssueOpCertCmdArgs
args -> NodeIssueOpCertCmdArgs -> ExceptT NodeCmdError IO ()
runNodeIssueOpCertCmd NodeIssueOpCertCmdArgs
args

runNodeKeyGenColdCmd
  :: ()
  => Cmd.NodeKeyGenColdCmdArgs
  -> ExceptT NodeCmdError IO ()
runNodeKeyGenColdCmd :: NodeKeyGenColdCmdArgs -> ExceptT NodeCmdError IO ()
runNodeKeyGenColdCmd
  Cmd.NodeKeyGenColdCmdArgs
    { KeyOutputFormat
keyOutputFormat :: KeyOutputFormat
keyOutputFormat :: NodeKeyGenColdCmdArgs -> KeyOutputFormat
keyOutputFormat
    , VerificationKeyFile 'Out
vkeyFile :: VerificationKeyFile 'Out
vkeyFile :: NodeKeyGenColdCmdArgs -> VerificationKeyFile 'Out
vkeyFile
    , SigningKeyFile 'Out
skeyFile :: SigningKeyFile 'Out
skeyFile :: NodeKeyGenColdCmdArgs -> SigningKeyFile 'Out
skeyFile
    , OpCertCounterFile 'Out
operationalCertificateIssueCounter :: OpCertCounterFile 'Out
operationalCertificateIssueCounter :: NodeKeyGenColdCmdArgs -> OpCertCounterFile 'Out
operationalCertificateIssueCounter
    } = do
    SigningKey StakePoolKey
skey <- AsType StakePoolKey
-> ExceptT NodeCmdError IO (SigningKey StakePoolKey)
forall (m :: * -> *) keyrole.
(MonadIO m, Key keyrole) =>
AsType keyrole -> m (SigningKey keyrole)
generateSigningKey AsType StakePoolKey
AsStakePoolKey
    let vkey :: VerificationKey StakePoolKey
vkey = SigningKey StakePoolKey -> VerificationKey StakePoolKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey StakePoolKey
skey

    case KeyOutputFormat
keyOutputFormat of
      KeyOutputFormat
KeyOutputFormatTextEnvelope ->
        (FileError () -> NodeCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT NodeCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> NodeCmdError
NodeCmdWriteFileError
          (ExceptT (FileError ()) IO () -> ExceptT NodeCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT NodeCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
          (IO (Either (FileError ()) ()) -> ExceptT NodeCmdError IO ())
-> IO (Either (FileError ()) ()) -> ExceptT NodeCmdError IO ()
forall a b. (a -> b) -> a -> b
$ SigningKeyFile 'Out -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile SigningKeyFile 'Out
skeyFile
          (ByteString -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$ Maybe TextEnvelopeDescr -> SigningKey StakePoolKey -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
skeyDesc) SigningKey StakePoolKey
skey
      KeyOutputFormat
KeyOutputFormatBech32 ->
        (FileError () -> NodeCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT NodeCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> NodeCmdError
NodeCmdWriteFileError
          (ExceptT (FileError ()) IO () -> ExceptT NodeCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT NodeCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
          (IO (Either (FileError ()) ()) -> ExceptT NodeCmdError IO ())
-> IO (Either (FileError ()) ()) -> ExceptT NodeCmdError IO ()
forall a b. (a -> b) -> a -> b
$ SigningKeyFile 'Out -> Text -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> Text -> m (Either (FileError e) ())
writeTextFile SigningKeyFile 'Out
skeyFile
          (Text -> IO (Either (FileError ()) ()))
-> Text -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$ SigningKey StakePoolKey -> Text
forall a. SerialiseAsBech32 a => a -> Text
serialiseToBech32 SigningKey StakePoolKey
skey

    case KeyOutputFormat
keyOutputFormat of
      KeyOutputFormat
KeyOutputFormatTextEnvelope ->
        (FileError () -> NodeCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT NodeCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> NodeCmdError
NodeCmdWriteFileError
          (ExceptT (FileError ()) IO () -> ExceptT NodeCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT NodeCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
          (IO (Either (FileError ()) ()) -> ExceptT NodeCmdError IO ())
-> IO (Either (FileError ()) ()) -> ExceptT NodeCmdError IO ()
forall a b. (a -> b) -> a -> b
$ VerificationKeyFile 'Out
-> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile VerificationKeyFile 'Out
vkeyFile
          (ByteString -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$ Maybe TextEnvelopeDescr
-> VerificationKey StakePoolKey -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
vkeyDesc) VerificationKey StakePoolKey
vkey
      KeyOutputFormat
KeyOutputFormatBech32 ->
        (FileError () -> NodeCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT NodeCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> NodeCmdError
NodeCmdWriteFileError
          (ExceptT (FileError ()) IO () -> ExceptT NodeCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT NodeCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
          (IO (Either (FileError ()) ()) -> ExceptT NodeCmdError IO ())
-> IO (Either (FileError ()) ()) -> ExceptT NodeCmdError IO ()
forall a b. (a -> b) -> a -> b
$ VerificationKeyFile 'Out -> Text -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> Text -> m (Either (FileError e) ())
writeTextFile VerificationKeyFile 'Out
vkeyFile
          (Text -> IO (Either (FileError ()) ()))
-> Text -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$ VerificationKey StakePoolKey -> Text
forall a. SerialiseAsBech32 a => a -> Text
serialiseToBech32 VerificationKey StakePoolKey
vkey

    (FileError () -> NodeCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT NodeCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> NodeCmdError
NodeCmdWriteFileError
      (ExceptT (FileError ()) IO () -> ExceptT NodeCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT NodeCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
      (IO (Either (FileError ()) ()) -> ExceptT NodeCmdError IO ())
-> IO (Either (FileError ()) ()) -> ExceptT NodeCmdError IO ()
forall a b. (a -> b) -> a -> b
$ OpCertCounterFile 'Out
-> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile OpCertCounterFile 'Out
operationalCertificateIssueCounter
      (ByteString -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$ Maybe TextEnvelopeDescr
-> OperationalCertificateIssueCounter -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
ocertCtrDesc)
      (OperationalCertificateIssueCounter -> ByteString)
-> OperationalCertificateIssueCounter -> ByteString
forall a b. (a -> b) -> a -> b
$ Word64
-> VerificationKey StakePoolKey
-> OperationalCertificateIssueCounter
OperationalCertificateIssueCounter Word64
initialCounter VerificationKey StakePoolKey
vkey
   where
    skeyDesc :: TextEnvelopeDescr
    skeyDesc :: TextEnvelopeDescr
skeyDesc = TextEnvelopeDescr
"Stake Pool Operator Signing Key"

    vkeyDesc :: TextEnvelopeDescr
    vkeyDesc :: TextEnvelopeDescr
vkeyDesc = TextEnvelopeDescr
"Stake Pool Operator Verification Key"

    ocertCtrDesc :: TextEnvelopeDescr
    ocertCtrDesc :: TextEnvelopeDescr
ocertCtrDesc =
      TextEnvelopeDescr
"Next certificate issue number: "
        TextEnvelopeDescr -> TextEnvelopeDescr -> TextEnvelopeDescr
forall a. Semigroup a => a -> a -> a
<> String -> TextEnvelopeDescr
forall a. IsString a => String -> a
fromString (Word64 -> String
forall a. Show a => a -> String
show Word64
initialCounter)

    initialCounter :: Word64
    initialCounter :: Word64
initialCounter = Word64
0

runNodeKeyGenKesCmd
  :: ()
  => Cmd.NodeKeyGenKESCmdArgs
  -> ExceptT NodeCmdError IO ()
runNodeKeyGenKesCmd :: NodeKeyGenKESCmdArgs -> ExceptT NodeCmdError IO ()
runNodeKeyGenKesCmd
  Cmd.NodeKeyGenKESCmdArgs
    { KeyOutputFormat
keyOutputFormat :: KeyOutputFormat
keyOutputFormat :: NodeKeyGenKESCmdArgs -> KeyOutputFormat
keyOutputFormat
    , VerificationKeyFile 'Out
vkeyFile :: VerificationKeyFile 'Out
vkeyFile :: NodeKeyGenKESCmdArgs -> VerificationKeyFile 'Out
vkeyFile
    , SigningKeyFile 'Out
skeyFile :: SigningKeyFile 'Out
skeyFile :: NodeKeyGenKESCmdArgs -> SigningKeyFile 'Out
skeyFile
    } = do
    SigningKey KesKey
skey <- AsType KesKey -> ExceptT NodeCmdError IO (SigningKey KesKey)
forall (m :: * -> *) keyrole.
(MonadIO m, Key keyrole) =>
AsType keyrole -> m (SigningKey keyrole)
generateSigningKey AsType KesKey
AsKesKey

    let vkey :: VerificationKey KesKey
vkey = SigningKey KesKey -> VerificationKey KesKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey KesKey
skey

    case KeyOutputFormat
keyOutputFormat of
      KeyOutputFormat
KeyOutputFormatTextEnvelope ->
        (FileError () -> NodeCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT NodeCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> NodeCmdError
NodeCmdWriteFileError
          (ExceptT (FileError ()) IO () -> ExceptT NodeCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT NodeCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
          (IO (Either (FileError ()) ()) -> ExceptT NodeCmdError IO ())
-> IO (Either (FileError ()) ()) -> ExceptT NodeCmdError IO ()
forall a b. (a -> b) -> a -> b
$ SigningKeyFile 'Out -> ByteString -> IO (Either (FileError ()) ())
forall content e.
File content 'Out -> ByteString -> IO (Either (FileError e) ())
writeLazyByteStringFileWithOwnerPermissions SigningKeyFile 'Out
skeyFile
          (ByteString -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$ Maybe TextEnvelopeDescr -> SigningKey KesKey -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
skeyDesc) SigningKey KesKey
skey
      KeyOutputFormat
KeyOutputFormatBech32 ->
        (FileError () -> NodeCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT NodeCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> NodeCmdError
NodeCmdWriteFileError
          (ExceptT (FileError ()) IO () -> ExceptT NodeCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT NodeCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
          (IO (Either (FileError ()) ()) -> ExceptT NodeCmdError IO ())
-> IO (Either (FileError ()) ()) -> ExceptT NodeCmdError IO ()
forall a b. (a -> b) -> a -> b
$ SigningKeyFile 'Out -> Text -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> Text -> m (Either (FileError e) ())
writeTextFile SigningKeyFile 'Out
skeyFile
          (Text -> IO (Either (FileError ()) ()))
-> Text -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$ SigningKey KesKey -> Text
forall a. SerialiseAsBech32 a => a -> Text
serialiseToBech32 SigningKey KesKey
skey

    case KeyOutputFormat
keyOutputFormat of
      KeyOutputFormat
KeyOutputFormatTextEnvelope ->
        (FileError () -> NodeCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT NodeCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> NodeCmdError
NodeCmdWriteFileError
          (ExceptT (FileError ()) IO () -> ExceptT NodeCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT NodeCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
          (IO (Either (FileError ()) ()) -> ExceptT NodeCmdError IO ())
-> IO (Either (FileError ()) ()) -> ExceptT NodeCmdError IO ()
forall a b. (a -> b) -> a -> b
$ VerificationKeyFile 'Out
-> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile VerificationKeyFile 'Out
vkeyFile
          (ByteString -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$ Maybe TextEnvelopeDescr -> VerificationKey KesKey -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
vkeyDesc) VerificationKey KesKey
vkey
      KeyOutputFormat
KeyOutputFormatBech32 ->
        (FileError () -> NodeCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT NodeCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> NodeCmdError
NodeCmdWriteFileError
          (ExceptT (FileError ()) IO () -> ExceptT NodeCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT NodeCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
          (IO (Either (FileError ()) ()) -> ExceptT NodeCmdError IO ())
-> IO (Either (FileError ()) ()) -> ExceptT NodeCmdError IO ()
forall a b. (a -> b) -> a -> b
$ VerificationKeyFile 'Out -> Text -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> Text -> m (Either (FileError e) ())
writeTextFile VerificationKeyFile 'Out
vkeyFile
          (Text -> IO (Either (FileError ()) ()))
-> Text -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$ VerificationKey KesKey -> Text
forall a. SerialiseAsBech32 a => a -> Text
serialiseToBech32 VerificationKey KesKey
vkey
   where
    skeyDesc :: TextEnvelopeDescr
    skeyDesc :: TextEnvelopeDescr
skeyDesc = TextEnvelopeDescr
"KES Signing Key"

    vkeyDesc :: TextEnvelopeDescr
    vkeyDesc :: TextEnvelopeDescr
vkeyDesc = TextEnvelopeDescr
"KES Verification Key"

runNodeKeyGenVrfCmd
  :: ()
  => Cmd.NodeKeyGenVRFCmdArgs
  -> ExceptT NodeCmdError IO ()
runNodeKeyGenVrfCmd :: NodeKeyGenVRFCmdArgs -> ExceptT NodeCmdError IO ()
runNodeKeyGenVrfCmd
  Cmd.NodeKeyGenVRFCmdArgs
    { KeyOutputFormat
keyOutputFormat :: KeyOutputFormat
keyOutputFormat :: NodeKeyGenVRFCmdArgs -> KeyOutputFormat
keyOutputFormat
    , VerificationKeyFile 'Out
vkeyFile :: VerificationKeyFile 'Out
vkeyFile :: NodeKeyGenVRFCmdArgs -> VerificationKeyFile 'Out
vkeyFile
    , SigningKeyFile 'Out
skeyFile :: SigningKeyFile 'Out
skeyFile :: NodeKeyGenVRFCmdArgs -> SigningKeyFile 'Out
skeyFile
    } = do
    SigningKey VrfKey
skey <- AsType VrfKey -> ExceptT NodeCmdError IO (SigningKey VrfKey)
forall (m :: * -> *) keyrole.
(MonadIO m, Key keyrole) =>
AsType keyrole -> m (SigningKey keyrole)
generateSigningKey AsType VrfKey
AsVrfKey

    let vkey :: VerificationKey VrfKey
vkey = SigningKey VrfKey -> VerificationKey VrfKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey VrfKey
skey

    case KeyOutputFormat
keyOutputFormat of
      KeyOutputFormat
KeyOutputFormatTextEnvelope ->
        (FileError () -> NodeCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT NodeCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> NodeCmdError
NodeCmdWriteFileError
          (ExceptT (FileError ()) IO () -> ExceptT NodeCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT NodeCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
          (IO (Either (FileError ()) ()) -> ExceptT NodeCmdError IO ())
-> IO (Either (FileError ()) ()) -> ExceptT NodeCmdError IO ()
forall a b. (a -> b) -> a -> b
$ SigningKeyFile 'Out -> ByteString -> IO (Either (FileError ()) ())
forall content e.
File content 'Out -> ByteString -> IO (Either (FileError e) ())
writeLazyByteStringFileWithOwnerPermissions SigningKeyFile 'Out
skeyFile
          (ByteString -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$ Maybe TextEnvelopeDescr -> SigningKey VrfKey -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
skeyDesc) SigningKey VrfKey
skey
      KeyOutputFormat
KeyOutputFormatBech32 ->
        (FileError () -> NodeCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT NodeCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> NodeCmdError
NodeCmdWriteFileError
          (ExceptT (FileError ()) IO () -> ExceptT NodeCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT NodeCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
          (IO (Either (FileError ()) ()) -> ExceptT NodeCmdError IO ())
-> IO (Either (FileError ()) ()) -> ExceptT NodeCmdError IO ()
forall a b. (a -> b) -> a -> b
$ SigningKeyFile 'Out -> Text -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> Text -> m (Either (FileError e) ())
writeTextFile SigningKeyFile 'Out
skeyFile
          (Text -> IO (Either (FileError ()) ()))
-> Text -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$ SigningKey VrfKey -> Text
forall a. SerialiseAsBech32 a => a -> Text
serialiseToBech32 SigningKey VrfKey
skey

    case KeyOutputFormat
keyOutputFormat of
      KeyOutputFormat
KeyOutputFormatTextEnvelope ->
        (FileError () -> NodeCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT NodeCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> NodeCmdError
NodeCmdWriteFileError
          (ExceptT (FileError ()) IO () -> ExceptT NodeCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT NodeCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
          (IO (Either (FileError ()) ()) -> ExceptT NodeCmdError IO ())
-> IO (Either (FileError ()) ()) -> ExceptT NodeCmdError IO ()
forall a b. (a -> b) -> a -> b
$ VerificationKeyFile 'Out
-> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile VerificationKeyFile 'Out
vkeyFile
          (ByteString -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$ Maybe TextEnvelopeDescr -> VerificationKey VrfKey -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
vkeyDesc) VerificationKey VrfKey
vkey
      KeyOutputFormat
KeyOutputFormatBech32 ->
        (FileError () -> NodeCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT NodeCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> NodeCmdError
NodeCmdWriteFileError
          (ExceptT (FileError ()) IO () -> ExceptT NodeCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT NodeCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
          (IO (Either (FileError ()) ()) -> ExceptT NodeCmdError IO ())
-> IO (Either (FileError ()) ()) -> ExceptT NodeCmdError IO ()
forall a b. (a -> b) -> a -> b
$ VerificationKeyFile 'Out -> Text -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> Text -> m (Either (FileError e) ())
writeTextFile VerificationKeyFile 'Out
vkeyFile
          (Text -> IO (Either (FileError ()) ()))
-> Text -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$ VerificationKey VrfKey -> Text
forall a. SerialiseAsBech32 a => a -> Text
serialiseToBech32 VerificationKey VrfKey
vkey
   where
    skeyDesc, vkeyDesc :: TextEnvelopeDescr
    skeyDesc :: TextEnvelopeDescr
skeyDesc = TextEnvelopeDescr
"VRF Signing Key"
    vkeyDesc :: TextEnvelopeDescr
vkeyDesc = TextEnvelopeDescr
"VRF Verification Key"

runNodeKeyHashVrfCmd
  :: ()
  => Cmd.NodeKeyHashVRFCmdArgs
  -> ExceptT NodeCmdError IO ()
runNodeKeyHashVrfCmd :: NodeKeyHashVRFCmdArgs -> ExceptT NodeCmdError IO ()
runNodeKeyHashVrfCmd
  Cmd.NodeKeyHashVRFCmdArgs
    { VerificationKeyOrFile VrfKey
vkeySource :: VerificationKeyOrFile VrfKey
vkeySource :: NodeKeyHashVRFCmdArgs -> VerificationKeyOrFile VrfKey
vkeySource
    , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: NodeKeyHashVRFCmdArgs -> Maybe (File () 'Out)
mOutFile
    } = do
    VerificationKey VrfKey
vkey <-
      (FileError InputDecodeError -> NodeCmdError)
-> ExceptT (FileError InputDecodeError) IO (VerificationKey VrfKey)
-> ExceptT NodeCmdError IO (VerificationKey VrfKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError InputDecodeError -> NodeCmdError
NodeCmdReadKeyFileError (ExceptT (FileError InputDecodeError) IO (VerificationKey VrfKey)
 -> ExceptT NodeCmdError IO (VerificationKey VrfKey))
-> ExceptT (FileError InputDecodeError) IO (VerificationKey VrfKey)
-> ExceptT NodeCmdError IO (VerificationKey VrfKey)
forall a b. (a -> b) -> a -> b
$
        AsType VrfKey
-> VerificationKeyOrFile VrfKey
-> ExceptT (FileError InputDecodeError) IO (VerificationKey VrfKey)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) keyrole.
(MonadIOTransError (FileError InputDecodeError) t m,
 HasTextEnvelope (VerificationKey keyrole),
 SerialiseAsBech32 (VerificationKey keyrole)) =>
AsType keyrole
-> VerificationKeyOrFile keyrole -> t m (VerificationKey keyrole)
readVerificationKeyOrFile AsType VrfKey
AsVrfKey VerificationKeyOrFile VrfKey
vkeySource

    let hexKeyHash :: ByteString
hexKeyHash = Hash VrfKey -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytesHex (VerificationKey VrfKey -> Hash VrfKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey VrfKey
vkey)

    case Maybe (File () 'Out)
mOutFile of
      Just File () 'Out
fpath -> IO () -> ExceptT NodeCmdError IO ()
forall a. IO a -> ExceptT NodeCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT NodeCmdError IO ())
-> IO () -> ExceptT NodeCmdError IO ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString -> IO ()
BS.writeFile (File () 'Out -> String
forall content (direction :: FileDirection).
File content direction -> String
unFile File () 'Out
fpath) ByteString
hexKeyHash
      Maybe (File () 'Out)
Nothing -> IO () -> ExceptT NodeCmdError IO ()
forall a. IO a -> ExceptT NodeCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT NodeCmdError IO ())
-> IO () -> ExceptT NodeCmdError IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
BS.putStrLn ByteString
hexKeyHash

runNodeNewCounterCmd
  :: ()
  => Cmd.NodeNewCounterCmdArgs
  -> ExceptT NodeCmdError IO ()
runNodeNewCounterCmd :: NodeNewCounterCmdArgs -> ExceptT NodeCmdError IO ()
runNodeNewCounterCmd
  Cmd.NodeNewCounterCmdArgs
    { ColdVerificationKeyOrFile
coldVkeyFile :: ColdVerificationKeyOrFile
coldVkeyFile :: NodeNewCounterCmdArgs -> ColdVerificationKeyOrFile
coldVkeyFile
    , Word
counter :: Word
counter :: NodeNewCounterCmdArgs -> Word
counter
    , OpCertCounterFile 'InOut
mOutFile :: OpCertCounterFile 'InOut
mOutFile :: NodeNewCounterCmdArgs -> OpCertCounterFile 'InOut
mOutFile
    } = do
    VerificationKey StakePoolKey
vkey <-
      (FileError TextEnvelopeError -> NodeCmdError)
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey StakePoolKey)
-> ExceptT NodeCmdError IO (VerificationKey StakePoolKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> NodeCmdError
NodeCmdReadFileError (ExceptT
   (FileError TextEnvelopeError) IO (VerificationKey StakePoolKey)
 -> ExceptT NodeCmdError IO (VerificationKey StakePoolKey))
-> (IO
      (Either
         (FileError TextEnvelopeError) (VerificationKey StakePoolKey))
    -> ExceptT
         (FileError TextEnvelopeError) IO (VerificationKey StakePoolKey))
-> IO
     (Either
        (FileError TextEnvelopeError) (VerificationKey StakePoolKey))
-> ExceptT NodeCmdError IO (VerificationKey StakePoolKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO
  (Either
     (FileError TextEnvelopeError) (VerificationKey StakePoolKey))
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey StakePoolKey)
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO
   (Either
      (FileError TextEnvelopeError) (VerificationKey StakePoolKey))
 -> ExceptT NodeCmdError IO (VerificationKey StakePoolKey))
-> IO
     (Either
        (FileError TextEnvelopeError) (VerificationKey StakePoolKey))
-> ExceptT NodeCmdError IO (VerificationKey StakePoolKey)
forall a b. (a -> b) -> a -> b
$
        ColdVerificationKeyOrFile
-> IO
     (Either
        (FileError TextEnvelopeError) (VerificationKey StakePoolKey))
readColdVerificationKeyOrFile ColdVerificationKeyOrFile
coldVkeyFile

    let ocertIssueCounter :: OperationalCertificateIssueCounter
ocertIssueCounter =
          Word64
-> VerificationKey StakePoolKey
-> OperationalCertificateIssueCounter
OperationalCertificateIssueCounter (Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
counter) VerificationKey StakePoolKey
vkey

    (FileError () -> NodeCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT NodeCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> NodeCmdError
NodeCmdWriteFileError (ExceptT (FileError ()) IO () -> ExceptT NodeCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT NodeCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError ()) ()) -> ExceptT NodeCmdError IO ())
-> IO (Either (FileError ()) ()) -> ExceptT NodeCmdError IO ()
forall a b. (a -> b) -> a -> b
$
      OpCertCounterFile 'Out
-> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile (OpCertCounterFile 'InOut -> OpCertCounterFile 'Out
forall content. File content 'InOut -> File content 'Out
onlyOut OpCertCounterFile 'InOut
mOutFile) (ByteString -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$
        Maybe TextEnvelopeDescr
-> OperationalCertificateIssueCounter -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON Maybe TextEnvelopeDescr
forall a. Maybe a
Nothing OperationalCertificateIssueCounter
ocertIssueCounter

runNodeIssueOpCertCmd
  :: ()
  => Cmd.NodeIssueOpCertCmdArgs
  -> ExceptT NodeCmdError IO ()
runNodeIssueOpCertCmd :: NodeIssueOpCertCmdArgs -> ExceptT NodeCmdError IO ()
runNodeIssueOpCertCmd
  Cmd.NodeIssueOpCertCmdArgs
    { VerificationKeyOrFile KesKey
kesVkeySource :: VerificationKeyOrFile KesKey
kesVkeySource :: NodeIssueOpCertCmdArgs -> VerificationKeyOrFile KesKey
kesVkeySource
    , SigningKeyFile 'In
poolSkeyFile :: SigningKeyFile 'In
poolSkeyFile :: NodeIssueOpCertCmdArgs -> SigningKeyFile 'In
poolSkeyFile
    , OpCertCounterFile 'InOut
operationalCertificateCounterFile :: OpCertCounterFile 'InOut
operationalCertificateCounterFile :: NodeIssueOpCertCmdArgs -> OpCertCounterFile 'InOut
operationalCertificateCounterFile
    , KESPeriod
kesPeriod :: KESPeriod
kesPeriod :: NodeIssueOpCertCmdArgs -> KESPeriod
kesPeriod
    , File () 'Out
outFile :: File () 'Out
outFile :: NodeIssueOpCertCmdArgs -> File () 'Out
outFile
    } = do
    OperationalCertificateIssueCounter
ocertIssueCounter <-
      (FileError TextEnvelopeError -> NodeCmdError)
-> ExceptT
     (FileError TextEnvelopeError) IO OperationalCertificateIssueCounter
-> ExceptT NodeCmdError IO OperationalCertificateIssueCounter
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> NodeCmdError
NodeCmdReadFileError
        (ExceptT
   (FileError TextEnvelopeError) IO OperationalCertificateIssueCounter
 -> ExceptT NodeCmdError IO OperationalCertificateIssueCounter)
-> (IO
      (Either
         (FileError TextEnvelopeError) OperationalCertificateIssueCounter)
    -> ExceptT
         (FileError TextEnvelopeError)
         IO
         OperationalCertificateIssueCounter)
-> IO
     (Either
        (FileError TextEnvelopeError) OperationalCertificateIssueCounter)
-> ExceptT NodeCmdError IO OperationalCertificateIssueCounter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO
  (Either
     (FileError TextEnvelopeError) OperationalCertificateIssueCounter)
-> ExceptT
     (FileError TextEnvelopeError) IO OperationalCertificateIssueCounter
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
        (IO
   (Either
      (FileError TextEnvelopeError) OperationalCertificateIssueCounter)
 -> ExceptT NodeCmdError IO OperationalCertificateIssueCounter)
-> IO
     (Either
        (FileError TextEnvelopeError) OperationalCertificateIssueCounter)
-> ExceptT NodeCmdError IO OperationalCertificateIssueCounter
forall a b. (a -> b) -> a -> b
$ AsType OperationalCertificateIssueCounter
-> File OpCertCounter 'In
-> IO
     (Either
        (FileError TextEnvelopeError) OperationalCertificateIssueCounter)
forall a content.
HasTextEnvelope a =>
AsType a
-> File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope AsType OperationalCertificateIssueCounter
AsOperationalCertificateIssueCounter (OpCertCounterFile 'InOut -> File OpCertCounter 'In
forall content. File content 'InOut -> File content 'In
onlyIn OpCertCounterFile 'InOut
operationalCertificateCounterFile)

    VerificationKey KesKey
verKeyKes <-
      (FileError InputDecodeError -> NodeCmdError)
-> ExceptT (FileError InputDecodeError) IO (VerificationKey KesKey)
-> ExceptT NodeCmdError IO (VerificationKey KesKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError InputDecodeError -> NodeCmdError
NodeCmdReadKeyFileError (ExceptT (FileError InputDecodeError) IO (VerificationKey KesKey)
 -> ExceptT NodeCmdError IO (VerificationKey KesKey))
-> ExceptT (FileError InputDecodeError) IO (VerificationKey KesKey)
-> ExceptT NodeCmdError IO (VerificationKey KesKey)
forall a b. (a -> b) -> a -> b
$
        AsType KesKey
-> VerificationKeyOrFile KesKey
-> ExceptT (FileError InputDecodeError) IO (VerificationKey KesKey)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) keyrole.
(MonadIOTransError (FileError InputDecodeError) t m,
 HasTextEnvelope (VerificationKey keyrole),
 SerialiseAsBech32 (VerificationKey keyrole)) =>
AsType keyrole
-> VerificationKeyOrFile keyrole -> t m (VerificationKey keyrole)
readVerificationKeyOrFile AsType KesKey
AsKesKey VerificationKeyOrFile KesKey
kesVkeySource

    Either
  (SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey)
signKey <-
      (FileError InputDecodeError -> NodeCmdError)
-> ExceptT
     (FileError InputDecodeError)
     IO
     (Either
        (SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey))
-> ExceptT
     NodeCmdError
     IO
     (Either
        (SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey))
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError InputDecodeError -> NodeCmdError
NodeCmdReadKeyFileError
        (ExceptT
   (FileError InputDecodeError)
   IO
   (Either
      (SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey))
 -> ExceptT
      NodeCmdError
      IO
      (Either
         (SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey)))
-> (IO
      (Either
         (FileError InputDecodeError)
         (Either
            (SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey)))
    -> ExceptT
         (FileError InputDecodeError)
         IO
         (Either
            (SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey)))
-> IO
     (Either
        (FileError InputDecodeError)
        (Either
           (SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey)))
-> ExceptT
     NodeCmdError
     IO
     (Either
        (SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO
  (Either
     (FileError InputDecodeError)
     (Either
        (SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey)))
-> ExceptT
     (FileError InputDecodeError)
     IO
     (Either
        (SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey))
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
        (IO
   (Either
      (FileError InputDecodeError)
      (Either
         (SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey)))
 -> ExceptT
      NodeCmdError
      IO
      (Either
         (SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey)))
-> IO
     (Either
        (FileError InputDecodeError)
        (Either
           (SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey)))
-> ExceptT
     NodeCmdError
     IO
     (Either
        (SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey))
forall a b. (a -> b) -> a -> b
$ [FromSomeType
   SerialiseAsBech32
   (Either
      (SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey))]
-> [FromSomeType
      HasTextEnvelope
      (Either
         (SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey))]
-> SigningKeyFile 'In
-> IO
     (Either
        (FileError InputDecodeError)
        (Either
           (SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey)))
forall content b.
[FromSomeType SerialiseAsBech32 b]
-> [FromSomeType HasTextEnvelope b]
-> File content 'In
-> IO (Either (FileError InputDecodeError) b)
readKeyFileAnyOf
          [FromSomeType
   SerialiseAsBech32
   (Either
      (SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey))]
bech32PossibleBlockIssuers
          [FromSomeType
   HasTextEnvelope
   (Either
      (SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey))]
textEnvPossibleBlockIssuers
          SigningKeyFile 'In
poolSkeyFile

    (OperationalCertificate
ocert, OperationalCertificateIssueCounter
nextOcertCtr) <-
      (OperationalCertIssueError -> NodeCmdError)
-> ExceptT
     OperationalCertIssueError
     IO
     (OperationalCertificate, OperationalCertificateIssueCounter)
-> ExceptT
     NodeCmdError
     IO
     (OperationalCertificate, OperationalCertificateIssueCounter)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT OperationalCertIssueError -> NodeCmdError
NodeCmdOperationalCertificateIssueError
        (ExceptT
   OperationalCertIssueError
   IO
   (OperationalCertificate, OperationalCertificateIssueCounter)
 -> ExceptT
      NodeCmdError
      IO
      (OperationalCertificate, OperationalCertificateIssueCounter))
-> (Either
      OperationalCertIssueError
      (OperationalCertificate, OperationalCertificateIssueCounter)
    -> ExceptT
         OperationalCertIssueError
         IO
         (OperationalCertificate, OperationalCertificateIssueCounter))
-> Either
     OperationalCertIssueError
     (OperationalCertificate, OperationalCertificateIssueCounter)
-> ExceptT
     NodeCmdError
     IO
     (OperationalCertificate, OperationalCertificateIssueCounter)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either
  OperationalCertIssueError
  (OperationalCertificate, OperationalCertificateIssueCounter)
-> ExceptT
     OperationalCertIssueError
     IO
     (OperationalCertificate, OperationalCertificateIssueCounter)
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither
        (Either
   OperationalCertIssueError
   (OperationalCertificate, OperationalCertificateIssueCounter)
 -> ExceptT
      NodeCmdError
      IO
      (OperationalCertificate, OperationalCertificateIssueCounter))
-> Either
     OperationalCertIssueError
     (OperationalCertificate, OperationalCertificateIssueCounter)
-> ExceptT
     NodeCmdError
     IO
     (OperationalCertificate, OperationalCertificateIssueCounter)
forall a b. (a -> b) -> a -> b
$ VerificationKey KesKey
-> Either
     (SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey)
-> KESPeriod
-> OperationalCertificateIssueCounter
-> Either
     OperationalCertIssueError
     (OperationalCertificate, OperationalCertificateIssueCounter)
issueOperationalCertificate
          VerificationKey KesKey
verKeyKes
          Either
  (SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey)
signKey
          KESPeriod
kesPeriod
          OperationalCertificateIssueCounter
ocertIssueCounter

    -- Write the counter first, to reduce the chance of ending up with
    -- a new cert but without updating the counter.
    (FileError () -> NodeCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT NodeCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> NodeCmdError
NodeCmdWriteFileError
      (ExceptT (FileError ()) IO () -> ExceptT NodeCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT NodeCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
      (IO (Either (FileError ()) ()) -> ExceptT NodeCmdError IO ())
-> IO (Either (FileError ()) ()) -> ExceptT NodeCmdError IO ()
forall a b. (a -> b) -> a -> b
$ OpCertCounterFile 'Out
-> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile (OpCertCounterFile 'InOut -> OpCertCounterFile 'Out
forall content. File content 'InOut -> File content 'Out
onlyOut OpCertCounterFile 'InOut
operationalCertificateCounterFile)
      (ByteString -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$ Maybe TextEnvelopeDescr
-> OperationalCertificateIssueCounter -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just (TextEnvelopeDescr -> Maybe TextEnvelopeDescr)
-> TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a b. (a -> b) -> a -> b
$ Word64 -> TextEnvelopeDescr
ocertCtrDesc (Word64 -> TextEnvelopeDescr) -> Word64 -> TextEnvelopeDescr
forall a b. (a -> b) -> a -> b
$ OperationalCertificateIssueCounter -> Word64
getCounter OperationalCertificateIssueCounter
nextOcertCtr) OperationalCertificateIssueCounter
nextOcertCtr

    (FileError () -> NodeCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT NodeCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> NodeCmdError
NodeCmdWriteFileError
      (ExceptT (FileError ()) IO () -> ExceptT NodeCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT NodeCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
      (IO (Either (FileError ()) ()) -> ExceptT NodeCmdError IO ())
-> IO (Either (FileError ()) ()) -> ExceptT NodeCmdError IO ()
forall a b. (a -> b) -> a -> b
$ File () 'Out -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile File () 'Out
outFile
      (ByteString -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$ Maybe TextEnvelopeDescr -> OperationalCertificate -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON Maybe TextEnvelopeDescr
forall a. Maybe a
Nothing OperationalCertificate
ocert
   where
    getCounter :: OperationalCertificateIssueCounter -> Word64
    getCounter :: OperationalCertificateIssueCounter -> Word64
getCounter (OperationalCertificateIssueCounter Word64
n VerificationKey StakePoolKey
_) = Word64
n

    ocertCtrDesc :: Word64 -> TextEnvelopeDescr
    ocertCtrDesc :: Word64 -> TextEnvelopeDescr
ocertCtrDesc Word64
n = TextEnvelopeDescr
"Next certificate issue number: " TextEnvelopeDescr -> TextEnvelopeDescr -> TextEnvelopeDescr
forall a. Semigroup a => a -> a -> a
<> String -> TextEnvelopeDescr
forall a. IsString a => String -> a
fromString (Word64 -> String
forall a. Show a => a -> String
show Word64
n)

    textEnvPossibleBlockIssuers
      :: [ FromSomeType
            HasTextEnvelope
            ( Either
                (SigningKey StakePoolKey)
                (SigningKey GenesisDelegateExtendedKey)
            )
         ]
    textEnvPossibleBlockIssuers :: [FromSomeType
   HasTextEnvelope
   (Either
      (SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey))]
textEnvPossibleBlockIssuers =
      [ AsType (SigningKey StakePoolKey)
-> (SigningKey StakePoolKey
    -> Either
         (SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey))
-> FromSomeType
     HasTextEnvelope
     (Either
        (SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey))
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType StakePoolKey -> AsType (SigningKey StakePoolKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType StakePoolKey
AsStakePoolKey) SigningKey StakePoolKey
-> Either
     (SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey)
forall a b. a -> Either a b
Left
      , AsType (SigningKey GenesisDelegateKey)
-> (SigningKey GenesisDelegateKey
    -> Either
         (SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey))
-> FromSomeType
     HasTextEnvelope
     (Either
        (SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey))
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType GenesisDelegateKey -> AsType (SigningKey GenesisDelegateKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType GenesisDelegateKey
AsGenesisDelegateKey) (SigningKey StakePoolKey
-> Either
     (SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey)
forall a b. a -> Either a b
Left (SigningKey StakePoolKey
 -> Either
      (SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey))
-> (SigningKey GenesisDelegateKey -> SigningKey StakePoolKey)
-> SigningKey GenesisDelegateKey
-> Either
     (SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SigningKey GenesisDelegateKey -> SigningKey StakePoolKey
forall keyroleA keyroleB.
CastSigningKeyRole keyroleA keyroleB =>
SigningKey keyroleA -> SigningKey keyroleB
castSigningKey)
      , AsType (SigningKey GenesisDelegateExtendedKey)
-> (SigningKey GenesisDelegateExtendedKey
    -> Either
         (SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey))
-> FromSomeType
     HasTextEnvelope
     (Either
        (SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey))
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType GenesisDelegateExtendedKey
-> AsType (SigningKey GenesisDelegateExtendedKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType GenesisDelegateExtendedKey
AsGenesisDelegateExtendedKey) SigningKey GenesisDelegateExtendedKey
-> Either
     (SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey)
forall a b. b -> Either a b
Right
      ]

    bech32PossibleBlockIssuers
      :: [ FromSomeType
            SerialiseAsBech32
            ( Either
                (SigningKey StakePoolKey)
                (SigningKey GenesisDelegateExtendedKey)
            )
         ]
    bech32PossibleBlockIssuers :: [FromSomeType
   SerialiseAsBech32
   (Either
      (SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey))]
bech32PossibleBlockIssuers =
      [AsType (SigningKey StakePoolKey)
-> (SigningKey StakePoolKey
    -> Either
         (SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey))
-> FromSomeType
     SerialiseAsBech32
     (Either
        (SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey))
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType StakePoolKey -> AsType (SigningKey StakePoolKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType StakePoolKey
AsStakePoolKey) SigningKey StakePoolKey
-> Either
     (SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey)
forall a b. a -> Either a b
Left]

-- | Read a cold verification key or file.
--
-- If a filepath is provided, it will be interpreted as a text envelope
-- formatted file.
readColdVerificationKeyOrFile
  :: ColdVerificationKeyOrFile
  -> IO (Either (FileError TextEnvelopeError) (VerificationKey StakePoolKey))
readColdVerificationKeyOrFile :: ColdVerificationKeyOrFile
-> IO
     (Either
        (FileError TextEnvelopeError) (VerificationKey StakePoolKey))
readColdVerificationKeyOrFile ColdVerificationKeyOrFile
coldVerKeyOrFile =
  case ColdVerificationKeyOrFile
coldVerKeyOrFile of
    ColdStakePoolVerificationKey VerificationKey StakePoolKey
vk -> Either (FileError TextEnvelopeError) (VerificationKey StakePoolKey)
-> IO
     (Either
        (FileError TextEnvelopeError) (VerificationKey StakePoolKey))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VerificationKey StakePoolKey
-> Either
     (FileError TextEnvelopeError) (VerificationKey StakePoolKey)
forall a b. b -> Either a b
Right VerificationKey StakePoolKey
vk)
    ColdGenesisDelegateVerificationKey VerificationKey GenesisDelegateKey
vk ->
      Either (FileError TextEnvelopeError) (VerificationKey StakePoolKey)
-> IO
     (Either
        (FileError TextEnvelopeError) (VerificationKey StakePoolKey))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either
   (FileError TextEnvelopeError) (VerificationKey StakePoolKey)
 -> IO
      (Either
         (FileError TextEnvelopeError) (VerificationKey StakePoolKey)))
-> Either
     (FileError TextEnvelopeError) (VerificationKey StakePoolKey)
-> IO
     (Either
        (FileError TextEnvelopeError) (VerificationKey StakePoolKey))
forall a b. (a -> b) -> a -> b
$ VerificationKey StakePoolKey
-> Either
     (FileError TextEnvelopeError) (VerificationKey StakePoolKey)
forall a b. b -> Either a b
Right (VerificationKey GenesisDelegateKey -> VerificationKey StakePoolKey
forall keyroleA keyroleB.
CastVerificationKeyRole keyroleA keyroleB =>
VerificationKey keyroleA -> VerificationKey keyroleB
castVerificationKey VerificationKey GenesisDelegateKey
vk)
    ColdVerificationKeyFile VerificationKeyFile 'In
fp ->
      [FromSomeType HasTextEnvelope (VerificationKey StakePoolKey)]
-> VerificationKeyFile 'In
-> IO
     (Either
        (FileError TextEnvelopeError) (VerificationKey StakePoolKey))
forall b content.
[FromSomeType HasTextEnvelope b]
-> File content 'In -> IO (Either (FileError TextEnvelopeError) b)
readFileTextEnvelopeAnyOf
        [ AsType (VerificationKey StakePoolKey)
-> (VerificationKey StakePoolKey -> VerificationKey StakePoolKey)
-> FromSomeType HasTextEnvelope (VerificationKey StakePoolKey)
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType StakePoolKey -> AsType (VerificationKey StakePoolKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType StakePoolKey
AsStakePoolKey) VerificationKey StakePoolKey -> VerificationKey StakePoolKey
forall a. a -> a
id
        , AsType (VerificationKey GenesisDelegateKey)
-> (VerificationKey GenesisDelegateKey
    -> VerificationKey StakePoolKey)
-> FromSomeType HasTextEnvelope (VerificationKey StakePoolKey)
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType GenesisDelegateKey
-> AsType (VerificationKey GenesisDelegateKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType GenesisDelegateKey
AsGenesisDelegateKey) VerificationKey GenesisDelegateKey -> VerificationKey StakePoolKey
forall keyroleA keyroleB.
CastVerificationKeyRole keyroleA keyroleB =>
VerificationKey keyroleA -> VerificationKey keyroleB
castVerificationKey
        ]
        VerificationKeyFile 'In
fp