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

module Cardano.Node.Protocol.Shelley
  ( mkSomeConsensusProtocolShelley

    -- * Errors
  , ShelleyProtocolInstantiationError(..)
  , GenesisReadError(..)
  , GenesisValidationError(..)
  , PraosLeaderCredentialsError(..)

    -- * Reusable parts
  , readGenesis
  , readGenesisAny
  , readLeaderCredentials
  , genesisHashToPraosNonce
  , validateGenesis
  ) where

import qualified Cardano.Api as Api
import           Cardano.Prelude
import           Prelude (String, id)

import qualified Data.Aeson as Aeson
import qualified Data.ByteString as BS
import qualified Data.Text as T

import           Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistEither, left,
                   newExceptT)

import qualified Cardano.Crypto.Hash.Class as Crypto
import           Cardano.Ledger.Crypto (StandardCrypto)
import           Cardano.Ledger.Keys (coerceKeyRole)

import qualified Ouroboros.Consensus.Cardano as Consensus
import qualified Ouroboros.Consensus.Mempool.TxLimits as TxLimits
import           Ouroboros.Consensus.Protocol.Praos.Common (PraosCanBeLeader (..))
import           Ouroboros.Consensus.Shelley.Eras (StandardShelley)
import           Ouroboros.Consensus.Shelley.Node (Nonce (..), ProtocolParamsShelley (..),
                   ProtocolParamsShelleyBased (..), ShelleyLeaderCredentials (..))

import           Cardano.Ledger.BaseTypes (ProtVer (..))
import qualified Cardano.Ledger.Shelley.Genesis as Shelley

import           Cardano.Api.Orphans ()
import           Cardano.Api.Shelley hiding (FileError)

import           Cardano.Node.Types

import           Cardano.Tracing.OrphanInstances.HardFork ()
import           Cardano.Tracing.OrphanInstances.Shelley ()

import           Cardano.Node.Tracing.Era.HardFork ()
import           Cardano.Node.Tracing.Era.Shelley ()
import           Cardano.Node.Tracing.Formatting ()
import           Cardano.Node.Tracing.Tracers.ChainDB ()

import           Cardano.Node.Protocol.Types

------------------------------------------------------------------------------
-- Shelley protocol
--

-- | Make 'SomeConsensusProtocol' using the Shelley instance.
--
-- This lets us handle multiple protocols in a generic way.
--
-- This also serves a purpose as a sanity check that we have all the necessary
-- type class instances available.
mkSomeConsensusProtocolShelley
  :: NodeShelleyProtocolConfiguration
  -> Maybe ProtocolFilepaths
  -> ExceptT ShelleyProtocolInstantiationError IO SomeConsensusProtocol
mkSomeConsensusProtocolShelley :: NodeShelleyProtocolConfiguration
-> Maybe ProtocolFilepaths
-> ExceptT
     ShelleyProtocolInstantiationError IO SomeConsensusProtocol
mkSomeConsensusProtocolShelley NodeShelleyProtocolConfiguration {
                                  GenesisFile
npcShelleyGenesisFile :: NodeShelleyProtocolConfiguration -> GenesisFile
npcShelleyGenesisFile :: GenesisFile
npcShelleyGenesisFile,
                                  Maybe GenesisHash
npcShelleyGenesisFileHash :: NodeShelleyProtocolConfiguration -> Maybe GenesisHash
npcShelleyGenesisFileHash :: Maybe GenesisHash
npcShelleyGenesisFileHash
                                }
                          Maybe ProtocolFilepaths
files = do
    (ShelleyGenesis StandardShelley
genesis, GenesisHash
genesisHash) <- (GenesisReadError -> ShelleyProtocolInstantiationError)
-> ExceptT
     GenesisReadError IO (ShelleyGenesis StandardShelley, GenesisHash)
-> ExceptT
     ShelleyProtocolInstantiationError
     IO
     (ShelleyGenesis StandardShelley, GenesisHash)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT GenesisReadError -> ShelleyProtocolInstantiationError
GenesisReadError (ExceptT
   GenesisReadError IO (ShelleyGenesis StandardShelley, GenesisHash)
 -> ExceptT
      ShelleyProtocolInstantiationError
      IO
      (ShelleyGenesis StandardShelley, GenesisHash))
-> ExceptT
     GenesisReadError IO (ShelleyGenesis StandardShelley, GenesisHash)
-> ExceptT
     ShelleyProtocolInstantiationError
     IO
     (ShelleyGenesis StandardShelley, GenesisHash)
forall a b. (a -> b) -> a -> b
$
                              GenesisFile
-> Maybe GenesisHash
-> ExceptT
     GenesisReadError IO (ShelleyGenesis StandardShelley, GenesisHash)
readGenesis GenesisFile
npcShelleyGenesisFile
                                          Maybe GenesisHash
npcShelleyGenesisFileHash
    (GenesisValidationError -> ShelleyProtocolInstantiationError)
-> ExceptT GenesisValidationError IO ()
-> ExceptT ShelleyProtocolInstantiationError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT GenesisValidationError -> ShelleyProtocolInstantiationError
GenesisValidationError (ExceptT GenesisValidationError IO ()
 -> ExceptT ShelleyProtocolInstantiationError IO ())
-> ExceptT GenesisValidationError IO ()
-> ExceptT ShelleyProtocolInstantiationError IO ()
forall a b. (a -> b) -> a -> b
$ ShelleyGenesis StandardShelley
-> ExceptT GenesisValidationError IO ()
validateGenesis ShelleyGenesis StandardShelley
genesis
    [ShelleyLeaderCredentials StandardCrypto]
leaderCredentials <- (PraosLeaderCredentialsError -> ShelleyProtocolInstantiationError)
-> ExceptT
     PraosLeaderCredentialsError
     IO
     [ShelleyLeaderCredentials StandardCrypto]
-> ExceptT
     ShelleyProtocolInstantiationError
     IO
     [ShelleyLeaderCredentials StandardCrypto]
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT PraosLeaderCredentialsError -> ShelleyProtocolInstantiationError
PraosLeaderCredentialsError (ExceptT
   PraosLeaderCredentialsError
   IO
   [ShelleyLeaderCredentials StandardCrypto]
 -> ExceptT
      ShelleyProtocolInstantiationError
      IO
      [ShelleyLeaderCredentials StandardCrypto])
-> ExceptT
     PraosLeaderCredentialsError
     IO
     [ShelleyLeaderCredentials StandardCrypto]
-> ExceptT
     ShelleyProtocolInstantiationError
     IO
     [ShelleyLeaderCredentials StandardCrypto]
forall a b. (a -> b) -> a -> b
$
                         Maybe ProtocolFilepaths
