{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}

-- | The forging credentials, as the consensus layer wants them.
--
-- Which files a tool was pointed at comes from @cardano-config@, as ordinary
-- node command-line options, and decoding them is @cardano-keys@'s job. Left
-- for here is the step that produces consensus types: mapping the key material
-- onto 'ByronLeaderCredentials' and 'ShelleyLeaderCredentials'.
module Cardano.Tools.Credentials
  ( LeaderCredentials (..)
  , readLeaderCredentials
  ) where

import qualified Cardano.Chain.Delegation as Byron.Delegation
import qualified Cardano.Chain.Genesis as Byron.Genesis
import qualified Cardano.Configuration.CliArgs as CLI
import qualified Cardano.Crypto.Signing as Byron.Crypto
import qualified Cardano.Crypto.VRF as VRF
import qualified Cardano.Keys as Keys
import Cardano.Ledger.BaseTypes (StrictMaybe (..))
import Cardano.Ledger.Keys (KeyRole (StakePool), VKey, coerceKeyRole)
import Cardano.Protocol.Crypto (StandardCrypto, VRF)
import qualified Cardano.Protocol.TPraos.OCert as OCert
import Control.Monad.Trans.Except (ExceptT (..), except, runExceptT, throwE)
import Data.Bifunctor (first)
import Ouroboros.Consensus.Byron.Node
  ( ByronLeaderCredentials
  , mkByronLeaderCredentials
  )
import Ouroboros.Consensus.Protocol.Praos.Common
  ( PraosCanBeLeader (..)
  , PraosCredentialsSource (..)
  )
import Ouroboros.Consensus.Shelley.Node (ShelleyLeaderCredentials (..))
import Prettyprinter (Doc, pretty)

-- | The credentials a Cardano protocol forges with: at most one Byron-era set,
-- and any number of Shelley-based ones.
data LeaderCredentials = LeaderCredentials
  { LeaderCredentials -> Maybe ByronLeaderCredentials
byronLeaderCredentials :: Maybe ByronLeaderCredentials
  , LeaderCredentials -> [ShelleyLeaderCredentials StandardCrypto]
shelleyLeaderCredentials :: [ShelleyLeaderCredentials StandardCrypto]
  }

-- | Read the credential files named on the command line and map them onto the
-- consensus leader credentials.
--
-- As in the node, the Shelley-based credentials are the sum of what the
-- individual @--shelley-*@ options name and what the bulk credentials file
-- holds. Supplying none is not an error; it yields no forgers.
--
-- The Byron genesis is needed because a Byron delegation certificate has to be
-- issued by one of its genesis keys.
readLeaderCredentials ::
  Byron.Genesis.Config ->
  CLI.Credentials ->
  IO (Either String LeaderCredentials)
readLeaderCredentials :: Config -> Credentials -> IO (Either [Char] LeaderCredentials)
readLeaderCredentials Config
byronGenesis Credentials
creds = ExceptT [Char] IO LeaderCredentials
-> IO (Either [Char] LeaderCredentials)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT [Char] IO LeaderCredentials
 -> IO (Either [Char] LeaderCredentials))
-> ExceptT [Char] IO LeaderCredentials
-> IO (Either [Char] LeaderCredentials)
forall a b. (a -> b) -> a -> b
$ do
  byron <- Config
-> Credentials -> ExceptT [Char] IO (Maybe ByronLeaderCredentials)
readByron Config
byronGenesis Credentials
creds
  shelley <- readShelley creds
  bulk <- readShelleyBulk creds
  pure
    LeaderCredentials
      { byronLeaderCredentials = byron
      , shelleyLeaderCredentials = shelley <> bulk
      }

--
-- Byron
--

-- | The Byron delegation certificate and the signing key it delegates to, which
-- are only useful together: either both are given or neither is.
readByron ::
  Byron.Genesis.Config ->
  CLI.Credentials ->
  ExceptT String IO (Maybe ByronLeaderCredentials)
