module Cardano.CLI.Shelley.Run.Node
( ShelleyNodeCmdError(ShelleyNodeCmdReadFileError)
, renderShelleyNodeCmdError
, runNodeCmd
, runNodeIssueOpCert
, runNodeKeyGenCold
, runNodeKeyGenKES
, runNodeKeyGenVRF
) where
import Cardano.Prelude hiding ((<.>))
import Prelude (id)
import qualified Data.ByteString.Char8 as BS
import Data.String (fromString)
import qualified Data.Text as Text
import Control.Monad.Trans.Except.Extra (firstExceptT, hoistEither, newExceptT)
import Cardano.Api
import Cardano.Api.Shelley
import Cardano.CLI.Shelley.Commands
import Cardano.CLI.Shelley.Key (InputDecodeError, VerificationKeyOrFile,
readSigningKeyFileAnyOf, readVerificationKeyOrFile)
import Cardano.CLI.Types (SigningKeyFile (..), VerificationKeyFile (..))
data ShelleyNodeCmdError
= ShelleyNodeCmdReadFileError !(FileError TextEnvelopeError)
| ShelleyNodeCmdReadKeyFileError !(FileError InputDecodeError)
| ShelleyNodeCmdWriteFileError !(FileError ())
| ShelleyNodeCmdOperationalCertificateIssueError !OperationalCertIssueError
| ShelleyNodeCmdVrfSigningKeyCreationError
FilePath
FilePath
deriving Int -> ShelleyNodeCmdError -> ShowS
[ShelleyNodeCmdError] -> ShowS
ShelleyNodeCmdError -> String
(Int -> ShelleyNodeCmdError -> ShowS)
-> (ShelleyNodeCmdError -> String)
-> ([ShelleyNodeCmdError] -> ShowS)
-> Show ShelleyNodeCmdError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShelleyNodeCmdError] -> ShowS
$cshowList :: [ShelleyNodeCmdError] -> ShowS
show :: ShelleyNodeCmdError -> String
$cshow :: ShelleyNodeCmdError -> String
showsPrec :: Int -> ShelleyNodeCmdError -> ShowS
$cshowsPrec :: Int -> ShelleyNodeCmdError -> ShowS
Show
renderShelleyNodeCmdError :: ShelleyNodeCmdError -> Text
renderShelleyNodeCmdError :: ShelleyNodeCmdError -> Text
renderShelleyNodeCmdError ShelleyNodeCmdError
err =
case ShelleyNodeCmdError
err of
ShelleyNodeCmdVrfSigningKeyCreationError String
targetPath String
tempPath ->
String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"Error creating VRF signing key file. Target path: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
targetPath
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" Temporary path: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
tempPath
ShelleyNodeCmdReadFileError FileError TextEnvelopeError
fileErr -> String -> Text
Text.pack (FileError TextEnvelopeError -> String
forall e. Error e => e -> String
displayError FileError TextEnvelopeError
fileErr)
ShelleyNodeCmdReadKeyFileError FileError InputDecodeError
fileErr -> String -> Text
Text.pack (FileError InputDecodeError -> String
forall e. Error e => e -> String
displayError FileError InputDecodeError
fileErr)
ShelleyNodeCmdWriteFileError FileError ()
fileErr -> String -> Text
Text.pack (FileError () -> String
forall e. Error e => e -> String
displayError FileError ()
fileErr)
ShelleyNodeCmdOperationalCertificateIssueError OperationalCertIssueError
issueErr ->
String -> Text
Text.pack (OperationalCertIssueError -> String
forall e. Error e => e -> String
displayError OperationalCertIssueError
issueErr)
runNodeCmd :: NodeCmd -> ExceptT ShelleyNodeCmdError IO ()
runNodeCmd :: NodeCmd -> ExceptT ShelleyNodeCmdError IO ()
runNodeCmd (NodeKeyGenCold VerificationKeyFile
vk SigningKeyFile
sk OpCertCounterFile
ctr) = VerificationKeyFile
-> SigningKeyFile
-> OpCertCounterFile
-> ExceptT ShelleyNodeCmdError IO ()
runNodeKeyGenCold VerificationKeyFile
vk SigningKeyFile
sk OpCertCounterFile
ctr
runNodeCmd (NodeKeyGenKES VerificationKeyFile
vk SigningKeyFile
sk) = VerificationKeyFile
-> SigningKeyFile -> ExceptT ShelleyNodeCmdError IO ()
runNodeKeyGenKES VerificationKeyFile
vk SigningKeyFile
sk
runNodeCmd (NodeKeyGenVRF VerificationKeyFile
vk SigningKeyFile
sk) = VerificationKeyFile
-> SigningKeyFile -> ExceptT ShelleyNodeCmdError IO ()
runNodeKeyGenVRF VerificationKeyFile
vk SigningKeyFile
sk
runNodeCmd (NodeKeyHashVRF VerificationKeyOrFile VrfKey
vk Maybe OutputFile
mOutFp) = VerificationKeyOrFile VrfKey
-> Maybe OutputFile -> ExceptT ShelleyNodeCmdError IO ()
runNodeKeyHashVRF VerificationKeyOrFile VrfKey
vk Maybe OutputFile
mOutFp
runNodeCmd (NodeNewCounter ColdVerificationKeyOrFile
vk Word
ctr OpCertCounterFile
out) = ColdVerificationKeyOrFile
-> Word -> OpCertCounterFile -> ExceptT ShelleyNodeCmdError IO ()
runNodeNewCounter ColdVerificationKeyOrFile
vk Word
ctr OpCertCounterFile
out
runNodeCmd (NodeIssueOpCert VerificationKeyOrFile KesKey
vk SigningKeyFile
sk OpCertCounterFile
ctr KESPeriod
p OutputFile
out) =
VerificationKeyOrFile KesKey
-> SigningKeyFile
-> OpCertCounterFile
-> KESPeriod
-> OutputFile
-> ExceptT ShelleyNodeCmdError IO ()
runNodeIssueOpCert VerificationKeyOrFile KesKey
vk SigningKeyFile
sk OpCertCounterFile
ctr KESPeriod
p OutputFile
out
runNodeKeyGenCold :: VerificationKeyFile
-> SigningKeyFile
-> OpCertCounterFile
-> ExceptT ShelleyNodeCmdError IO ()
runNodeKeyGenCold :: VerificationKeyFile
-> SigningKeyFile
-> OpCertCounterFile
-> ExceptT ShelleyNodeCmdError IO ()
runNodeKeyGenCold (VerificationKeyFile String
vkeyPath) (SigningKeyFile String
skeyPath)
(OpCertCounterFile String
ocertCtrPath) = do
SigningKey StakePoolKey
skey <- IO (SigningKey StakePoolKey)
-> ExceptT ShelleyNodeCmdError IO (SigningKey StakePoolKey)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (SigningKey StakePoolKey)
-> ExceptT ShelleyNodeCmdError IO (SigningKey StakePoolKey))
-> IO (SigningKey StakePoolKey)
-> ExceptT ShelleyNodeCmdError IO (SigningKey StakePoolKey)
forall a b. (a -> b) -> a -> b
$ AsType StakePoolKey -> IO (SigningKey StakePoolKey)
forall keyrole.
Key keyrole =>
AsType keyrole -> IO (SigningKey keyrole)
generateSigningKey AsType StakePoolKey
AsStakePoolKey
let vkey :: VerificationKey StakePoolKey
vkey = SigningKey StakePoolKey -> VerificationKey StakePoolKey
forall keyrole.
Key keyrole =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey StakePoolKey
skey
(FileError () -> ShelleyNodeCmdError)
-> ExceptT (FileError ()) IO ()
-> ExceptT ShelleyNodeCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> ShelleyNodeCmdError
ShelleyNodeCmdWriteFileError
(ExceptT (FileError ()) IO () -> ExceptT ShelleyNodeCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT ShelleyNodeCmdError IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 ShelleyNodeCmdError IO ())
-> IO (Either (FileError ()) ())
-> ExceptT ShelleyNodeCmdError IO ()
forall a b. (a -> b) -> a -> b
$ String
-> Maybe TextEnvelopeDescr
-> SigningKey StakePoolKey
-> IO (Either (FileError ()) ())
forall a.
HasTextEnvelope a =>
String
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope String
skeyPath (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
skeyDesc) SigningKey StakePoolKey
skey
(FileError () -> ShelleyNodeCmdError)
-> ExceptT (FileError ()) IO ()
-> ExceptT ShelleyNodeCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> ShelleyNodeCmdError
ShelleyNodeCmdWriteFileError
(ExceptT (FileError ()) IO () -> ExceptT ShelleyNodeCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT ShelleyNodeCmdError IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 ShelleyNodeCmdError IO ())
-> IO (Either (FileError ()) ())
-> ExceptT ShelleyNodeCmdError IO ()
forall a b. (a -> b) -> a -> b
$ String
-> Maybe TextEnvelopeDescr
-> VerificationKey StakePoolKey
-> IO (Either (FileError ()) ())
forall a.
HasTextEnvelope a =>
String
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope String
vkeyPath (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
vkeyDesc) VerificationKey StakePoolKey
vkey
(FileError () -> ShelleyNodeCmdError)
-> ExceptT (FileError ()) IO ()
-> ExceptT ShelleyNodeCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> ShelleyNodeCmdError
ShelleyNodeCmdWriteFileError
(ExceptT (FileError ()) IO () -> ExceptT ShelleyNodeCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT ShelleyNodeCmdError IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 ShelleyNodeCmdError IO ())
-> IO (Either (FileError ()) ())
-> ExceptT ShelleyNodeCmdError IO ()
forall a b. (a -> b) -> a -> b
$ String
-> Maybe TextEnvelopeDescr
-> OperationalCertificateIssueCounter
-> IO (Either (FileError ()) ())
forall a.
HasTextEnvelope a =>
String
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope String
ocertCtrPath (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
ocertCtrDesc)
(OperationalCertificateIssueCounter
-> IO (Either (FileError ()) ()))
-> OperationalCertificateIssueCounter
-> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$ Word64
-> VerificationKey StakePoolKey
-> OperationalCertificateIssueCounter
OperationalCertificateIssueCounter Word64
initialCounter VerificationKey StakePoolKey
vkey
where
skeyDesc, vkeyDesc, ocertCtrDesc :: TextEnvelopeDescr
skeyDesc :: TextEnvelopeDescr
skeyDesc = TextEnvelopeDescr
"Stake Pool Operator Signing Key"
vkeyDesc :: TextEnvelopeDescr
vkeyDesc = TextEnvelopeDescr
"Stake Pool Operator Verification Key"
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 b. (Show a, ConvertText String b) => a -> b
show Word64
initialCounter)
initialCounter :: Word64
initialCounter :: Word64
initialCounter = Word64
0
runNodeKeyGenKES :: VerificationKeyFile
-> SigningKeyFile
-> ExceptT ShelleyNodeCmdError IO ()
runNodeKeyGenKES :: VerificationKeyFile
-> SigningKeyFile -> ExceptT ShelleyNodeCmdError IO ()
runNodeKeyGenKES (VerificationKeyFile String
vkeyPath) (SigningKeyFile String
skeyPath) = do
SigningKey KesKey
skey <- IO (SigningKey KesKey)
-> ExceptT ShelleyNodeCmdError IO (SigningKey KesKey)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (SigningKey KesKey)
-> ExceptT ShelleyNodeCmdError IO (SigningKey KesKey))
-> IO (SigningKey KesKey)
-> ExceptT ShelleyNodeCmdError IO (SigningKey KesKey)
forall a b. (a -> b) -> a -> b
$ AsType KesKey -> IO (SigningKey KesKey)
forall keyrole.
Key keyrole =>
AsType keyrole -> IO (SigningKey keyrole)
generateSigningKey AsType KesKey
AsKesKey
let vkey :: VerificationKey KesKey
vkey = SigningKey KesKey -> VerificationKey KesKey
forall keyrole.
Key keyrole =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey KesKey
skey
(FileError () -> ShelleyNodeCmdError)
-> ExceptT (FileError ()) IO ()
-> ExceptT ShelleyNodeCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> ShelleyNodeCmdError
ShelleyNodeCmdWriteFileError
(ExceptT (FileError ()) IO () -> ExceptT ShelleyNodeCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT ShelleyNodeCmdError IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 ShelleyNodeCmdError IO ())
-> IO (Either (FileError ()) ())
-> ExceptT ShelleyNodeCmdError IO ()
forall a b. (a -> b) -> a -> b
$ String
-> Maybe TextEnvelopeDescr
-> SigningKey KesKey
-> IO (Either (FileError ()) ())
forall a.
HasTextEnvelope a =>
String
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope String
skeyPath (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
skeyDesc) SigningKey KesKey
skey
(FileError () -> ShelleyNodeCmdError)
-> ExceptT (FileError ()) IO ()
-> ExceptT ShelleyNodeCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> ShelleyNodeCmdError
ShelleyNodeCmdWriteFileError
(ExceptT (FileError ()) IO () -> ExceptT ShelleyNodeCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT ShelleyNodeCmdError IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 ShelleyNodeCmdError IO ())
-> IO (Either (FileError ()) ())
-> ExceptT ShelleyNodeCmdError IO ()
forall a b. (a -> b) -> a -> b
$ String
-> Maybe TextEnvelopeDescr
-> VerificationKey KesKey
-> IO (Either (FileError ()) ())
forall a.
HasTextEnvelope a =>
String
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope String
vkeyPath (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
vkeyDesc) VerificationKey KesKey
vkey
where
skeyDesc, vkeyDesc :: TextEnvelopeDescr
skeyDesc :: TextEnvelopeDescr
skeyDesc = TextEnvelopeDescr
"KES Signing Key"
vkeyDesc :: TextEnvelopeDescr
vkeyDesc = TextEnvelopeDescr
"KES Verification Key"
runNodeKeyGenVRF :: VerificationKeyFile -> SigningKeyFile
-> ExceptT ShelleyNodeCmdError IO ()
runNodeKeyGenVRF :: VerificationKeyFile
-> SigningKeyFile -> ExceptT ShelleyNodeCmdError IO ()
runNodeKeyGenVRF (VerificationKeyFile String
vkeyPath) (SigningKeyFile String
skeyPath) = do
SigningKey VrfKey
skey <- IO (SigningKey VrfKey)
-> ExceptT ShelleyNodeCmdError IO (SigningKey VrfKey)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (SigningKey VrfKey)
-> ExceptT ShelleyNodeCmdError IO (SigningKey VrfKey))
-> IO (SigningKey VrfKey)
-> ExceptT ShelleyNodeCmdError IO (SigningKey VrfKey)
forall a b. (a -> b) -> a -> b
$ AsType VrfKey -> IO (SigningKey VrfKey)
forall keyrole.
Key keyrole =>
AsType keyrole -> IO (SigningKey keyrole)
generateSigningKey AsType VrfKey
AsVrfKey
let vkey :: VerificationKey VrfKey
vkey = SigningKey VrfKey -> VerificationKey VrfKey
forall keyrole.
Key keyrole =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey VrfKey
skey
(FileError () -> ShelleyNodeCmdError)
-> ExceptT (FileError ()) IO ()
-> ExceptT ShelleyNodeCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> ShelleyNodeCmdError
ShelleyNodeCmdWriteFileError
(ExceptT (FileError ()) IO () -> ExceptT ShelleyNodeCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT ShelleyNodeCmdError IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 ShelleyNodeCmdError IO ())
-> IO (Either (FileError ()) ())
-> ExceptT ShelleyNodeCmdError IO ()
forall a b. (a -> b) -> a -> b
$ String
-> Maybe TextEnvelopeDescr
-> SigningKey VrfKey
-> IO (Either (FileError ()) ())
forall a.
HasTextEnvelope a =>
String
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelopeWithOwnerPermissions String
skeyPath (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
skeyDesc) SigningKey VrfKey
skey
(FileError () -> ShelleyNodeCmdError)
-> ExceptT (FileError ()) IO ()
-> ExceptT ShelleyNodeCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> ShelleyNodeCmdError
ShelleyNodeCmdWriteFileError
(ExceptT (FileError ()) IO () -> ExceptT ShelleyNodeCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT ShelleyNodeCmdError IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 ShelleyNodeCmdError IO ())
-> IO (Either (FileError ()) ())
-> ExceptT ShelleyNodeCmdError IO ()
forall a b. (a -> b) -> a -> b
$ String
-> Maybe TextEnvelopeDescr
-> VerificationKey VrfKey
-> IO (Either (FileError ()) ())
forall a.
HasTextEnvelope a =>
String
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope String
vkeyPath (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
vkeyDesc) VerificationKey VrfKey
vkey
where
skeyDesc, vkeyDesc :: TextEnvelopeDescr
skeyDesc :: TextEnvelopeDescr
skeyDesc = TextEnvelopeDescr
"VRF Signing Key"
vkeyDesc :: TextEnvelopeDescr
vkeyDesc = TextEnvelopeDescr
"VRF Verification Key"
runNodeKeyHashVRF :: VerificationKeyOrFile VrfKey
-> Maybe OutputFile
-> ExceptT ShelleyNodeCmdError IO ()
runNodeKeyHashVRF :: VerificationKeyOrFile VrfKey
-> Maybe OutputFile -> ExceptT ShelleyNodeCmdError IO ()
runNodeKeyHashVRF VerificationKeyOrFile VrfKey
verKeyOrFile Maybe OutputFile
mOutputFp = do
VerificationKey VrfKey
vkey <- (FileError InputDecodeError -> ShelleyNodeCmdError)
-> ExceptT (FileError InputDecodeError) IO (VerificationKey VrfKey)
-> ExceptT ShelleyNodeCmdError IO (VerificationKey VrfKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError InputDecodeError -> ShelleyNodeCmdError
ShelleyNodeCmdReadKeyFileError
(ExceptT (FileError InputDecodeError) IO (VerificationKey VrfKey)
-> ExceptT ShelleyNodeCmdError IO (VerificationKey VrfKey))
-> (IO
(Either (FileError InputDecodeError) (VerificationKey VrfKey))
-> ExceptT
(FileError InputDecodeError) IO (VerificationKey VrfKey))
-> IO
(Either (FileError InputDecodeError) (VerificationKey VrfKey))
-> ExceptT ShelleyNodeCmdError IO (VerificationKey VrfKey)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IO (Either (FileError InputDecodeError) (VerificationKey VrfKey))
-> ExceptT (FileError InputDecodeError) IO (VerificationKey VrfKey)
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
(IO (Either (FileError InputDecodeError) (VerificationKey VrfKey))
-> ExceptT ShelleyNodeCmdError IO (VerificationKey VrfKey))
-> IO
(Either (FileError InputDecodeError) (VerificationKey VrfKey))
-> ExceptT ShelleyNodeCmdError IO (VerificationKey VrfKey)
forall a b. (a -> b) -> a -> b
$ AsType VrfKey
-> VerificationKeyOrFile VrfKey
-> IO
(Either (FileError InputDecodeError) (VerificationKey VrfKey))
forall keyrole.
(HasTextEnvelope (VerificationKey keyrole),
SerialiseAsBech32 (VerificationKey keyrole)) =>
AsType keyrole
-> VerificationKeyOrFile keyrole
-> IO
(Either (FileError InputDecodeError) (VerificationKey keyrole))
readVerificationKeyOrFile AsType VrfKey
AsVrfKey VerificationKeyOrFile VrfKey
verKeyOrFile
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 OutputFile
mOutputFp of
Just (OutputFile String
fpath) -> IO () -> ExceptT ShelleyNodeCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyNodeCmdError IO ())
-> IO () -> ExceptT ShelleyNodeCmdError IO ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString -> IO ()
BS.writeFile String
fpath ByteString
hexKeyHash
Maybe OutputFile
Nothing -> IO () -> ExceptT ShelleyNodeCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyNodeCmdError IO ())
-> IO () -> ExceptT ShelleyNodeCmdError IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
BS.putStrLn ByteString
hexKeyHash
runNodeNewCounter :: ColdVerificationKeyOrFile
-> Word
-> OpCertCounterFile
-> ExceptT ShelleyNodeCmdError IO ()
runNodeNewCounter :: ColdVerificationKeyOrFile
-> Word -> OpCertCounterFile -> ExceptT ShelleyNodeCmdError IO ()
runNodeNewCounter ColdVerificationKeyOrFile
coldVerKeyOrFile Word
counter
(OpCertCounterFile String
ocertCtrPath) = do
VerificationKey StakePoolKey
vkey <- (FileError TextEnvelopeError -> ShelleyNodeCmdError)
-> ExceptT
(FileError TextEnvelopeError) IO (VerificationKey StakePoolKey)
-> ExceptT ShelleyNodeCmdError IO (VerificationKey StakePoolKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> ShelleyNodeCmdError
ShelleyNodeCmdReadFileError (ExceptT
(FileError TextEnvelopeError) IO (VerificationKey StakePoolKey)
-> ExceptT ShelleyNodeCmdError IO (VerificationKey StakePoolKey))
-> (IO
(Either
(FileError TextEnvelopeError) (VerificationKey StakePoolKey))
-> ExceptT
(FileError TextEnvelopeError) IO (VerificationKey StakePoolKey))
-> IO
(Either
(FileError TextEnvelopeError) (VerificationKey StakePoolKey))
-> ExceptT ShelleyNodeCmdError IO (VerificationKey StakePoolKey)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 ShelleyNodeCmdError IO (VerificationKey StakePoolKey))
-> IO
(Either
(FileError TextEnvelopeError) (VerificationKey StakePoolKey))
-> ExceptT ShelleyNodeCmdError IO (VerificationKey StakePoolKey)
forall a b. (a -> b) -> a -> b
$
ColdVerificationKeyOrFile
-> IO
(Either
(FileError TextEnvelopeError) (VerificationKey StakePoolKey))
readColdVerificationKeyOrFile ColdVerificationKeyOrFile
coldVerKeyOrFile
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 () -> ShelleyNodeCmdError)
-> ExceptT (FileError ()) IO ()
-> ExceptT ShelleyNodeCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> ShelleyNodeCmdError
ShelleyNodeCmdWriteFileError (ExceptT (FileError ()) IO () -> ExceptT ShelleyNodeCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT ShelleyNodeCmdError IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 ShelleyNodeCmdError IO ())
-> IO (Either (FileError ()) ())
-> ExceptT ShelleyNodeCmdError IO ()
forall a b. (a -> b) -> a -> b
$
String
-> Maybe TextEnvelopeDescr
-> OperationalCertificateIssueCounter
-> IO (Either (FileError ()) ())
forall a.
HasTextEnvelope a =>
String
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope String
ocertCtrPath Maybe TextEnvelopeDescr
forall a. Maybe a
Nothing OperationalCertificateIssueCounter
ocertIssueCounter
runNodeIssueOpCert :: VerificationKeyOrFile KesKey
-> SigningKeyFile
-> OpCertCounterFile
-> KESPeriod
-> OutputFile
-> ExceptT ShelleyNodeCmdError IO ()
runNodeIssueOpCert :: VerificationKeyOrFile KesKey
-> SigningKeyFile
-> OpCertCounterFile
-> KESPeriod
-> OutputFile
-> ExceptT ShelleyNodeCmdError IO ()
runNodeIssueOpCert VerificationKeyOrFile KesKey
kesVerKeyOrFile
SigningKeyFile
stakePoolSKeyFile
(OpCertCounterFile String
ocertCtrPath)
KESPeriod
kesPeriod
(OutputFile String
certFile) = do
OperationalCertificateIssueCounter
ocertIssueCounter <- (FileError TextEnvelopeError -> ShelleyNodeCmdError)
-> ExceptT
(FileError TextEnvelopeError) IO OperationalCertificateIssueCounter
-> ExceptT
ShelleyNodeCmdError IO OperationalCertificateIssueCounter
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> ShelleyNodeCmdError
ShelleyNodeCmdReadFileError
(ExceptT
(FileError TextEnvelopeError) IO OperationalCertificateIssueCounter
-> ExceptT
ShelleyNodeCmdError IO OperationalCertificateIssueCounter)
-> (IO
(Either
(FileError TextEnvelopeError) OperationalCertificateIssueCounter)
-> ExceptT
(FileError TextEnvelopeError)
IO
OperationalCertificateIssueCounter)
-> IO
(Either
(FileError TextEnvelopeError) OperationalCertificateIssueCounter)
-> ExceptT
ShelleyNodeCmdError IO OperationalCertificateIssueCounter
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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
ShelleyNodeCmdError IO OperationalCertificateIssueCounter)
-> IO
(Either
(FileError TextEnvelopeError) OperationalCertificateIssueCounter)
-> ExceptT
ShelleyNodeCmdError IO OperationalCertificateIssueCounter
forall a b. (a -> b) -> a -> b
$ AsType OperationalCertificateIssueCounter
-> String
-> IO
(Either
(FileError TextEnvelopeError) OperationalCertificateIssueCounter)
forall a.
HasTextEnvelope a =>
AsType a -> String -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope AsType OperationalCertificateIssueCounter
AsOperationalCertificateIssueCounter String
ocertCtrPath
VerificationKey KesKey
verKeyKes <- (FileError InputDecodeError -> ShelleyNodeCmdError)
-> ExceptT (FileError InputDecodeError) IO (VerificationKey KesKey)
-> ExceptT ShelleyNodeCmdError IO (VerificationKey KesKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError InputDecodeError -> ShelleyNodeCmdError
ShelleyNodeCmdReadKeyFileError
(ExceptT (FileError InputDecodeError) IO (VerificationKey KesKey)
-> ExceptT ShelleyNodeCmdError IO (VerificationKey KesKey))
-> (IO
(Either (FileError InputDecodeError) (VerificationKey KesKey))
-> ExceptT
(FileError InputDecodeError) IO (VerificationKey KesKey))
-> IO
(Either (FileError InputDecodeError) (VerificationKey KesKey))
-> ExceptT ShelleyNodeCmdError IO (VerificationKey KesKey)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IO (Either (FileError InputDecodeError) (VerificationKey KesKey))
-> ExceptT (FileError InputDecodeError) IO (VerificationKey KesKey)
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
(IO (Either (FileError InputDecodeError) (VerificationKey KesKey))
-> ExceptT ShelleyNodeCmdError IO (VerificationKey KesKey))
-> IO
(Either (FileError InputDecodeError) (VerificationKey KesKey))
-> ExceptT ShelleyNodeCmdError IO (VerificationKey KesKey)
forall a b. (a -> b) -> a -> b
$ AsType KesKey
-> VerificationKeyOrFile KesKey
-> IO
(Either (FileError InputDecodeError) (VerificationKey KesKey))
forall keyrole.
(HasTextEnvelope (VerificationKey keyrole),
SerialiseAsBech32 (VerificationKey keyrole)) =>
AsType keyrole
-> VerificationKeyOrFile keyrole
-> IO
(Either (FileError InputDecodeError) (VerificationKey keyrole))
readVerificationKeyOrFile AsType KesKey
AsKesKey VerificationKeyOrFile KesKey
kesVerKeyOrFile
Either
(SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey)
signKey <- (FileError InputDecodeError -> ShelleyNodeCmdError)
-> ExceptT
(FileError InputDecodeError)
IO
(Either
(SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey))
-> ExceptT
ShelleyNodeCmdError
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 -> ShelleyNodeCmdError
ShelleyNodeCmdReadKeyFileError
(ExceptT
(FileError InputDecodeError)
IO
(Either
(SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey))
-> ExceptT
ShelleyNodeCmdError
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
ShelleyNodeCmdError
IO
(Either
(SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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
ShelleyNodeCmdError
IO
(Either
(SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey)))
-> IO
(Either
(FileError InputDecodeError)
(Either
(SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey)))
-> ExceptT
ShelleyNodeCmdError
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
-> IO
(Either
(FileError InputDecodeError)
(Either
(SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey)))
forall b.
[FromSomeType SerialiseAsBech32 b]
-> [FromSomeType HasTextEnvelope b]
-> SigningKeyFile
-> IO (Either (FileError InputDecodeError) b)
readSigningKeyFileAnyOf
[FromSomeType
SerialiseAsBech32
(Either
(SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey))]
bech32PossibleBlockIssuers
[FromSomeType
HasTextEnvelope
(Either
(SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey))]
textEnvPossibleBlockIssuers
SigningKeyFile
stakePoolSKeyFile
(OperationalCertificate
ocert, OperationalCertificateIssueCounter
nextOcertCtr) <-
(OperationalCertIssueError -> ShelleyNodeCmdError)
-> ExceptT
OperationalCertIssueError
IO
(OperationalCertificate, OperationalCertificateIssueCounter)
-> ExceptT
ShelleyNodeCmdError
IO
(OperationalCertificate, OperationalCertificateIssueCounter)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT OperationalCertIssueError -> ShelleyNodeCmdError
ShelleyNodeCmdOperationalCertificateIssueError
(ExceptT
OperationalCertIssueError
IO
(OperationalCertificate, OperationalCertificateIssueCounter)
-> ExceptT
ShelleyNodeCmdError
IO
(OperationalCertificate, OperationalCertificateIssueCounter))
-> (Either
OperationalCertIssueError
(OperationalCertificate, OperationalCertificateIssueCounter)
-> ExceptT
OperationalCertIssueError
IO
(OperationalCertificate, OperationalCertificateIssueCounter))
-> Either
OperationalCertIssueError
(OperationalCertificate, OperationalCertificateIssueCounter)
-> ExceptT
ShelleyNodeCmdError
IO
(OperationalCertificate, OperationalCertificateIssueCounter)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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
ShelleyNodeCmdError
IO
(OperationalCertificate, OperationalCertificateIssueCounter))
-> Either
OperationalCertIssueError
(OperationalCertificate, OperationalCertificateIssueCounter)
-> ExceptT
ShelleyNodeCmdError
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
(FileError () -> ShelleyNodeCmdError)
-> ExceptT (FileError ()) IO ()
-> ExceptT ShelleyNodeCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> ShelleyNodeCmdError
ShelleyNodeCmdWriteFileError
(ExceptT (FileError ()) IO () -> ExceptT ShelleyNodeCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT ShelleyNodeCmdError IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 ShelleyNodeCmdError IO ())
-> IO (Either (FileError ()) ())
-> ExceptT ShelleyNodeCmdError IO ()
forall a b. (a -> b) -> a -> b
$ String
-> Maybe TextEnvelopeDescr
-> OperationalCertificateIssueCounter
-> IO (Either (FileError ()) ())
forall a.
HasTextEnvelope a =>
String
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope
String
ocertCtrPath
(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 () -> ShelleyNodeCmdError)
-> ExceptT (FileError ()) IO ()
-> ExceptT ShelleyNodeCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> ShelleyNodeCmdError
ShelleyNodeCmdWriteFileError
(ExceptT (FileError ()) IO () -> ExceptT ShelleyNodeCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT ShelleyNodeCmdError IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 ShelleyNodeCmdError IO ())
-> IO (Either (FileError ()) ())
-> ExceptT ShelleyNodeCmdError IO ()
forall a b. (a -> b) -> a -> b
$ String
-> Maybe TextEnvelopeDescr
-> OperationalCertificate
-> IO (Either (FileError ()) ())
forall a.
HasTextEnvelope a =>
String
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope String
certFile 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 b. (Show a, ConvertText String b) => a -> b
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 k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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]
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 (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 (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 String
fp) ->
[FromSomeType HasTextEnvelope (VerificationKey StakePoolKey)]
-> String
-> IO
(Either
(FileError TextEnvelopeError) (VerificationKey StakePoolKey))
forall b.
[FromSomeType HasTextEnvelope b]
-> String -> 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
]
String
fp