-> ExceptT
     PraosLeaderCredentialsError
     IO
     [ShelleyLeaderCredentials StandardCrypto]
readLeaderCredentials Maybe ProtocolFilepaths
files

    SomeConsensusProtocol
-> ExceptT
     ShelleyProtocolInstantiationError IO SomeConsensusProtocol
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeConsensusProtocol
 -> ExceptT
      ShelleyProtocolInstantiationError IO SomeConsensusProtocol)
-> SomeConsensusProtocol
-> ExceptT
     ShelleyProtocolInstantiationError IO SomeConsensusProtocol
forall a b. (a -> b) -> a -> b
$ BlockType
  (HardForkBlock
     '[ShelleyBlock (TPraos StandardCrypto) StandardShelley])
-> ProtocolInfoArgs
     IO
     (HardForkBlock
        '[ShelleyBlock (TPraos StandardCrypto) StandardShelley])
-> SomeConsensusProtocol
forall blk.
(Protocol IO blk, HasKESMetricsData blk, HasKESInfo blk,
 TraceConstraints blk) =>
BlockType blk -> ProtocolInfoArgs IO blk -> SomeConsensusProtocol
SomeConsensusProtocol BlockType
  (HardForkBlock
     '[ShelleyBlock (TPraos StandardCrypto) StandardShelley])
Api.ShelleyBlockType (ProtocolInfoArgs
   IO
   (HardForkBlock
      '[ShelleyBlock (TPraos StandardCrypto) StandardShelley])
 -> SomeConsensusProtocol)
-> ProtocolInfoArgs
     IO
     (HardForkBlock
        '[ShelleyBlock (TPraos StandardCrypto) StandardShelley])
-> SomeConsensusProtocol
forall a b. (a -> b) -> a -> b
$ ProtocolParamsShelleyBased StandardShelley
-> ProtocolParamsShelley StandardCrypto
-> ProtocolInfoArgs
     IO
     (HardForkBlock
        '[ShelleyBlock (TPraos StandardCrypto) StandardShelley])
forall (m :: * -> *).
ProtocolParamsShelleyBased StandardShelley
-> ProtocolParamsShelley StandardCrypto
-> ProtocolInfoArgs
     m
     (HardForkBlock
        '[ShelleyBlock (TPraos StandardCrypto) StandardShelley])
Api.ProtocolInfoArgsShelley
      ProtocolParamsShelleyBased :: forall era.
ShelleyGenesis era
-> Nonce
-> [ShelleyLeaderCredentials (EraCrypto era)]
-> ProtocolParamsShelleyBased era
Consensus.ProtocolParamsShelleyBased {
        shelleyBasedGenesis :: ShelleyGenesis StandardShelley
shelleyBasedGenesis = ShelleyGenesis StandardShelley
genesis,
        shelleyBasedInitialNonce :: Nonce
shelleyBasedInitialNonce = GenesisHash -> Nonce
genesisHashToPraosNonce GenesisHash
genesisHash,
        shelleyBasedLeaderCredentials :: [ShelleyLeaderCredentials (EraCrypto StandardShelley)]
shelleyBasedLeaderCredentials =
            [ShelleyLeaderCredentials StandardCrypto]
[ShelleyLeaderCredentials (EraCrypto StandardShelley)]
leaderCredentials
      }
      ProtocolParamsShelley :: forall c.
ProtVer
-> Overrides (ShelleyBlock (TPraos c) (ShelleyEra c))
-> ProtocolParamsShelley c
Consensus.ProtocolParamsShelley {
        $sel:shelleyProtVer:ProtocolParamsShelley :: ProtVer
shelleyProtVer =
          Natural -> Natural -> ProtVer
ProtVer Natural
2 Natural
0,
        $sel:shelleyMaxTxCapacityOverrides:ProtocolParamsShelley :: Overrides (ShelleyBlock (TPraos StandardCrypto) StandardShelley)
shelleyMaxTxCapacityOverrides =
          TxMeasure (ShelleyBlock (TPraos StandardCrypto) StandardShelley)
-> Overrides (ShelleyBlock (TPraos StandardCrypto) StandardShelley)
forall blk. TxMeasure blk -> Overrides blk
TxLimits.mkOverrides TxMeasure (ShelleyBlock (TPraos StandardCrypto) StandardShelley)
forall a. BoundedMeasure a => a
TxLimits.noOverridesMeasure
      }

genesisHashToPraosNonce :: GenesisHash -> Nonce
genesisHashToPraosNonce :: GenesisHash -> Nonce
genesisHashToPraosNonce (GenesisHash Hash Blake2b_256 ByteString
h) = Hash Blake2b_256 Nonce -> Nonce
Nonce (Hash Blake2b_256 ByteString -> Hash Blake2b_256 Nonce
forall h a b. Hash h a -> Hash h b
Crypto.castHash Hash Blake2b_256 ByteString
h)

readGenesis :: GenesisFile
            -> Maybe GenesisHash
            -> ExceptT GenesisReadError IO
                       (ShelleyGenesis StandardShelley, GenesisHash)
readGenesis :: GenesisFile
-> Maybe GenesisHash
-> ExceptT
     GenesisReadError IO (ShelleyGenesis StandardShelley, GenesisHash)
readGenesis = GenesisFile
-> Maybe GenesisHash
-> ExceptT
     GenesisReadError IO (ShelleyGenesis StandardShelley, GenesisHash)
forall genesis.
FromJSON genesis =>
GenesisFile
-> Maybe GenesisHash
-> ExceptT GenesisReadError IO (genesis, GenesisHash)
readGenesisAny

readGenesisAny :: FromJSON genesis
               => GenesisFile
               -> Maybe GenesisHash
               -> ExceptT GenesisReadError IO (genesis, GenesisHash)
readGenesisAny :: GenesisFile
-> Maybe GenesisHash
-> ExceptT GenesisReadError IO (genesis, GenesisHash)
readGenesisAny (GenesisFile FilePath
file) Maybe GenesisHash
mbExpectedGenesisHash = do
    ByteString
content <- (IOException -> GenesisReadError)
-> IO ByteString -> ExceptT GenesisReadError IO ByteString
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FilePath -> IOException -> GenesisReadError
GenesisReadFileError FilePath
file) (IO ByteString -> ExceptT GenesisReadError IO ByteString)
-> IO ByteString -> ExceptT GenesisReadError IO ByteString
forall a b. (a -> b) -> a -> b
$
                 FilePath -> IO ByteString
BS.readFile FilePath
file
    let genesisHash :: GenesisHash
genesisHash = Hash Blake2b_256 ByteString -> GenesisHash
GenesisHash ((ByteString -> ByteString)
-> ByteString -> Hash Blake2b_256 ByteString
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
Crypto.hashWith ByteString -> ByteString
forall a. a -> a
id ByteString
content)
    GenesisHash -> ExceptT GenesisReadError IO ()
checkExpectedGenesisHash GenesisHash
genesisHash
    genesis
genesis <- (FilePath -> GenesisReadError)
-> ExceptT FilePath IO genesis
-> ExceptT GenesisReadError IO genesis
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (FilePath -> FilePath -> GenesisReadError
GenesisDecodeError FilePath
file) (ExceptT FilePath IO genesis
 -> ExceptT GenesisReadError IO genesis)
-> ExceptT FilePath IO genesis
-> ExceptT GenesisReadError IO genesis
forall a b. (a -> b) -> a -> b
$ Either FilePath genesis -> ExceptT FilePath IO genesis
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (Either FilePath genesis -> ExceptT FilePath IO genesis)
-> Either FilePath genesis -> ExceptT FilePath IO genesis
forall a b. (a -> b) -> a -> b
$
                 ByteString -> Either FilePath genesis
forall a. FromJSON a => ByteString -> Either FilePath a
Aeson.eitherDecodeStrict' ByteString
content
    (genesis, GenesisHash)
-> ExceptT GenesisReadError IO (genesis, GenesisHash)
forall (m :: * -> *) a. Monad m => a -> m a
return (genesis
genesis, GenesisHash
genesisHash)
  where
    checkExpectedGenesisHash :: GenesisHash
                             -> ExceptT GenesisReadError IO ()
    checkExpectedGenesisHash :: GenesisHash -> ExceptT GenesisReadError IO ()
checkExpectedGenesisHash GenesisHash
actual =
      case Maybe GenesisHash
mbExpectedGenesisHash of
        Just GenesisHash
expected | GenesisHash
actual GenesisHash -> GenesisHash -> Bool
forall a. Eq a => a -> a -> Bool
/= GenesisHash
expected
          -> GenesisReadError -> ExceptT GenesisReadError IO ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GenesisHash -> GenesisHash -> GenesisReadError
GenesisHashMismatch GenesisHash
actual GenesisHash
expected)
        Maybe GenesisHash
_ -> () -> ExceptT GenesisReadError IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

validateGenesis :: ShelleyGenesis StandardShelley
                -> ExceptT GenesisValidationError IO ()
validateGenesis :: ShelleyGenesis StandardShelley
-> ExceptT GenesisValidationError IO ()
validateGenesis ShelleyGenesis StandardShelley
genesis =
    ([ValidationErr] -> GenesisValidationError)
-> ExceptT [ValidationErr] IO ()
-> ExceptT GenesisValidationError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT [ValidationErr] -> GenesisValidationError
GenesisValidationErrors (ExceptT [ValidationErr] IO ()
 -> ExceptT GenesisValidationError IO ())
-> (Either [ValidationErr] () -> ExceptT [ValidationErr] IO ())
-> Either [ValidationErr] ()
-> ExceptT GenesisValidationError IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Either [ValidationErr] () -> ExceptT [ValidationErr] IO ()
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (Either [ValidationErr] () -> ExceptT GenesisValidationError IO ())
-> Either [ValidationErr] ()
-> ExceptT GenesisValidationError IO ()
forall a b. (a -> b) -> a -> b
$
      ShelleyGenesis StandardShelley -> Either [ValidationErr] ()
forall era.
Era era =>
ShelleyGenesis era -> Either [ValidationErr] ()
Shelley.validateGenesis ShelleyGenesis StandardShelley
genesis

readLeaderCredentials
  :: Maybe ProtocolFilepaths
  -> ExceptT PraosLeaderCredentialsError IO [ShelleyLeaderCredentials StandardCrypto]
readLeaderCredentials :: Maybe ProtocolFilepaths
-> ExceptT
     PraosLeaderCredentialsError
     IO
     [ShelleyLeaderCredentials StandardCrypto]
readLeaderCredentials Maybe ProtocolFilepaths
Nothing = [ShelleyLeaderCredentials StandardCrypto]
-> ExceptT
     PraosLeaderCredentialsError
     IO
     [ShelleyLeaderCredentials StandardCrypto]
forall (m :: * -> *) a. Monad m => a -> m a
return []
readLeaderCredentials (Just ProtocolFilepaths
pfp) =
  -- The set of credentials is a sum total of what comes from the CLI,
  -- as well as what's in the bulk credentials file.
  [ShelleyLeaderCredentials StandardCrypto]
-> [ShelleyLeaderCredentials StandardCrypto]
-> [ShelleyLeaderCredentials StandardCrypto]
forall a. Semigroup a => a -> a -> a
(<>) ([ShelleyLeaderCredentials StandardCrypto]
 -> [ShelleyLeaderCredentials StandardCrypto]
 -> [ShelleyLeaderCredentials StandardCrypto])
-> ExceptT
     PraosLeaderCredentialsError
     IO
     [ShelleyLeaderCredentials StandardCrypto]
-> ExceptT
     PraosLeaderCredentialsError
     IO
     ([ShelleyLeaderCredentials StandardCrypto]
      -> [ShelleyLeaderCredentials StandardCrypto])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtocolFilepaths
-> ExceptT
     PraosLeaderCredentialsError
     IO
     [ShelleyLeaderCredentials StandardCrypto]
readLeaderCredentialsSingleton ProtocolFilepaths
pfp
       ExceptT
  PraosLeaderCredentialsError
  IO
  ([ShelleyLeaderCredentials StandardCrypto]
   -> [ShelleyLeaderCredentials StandardCrypto])
-> ExceptT
     PraosLeaderCredentialsError
     IO
     [ShelleyLeaderCredentials StandardCrypto]
-> ExceptT
     PraosLeaderCredentialsError
     IO
     [ShelleyLeaderCredentials StandardCrypto]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ProtocolFilepaths
-> ExceptT
     PraosLeaderCredentialsError
     IO
     [ShelleyLeaderCredentials StandardCrypto]
readLeaderCredentialsBulk      ProtocolFilepaths
pfp

readLeaderCredentialsSingleton ::
     ProtocolFilepaths ->
     ExceptT PraosLeaderCredentialsError IO
             [ShelleyLeaderCredentials StandardCrypto]
-- It's OK to supply none of the files on the CLI
readLeaderCredentialsSingleton :: ProtocolFilepaths
-> ExceptT
     PraosLeaderCredentialsError
     IO
     [ShelleyLeaderCredentials StandardCrypto]
readLeaderCredentialsSingleton
   ProtocolFilepaths
     { shelleyCertFile :: ProtocolFilepaths -> Maybe FilePath
shelleyCertFile      = Maybe FilePath
Nothing,
       shelleyVRFFile :: ProtocolFilepaths -> Maybe FilePath
shelleyVRFFile       = Maybe FilePath
Nothing,
       shelleyKESFile :: ProtocolFilepaths -> Maybe FilePath
shelleyKESFile       = Maybe FilePath
Nothing
     } = [ShelleyLeaderCredentials StandardCrypto]
-> ExceptT
     PraosLeaderCredentialsError
     IO
     [ShelleyLeaderCredentials StandardCrypto]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
-- Or to supply all of the files
readLeaderCredentialsSingleton
  ProtocolFilepaths { shelleyCertFile :: ProtocolFilepaths -> Maybe FilePath
shelleyCertFile = Just FilePath
opCertFile,
                      shelleyVRFFile :: ProtocolFilepaths -> Maybe FilePath
shelleyVRFFile = Just FilePath
vrfFile,
                      shelleyKESFile :: ProtocolFilepaths -> Maybe FilePath
shelleyKESFile = Just FilePath
kesFile
                    } = do
    SigningKey VrfKey
vrfSKey <-
      (FileError TextEnvelopeError -> PraosLeaderCredentialsError)
-> ExceptT (FileError TextEnvelopeError) IO (SigningKey VrfKey)
-> ExceptT PraosLeaderCredentialsError IO (SigningKey VrfKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> PraosLeaderCredentialsError
FileError (IO (Either (FileError TextEnvelopeError) (SigningKey VrfKey))
-> ExceptT (FileError TextEnvelopeError) IO (SigningKey VrfKey)
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError TextEnvelopeError) (SigningKey VrfKey))
 -> ExceptT (FileError TextEnvelopeError) IO (SigningKey VrfKey))
-> IO (Either (FileError TextEnvelopeError) (SigningKey VrfKey))
-> ExceptT (FileError TextEnvelopeError) IO (SigningKey VrfKey)
forall a b. (a -> b) -> a -> b
$ AsType (SigningKey VrfKey)
-> FilePath
-> IO (Either (FileError TextEnvelopeError) (SigningKey VrfKey))
forall a.
HasTextEnvelope a =>
AsType a -> FilePath -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope (AsType VrfKey -> AsType (SigningKey VrfKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType VrfKey
AsVrfKey) FilePath
vrfFile)

    (OperationalCertificate
opCert, SigningKey KesKey
kesSKey) <- FilePath
-> FilePath
-> ExceptT
     PraosLeaderCredentialsError
     IO
     (OperationalCertificate, SigningKey KesKey)
opCertKesKeyCheck FilePath
kesFile FilePath
opCertFile

    [ShelleyLeaderCredentials StandardCrypto]
-> ExceptT
     PraosLeaderCredentialsError
     IO
     [ShelleyLeaderCredentials StandardCrypto]
forall (m :: * -> *) a. Monad m => a -> m a
return [OperationalCertificate
-> SigningKey VrfKey
-> SigningKey KesKey
-> ShelleyLeaderCredentials StandardCrypto
mkPraosLeaderCredentials OperationalCertificate
opCert SigningKey VrfKey
vrfSKey SigningKey KesKey
kesSKey]

-- But not OK to supply some of the files without the others.
readLeaderCredentialsSingleton ProtocolFilepaths {shelleyCertFile :: ProtocolFilepaths -> Maybe FilePath
shelleyCertFile = Maybe FilePath
Nothing} =
     PraosLeaderCredentialsError
-> ExceptT
     PraosLeaderCredentialsError
     IO
     [ShelleyLeaderCredentials StandardCrypto]
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left PraosLeaderCredentialsError
OCertNotSpecified
readLeaderCredentialsSingleton ProtocolFilepaths {shelleyVRFFile :: ProtocolFilepaths -> Maybe FilePath
shelleyVRFFile = Maybe FilePath
Nothing} =
     PraosLeaderCredentialsError
-> ExceptT
     PraosLeaderCredentialsError
     IO
     [ShelleyLeaderCredentials StandardCrypto]
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left PraosLeaderCredentialsError
VRFKeyNotSpecified
readLeaderCredentialsSingleton ProtocolFilepaths {shelleyKESFile :: ProtocolFilepaths -> Maybe FilePath
shelleyKESFile = Maybe FilePath
Nothing} =
     PraosLeaderCredentialsError
-> ExceptT
     PraosLeaderCredentialsError
     IO
     [ShelleyLeaderCredentials StandardCrypto]
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left PraosLeaderCredentialsError
KESKeyNotSpecified

opCertKesKeyCheck
  :: FilePath
  -- ^ KES key
  -> FilePath
  -- ^ Operational certificate
  -> ExceptT PraosLeaderCredentialsError IO (OperationalCertificate, SigningKey KesKey)
opCertKesKeyCheck :: FilePath
-> FilePath
-> ExceptT
     PraosLeaderCredentialsError
     IO
     (OperationalCertificate, SigningKey KesKey)
opCertKesKeyCheck FilePath
kesFile FilePath
certFile = do
  OperationalCertificate
opCert <-
    (FileError TextEnvelopeError -> PraosLeaderCredentialsError)
-> ExceptT (FileError TextEnvelopeError) IO OperationalCertificate
-> ExceptT PraosLeaderCredentialsError IO OperationalCertificate
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> PraosLeaderCredentialsError
FileError (IO (Either (FileError TextEnvelopeError) OperationalCertificate)
-> ExceptT (FileError TextEnvelopeError) IO OperationalCertificate
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError TextEnvelopeError) OperationalCertificate)
 -> ExceptT (FileError TextEnvelopeError) IO OperationalCertificate)
-> IO (Either (FileError TextEnvelopeError) OperationalCertificate)
-> ExceptT (FileError TextEnvelopeError) IO OperationalCertificate
forall a b. (a -> b) -> a -> b
$ AsType OperationalCertificate
-> FilePath
-> IO (Either (FileError TextEnvelopeError) OperationalCertificate)
forall a.
HasTextEnvelope a =>
AsType a -> FilePath -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope AsType OperationalCertificate
AsOperationalCertificate FilePath
certFile)
  SigningKey KesKey
kesSKey <-
    (FileError TextEnvelopeError -> PraosLeaderCredentialsError)
-> ExceptT (FileError TextEnvelopeError) IO (SigningKey KesKey)
-> ExceptT PraosLeaderCredentialsError IO (SigningKey KesKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> PraosLeaderCredentialsError
FileError (IO (Either (FileError TextEnvelopeError) (SigningKey KesKey))
-> ExceptT (FileError TextEnvelopeError) IO (SigningKey KesKey)
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError TextEnvelopeError) (SigningKey KesKey))
 -> ExceptT (FileError TextEnvelopeError) IO (SigningKey KesKey))