readByron :: Config
-> Credentials -> ExceptT [Char] IO (Maybe ByronLeaderCredentials)
readByron Config
byronGenesis Credentials
creds =
  case (Credentials -> StrictMaybe [Char]
CLI.byronDelegationCertificate Credentials
creds, Credentials -> StrictMaybe [Char]
CLI.byronSigningKey Credentials
creds) of
    (StrictMaybe [Char]
SNothing, StrictMaybe [Char]
SNothing) -> Maybe ByronLeaderCredentials
-> ExceptT [Char] IO (Maybe ByronLeaderCredentials)
forall a. a -> ExceptT [Char] IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ByronLeaderCredentials
forall a. Maybe a
Nothing
    (SJust [Char]
_, StrictMaybe [Char]
SNothing) -> [Char] -> ExceptT [Char] IO (Maybe ByronLeaderCredentials)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ([Char] -> ExceptT [Char] IO (Maybe ByronLeaderCredentials))
-> [Char] -> ExceptT [Char] IO (Maybe ByronLeaderCredentials)
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
missingOption [Char]
"byron-signing-key"
    (StrictMaybe [Char]
SNothing, SJust [Char]
_) -> [Char] -> ExceptT [Char] IO (Maybe ByronLeaderCredentials)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ([Char] -> ExceptT [Char] IO (Maybe ByronLeaderCredentials))
-> [Char] -> ExceptT [Char] IO (Maybe ByronLeaderCredentials)
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
missingOption [Char]
"byron-delegation-certificate"
    (SJust [Char]
certFile, SJust [Char]
keyFile) -> do
      cert <- [Char] -> ExceptT [Char] IO Certificate
readByronDelegationCertificate [Char]
certFile
      signingKey <- readByronSigningKey keyFile
      fmap Just . except . first renderError $
        mkByronLeaderCredentials byronGenesis signingKey cert "Byron"
 where
  renderError :: a -> [Char]
renderError a
err = [Char]
"Byron leader credentials error: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> a -> [Char]
forall {a}. Show a => a -> [Char]
show a
err

--
-- Shelley
--

-- | The Shelley-based credentials named by the individual @--shelley-*@
-- options: the operational certificate, the VRF signing key and the KES source
-- are useful only together, so either all three are given or none is.
readShelley ::
  CLI.Credentials -> ExceptT String IO [ShelleyLeaderCredentials StandardCrypto]
readShelley :: Credentials
-> ExceptT [Char] IO [ShelleyLeaderCredentials StandardCrypto]
readShelley Credentials
creds =
  case ( Credentials -> StrictMaybe [Char]
CLI.shelleyOperationalCertificate Credentials
creds
       , Credentials -> StrictMaybe [Char]
CLI.shelleyVRFKey Credentials
creds
       , Credentials -> StrictMaybe KESSource
CLI.shelleyKES Credentials
creds
       ) of
    (StrictMaybe [Char]
SNothing, StrictMaybe [Char]
SNothing, StrictMaybe KESSource
SNothing) -> [ShelleyLeaderCredentials StandardCrypto]
-> ExceptT [Char] IO [ShelleyLeaderCredentials StandardCrypto]
forall a. a -> ExceptT [Char] IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    (StrictMaybe [Char]
SNothing, StrictMaybe [Char]
_, StrictMaybe KESSource
_) -> [Char]
-> ExceptT [Char] IO [ShelleyLeaderCredentials StandardCrypto]
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ([Char]
 -> ExceptT [Char] IO [ShelleyLeaderCredentials StandardCrypto])
-> [Char]
-> ExceptT [Char] IO [ShelleyLeaderCredentials StandardCrypto]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
missingOption [Char]
"shelley-operational-certificate"
    (StrictMaybe [Char]
_, StrictMaybe [Char]
SNothing, StrictMaybe KESSource
_) -> [Char]
-> ExceptT [Char] IO [ShelleyLeaderCredentials StandardCrypto]
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ([Char]
 -> ExceptT [Char] IO [ShelleyLeaderCredentials StandardCrypto])
-> [Char]
-> ExceptT [Char] IO [ShelleyLeaderCredentials StandardCrypto]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
missingOption [Char]
"shelley-vrf-key"
    (StrictMaybe [Char]
_, StrictMaybe [Char]
_, StrictMaybe KESSource
SNothing) ->
      [Char]
-> ExceptT [Char] IO [ShelleyLeaderCredentials StandardCrypto]
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ([Char]
 -> ExceptT [Char] IO [ShelleyLeaderCredentials StandardCrypto])
-> [Char]
-> ExceptT [Char] IO [ShelleyLeaderCredentials StandardCrypto]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
missingOption [Char]
"shelley-kes-key or --shelley-kes-agent-socket"
    (SJust [Char]
certFile, SJust [Char]
vrfFile, SJust KESSource
kesSource) -> do
      opCert <- [Char] -> ExceptT [Char] IO OperationalCertificate
