{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}

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

import Cardano.Api

import Cardano.CLI.Compatible.Exception
import Cardano.CLI.EraIndependent.Node.Command qualified as Cmd
import Cardano.CLI.Type.Common
import Cardano.CLI.Type.Key

import Data.Function ((&))
import Data.String (fromString)
import Data.Word (Word64)
import Vary qualified

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

runNodeKeyGenColdCmd
  :: ()
  => Cmd.NodeKeyGenColdCmdArgs
  -> CIO e ()
runNodeKeyGenColdCmd :: forall e. NodeKeyGenColdCmdArgs -> CIO e ()
runNodeKeyGenColdCmd
  Cmd.NodeKeyGenColdCmdArgs
    { Vary '[FormatBech32, FormatTextEnvelope]
keyOutputFormat :: Vary '[FormatBech32, FormatTextEnvelope]
keyOutputFormat :: NodeKeyGenColdCmdArgs -> Vary '[FormatBech32, FormatTextEnvelope]
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 -> RIO e (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

    Vary '[FormatBech32, FormatTextEnvelope]
keyOutputFormat
      Vary '[FormatBech32, FormatTextEnvelope]
-> (Vary '[FormatBech32, FormatTextEnvelope] -> RIO e ())
-> RIO e ()
forall a b. a -> (a -> b) -> b
& ( (Vary '[FormatBech32, FormatTextEnvelope] -> RIO e ())
-> Vary '[FormatBech32, FormatTextEnvelope] -> RIO e ()
forall a. a -> a
id
            ((Vary '[FormatBech32, FormatTextEnvelope] -> RIO e ())
 -> Vary '[FormatBech32, FormatTextEnvelope] -> RIO e ())
-> ((Vary '[] -> RIO e ())
    -> Vary '[FormatBech32, FormatTextEnvelope] -> RIO e ())
-> (Vary '[] -> RIO e ())
-> Vary '[FormatBech32, FormatTextEnvelope]
-> RIO e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatBech32 -> RIO e ())
-> (Vary '[FormatTextEnvelope] -> RIO e ())
-> Vary '[FormatBech32, FormatTextEnvelope]
-> RIO e ()
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on
              ( \FormatBech32
FormatBech32 ->
                  forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ())
                    (IO (Either (FileError ()) ()) -> RIO e ())
-> (Text -> IO (Either (FileError ()) ())) -> Text -> RIO e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> RIO e ()) -> Text -> RIO e ()
forall a b. (a -> b) -> a -> b
$ SigningKey StakePoolKey -> Text
forall a. SerialiseAsBech32 a => a -> Text
serialiseToBech32 SigningKey StakePoolKey
skey
              )
            ((Vary '[FormatTextEnvelope] -> RIO e ())
 -> Vary '[FormatBech32, FormatTextEnvelope] -> RIO e ())
-> ((Vary '[] -> RIO e ())
    -> Vary '[FormatTextEnvelope] -> RIO e ())
-> (Vary '[] -> RIO e ())
-> Vary '[FormatBech32, FormatTextEnvelope]
-> RIO e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatTextEnvelope -> RIO e ())
-> (Vary '[] -> RIO e ()) -> Vary '[FormatTextEnvelope] -> RIO e ()
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on
              ( \FormatTextEnvelope
FormatTextEnvelope ->
                  forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ()) -> RIO e ())
-> (ByteString -> IO (Either (FileError ()) ()))
-> ByteString
-> RIO e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> RIO e ()) -> ByteString -> RIO e ()
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
              )
            ((Vary '[] -> RIO e ())
 -> Vary '[FormatBech32, FormatTextEnvelope] -> RIO e ())
-> (Vary '[] -> RIO e ())
-> Vary '[FormatBech32, FormatTextEnvelope]
-> RIO e ()
forall a b. (a -> b) -> a -> b
$ Vary '[] -> RIO e ()
forall anything. Vary '[] -> anything
Vary.exhaustiveCase
        )

    Vary '[FormatBech32, FormatTextEnvelope]
keyOutputFormat
      Vary '[FormatBech32, FormatTextEnvelope]
-> (Vary '[FormatBech32, FormatTextEnvelope] -> RIO e ())
-> RIO e ()
forall a b. a -> (a -> b) -> b
& ( (Vary '[FormatBech32, FormatTextEnvelope] -> RIO e ())
-> Vary '[FormatBech32, FormatTextEnvelope] -> RIO e ()
forall a. a -> a
id
            ((Vary '[FormatBech32, FormatTextEnvelope] -> RIO e ())
 -> Vary '[FormatBech32, FormatTextEnvelope] -> RIO e ())
-> ((Vary '[] -> RIO e ())
    -> Vary '[FormatBech32, FormatTextEnvelope] -> RIO e ())
-> (Vary '[] -> RIO e ())
-> Vary '[FormatBech32, FormatTextEnvelope]
-> RIO e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatBech32 -> RIO e ())
-> (Vary '[FormatTextEnvelope] -> RIO e ())
-> Vary '[FormatBech32, FormatTextEnvelope]
-> RIO e ()
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on
              ( \FormatBech32
FormatBech32 ->
                  forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ())
                    (IO (Either (FileError ()) ()) -> RIO e ())
-> (Text -> IO (Either (FileError ()) ())) -> Text -> RIO e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> RIO e ()) -> Text -> RIO e ()
forall a b. (a -> b) -> a -> b
$ VerificationKey StakePoolKey -> Text
forall a. SerialiseAsBech32 a => a -> Text
serialiseToBech32 VerificationKey StakePoolKey
vkey
              )
            ((Vary '[FormatTextEnvelope] -> RIO e ())
 -> Vary '[FormatBech32, FormatTextEnvelope] -> RIO e ())
-> ((Vary '[] -> RIO e ())
    -> Vary '[FormatTextEnvelope] -> RIO e ())
-> (Vary '[] -> RIO e ())
-> Vary '[FormatBech32, FormatTextEnvelope]
-> RIO e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatTextEnvelope -> RIO e ())
-> (Vary '[] -> RIO e ()) -> Vary '[FormatTextEnvelope] -> RIO e ()
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on
              ( \FormatTextEnvelope
FormatTextEnvelope ->
                  forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ())
                    (IO (Either (FileError ()) ()) -> RIO e ())
-> (ByteString -> IO (Either (FileError ()) ()))
-> ByteString
-> RIO e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> RIO e ()) -> ByteString -> RIO e ()
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
              )
            ((Vary '[] -> RIO e ())
 -> Vary '[FormatBech32, FormatTextEnvelope] -> RIO e ())
-> (Vary '[] -> RIO e ())
-> Vary '[FormatBech32, FormatTextEnvelope]
-> RIO e ()
forall a b. (a -> b) -> a -> b
$ Vary '[] -> RIO e ()
forall anything. Vary '[] -> anything
Vary.exhaustiveCase
        )

    forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
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
  -> CIO e ()
runNodeKeyGenKesCmd :: forall e. NodeKeyGenKESCmdArgs -> CIO e ()
runNodeKeyGenKesCmd
  Cmd.NodeKeyGenKESCmdArgs
    { Vary '[FormatBech32, FormatTextEnvelope]
keyOutputFormat :: Vary '[FormatBech32, FormatTextEnvelope]
keyOutputFormat :: NodeKeyGenKESCmdArgs -> Vary '[FormatBech32, FormatTextEnvelope]
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 -> RIO e (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

    Vary '[FormatBech32, FormatTextEnvelope]
keyOutputFormat
      Vary '[FormatBech32, FormatTextEnvelope]
-> (Vary '[FormatBech32, FormatTextEnvelope] -> RIO e ())
-> RIO e ()
forall a b. a -> (a -> b) -> b
& ( (Vary '[FormatBech32, FormatTextEnvelope] -> RIO e ())
-> Vary '[FormatBech32, FormatTextEnvelope] -> RIO e ()
forall a. a -> a
id
            ((Vary '[FormatBech32, FormatTextEnvelope] -> RIO e ())
 -> Vary '[FormatBech32, FormatTextEnvelope] -> RIO e ())
-> ((Vary '[] -> RIO e ())
    -> Vary '[FormatBech32, FormatTextEnvelope] -> RIO e ())
-> (Vary '[] -> RIO e ())
-> Vary '[FormatBech32, FormatTextEnvelope]
-> RIO e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatBech32 -> RIO e ())
-> (Vary '[FormatTextEnvelope] -> RIO e ())
-> Vary '[FormatBech32, FormatTextEnvelope]
-> RIO e ()
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on
              ( \FormatBech32
FormatBech32 ->
                  forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ())
                    (IO (Either (FileError ()) ()) -> RIO e ())
-> (Text -> IO (Either (FileError ()) ())) -> Text -> RIO e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> RIO e ()) -> Text -> RIO e ()
forall a b. (a -> b) -> a -> b
$ SigningKey KesKey -> Text
forall a. SerialiseAsBech32 a => a -> Text
serialiseToBech32 SigningKey KesKey
skey
              )
            ((Vary '[FormatTextEnvelope] -> RIO e ())
 -> Vary '[FormatBech32, FormatTextEnvelope] -> RIO e ())
-> ((Vary '[] -> RIO e ())
    -> Vary '[FormatTextEnvelope] -> RIO e ())
-> (Vary '[] -> RIO e ())
-> Vary '[FormatBech32, FormatTextEnvelope]
-> RIO e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatTextEnvelope -> RIO e ())
-> (Vary '[] -> RIO e ()) -> Vary '[FormatTextEnvelope] -> RIO e ()
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on
              ( \FormatTextEnvelope
FormatTextEnvelope ->
                  forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ())
                    (IO (Either (FileError ()) ()) -> RIO e ())
-> (ByteString -> IO (Either (FileError ()) ()))
-> ByteString
-> RIO e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SigningKeyFile 'Out -> ByteString -> IO (Either (FileError ()) ())
forall content e.
File content 'Out -> ByteString -> IO (Either (FileError e) ())
writeLazyByteStringFileWithOwnerPermissions SigningKeyFile 'Out
skeyFile
                    (ByteString -> RIO e ()) -> ByteString -> RIO e ()
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
              )
            ((Vary '[] -> RIO e ())
 -> Vary '[FormatBech32, FormatTextEnvelope] -> RIO e ())
-> (Vary '[] -> RIO e ())
-> Vary '[FormatBech32, FormatTextEnvelope]
-> RIO e ()
forall a b. (a -> b) -> a -> b
$ Vary '[] -> RIO e ()
forall anything. Vary '[] -> anything
Vary.exhaustiveCase
        )

    Vary '[FormatBech32, FormatTextEnvelope]
keyOutputFormat
      Vary '[FormatBech32, FormatTextEnvelope]
-> (Vary '[FormatBech32, FormatTextEnvelope] -> RIO e ())
-> RIO e ()
forall a b. a -> (a -> b) -> b
& ( (Vary '[FormatBech32, FormatTextEnvelope] -> RIO e ())
-> Vary '[FormatBech32, FormatTextEnvelope] -> RIO e ()
forall a. a -> a
id
            ((Vary '[FormatBech32, FormatTextEnvelope] -> RIO e ())
 -> Vary '[FormatBech32, FormatTextEnvelope] -> RIO e ())
-> ((Vary '[] -> RIO e ())
    -> Vary '[FormatBech32, FormatTextEnvelope] -> RIO e ())
-> (Vary '[] -> RIO e ())
-> Vary '[FormatBech32, FormatTextEnvelope]
-> RIO e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatBech32 -> RIO e ())
-> (Vary '[FormatTextEnvelope] -> RIO e ())
-> Vary '[FormatBech32, FormatTextEnvelope]
-> RIO e ()
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on
              ( \FormatBech32
FormatBech32 ->
                  forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ())
                    (IO (Either (FileError ()) ()) -> RIO e ())
-> (Text -> IO (Either (FileError ()) ())) -> Text -> RIO e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> RIO e ()) -> Text -> RIO e ()
forall a b. (a -> b) -> a -> b
$ VerificationKey KesKey -> Text
forall a. SerialiseAsBech32 a => a -> Text
serialiseToBech32 VerificationKey KesKey
vkey
              )
            ((Vary '[FormatTextEnvelope] -> RIO e ())
 -> Vary '[FormatBech32, FormatTextEnvelope] -> RIO e ())
-> ((Vary '[] -> RIO e ())
    -> Vary '[FormatTextEnvelope] -> RIO e ())
-> (Vary '[] -> RIO e ())
-> Vary '[FormatBech32, FormatTextEnvelope]
-> RIO e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatTextEnvelope -> RIO e ())
-> (Vary '[] -> RIO e ()) -> Vary '[FormatTextEnvelope] -> RIO e ()
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on
              ( \FormatTextEnvelope
FormatTextEnvelope ->
                  forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ())
                    (IO (Either (FileError ()) ()) -> RIO e ())
-> (ByteString -> IO (Either (FileError ()) ()))
-> ByteString
-> RIO e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> RIO e ()) -> ByteString -> RIO e ()
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
              )
            ((Vary '[] -> RIO e ())
 -> Vary '[FormatBech32, FormatTextEnvelope] -> RIO e ())
-> (Vary '[] -> RIO e ())
-> Vary '[FormatBech32, FormatTextEnvelope]
-> RIO e ()
forall a b. (a -> b) -> a -> b
$ Vary '[] -> RIO e ()
forall anything. Vary '[] -> anything
Vary.exhaustiveCase
        )
   where
    skeyDesc :: TextEnvelopeDescr
    skeyDesc :: TextEnvelopeDescr
skeyDesc = TextEnvelopeDescr
"KES Signing Key"

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

runNodeKeyGenVrfCmd
  :: ()
  => Cmd.NodeKeyGenVRFCmdArgs
  -> CIO e ()
runNodeKeyGenVrfCmd :: forall e. NodeKeyGenVRFCmdArgs -> CIO e ()
runNodeKeyGenVrfCmd
  Cmd.NodeKeyGenVRFCmdArgs
    { Vary '[FormatBech32, FormatTextEnvelope]
keyOutputFormat :: Vary '[FormatBech32, FormatTextEnvelope]
keyOutputFormat :: NodeKeyGenVRFCmdArgs -> Vary '[FormatBech32, FormatTextEnvelope]
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 -> RIO e (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

    Vary '[FormatBech32, FormatTextEnvelope]
keyOutputFormat
      Vary '[FormatBech32, FormatTextEnvelope]
-> (Vary '[FormatBech32, FormatTextEnvelope] -> RIO e ())
-> RIO e ()
forall a b. a -> (a -> b) -> b
& ( (Vary '[FormatBech32, FormatTextEnvelope] -> RIO e ())
-> Vary '[FormatBech32, FormatTextEnvelope] -> RIO e ()
forall a. a -> a
id
            ((Vary '[FormatBech32, FormatTextEnvelope] -> RIO e ())
 -> Vary '[FormatBech32, FormatTextEnvelope] -> RIO e ())
-> ((Vary '[] -> RIO e ())
    -> Vary '[FormatBech32, FormatTextEnvelope] -> RIO e ())
-> (Vary '[] -> RIO e ())
-> Vary '[FormatBech32, FormatTextEnvelope]
-> RIO e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatBech32 -> RIO e ())
-> (Vary '[FormatTextEnvelope] -> RIO e ())
-> Vary '[FormatBech32, FormatTextEnvelope]
-> RIO e ()
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on
              ( \FormatBech32
FormatBech32 ->
                  forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ())
                    (IO (Either (FileError ()) ()) -> RIO e ())
-> (Text -> IO (Either (FileError ()) ())) -> Text -> RIO e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> RIO e ()) -> Text -> RIO e ()
forall a b. (a -> b) -> a -> b
$ SigningKey VrfKey -> Text
forall a. SerialiseAsBech32 a => a -> Text
serialiseToBech32 SigningKey VrfKey
skey
              )
            ((Vary '[FormatTextEnvelope] -> RIO e ())
 -> Vary '[FormatBech32, FormatTextEnvelope] -> RIO e ())
-> ((Vary '[] -> RIO e ())
    -> Vary '[FormatTextEnvelope] -> RIO e ())
-> (Vary '[] -> RIO e ())
-> Vary '[FormatBech32, FormatTextEnvelope]
-> RIO e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatTextEnvelope -> RIO e ())
-> (Vary '[] -> RIO e ()) -> Vary '[FormatTextEnvelope] -> RIO e ()
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on
              ( \FormatTextEnvelope
FormatTextEnvelope ->
                  forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ())
                    (IO (Either (FileError ()) ()) -> RIO e ())
-> (ByteString -> IO (Either (FileError ()) ()))
-> ByteString
-> RIO e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SigningKeyFile 'Out -> ByteString -> IO (Either (FileError ()) ())
forall content e.
File content 'Out -> ByteString -> IO (Either (FileError e) ())
writeLazyByteStringFileWithOwnerPermissions SigningKeyFile 'Out
skeyFile
                    (ByteString -> RIO e ()) -> ByteString -> RIO e ()
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
              )
            ((Vary '[] -> RIO e ())
 -> Vary '[FormatBech32, FormatTextEnvelope] -> RIO e ())
-> (Vary '[] -> RIO e ())
-> Vary '[FormatBech32, FormatTextEnvelope]
-> RIO e ()
forall a b. (a -> b) -> a -> b
$ Vary '[] -> RIO e ()
forall anything. Vary '[] -> anything
Vary.exhaustiveCase
        )

    Vary '[FormatBech32, FormatTextEnvelope]
keyOutputFormat
      Vary '[FormatBech32, FormatTextEnvelope]
-> (Vary '[FormatBech32, FormatTextEnvelope] -> RIO e ())
-> RIO e ()
forall a b. a -> (a -> b) -> b
& ( (Vary '[FormatBech32, FormatTextEnvelope] -> RIO e ())
-> Vary '[FormatBech32, FormatTextEnvelope] -> RIO e ()
forall a. a -> a
id
            ((Vary '[FormatBech32, FormatTextEnvelope] -> RIO e ())
 -> Vary '[FormatBech32, FormatTextEnvelope] -> RIO e ())
-> ((Vary '[] -> RIO e ())
    -> Vary '[FormatBech32, FormatTextEnvelope] -> RIO e ())
-> (Vary '[] -> RIO e ())
-> Vary '[FormatBech32, FormatTextEnvelope]
-> RIO e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatBech32 -> RIO e ())
-> (Vary '[FormatTextEnvelope] -> RIO e ())
-> Vary '[FormatBech32, FormatTextEnvelope]
-> RIO e ()
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on
              ( \FormatBech32
FormatBech32 ->
                  forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
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
              )
            ((Vary '[FormatTextEnvelope] -> RIO e ())
 -> Vary '[FormatBech32, FormatTextEnvelope] -> RIO e ())
-> ((Vary '[] -> RIO e ())
    -> Vary '[FormatTextEnvelope] -> RIO e ())
-> (Vary '[] -> RIO e ())
-> Vary '[FormatBech32, FormatTextEnvelope]
-> RIO e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatTextEnvelope -> RIO e ())
-> (Vary '[] -> RIO e ()) -> Vary '[FormatTextEnvelope] -> RIO e ()
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on
              ( \FormatTextEnvelope
FormatTextEnvelope ->
                  forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
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
              )
            ((Vary '[] -> RIO e ())
 -> Vary '[FormatBech32, FormatTextEnvelope] -> RIO e ())
-> (Vary '[] -> RIO e ())
-> Vary '[FormatBech32, FormatTextEnvelope]
-> RIO e ()
forall a b. (a -> b) -> a -> b
$ Vary '[] -> RIO e ()
forall anything. Vary '[] -> anything
Vary.exhaustiveCase
        )
   where
    skeyDesc, vkeyDesc :: TextEnvelopeDescr
    skeyDesc :: TextEnvelopeDescr
skeyDesc = TextEnvelopeDescr
"VRF Signing Key"
    vkeyDesc :: TextEnvelopeDescr
vkeyDesc = TextEnvelopeDescr
"VRF Verification Key"

runNodeKeyHashVrfCmd
  :: ()
  => Cmd.NodeKeyHashVRFCmdArgs
  -> CIO e ()
runNodeKeyHashVrfCmd :: forall e. NodeKeyHashVRFCmdArgs -> CIO e ()
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 <-
      VerificationKeyOrFile VrfKey -> CIO e (VerificationKey VrfKey)
forall keyrole e.
(HasTextEnvelope (VerificationKey keyrole),
 SerialiseAsBech32 (VerificationKey keyrole)) =>
VerificationKeyOrFile keyrole -> CIO e (VerificationKey keyrole)
readVerificationKeyOrFile 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)

    forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$
      Maybe (File () 'Out) -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
Maybe (File content 'Out)
-> ByteString -> m (Either (FileError e) ())
writeByteStringOutput Maybe (File () 'Out)
mOutFile ByteString
hexKeyHash

runNodeNewCounterCmd
  :: ()
  => Cmd.NodeNewCounterCmdArgs
  -> CIO e ()
runNodeNewCounterCmd :: forall e. NodeNewCounterCmdArgs -> CIO e ()
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
    AnyStakePoolVerificationKey
vkey <-
      IO
  (Either (FileError TextEnvelopeError) AnyStakePoolVerificationKey)
-> RIO e AnyStakePoolVerificationKey
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli (IO
   (Either (FileError TextEnvelopeError) AnyStakePoolVerificationKey)
 -> RIO e AnyStakePoolVerificationKey)
-> IO
     (Either (FileError TextEnvelopeError) AnyStakePoolVerificationKey)
-> RIO e AnyStakePoolVerificationKey
forall a b. (a -> b) -> a -> b
$
        ColdVerificationKeyOrFile
-> IO
     (Either (FileError TextEnvelopeError) AnyStakePoolVerificationKey)
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)
            ( case AnyStakePoolVerificationKey
vkey of
                AnyStakePoolNormalVerificationKey VerificationKey StakePoolKey
normalStakePoolVKey -> VerificationKey StakePoolKey
normalStakePoolVKey
                AnyStakePoolExtendedVerificationKey VerificationKey StakePoolExtendedKey
extendedStakePoolVKey ->
                  VerificationKey StakePoolExtendedKey
-> VerificationKey StakePoolKey
forall keyroleA keyroleB.
CastVerificationKeyRole keyroleA keyroleB =>
VerificationKey keyroleA -> VerificationKey keyroleB
castVerificationKey VerificationKey StakePoolExtendedKey
extendedStakePoolVKey
            )

    forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
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
  -> CIO e ()
runNodeIssueOpCertCmd :: forall e. NodeIssueOpCertCmdArgs -> CIO e ()
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 <-
      IO
  (Either
     (FileError TextEnvelopeError) OperationalCertificateIssueCounter)
-> RIO e OperationalCertificateIssueCounter
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli (IO
   (Either
      (FileError TextEnvelopeError) OperationalCertificateIssueCounter)
 -> RIO e OperationalCertificateIssueCounter)
-> IO
     (Either
        (FileError TextEnvelopeError) OperationalCertificateIssueCounter)
-> RIO e OperationalCertificateIssueCounter
forall a b. (a -> b) -> a -> b
$
        File OpCertCounter 'In
-> IO
     (Either
        (FileError TextEnvelopeError) OperationalCertificateIssueCounter)
forall a content.
HasTextEnvelope a =>
File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope (OpCertCounterFile 'InOut -> File OpCertCounter 'In
forall content. File content 'InOut -> File content 'In
onlyIn OpCertCounterFile 'InOut
operationalCertificateCounterFile)

    VerificationKey KesKey
verKeyKes <-
      VerificationKeyOrFile KesKey -> CIO e (VerificationKey KesKey)
forall keyrole e.
(HasTextEnvelope (VerificationKey keyrole),
 SerialiseAsBech32 (VerificationKey keyrole)) =>
VerificationKeyOrFile keyrole -> CIO e (VerificationKey keyrole)
readVerificationKeyOrFile VerificationKeyOrFile KesKey
kesVkeySource

    Either
  AnyStakePoolSigningKey (SigningKey GenesisDelegateExtendedKey)
signKey <-
      IO
  (Either
     (FileError InputDecodeError)
     (Either
        AnyStakePoolSigningKey (SigningKey GenesisDelegateExtendedKey)))
-> RIO
     e
     (Either
        AnyStakePoolSigningKey (SigningKey GenesisDelegateExtendedKey))
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli (IO
   (Either
      (FileError InputDecodeError)
      (Either
         AnyStakePoolSigningKey (SigningKey GenesisDelegateExtendedKey)))
 -> RIO
      e
      (Either
         AnyStakePoolSigningKey (SigningKey GenesisDelegateExtendedKey)))
-> IO
     (Either
        (FileError InputDecodeError)
        (Either
           AnyStakePoolSigningKey (SigningKey GenesisDelegateExtendedKey)))
-> RIO
     e
     (Either
        AnyStakePoolSigningKey (SigningKey GenesisDelegateExtendedKey))
forall a b. (a -> b) -> a -> b
$
        [FromSomeType
   SerialiseAsBech32
   (Either
      AnyStakePoolSigningKey (SigningKey GenesisDelegateExtendedKey))]
-> [FromSomeType
      HasTextEnvelope
      (Either
         AnyStakePoolSigningKey (SigningKey GenesisDelegateExtendedKey))]
-> SigningKeyFile 'In
-> IO
     (Either
        (FileError InputDecodeError)
        (Either
           AnyStakePoolSigningKey (SigningKey GenesisDelegateExtendedKey)))
forall content b.
[FromSomeType SerialiseAsBech32 b]
-> [FromSomeType HasTextEnvelope b]
-> File content 'In
-> IO (Either (FileError InputDecodeError) b)
readFormattedFileAnyOf
          [FromSomeType
   SerialiseAsBech32
   (Either
      AnyStakePoolSigningKey (SigningKey GenesisDelegateExtendedKey))]
bech32PossibleBlockIssuers
          [FromSomeType
   HasTextEnvelope
   (Either
      AnyStakePoolSigningKey (SigningKey GenesisDelegateExtendedKey))]
textEnvPossibleBlockIssuers
          SigningKeyFile 'In
poolSkeyFile

    (OperationalCertificate
ocert, OperationalCertificateIssueCounter
nextOcertCtr) <-
      Either
  OperationalCertIssueError
  (OperationalCertificate, OperationalCertificateIssueCounter)
-> RIO
     e (OperationalCertificate, OperationalCertificateIssueCounter)
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
Either e a -> m a
fromEitherCli (Either
   OperationalCertIssueError
   (OperationalCertificate, OperationalCertificateIssueCounter)
 -> RIO
      e (OperationalCertificate, OperationalCertificateIssueCounter))
-> Either
     OperationalCertIssueError
     (OperationalCertificate, OperationalCertificateIssueCounter)
-> RIO
     e (OperationalCertificate, OperationalCertificateIssueCounter)
forall a b. (a -> b) -> a -> b
$
        VerificationKey KesKey
-> Either
     AnyStakePoolSigningKey (SigningKey GenesisDelegateExtendedKey)
-> KESPeriod
-> OperationalCertificateIssueCounter
-> Either
     OperationalCertIssueError
     (OperationalCertificate, OperationalCertificateIssueCounter)
issueOperationalCertificate
          VerificationKey KesKey
verKeyKes
          Either
  AnyStakePoolSigningKey (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.
    forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
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

    forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
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
                 AnyStakePoolSigningKey
                 (SigningKey GenesisDelegateExtendedKey)
             )
         ]
    textEnvPossibleBlockIssuers :: [FromSomeType
   HasTextEnvelope
   (Either
      AnyStakePoolSigningKey (SigningKey GenesisDelegateExtendedKey))]
textEnvPossibleBlockIssuers =
      [ AsType (SigningKey StakePoolKey)
-> (SigningKey StakePoolKey
    -> Either
         AnyStakePoolSigningKey (SigningKey GenesisDelegateExtendedKey))
-> FromSomeType
     HasTextEnvelope
     (Either
        AnyStakePoolSigningKey (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) (AnyStakePoolSigningKey
-> Either
     AnyStakePoolSigningKey (SigningKey GenesisDelegateExtendedKey)
forall a b. a -> Either a b
Left (AnyStakePoolSigningKey
 -> Either
      AnyStakePoolSigningKey (SigningKey GenesisDelegateExtendedKey))
-> (SigningKey StakePoolKey -> AnyStakePoolSigningKey)
-> SigningKey StakePoolKey
-> Either
     AnyStakePoolSigningKey (SigningKey GenesisDelegateExtendedKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SigningKey StakePoolKey -> AnyStakePoolSigningKey
AnyStakePoolNormalSigningKey)
      , AsType (SigningKey StakePoolExtendedKey)
-> (SigningKey StakePoolExtendedKey
    -> Either
         AnyStakePoolSigningKey (SigningKey GenesisDelegateExtendedKey))
-> FromSomeType
     HasTextEnvelope
     (Either
        AnyStakePoolSigningKey (SigningKey GenesisDelegateExtendedKey))
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType StakePoolExtendedKey
-> AsType (SigningKey StakePoolExtendedKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType StakePoolExtendedKey
AsStakePoolExtendedKey) (AnyStakePoolSigningKey
-> Either
     AnyStakePoolSigningKey (SigningKey GenesisDelegateExtendedKey)
forall a b. a -> Either a b
Left (AnyStakePoolSigningKey
 -> Either
      AnyStakePoolSigningKey (SigningKey GenesisDelegateExtendedKey))
-> (SigningKey StakePoolExtendedKey -> AnyStakePoolSigningKey)
-> SigningKey StakePoolExtendedKey
-> Either
     AnyStakePoolSigningKey (SigningKey GenesisDelegateExtendedKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SigningKey StakePoolExtendedKey -> AnyStakePoolSigningKey
AnyStakePoolExtendedSigningKey)
      , AsType (SigningKey GenesisDelegateKey)
-> (SigningKey GenesisDelegateKey
    -> Either
         AnyStakePoolSigningKey (SigningKey GenesisDelegateExtendedKey))
-> FromSomeType
     HasTextEnvelope
     (Either
        AnyStakePoolSigningKey (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)
          (AnyStakePoolSigningKey
-> Either
     AnyStakePoolSigningKey (SigningKey GenesisDelegateExtendedKey)
forall a b. a -> Either a b
Left (AnyStakePoolSigningKey
 -> Either
      AnyStakePoolSigningKey (SigningKey GenesisDelegateExtendedKey))
-> (SigningKey GenesisDelegateKey -> AnyStakePoolSigningKey)
-> SigningKey GenesisDelegateKey
-> Either
     AnyStakePoolSigningKey (SigningKey GenesisDelegateExtendedKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SigningKey StakePoolKey -> AnyStakePoolSigningKey
AnyStakePoolNormalSigningKey (SigningKey StakePoolKey -> AnyStakePoolSigningKey)
-> (SigningKey GenesisDelegateKey -> SigningKey StakePoolKey)
-> SigningKey GenesisDelegateKey
-> AnyStakePoolSigningKey
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
         AnyStakePoolSigningKey (SigningKey GenesisDelegateExtendedKey))
-> FromSomeType
     HasTextEnvelope
     (Either
        AnyStakePoolSigningKey (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
     AnyStakePoolSigningKey (SigningKey GenesisDelegateExtendedKey)
forall a b. b -> Either a b
Right
      ]

    bech32PossibleBlockIssuers
      :: [ FromSomeType
             SerialiseAsBech32
             ( Either
                 AnyStakePoolSigningKey
                 (SigningKey GenesisDelegateExtendedKey)
             )
         ]
    bech32PossibleBlockIssuers :: [FromSomeType
   SerialiseAsBech32
   (Either
      AnyStakePoolSigningKey (SigningKey GenesisDelegateExtendedKey))]
bech32PossibleBlockIssuers =
      [ AsType (SigningKey StakePoolKey)
-> (SigningKey StakePoolKey
    -> Either
         AnyStakePoolSigningKey (SigningKey GenesisDelegateExtendedKey))
-> FromSomeType
     SerialiseAsBech32
     (Either
        AnyStakePoolSigningKey (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) (AnyStakePoolSigningKey
-> Either
     AnyStakePoolSigningKey (SigningKey GenesisDelegateExtendedKey)
forall a b. a -> Either a b
Left (AnyStakePoolSigningKey
 -> Either
      AnyStakePoolSigningKey (SigningKey GenesisDelegateExtendedKey))
-> (SigningKey StakePoolKey -> AnyStakePoolSigningKey)
-> SigningKey StakePoolKey
-> Either
     AnyStakePoolSigningKey (SigningKey GenesisDelegateExtendedKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SigningKey StakePoolKey -> AnyStakePoolSigningKey
AnyStakePoolNormalSigningKey)
      , AsType (SigningKey StakePoolExtendedKey)
-> (SigningKey StakePoolExtendedKey
    -> Either
         AnyStakePoolSigningKey (SigningKey GenesisDelegateExtendedKey))
-> FromSomeType
     SerialiseAsBech32
     (Either
        AnyStakePoolSigningKey (SigningKey GenesisDelegateExtendedKey))
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType StakePoolExtendedKey
-> AsType (SigningKey StakePoolExtendedKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType StakePoolExtendedKey
AsStakePoolExtendedKey) (AnyStakePoolSigningKey
-> Either
     AnyStakePoolSigningKey (SigningKey GenesisDelegateExtendedKey)
forall a b. a -> Either a b
Left (AnyStakePoolSigningKey
 -> Either
      AnyStakePoolSigningKey (SigningKey GenesisDelegateExtendedKey))
-> (SigningKey StakePoolExtendedKey -> AnyStakePoolSigningKey)
-> SigningKey StakePoolExtendedKey
-> Either
     AnyStakePoolSigningKey (SigningKey GenesisDelegateExtendedKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SigningKey StakePoolExtendedKey -> AnyStakePoolSigningKey
AnyStakePoolExtendedSigningKey)
      ]

-- | 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) AnyStakePoolVerificationKey)
readColdVerificationKeyOrFile :: ColdVerificationKeyOrFile
-> IO
     (Either (FileError TextEnvelopeError) AnyStakePoolVerificationKey)
readColdVerificationKeyOrFile ColdVerificationKeyOrFile
coldVerKeyOrFile =
  case ColdVerificationKeyOrFile
coldVerKeyOrFile of
    ColdStakePoolVerificationKey AnyStakePoolVerificationKey
vk -> Either (FileError TextEnvelopeError) AnyStakePoolVerificationKey
-> IO
     (Either (FileError TextEnvelopeError) AnyStakePoolVerificationKey)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnyStakePoolVerificationKey
-> Either (FileError TextEnvelopeError) AnyStakePoolVerificationKey
forall a b. b -> Either a b
Right AnyStakePoolVerificationKey
vk)
    ColdGenesisDelegateVerificationKey VerificationKey GenesisDelegateKey
vk ->
      Either (FileError TextEnvelopeError) AnyStakePoolVerificationKey
-> IO
     (Either (FileError TextEnvelopeError) AnyStakePoolVerificationKey)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (FileError TextEnvelopeError) AnyStakePoolVerificationKey
 -> IO
      (Either (FileError TextEnvelopeError) AnyStakePoolVerificationKey))
-> Either (FileError TextEnvelopeError) AnyStakePoolVerificationKey
-> IO
     (Either (FileError TextEnvelopeError) AnyStakePoolVerificationKey)
forall a b. (a -> b) -> a -> b
$ AnyStakePoolVerificationKey
-> Either (FileError TextEnvelopeError) AnyStakePoolVerificationKey
forall a b. b -> Either a b
Right (VerificationKey StakePoolKey -> AnyStakePoolVerificationKey
AnyStakePoolNormalVerificationKey (VerificationKey StakePoolKey -> AnyStakePoolVerificationKey)
-> VerificationKey StakePoolKey -> AnyStakePoolVerificationKey
forall a b. (a -> b) -> a -> b
$ VerificationKey GenesisDelegateKey -> VerificationKey StakePoolKey
forall keyroleA keyroleB.
CastVerificationKeyRole keyroleA keyroleB =>
VerificationKey keyroleA -> VerificationKey keyroleB
castVerificationKey VerificationKey GenesisDelegateKey
vk)
    ColdVerificationKeyFile VerificationKeyFile 'In
fp ->
      [FromSomeType HasTextEnvelope AnyStakePoolVerificationKey]
-> VerificationKeyFile 'In
-> IO
     (Either (FileError TextEnvelopeError) AnyStakePoolVerificationKey)
forall b content.
[FromSomeType HasTextEnvelope b]
-> File content 'In -> IO (Either (FileError TextEnvelopeError) b)
readFileTextEnvelopeAnyOf
        [ AsType (VerificationKey StakePoolKey)
-> (VerificationKey StakePoolKey -> AnyStakePoolVerificationKey)
-> FromSomeType HasTextEnvelope AnyStakePoolVerificationKey
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 -> AnyStakePoolVerificationKey
AnyStakePoolNormalVerificationKey
        , AsType (VerificationKey StakePoolExtendedKey)
-> (VerificationKey StakePoolExtendedKey
    -> AnyStakePoolVerificationKey)
-> FromSomeType HasTextEnvelope AnyStakePoolVerificationKey
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType StakePoolExtendedKey
-> AsType (VerificationKey StakePoolExtendedKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType StakePoolExtendedKey
AsStakePoolExtendedKey) VerificationKey StakePoolExtendedKey -> AnyStakePoolVerificationKey
AnyStakePoolExtendedVerificationKey
        , AsType (VerificationKey GenesisDelegateKey)
-> (VerificationKey GenesisDelegateKey
    -> AnyStakePoolVerificationKey)
-> FromSomeType HasTextEnvelope AnyStakePoolVerificationKey
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 StakePoolKey -> AnyStakePoolVerificationKey
AnyStakePoolNormalVerificationKey (VerificationKey StakePoolKey -> AnyStakePoolVerificationKey)
-> (VerificationKey GenesisDelegateKey
    -> VerificationKey StakePoolKey)
-> VerificationKey GenesisDelegateKey
-> AnyStakePoolVerificationKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerificationKey GenesisDelegateKey -> VerificationKey StakePoolKey
forall keyroleA keyroleB.
CastVerificationKeyRole keyroleA keyroleB =>
VerificationKey keyroleA -> VerificationKey keyroleB
castVerificationKey)
        ]
        VerificationKeyFile 'In
fp