-> IO (Either (FileError TextEnvelopeError) (SigningKey KesKey))
-> ExceptT (FileError TextEnvelopeError) IO (SigningKey KesKey)
forall a b. (a -> b) -> a -> b
$ AsType (SigningKey KesKey)
-> FilePath
-> IO (Either (FileError TextEnvelopeError) (SigningKey KesKey))
forall a.
HasTextEnvelope a =>
AsType a -> FilePath -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope (AsType KesKey -> AsType (SigningKey KesKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType KesKey
AsKesKey) FilePath
kesFile)
  let opCertSpecifiedKesKeyhash :: Hash KesKey
opCertSpecifiedKesKeyhash = VerificationKey KesKey -> Hash KesKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash (VerificationKey KesKey -> Hash KesKey)
-> VerificationKey KesKey -> Hash KesKey
forall a b. (a -> b) -> a -> b
$ OperationalCertificate -> VerificationKey KesKey
getHotKey OperationalCertificate
opCert
      suppliedKesKeyHash :: Hash KesKey
suppliedKesKeyHash = VerificationKey KesKey -> Hash KesKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash (VerificationKey KesKey -> Hash KesKey)
-> VerificationKey KesKey -> Hash KesKey
forall a b. (a -> b) -> a -> b
$ SigningKey KesKey -> VerificationKey KesKey
forall keyrole.
Key keyrole =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey KesKey
kesSKey
  -- Specified KES key in operational certificate should match the one
  -- supplied to the node.
  if Hash KesKey