forall a. HasTextEnvelope a => [Char] -> ExceptT [Char] IO a
readTextEnvelope [Char]
certFile
      Keys.VrfSigningKey vrfSignKey <- readTextEnvelope vrfFile
      credentialsSource <- case kesSource of
        -- The unsound variant: the KES signing key sits in a file on disk
        -- instead of never leaving a KES agent's memory.
        CLI.KESKeyFilePath [Char]
kesFile -> do
          kesSignKey <- [Char] -> ExceptT [Char] IO (SigningKey KesKey)
forall a. HasTextEnvelope a => [Char] -> ExceptT [Char] IO a
readTextEnvelope [Char]
kesFile
          checkOpCertKesKey (certFile <> " with " <> kesFile) opCert kesSignKey
          pure $
            PraosCredentialsUnsound
              (opCertOf opCert)
              (Keys.unsoundPureKesSigningKey kesSignKey)
        CLI.KESAgentSocketPath [Char]
socketPath ->
          PraosCredentialsSource StandardCrypto
-> ExceptT [Char] IO (PraosCredentialsSource StandardCrypto)
forall a. a -> ExceptT [Char] IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PraosCredentialsSource StandardCrypto
 -> ExceptT [Char] IO (PraosCredentialsSource StandardCrypto))
-> PraosCredentialsSource StandardCrypto
-> ExceptT [Char] IO (PraosCredentialsSource StandardCrypto)
forall a b. (a -> b) -> a -> b
$ [Char] -> PraosCredentialsSource StandardCrypto
forall c.
(DSIGN (ACrypto c) ~ DSIGN) =>
[Char] -> PraosCredentialsSource c
PraosCredentialsAgent [Char]
socketPath
      pure [mkShelleyCredentials (coldVerKeyOf opCert) vrfSignKey credentialsSource]

-- | The Shelley-based credentials in the bulk credentials file, which holds any
-- number of them. A bulk file only ever carries KES signing keys, never a KES
-- agent's socket.
readShelleyBulk ::
  CLI.Credentials -> ExceptT String IO [ShelleyLeaderCredentials StandardCrypto]
readShelleyBulk :: Credentials
-> ExceptT [Char] IO [ShelleyLeaderCredentials StandardCrypto]
readShelleyBulk Credentials
creds = case Credentials -> StrictMaybe [Char]
CLI.bulkCredentialsFile Credentials
creds of
  StrictMaybe [Char]
SNothing -> [ShelleyLeaderCredentials StandardCrypto]
-> ExceptT [Char] IO [ShelleyLeaderCredentials StandardCrypto]
forall a. a -> ExceptT [Char] IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  SJust [Char]
file -> do
    entries <-
      IO
  (Either
     [Char]
     [(OperationalCertificate, SigningKey VrfKey, SigningKey KesKey)])
-> ExceptT
     [Char]
     IO
     [(OperationalCertificate, SigningKey VrfKey, SigningKey KesKey)]
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO
   (Either
      [Char]
      [(OperationalCertificate, SigningKey VrfKey, SigningKey KesKey)])
 -> ExceptT
      [Char]
      IO
      [(OperationalCertificate, SigningKey VrfKey, SigningKey KesKey)])
-> IO
     (Either
        [Char]
        [(OperationalCertificate, SigningKey VrfKey, SigningKey KesKey)])
-> ExceptT
     [Char]
     IO
     [(OperationalCertificate, SigningKey VrfKey, SigningKey KesKey)]
forall a b. (a -> b) -> a -> b
$
        (FileError TextEnvelopeError -> [Char])
-> Either
     (FileError TextEnvelopeError)
     [(OperationalCertificate, SigningKey VrfKey, SigningKey KesKey)]
-> Either
     [Char]
     [(OperationalCertificate, SigningKey VrfKey, SigningKey KesKey)]
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((TextEnvelopeError -> Doc (ZonkAny 4))
-> FileError TextEnvelopeError -> [Char]
forall e ann. (e -> Doc ann) -> FileError e -> [Char]
renderKeyFileError TextEnvelopeError -> Doc (ZonkAny 4)
forall ann. TextEnvelopeError -> Doc ann
Keys.renderTextEnvelopeError)
          (Either
   (FileError TextEnvelopeError)
   [(OperationalCertificate, SigningKey VrfKey, SigningKey KesKey)]
 -> Either
      [Char]
      [(OperationalCertificate, SigningKey VrfKey, SigningKey KesKey)])
-> IO
     (Either
        (FileError TextEnvelopeError)
        [(OperationalCertificate, SigningKey VrfKey, SigningKey KesKey)])