suppliedKesKeyHash Hash KesKey -> Hash KesKey -> Bool
forall a. Eq a => a -> a -> Bool
/= Hash KesKey
opCertSpecifiedKesKeyhash
  then PraosLeaderCredentialsError
-> ExceptT
     PraosLeaderCredentialsError
     IO
     (OperationalCertificate, SigningKey KesKey)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (PraosLeaderCredentialsError
 -> ExceptT
      PraosLeaderCredentialsError
      IO
      (OperationalCertificate, SigningKey KesKey))
-> PraosLeaderCredentialsError
-> ExceptT
     PraosLeaderCredentialsError
     IO
     (OperationalCertificate, SigningKey KesKey)
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> PraosLeaderCredentialsError
MismatchedKesKey FilePath
kesFile FilePath
certFile
  else (OperationalCertificate, SigningKey KesKey)
-> ExceptT
     PraosLeaderCredentialsError
     IO
     (OperationalCertificate, SigningKey KesKey)
forall (m :: * -> *) a. Monad m => a -> m a
return (OperationalCertificate
opCert, SigningKey KesKey
kesSKey)

data ShelleyCredentials
  = ShelleyCredentials
    { ShelleyCredentials -> (TextEnvelope, FilePath)
scCert :: (TextEnvelope, FilePath)
    , ShelleyCredentials -> (TextEnvelope, FilePath)
scVrf  :: (TextEnvelope, FilePath)
    , ShelleyCredentials -> (TextEnvelope, FilePath)
scKes  :: (TextEnvelope, FilePath)
    }