-> IO
     (Either
        [Char]
        [(OperationalCertificate, SigningKey VrfKey, SigningKey KesKey)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char]
-> IO
     (Either
        (FileError TextEnvelopeError)
        [(OperationalCertificate, SigningKey VrfKey, SigningKey KesKey)])
Keys.readBulkCredentialsFile [Char]
file
    traverse (fromBulkEntry file) (zip [0 :: Int ..] entries)
 where
  fromBulkEntry :: [Char]
-> (a,
    (OperationalCertificate, SigningKey VrfKey, SigningKey KesKey))
-> ExceptT [Char] IO (ShelleyLeaderCredentials StandardCrypto)
fromBulkEntry [Char]
file (a
index, (OperationalCertificate
opCert, Keys.VrfSigningKey SignKeyVRF (VRF StandardCrypto)
vrfSignKey, SigningKey KesKey
kesSignKey)) = do
    -- Which entry of the file it was, because that is all that distinguishes
    -- one pair in a bulk file from the next.
    [Char]
-> OperationalCertificate
-> SigningKey KesKey
-> ExceptT [Char] IO ()
checkOpCertKesKey ([Char]
file [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
", entry " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> a -> [Char]
forall {a}. Show a => a -> [Char]
show a
index) OperationalCertificate
opCert SigningKey KesKey
kesSignKey
    ShelleyLeaderCredentials StandardCrypto
-> ExceptT [Char] IO (ShelleyLeaderCredentials StandardCrypto)
forall a. a -> ExceptT [Char] IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShelleyLeaderCredentials StandardCrypto
 -> ExceptT [Char] IO (ShelleyLeaderCredentials StandardCrypto))
-> ShelleyLeaderCredentials StandardCrypto
-> ExceptT [Char] IO (ShelleyLeaderCredentials StandardCrypto)
forall a b. (a -> b) -> a -> b
$
      VKey StakePool
-> SignKeyVRF (VRF StandardCrypto)
-> PraosCredentialsSource StandardCrypto
-> ShelleyLeaderCredentials StandardCrypto
mkShelleyCredentials
        (OperationalCertificate -> VKey StakePool
coldVerKeyOf OperationalCertificate
opCert)
        SignKeyVRF (VRF StandardCrypto)
vrfSignKey
        ( OCert StandardCrypto
-> UnsoundPureSignKeyKES (KES StandardCrypto)
-> PraosCredentialsSource StandardCrypto
forall c.
OCert c
-> UnsoundPureSignKeyKES (KES c) -> PraosCredentialsSource c
PraosCredentialsUnsound
            (OperationalCertificate -> OCert StandardCrypto
opCertOf OperationalCertificate
opCert)
            (SigningKey KesKey -> UnsoundPureSignKeyKES (KES StandardCrypto)
Keys.unsoundPureKesSigningKey SigningKey KesKey
kesSignKey)
        )

mkShelleyCredentials ::
  VKey StakePool ->
  VRF.SignKeyVRF (VRF StandardCrypto) ->
  PraosCredentialsSource StandardCrypto ->
  ShelleyLeaderCredentials StandardCrypto
mkShelleyCredentials :: VKey StakePool
-> SignKeyVRF (VRF StandardCrypto)
-> PraosCredentialsSource StandardCrypto
-> ShelleyLeaderCredentials StandardCrypto
mkShelleyCredentials VKey StakePool
coldVerKey SignKeyVRF (VRF StandardCrypto)
vrfSignKey PraosCredentialsSource StandardCrypto
credentialsSource =
  ShelleyLeaderCredentials
    { shelleyLeaderCredentialsCanBeLeader :: PraosCanBeLeader StandardCrypto
shelleyLeaderCredentialsCanBeLeader =
        PraosCanBeLeader
          { praosCanBeLeaderColdVerKey :: VKey BlockIssuer
praosCanBeLeaderColdVerKey = VKey StakePool -> VKey BlockIssuer
forall (r :: KeyRole) (r' :: KeyRole). VKey r -> VKey r'
forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
coerceKeyRole VKey StakePool
coldVerKey
          , praosCanBeLeaderSignKeyVRF :: SignKeyVRF (VRF StandardCrypto)
praosCanBeLeaderSignKeyVRF = SignKeyVRF (VRF StandardCrypto)
vrfSignKey
          , praosCanBeLeaderCredentialsSource :: PraosCredentialsSource StandardCrypto
praosCanBeLeaderCredentialsSource = PraosCredentialsSource StandardCrypto
credentialsSource
          }
    , -- Consensus uses this to name the era these credentials forge in.
      shelleyLeaderCredentialsLabel :: Text
shelleyLeaderCredentialsLabel = Text
"Shelley"
    }

--
-- Reading the credential files
--

-- | Read a text envelope: the operational certificate and the VRF and KES
-- signing keys are all stored as one. Which type the file has to hold follows
-- from the type the caller wants back.
readTextEnvelope :: Keys.HasTextEnvelope a => FilePath -> ExceptT String IO a
readTextEnvelope :: forall a. HasTextEnvelope a => [Char] -> ExceptT [Char] IO a
readTextEnvelope [Char]
path =
  IO (Either [Char] a) -> ExceptT [Char] IO a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either [Char] a) -> ExceptT [Char] IO a)