readLeaderCredentialsBulk
  :: ProtocolFilepaths
  -> ExceptT PraosLeaderCredentialsError IO [ShelleyLeaderCredentials StandardCrypto]
readLeaderCredentialsBulk :: ProtocolFilepaths
-> ExceptT
     PraosLeaderCredentialsError
     IO
     [ShelleyLeaderCredentials StandardCrypto]
readLeaderCredentialsBulk ProtocolFilepaths { shelleyBulkCredsFile :: ProtocolFilepaths -> Maybe FilePath
shelleyBulkCredsFile = Maybe FilePath
mfp } =
  (ShelleyCredentials
 -> ExceptT
      PraosLeaderCredentialsError
      IO
      (ShelleyLeaderCredentials StandardCrypto))
-> [ShelleyCredentials]
-> ExceptT
     PraosLeaderCredentialsError
     IO
     [ShelleyLeaderCredentials StandardCrypto]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ShelleyCredentials
-> ExceptT
     PraosLeaderCredentialsError
     IO
     (ShelleyLeaderCredentials StandardCrypto)
parseShelleyCredentials ([ShelleyCredentials]
 -> ExceptT
      PraosLeaderCredentialsError
      IO
      [ShelleyLeaderCredentials StandardCrypto])
-> ExceptT PraosLeaderCredentialsError IO [ShelleyCredentials]
-> ExceptT
     PraosLeaderCredentialsError
     IO
     [ShelleyLeaderCredentials StandardCrypto]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe FilePath
-> ExceptT PraosLeaderCredentialsError IO [ShelleyCredentials]
readBulkFile Maybe FilePath
mfp
 where
   parseShelleyCredentials
     :: ShelleyCredentials
     -> ExceptT PraosLeaderCredentialsError IO (ShelleyLeaderCredentials StandardCrypto)
   parseShelleyCredentials :: ShelleyCredentials
-> ExceptT
     PraosLeaderCredentialsError
     IO
     (ShelleyLeaderCredentials StandardCrypto)
parseShelleyCredentials ShelleyCredentials { (TextEnvelope, FilePath)
scCert :: (TextEnvelope, FilePath)
scCert :: ShelleyCredentials -> (TextEnvelope, FilePath)
scCert, (TextEnvelope, FilePath)
scVrf :: (TextEnvelope, FilePath)
scVrf :: ShelleyCredentials -> (TextEnvelope, FilePath)
scVrf, (TextEnvelope, FilePath)
scKes :: (TextEnvelope, FilePath)
scKes :: ShelleyCredentials -> (TextEnvelope, FilePath)
scKes } = do
     OperationalCertificate
-> SigningKey VrfKey
-> SigningKey KesKey
-> ShelleyLeaderCredentials StandardCrypto
mkPraosLeaderCredentials
       (OperationalCertificate
 -> SigningKey VrfKey
 -> SigningKey KesKey
 -> ShelleyLeaderCredentials StandardCrypto)