-> IO (Either [Char] a) -> ExceptT [Char] IO a
forall a b. (a -> b) -> a -> b
$
    (FileError TextEnvelopeError -> [Char])
-> Either (FileError TextEnvelopeError) a -> Either [Char] a
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((TextEnvelopeError -> Doc (ZonkAny 3))
-> FileError TextEnvelopeError -> [Char]
forall e ann. (e -> Doc ann) -> FileError e -> [Char]
renderKeyFileError TextEnvelopeError -> Doc (ZonkAny 3)
forall ann. TextEnvelopeError -> Doc ann
Keys.renderTextEnvelopeError)
      (Either (FileError TextEnvelopeError) a -> Either [Char] a)
-> IO (Either (FileError TextEnvelopeError) a)
-> IO (Either [Char] a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO (Either (FileError TextEnvelopeError) a)
forall a.
HasTextEnvelope a =>
[Char] -> IO (Either (FileError TextEnvelopeError) a)
Keys.readFileTextEnvelope [Char]
path

-- | The Byron signing key, which is not a text envelope: the file is the raw
-- CBOR of a legacy Byron @XPrv@.
readByronSigningKey :: FilePath -> ExceptT String IO Byron.Crypto.SigningKey
readByronSigningKey :: [Char] -> ExceptT [Char] IO SigningKey
readByronSigningKey [Char]
path = do
  Keys.ByronSigningKey signingKey <-
    IO (Either [Char] (SigningKey ByronKey))
-> ExceptT [Char] IO (SigningKey ByronKey)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either [Char] (SigningKey ByronKey))
 -> ExceptT [Char] IO (SigningKey ByronKey))
-> IO (Either [Char] (SigningKey ByronKey))
-> ExceptT [Char] IO (SigningKey ByronKey)
forall a b. (a -> b) -> a -> b
$
      (FileError SerialiseAsRawBytesError -> [Char])
-> Either
     (FileError SerialiseAsRawBytesError) (SigningKey ByronKey)
-> Either [Char] (SigningKey ByronKey)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((SerialiseAsRawBytesError -> Doc (ZonkAny 2))
-> FileError SerialiseAsRawBytesError -> [Char]
forall e ann. (e -> Doc ann) -> FileError e -> [Char]
renderKeyFileError SerialiseAsRawBytesError -> Doc (ZonkAny 2)
forall ann. SerialiseAsRawBytesError -> Doc ann
Keys.renderSerialiseAsRawBytesError)
        (Either (FileError SerialiseAsRawBytesError) (SigningKey ByronKey)
 -> Either [Char] (SigningKey ByronKey))
-> IO
     (Either (FileError SerialiseAsRawBytesError) (SigningKey ByronKey))
-> IO (Either [Char] (SigningKey ByronKey))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char]
-> IO
     (Either (FileError SerialiseAsRawBytesError) (SigningKey ByronKey))
Keys.readByronSigningKeyFile [Char]
path
  pure signingKey

-- | The Byron delegation certificate, which is neither a text envelope nor
-- CBOR: the file is canonical JSON, like the Byron genesis itself.
readByronDelegationCertificate ::
  FilePath -> ExceptT String IO Byron.Delegation.Certificate
readByronDelegationCertificate :: [Char] -> ExceptT [Char] IO Certificate
readByronDelegationCertificate [Char]
path =
  IO (Either [Char] Certificate) -> ExceptT [Char] IO Certificate
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either [Char] Certificate) -> ExceptT [Char] IO Certificate)
-> IO (Either [Char] Certificate) -> ExceptT [Char] IO Certificate
forall a b. (a -> b) -> a -> b
$
    (FileError Text -> [Char])
-> Either (FileError Text) Certificate -> Either [Char] Certificate
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((Text -> Doc (ZonkAny 1)) -> FileError Text -> [Char]
forall e ann. (e -> Doc ann) -> FileError e -> [Char]
renderKeyFileError Text -> Doc (ZonkAny 1)
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty)
      (Either (FileError Text) Certificate -> Either [Char] Certificate)
-> IO (Either (FileError Text) Certificate)
-> IO (Either [Char] Certificate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO (Either (FileError Text) Certificate)
Keys.readByronDelegationCertificateFile [Char]
path

-- | Check that an operational certificate authorises the KES key it was handed
-- alongside.
--
-- @cardano-keys@ leaves this to the caller. It matters: a certificate paired
-- with a KES key it does not name forges blocks the certificate does not
-- authorise, which the network rejects while the tool reports nothing.
checkOpCertKesKey ::
  -- | Where the two came from, for the error message.
  String ->
  Keys.OperationalCertificate ->
  Keys.SigningKey Keys.KesKey ->
  ExceptT String IO ()
checkOpCertKesKey :: [Char]
-> OperationalCertificate
-> SigningKey KesKey
-> ExceptT [Char] IO ()
checkOpCertKesKey [Char]
source OperationalCertificate
opCert SigningKey KesKey
kesSignKey =
  Either [Char] () -> ExceptT [Char] IO ()
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either [Char] () -> ExceptT [Char] IO ())
-> (Either KesKeyMismatch () -> Either [Char] ())
-> Either KesKeyMismatch ()
-> ExceptT [Char] IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KesKeyMismatch -> [Char])
-> Either KesKeyMismatch () -> Either [Char] ()
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first KesKeyMismatch -> [Char]
renderMismatch (Either KesKeyMismatch () -> ExceptT [Char] IO ())
-> Either KesKeyMismatch () -> ExceptT [Char] IO ()
forall a b. (a -> b) -> a -> b
$ OperationalCertificate
-> SigningKey KesKey -> Either KesKeyMismatch ()
Keys.checkKesKeyMatchesOpCert OperationalCertificate
opCert SigningKey KesKey
kesSignKey
 where
  renderMismatch :: KesKeyMismatch -> [Char]
renderMismatch KesKeyMismatch
mismatch =
    [Char]
source [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
": " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Doc (ZonkAny 0) -> [Char]
forall ann. Doc ann -> [Char]
Keys.docToString (KesKeyMismatch -> Doc (ZonkAny 0)
forall ann. KesKeyMismatch -> Doc ann
Keys.renderKesKeyMismatch KesKeyMismatch
mismatch)

-- | Report one of @cardano-keys@' file errors as a message. It renders errors
-- as @prettyprinter@ documents and hands out the payload renderer separately,
-- hence the argument.
renderKeyFileError :: (e -> Doc ann) -> Keys.FileError e -> String
renderKeyFileError :: forall e ann. (e -> Doc ann) -> FileError e -> [Char]
renderKeyFileError e -> Doc ann
renderPayload =
  Doc ann -> [Char]
forall ann. Doc ann -> [Char]
Keys.docToString (Doc ann -> [Char])
-> (FileError e -> Doc ann) -> FileError e -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> Doc ann) -> FileError e -> Doc ann
forall e ann. (e -> Doc ann) -> FileError e -> Doc ann
Keys.renderFileError e -> Doc ann
renderPayload

--
-- Mapping onto the consensus types
--

-- | The consensus operational certificate a @cardano-keys@ one wraps.
opCertOf :: Keys.OperationalCertificate -> OCert.OCert StandardCrypto
opCertOf :: OperationalCertificate -> OCert StandardCrypto
opCertOf (Keys.OperationalCertificate OCert StandardCrypto
opCert VerificationKey StakePoolKey
_) = OCert StandardCrypto
opCert

-- | The stake pool cold verification key an operational certificate names,
-- which the file carries alongside the certificate itself.
coldVerKeyOf :: Keys.OperationalCertificate -> VKey StakePool
coldVerKeyOf :: OperationalCertificate -> VKey StakePool
coldVerKeyOf (Keys.OperationalCertificate OCert StandardCrypto
_ (Keys.StakePoolVerificationKey VKey StakePool
coldVerKey)) =
  VKey StakePool
coldVerKey

--
-- Errors
--

-- | The credential options only make sense in complete sets, so a partial set
-- is reported by naming the option that would complete it.
missingOption :: String -> String
missingOption :: [Char] -> [Char]
missingOption [Char]
option =
  [Char]
"To forge blocks, --" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
option [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" must also be specified"