-> ExceptT PraosLeaderCredentialsError IO OperationalCertificate
-> ExceptT
     PraosLeaderCredentialsError
     IO
     (SigningKey VrfKey
      -> SigningKey KesKey -> ShelleyLeaderCredentials StandardCrypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AsType OperationalCertificate
-> (TextEnvelope, FilePath)
-> ExceptT PraosLeaderCredentialsError IO OperationalCertificate
forall a.
HasTextEnvelope a =>
AsType a
-> (TextEnvelope, FilePath)
-> ExceptT PraosLeaderCredentialsError IO a
parseEnvelope AsType OperationalCertificate
AsOperationalCertificate (TextEnvelope, FilePath)
scCert
       ExceptT
  PraosLeaderCredentialsError
  IO
  (SigningKey VrfKey
   -> SigningKey KesKey -> ShelleyLeaderCredentials StandardCrypto)
-> ExceptT PraosLeaderCredentialsError IO (SigningKey VrfKey)
-> ExceptT
     PraosLeaderCredentialsError
     IO
     (SigningKey KesKey -> ShelleyLeaderCredentials StandardCrypto)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AsType (SigningKey VrfKey)
-> (TextEnvelope, FilePath)
-> ExceptT PraosLeaderCredentialsError IO (SigningKey VrfKey)
forall a.
HasTextEnvelope a =>
AsType a
-> (TextEnvelope, FilePath)
-> ExceptT PraosLeaderCredentialsError IO a
parseEnvelope (AsType VrfKey -> AsType (SigningKey VrfKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType VrfKey
AsVrfKey) (TextEnvelope, FilePath)
scVrf
       ExceptT
  PraosLeaderCredentialsError
  IO
  (SigningKey KesKey -> ShelleyLeaderCredentials StandardCrypto)
-> ExceptT PraosLeaderCredentialsError IO (SigningKey KesKey)
-> ExceptT
     PraosLeaderCredentialsError
     IO
     (ShelleyLeaderCredentials StandardCrypto)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AsType (SigningKey KesKey)
-> (TextEnvelope, FilePath)
-> ExceptT PraosLeaderCredentialsError IO (SigningKey KesKey)
forall a.
HasTextEnvelope a =>
AsType a
-> (TextEnvelope, FilePath)
-> ExceptT PraosLeaderCredentialsError IO a
parseEnvelope (AsType KesKey -> AsType (SigningKey KesKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType KesKey
AsKesKey) (TextEnvelope, FilePath)
scKes

   readBulkFile
     :: Maybe FilePath
     -> ExceptT PraosLeaderCredentialsError IO [ShelleyCredentials]
   readBulkFile :: Maybe FilePath
-> ExceptT PraosLeaderCredentialsError IO [ShelleyCredentials]
readBulkFile Maybe FilePath
Nothing = [ShelleyCredentials]
-> ExceptT PraosLeaderCredentialsError IO [ShelleyCredentials]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
   readBulkFile (Just FilePath
fp) = do
     ByteString
content <- (IOException -> PraosLeaderCredentialsError)
-> IO ByteString
-> ExceptT PraosLeaderCredentialsError IO ByteString
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FilePath -> IOException -> PraosLeaderCredentialsError
CredentialsReadError FilePath
fp) (IO ByteString
 -> ExceptT PraosLeaderCredentialsError IO ByteString)
-> IO ByteString
-> ExceptT PraosLeaderCredentialsError IO ByteString
forall a b. (a -> b) -> a -> b
$
                  FilePath -> IO ByteString
BS.readFile FilePath
fp
     [(TextEnvelope, TextEnvelope, TextEnvelope)]
envelopes <- (FilePath -> PraosLeaderCredentialsError)
-> ExceptT FilePath IO [(TextEnvelope, TextEnvelope, TextEnvelope)]
-> ExceptT
     PraosLeaderCredentialsError
     IO
     [(TextEnvelope, TextEnvelope, TextEnvelope)]
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (FilePath -> FilePath -> PraosLeaderCredentialsError
EnvelopeParseError FilePath
fp) (ExceptT FilePath IO [(TextEnvelope, TextEnvelope, TextEnvelope)]
 -> ExceptT
      PraosLeaderCredentialsError
      IO
      [(TextEnvelope, TextEnvelope, TextEnvelope)])
-> ExceptT FilePath IO [(TextEnvelope, TextEnvelope, TextEnvelope)]
-> ExceptT
     PraosLeaderCredentialsError
     IO
     [(TextEnvelope, TextEnvelope, TextEnvelope)]
forall a b. (a -> b) -> a -> b
$ Either FilePath [(TextEnvelope, TextEnvelope, TextEnvelope)]
-> ExceptT FilePath IO [(TextEnvelope, TextEnvelope, TextEnvelope)]
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (Either FilePath [(TextEnvelope, TextEnvelope, TextEnvelope)]
 -> ExceptT
      FilePath IO [(TextEnvelope, TextEnvelope, TextEnvelope)])
-> Either FilePath [(TextEnvelope, TextEnvelope, TextEnvelope)]
-> ExceptT FilePath IO [(TextEnvelope, TextEnvelope, TextEnvelope)]
forall a b. (a -> b) -> a -> b
$
                    ByteString
-> Either FilePath [(TextEnvelope, TextEnvelope, TextEnvelope)]
forall a. FromJSON a => ByteString -> Either FilePath a
Aeson.eitherDecodeStrict' ByteString
content
     [ShelleyCredentials]
-> ExceptT PraosLeaderCredentialsError IO [ShelleyCredentials]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ShelleyCredentials]
 -> ExceptT PraosLeaderCredentialsError IO [ShelleyCredentials])
-> [ShelleyCredentials]
-> ExceptT PraosLeaderCredentialsError IO [ShelleyCredentials]
forall a b. (a -> b) -> a -> b
$ (Int
 -> (TextEnvelope, TextEnvelope, TextEnvelope)
 -> ShelleyCredentials)
-> (Int, (TextEnvelope, TextEnvelope, TextEnvelope))
-> ShelleyCredentials
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int
-> (TextEnvelope, TextEnvelope, TextEnvelope) -> ShelleyCredentials
mkCredentials ((Int, (TextEnvelope, TextEnvelope, TextEnvelope))
 -> ShelleyCredentials)
-> [(Int, (TextEnvelope, TextEnvelope, TextEnvelope))]
-> [ShelleyCredentials]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int]
-> [(TextEnvelope, TextEnvelope, TextEnvelope)]
-> [(Int, (TextEnvelope, TextEnvelope, TextEnvelope))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [(TextEnvelope, TextEnvelope, TextEnvelope)]
envelopes
    where
      mkCredentials :: Int -> (TextEnvelope, TextEnvelope, TextEnvelope)
                    -> ShelleyCredentials
      mkCredentials :: Int
-> (TextEnvelope, TextEnvelope, TextEnvelope) -> ShelleyCredentials
mkCredentials Int
ix (TextEnvelope
teCert, TextEnvelope
teVrf, TextEnvelope
teKes) =
       let loc :: FilePath -> FilePath
loc FilePath
ty = FilePath
fp FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"." FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a b. (Show a, ConvertText FilePath b) => a -> b
show Int
ix FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
ty
       in (TextEnvelope, FilePath)
-> (TextEnvelope, FilePath)
-> (TextEnvelope, FilePath)
-> ShelleyCredentials
ShelleyCredentials (TextEnvelope
teCert, FilePath -> FilePath
loc FilePath
"cert")
                             (TextEnvelope
teVrf,  FilePath -> FilePath
loc FilePath
"vrf")
                             (TextEnvelope
teKes,  FilePath -> FilePath
loc FilePath
"kes")

mkPraosLeaderCredentials ::
     OperationalCertificate
  -> SigningKey VrfKey
  -> SigningKey KesKey
  -> ShelleyLeaderCredentials StandardCrypto
mkPraosLeaderCredentials :: OperationalCertificate
-> SigningKey VrfKey
-> SigningKey KesKey
-> ShelleyLeaderCredentials StandardCrypto
mkPraosLeaderCredentials
    (OperationalCertificate OCert StandardCrypto
opcert (StakePoolVerificationKey vkey))
    (VrfSigningKey vrfKey)
    (KesSigningKey kesKey) =
    ShelleyLeaderCredentials :: forall c.
SignKeyKES c
-> PraosCanBeLeader c -> Text -> ShelleyLeaderCredentials c
ShelleyLeaderCredentials
    { shelleyLeaderCredentialsCanBeLeader :: PraosCanBeLeader StandardCrypto
shelleyLeaderCredentialsCanBeLeader =
        PraosCanBeLeader :: forall c.
OCert c
-> VKey 'BlockIssuer c -> SignKeyVRF c -> PraosCanBeLeader c
PraosCanBeLeader {
        praosCanBeLeaderOpCert :: OCert StandardCrypto
praosCanBeLeaderOpCert     = OCert StandardCrypto
opcert,
          praosCanBeLeaderColdVerKey :: VKey 'BlockIssuer StandardCrypto
praosCanBeLeaderColdVerKey = VKey 'StakePool StandardCrypto -> VKey 'BlockIssuer StandardCrypto
forall (a :: KeyRole -> * -> *) (r :: KeyRole) crypto
       (r' :: KeyRole).
HasKeyRole a =>
a r crypto -> a r' crypto
coerceKeyRole VKey 'StakePool StandardCrypto
vkey,
          praosCanBeLeaderSignKeyVRF :: SignKeyVRF StandardCrypto
praosCanBeLeaderSignKeyVRF = SignKeyVRF StandardCrypto
vrfKey
        },
      shelleyLeaderCredentialsInitSignKey :: SignKeyKES StandardCrypto
shelleyLeaderCredentialsInitSignKey = SignKeyKES StandardCrypto
kesKey,
      shelleyLeaderCredentialsLabel :: Text
shelleyLeaderCredentialsLabel = Text
"Shelley"
    }

parseEnvelope ::
     HasTextEnvelope a
  => AsType a
  -> (TextEnvelope, String)
  -> ExceptT PraosLeaderCredentialsError IO a
parseEnvelope :: AsType a
-> (TextEnvelope, FilePath)
-> ExceptT PraosLeaderCredentialsError IO a
parseEnvelope AsType a
as (TextEnvelope
te, FilePath
loc) =
  (TextEnvelopeError -> PraosLeaderCredentialsError)
-> ExceptT TextEnvelopeError IO a
-> ExceptT PraosLeaderCredentialsError IO a
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (FileError TextEnvelopeError -> PraosLeaderCredentialsError
FileError (FileError TextEnvelopeError -> PraosLeaderCredentialsError)
-> (TextEnvelopeError -> FileError TextEnvelopeError)
-> TextEnvelopeError
-> PraosLeaderCredentialsError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. FilePath -> TextEnvelopeError -> FileError TextEnvelopeError
forall e. FilePath -> e -> FileError e
Api.FileError FilePath
loc) (ExceptT TextEnvelopeError IO a
 -> ExceptT PraosLeaderCredentialsError IO a)
-> (Either TextEnvelopeError a -> ExceptT TextEnvelopeError IO a)
-> Either TextEnvelopeError a
-> ExceptT PraosLeaderCredentialsError IO a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Either TextEnvelopeError a -> ExceptT TextEnvelopeError IO a
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (Either TextEnvelopeError a
 -> ExceptT PraosLeaderCredentialsError IO a)
-> Either TextEnvelopeError a
-> ExceptT PraosLeaderCredentialsError IO a
forall a b. (a -> b) -> a -> b
$
    AsType a -> TextEnvelope -> Either TextEnvelopeError a
forall a.
HasTextEnvelope a =>
AsType a -> TextEnvelope -> Either TextEnvelopeError a
deserialiseFromTextEnvelope AsType a
as TextEnvelope
te


------------------------------------------------------------------------------
-- Errors
--

data ShelleyProtocolInstantiationError =
       GenesisReadError GenesisReadError
     | GenesisValidationError GenesisValidationError
     | PraosLeaderCredentialsError PraosLeaderCredentialsError
  deriving Int -> ShelleyProtocolInstantiationError -> FilePath -> FilePath
[ShelleyProtocolInstantiationError] -> FilePath -> FilePath
ShelleyProtocolInstantiationError -> FilePath
(Int -> ShelleyProtocolInstantiationError -> FilePath -> FilePath)
-> (ShelleyProtocolInstantiationError -> FilePath)
-> ([ShelleyProtocolInstantiationError] -> FilePath -> FilePath)
-> Show ShelleyProtocolInstantiationError
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [ShelleyProtocolInstantiationError] -> FilePath -> FilePath
$cshowList :: [ShelleyProtocolInstantiationError] -> FilePath -> FilePath
show :: ShelleyProtocolInstantiationError -> FilePath
$cshow :: ShelleyProtocolInstantiationError -> FilePath
showsPrec :: Int -> ShelleyProtocolInstantiationError -> FilePath -> FilePath
$cshowsPrec :: Int -> ShelleyProtocolInstantiationError -> FilePath -> FilePath
Show

instance Error ShelleyProtocolInstantiationError where
  displayError :: ShelleyProtocolInstantiationError -> FilePath
displayError (GenesisReadError GenesisReadError
err) = GenesisReadError -> FilePath
forall e. Error e => e -> FilePath
displayError GenesisReadError
err
  displayError (GenesisValidationError GenesisValidationError
err) = GenesisValidationError -> FilePath
forall e. Error e => e -> FilePath
displayError GenesisValidationError
err
  displayError (PraosLeaderCredentialsError PraosLeaderCredentialsError
err) = PraosLeaderCredentialsError -> FilePath
forall e. Error e => e -> FilePath
displayError PraosLeaderCredentialsError
err


data GenesisReadError =
       GenesisReadFileError !FilePath !IOException
     | GenesisHashMismatch !GenesisHash !GenesisHash -- actual, expected
     | GenesisDecodeError !FilePath !String
  deriving Int -> GenesisReadError -> FilePath -> FilePath
[GenesisReadError] -> FilePath -> FilePath
GenesisReadError -> FilePath
(Int -> GenesisReadError -> FilePath -> FilePath)
-> (GenesisReadError -> FilePath)
-> ([GenesisReadError] -> FilePath -> FilePath)
-> Show GenesisReadError
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [GenesisReadError] -> FilePath -> FilePath
$cshowList :: [GenesisReadError] -> FilePath -> FilePath
show :: GenesisReadError -> FilePath
$cshow :: GenesisReadError -> FilePath
showsPrec :: Int -> GenesisReadError -> FilePath -> FilePath
$cshowsPrec :: Int -> GenesisReadError -> FilePath -> FilePath
Show

instance Error GenesisReadError where
  displayError :: GenesisReadError -> FilePath
displayError (GenesisReadFileError FilePath
fp IOException
err) =
        FilePath
"There was an error reading the genesis file: "
     FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> FilePath
forall a b. ConvertText a b => a -> b
toS FilePath
fp FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" Error: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> IOException -> FilePath
forall a b. (Show a, ConvertText FilePath b) => a -> b
show IOException
err

  displayError (GenesisHashMismatch GenesisHash
actual GenesisHash
expected) =
        FilePath
"Wrong genesis file: the actual hash is " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> GenesisHash -> FilePath
forall a b. (Show a, ConvertText FilePath b) => a -> b
show GenesisHash
actual
     FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
", but the expected genesis hash given in the node "
     FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"configuration file is " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> GenesisHash -> FilePath
forall a b. (Show a, ConvertText FilePath b) => a -> b
show GenesisHash
expected

  displayError (GenesisDecodeError FilePath
fp FilePath
err) =
        FilePath
"There was an error parsing the genesis file: "
     FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> FilePath
forall a b. ConvertText a b => a -> b
toS FilePath
fp FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" Error: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> FilePath
forall a b. (Show a, ConvertText FilePath b) => a -> b
show FilePath
err


newtype GenesisValidationError = GenesisValidationErrors [Shelley.ValidationErr]
  deriving Int -> GenesisValidationError -> FilePath -> FilePath
[GenesisValidationError] -> FilePath -> FilePath
GenesisValidationError -> FilePath
(Int -> GenesisValidationError -> FilePath -> FilePath)
-> (GenesisValidationError -> FilePath)
-> ([GenesisValidationError] -> FilePath -> FilePath)
-> Show GenesisValidationError
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [GenesisValidationError] -> FilePath -> FilePath
$cshowList :: [GenesisValidationError] -> FilePath -> FilePath
show :: GenesisValidationError -> FilePath
$cshow :: GenesisValidationError -> FilePath
showsPrec :: Int -> GenesisValidationError -> FilePath -> FilePath
$cshowsPrec :: Int -> GenesisValidationError -> FilePath -> FilePath
Show

instance Error GenesisValidationError where
  displayError :: GenesisValidationError -> FilePath
displayError (GenesisValidationErrors [ValidationErr]
vErrs) =
    Text -> FilePath
T.unpack ([Text] -> Text
unlines ((ValidationErr -> Text) -> [ValidationErr] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ValidationErr -> Text
Shelley.describeValidationErr [ValidationErr]
vErrs))


data PraosLeaderCredentialsError =
       CredentialsReadError !FilePath !IOException
     | EnvelopeParseError !FilePath !String
     | FileError !(Api.FileError TextEnvelopeError)
--TODO: pick a less generic constructor than FileError

     | OCertNotSpecified
     | VRFKeyNotSpecified
     | KESKeyNotSpecified
     | MismatchedKesKey
         FilePath
         -- KES signing key
         FilePath
         -- Operational certificate
  deriving Int -> PraosLeaderCredentialsError -> FilePath -> FilePath
[PraosLeaderCredentialsError] -> FilePath -> FilePath
PraosLeaderCredentialsError -> FilePath
(Int -> PraosLeaderCredentialsError -> FilePath -> FilePath)
-> (PraosLeaderCredentialsError -> FilePath)
-> ([PraosLeaderCredentialsError] -> FilePath -> FilePath)
-> Show PraosLeaderCredentialsError
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [PraosLeaderCredentialsError] -> FilePath -> FilePath
$cshowList :: [PraosLeaderCredentialsError] -> FilePath -> FilePath
show :: PraosLeaderCredentialsError -> FilePath
$cshow :: PraosLeaderCredentialsError -> FilePath
showsPrec :: Int -> PraosLeaderCredentialsError -> FilePath -> FilePath
$cshowsPrec :: Int -> PraosLeaderCredentialsError -> FilePath -> FilePath
Show

instance Error PraosLeaderCredentialsError where
  displayError :: PraosLeaderCredentialsError -> FilePath
displayError (CredentialsReadError FilePath
fp IOException
err) =
        FilePath
"There was an error reading a credentials file: "
     FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> FilePath
forall a b. ConvertText a b => a -> b
toS FilePath
fp FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" Error: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> IOException -> FilePath
forall a b. (Show a, ConvertText FilePath b) => a -> b
show IOException
err

  displayError (EnvelopeParseError FilePath
fp FilePath
err) =
        FilePath
"There was an error parsing a credentials envelope: "
     FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> FilePath
forall a b. ConvertText a b => a -> b
toS FilePath
fp FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" Error: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> FilePath
forall a b. (Show a, ConvertText FilePath b) => a -> b
show FilePath
err

  displayError (FileError FileError TextEnvelopeError
fileErr) = FileError TextEnvelopeError -> FilePath
forall e. Error e => e -> FilePath
displayError FileError TextEnvelopeError
fileErr
  displayError (MismatchedKesKey FilePath
kesFp FilePath
certFp) =
       FilePath
"The KES key provided at: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> FilePath
forall a b. (Show a, ConvertText FilePath b) => a -> b
show FilePath
kesFp
    FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" does not match the KES key specified in the operational certificate at: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> FilePath
forall a b. (Show a, ConvertText FilePath b) => a -> b
show FilePath
certFp
  displayError PraosLeaderCredentialsError
OCertNotSpecified  = FilePath -> FilePath
missingFlagMessage FilePath
"shelley-operational-certificate"
  displayError PraosLeaderCredentialsError
VRFKeyNotSpecified = FilePath -> FilePath
missingFlagMessage FilePath
"shelley-vrf-key"
  displayError PraosLeaderCredentialsError
KESKeyNotSpecified = FilePath -> FilePath
missingFlagMessage FilePath
"shelley-kes-key"

missingFlagMessage :: String -> String
missingFlagMessage :: FilePath -> FilePath
missingFlagMessage FilePath
flag =
  FilePath
"To create blocks, the --" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
flag FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" must also be specified"