{-# LANGUAGE NamedFieldPuns #-}

module Bcc.Node.Protocol.Cole
  ( mkSomeConsensusProtocolCole
    -- * Errors
  , ColeProtocolInstantiationError(..)

    -- * Reusable parts
  , readGenesis
  , readLeaderCredentials
  ) where


import           Bcc.Prelude
import           Control.Monad.Trans.Except.Extra (bimapExceptT, firstExceptT, hoistEither,
                   hoistMaybe, left)
import qualified Data.ByteString.Lazy as LB
import qualified Data.Text as Text

import           Bcc.Api.Cole
import qualified Bcc.Api.Protocol.Types as Protocol

import qualified Bcc.Crypto.Hash as Crypto

import qualified Bcc.Crypto.Hashing as Cole.Crypto

import qualified Bcc.Chain.Genesis as Genesis
import qualified Bcc.Chain.UTxO as UTxO
import qualified Bcc.Chain.Update as Update
import           Bcc.Crypto.ProtocolMagic (RequiresNetworkMagic)

import           Shardagnostic.Consensus.Bcc
import qualified Shardagnostic.Consensus.Bcc as Consensus
import qualified Shardagnostic.Consensus.Mempool.TxLimits as TxLimits

import           Bcc.Node.Types

import           Bcc.Node.Protocol.Types
import           Bcc.Tracing.OrphanInstances.Cole ()
import           Bcc.Tracing.OrphanInstances.HardFork ()
import           Bcc.Tracing.OrphanInstances.Sophie ()


------------------------------------------------------------------------------
-- Cole protocol
--

-- | Make 'SomeConsensusProtocol' using the Cole 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.
--
mkSomeConsensusProtocolCole
  :: NodeColeProtocolConfiguration
  -> Maybe ProtocolFilepaths
  -> ExceptT ColeProtocolInstantiationError IO SomeConsensusProtocol
mkSomeConsensusProtocolCole :: NodeColeProtocolConfiguration
-> Maybe ProtocolFilepaths
-> ExceptT ColeProtocolInstantiationError IO SomeConsensusProtocol
mkSomeConsensusProtocolCole NodeColeProtocolConfiguration {
                           GenesisFile
npcColeGenesisFile :: NodeColeProtocolConfiguration -> GenesisFile
npcColeGenesisFile :: GenesisFile
npcColeGenesisFile,
                           Maybe GenesisHash
npcColeGenesisFileHash :: NodeColeProtocolConfiguration -> Maybe GenesisHash
npcColeGenesisFileHash :: Maybe GenesisHash
npcColeGenesisFileHash,
                           RequiresNetworkMagic
npcColeReqNetworkMagic :: NodeColeProtocolConfiguration -> RequiresNetworkMagic
npcColeReqNetworkMagic :: RequiresNetworkMagic
npcColeReqNetworkMagic,
                           Maybe Double
npcColePbftSignatureThresh :: NodeColeProtocolConfiguration -> Maybe Double
npcColePbftSignatureThresh :: Maybe Double
npcColePbftSignatureThresh,
                           ApplicationName
npcColeApplicationName :: NodeColeProtocolConfiguration -> ApplicationName
npcColeApplicationName :: ApplicationName
npcColeApplicationName,
                           NumSoftwareVersion
npcColeApplicationVersion :: NodeColeProtocolConfiguration -> NumSoftwareVersion
npcColeApplicationVersion :: NumSoftwareVersion
npcColeApplicationVersion,
                           Word16
npcColeSupportedProtocolVersionMajor :: NodeColeProtocolConfiguration -> Word16
npcColeSupportedProtocolVersionMajor :: Word16
npcColeSupportedProtocolVersionMajor,
                           Word16
npcColeSupportedProtocolVersionSentry :: NodeColeProtocolConfiguration -> Word16
npcColeSupportedProtocolVersionSentry :: Word16
npcColeSupportedProtocolVersionSentry
                         }
                         Maybe ProtocolFilepaths
files = do
    Config
genesisConfig <- GenesisFile
-> Maybe GenesisHash
-> RequiresNetworkMagic
-> ExceptT ColeProtocolInstantiationError IO Config
readGenesis GenesisFile
npcColeGenesisFile
                                 Maybe GenesisHash
npcColeGenesisFileHash
                                 RequiresNetworkMagic
npcColeReqNetworkMagic

    Maybe ColeLeaderCredentials
optionalLeaderCredentials <- Config
-> Maybe ProtocolFilepaths
-> ExceptT
     ColeProtocolInstantiationError IO (Maybe ColeLeaderCredentials)
readLeaderCredentials Config
genesisConfig Maybe ProtocolFilepaths
files

    SomeConsensusProtocol
-> ExceptT ColeProtocolInstantiationError IO SomeConsensusProtocol
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeConsensusProtocol
 -> ExceptT ColeProtocolInstantiationError IO SomeConsensusProtocol)
-> SomeConsensusProtocol
-> ExceptT ColeProtocolInstantiationError IO SomeConsensusProtocol
forall a b. (a -> b) -> a -> b
$ BlockType (HardForkBlock '[ColeBlock])
-> ProtocolInfoArgs IO (HardForkBlock '[ColeBlock])
-> SomeConsensusProtocol
forall blk.
(Protocol IO blk, HasKESMetricsData blk, HasKESInfo blk,
 TraceConstraints blk) =>
BlockType blk -> ProtocolInfoArgs IO blk -> SomeConsensusProtocol
SomeConsensusProtocol BlockType (HardForkBlock '[ColeBlock])
Protocol.ColeBlockType (ProtocolInfoArgs IO (HardForkBlock '[ColeBlock])
 -> SomeConsensusProtocol)
-> ProtocolInfoArgs IO (HardForkBlock '[ColeBlock])
-> SomeConsensusProtocol
forall a b. (a -> b) -> a -> b
$ ProtocolParamsCole
-> ProtocolInfoArgs IO (HardForkBlock '[ColeBlock])
forall (m :: * -> *).
ProtocolParamsCole
-> ProtocolInfoArgs m (HardForkBlock '[ColeBlock])
Protocol.ProtocolInfoArgsCole (ProtocolParamsCole
 -> ProtocolInfoArgs IO (HardForkBlock '[ColeBlock]))
-> ProtocolParamsCole
-> ProtocolInfoArgs IO (HardForkBlock '[ColeBlock])
forall a b. (a -> b) -> a -> b
$ ProtocolParamsCole :: Config
-> Maybe PBftSignatureThreshold
-> ProtocolVersion
-> SoftwareVersion
-> Maybe ColeLeaderCredentials
-> Overrides ColeBlock
-> ProtocolParamsCole
Consensus.ProtocolParamsCole {
        $sel:coleGenesis:ProtocolParamsCole :: Config
coleGenesis = Config
genesisConfig,
        $sel:colePbftSignatureThreshold:ProtocolParamsCole :: Maybe PBftSignatureThreshold
colePbftSignatureThreshold =
          Double -> PBftSignatureThreshold
PBftSignatureThreshold (Double -> PBftSignatureThreshold)
-> Maybe Double -> Maybe PBftSignatureThreshold
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Double
npcColePbftSignatureThresh,
        $sel:coleProtocolVersion:ProtocolParamsCole :: ProtocolVersion
coleProtocolVersion =
          Word16 -> Word16 -> ProtocolVersion
Update.ProtocolVersion
            Word16
npcColeSupportedProtocolVersionMajor
            Word16
npcColeSupportedProtocolVersionSentry,
        $sel:coleSoftwareVersion:ProtocolParamsCole :: SoftwareVersion
coleSoftwareVersion =
          ApplicationName -> NumSoftwareVersion -> SoftwareVersion
Update.SoftwareVersion
            ApplicationName
npcColeApplicationName
            NumSoftwareVersion
npcColeApplicationVersion,
        $sel:coleLeaderCredentials:ProtocolParamsCole :: Maybe ColeLeaderCredentials
coleLeaderCredentials =
          Maybe ColeLeaderCredentials
optionalLeaderCredentials,
        $sel:coleMaxTxCapacityOverrides:ProtocolParamsCole :: Overrides ColeBlock
coleMaxTxCapacityOverrides =
          TxMeasure ColeBlock -> Overrides ColeBlock
forall blk. TxMeasure blk -> Overrides blk
TxLimits.mkOverrides TxMeasure ColeBlock
forall a. BoundedMeasure a => a
TxLimits.noOverridesMeasure
        }

readGenesis :: GenesisFile
            -> Maybe GenesisHash
            -> RequiresNetworkMagic
            -> ExceptT ColeProtocolInstantiationError IO
                       Genesis.Config
readGenesis :: GenesisFile
-> Maybe GenesisHash
-> RequiresNetworkMagic
-> ExceptT ColeProtocolInstantiationError IO Config
readGenesis (GenesisFile FilePath
file) Maybe GenesisHash
mbExpectedGenesisHash RequiresNetworkMagic
ncReqNetworkMagic = do
    (GenesisData
genesisData, GenesisHash
genesisHash) <- (GenesisDataError -> ColeProtocolInstantiationError)
-> ExceptT GenesisDataError IO (GenesisData, GenesisHash)
-> ExceptT
     ColeProtocolInstantiationError IO (GenesisData, GenesisHash)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (FilePath -> GenesisDataError -> ColeProtocolInstantiationError
GenesisReadError FilePath
file) (ExceptT GenesisDataError IO (GenesisData, GenesisHash)
 -> ExceptT
      ColeProtocolInstantiationError IO (GenesisData, GenesisHash))
-> ExceptT GenesisDataError IO (GenesisData, GenesisHash)
-> ExceptT
     ColeProtocolInstantiationError IO (GenesisData, GenesisHash)
forall a b. (a -> b) -> a -> b
$
                                  FilePath -> ExceptT GenesisDataError IO (GenesisData, GenesisHash)
forall (m :: * -> *).
(MonadError GenesisDataError m, MonadIO m) =>
FilePath -> m (GenesisData, GenesisHash)
Genesis.readGenesisData FilePath
file
    GenesisHash -> ExceptT ColeProtocolInstantiationError IO ()
checkExpectedGenesisHash GenesisHash
genesisHash
    Config -> ExceptT ColeProtocolInstantiationError IO Config
forall (m :: * -> *) a. Monad m => a -> m a
return Config :: GenesisData
-> GenesisHash
-> RequiresNetworkMagic
-> UTxOConfiguration
-> Config
Genesis.Config {
      configGenesisData :: GenesisData
Genesis.configGenesisData       = GenesisData
genesisData,
      configGenesisHash :: GenesisHash
Genesis.configGenesisHash       = GenesisHash
genesisHash,
      configReqNetMagic :: RequiresNetworkMagic
Genesis.configReqNetMagic       = RequiresNetworkMagic
ncReqNetworkMagic,
      configUTxOConfiguration :: UTxOConfiguration
Genesis.configUTxOConfiguration = UTxOConfiguration
UTxO.defaultUTxOConfiguration
      --TODO: add config support for the UTxOConfiguration if needed
    }
  where
    checkExpectedGenesisHash :: Genesis.GenesisHash
                             -> ExceptT ColeProtocolInstantiationError IO ()
    checkExpectedGenesisHash :: GenesisHash -> ExceptT ColeProtocolInstantiationError 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 ->
            ColeProtocolInstantiationError
-> ExceptT ColeProtocolInstantiationError IO ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GenesisHash -> GenesisHash -> ColeProtocolInstantiationError
GenesisHashMismatch GenesisHash
actual GenesisHash
expected)
          where
            actual :: GenesisHash
actual = GenesisHash -> GenesisHash
fromColeGenesisHash GenesisHash
actual'

        Maybe GenesisHash
_ -> () -> ExceptT ColeProtocolInstantiationError IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    fromColeGenesisHash :: Genesis.GenesisHash -> GenesisHash
    fromColeGenesisHash :: GenesisHash -> GenesisHash
fromColeGenesisHash (Genesis.GenesisHash Hash Raw
h) =
        Hash Blake2b_256 ByteString -> GenesisHash
GenesisHash
      (Hash Blake2b_256 ByteString -> GenesisHash)
-> (Hash Raw -> Hash Blake2b_256 ByteString)
-> Hash Raw
-> GenesisHash
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Hash Blake2b_256 ByteString
-> Maybe (Hash Blake2b_256 ByteString)
-> Hash Blake2b_256 ByteString
forall a. a -> Maybe a -> a
fromMaybe Hash Blake2b_256 ByteString
forall a. a
impossible
      (Maybe (Hash Blake2b_256 ByteString)
 -> Hash Blake2b_256 ByteString)
-> (Hash Raw -> Maybe (Hash Blake2b_256 ByteString))
-> Hash Raw
-> Hash Blake2b_256 ByteString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> Maybe (Hash Blake2b_256 ByteString)
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
Crypto.hashFromBytes
      (ByteString -> Maybe (Hash Blake2b_256 ByteString))
-> (Hash Raw -> ByteString)
-> Hash Raw
-> Maybe (Hash Blake2b_256 ByteString)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Hash Raw -> ByteString
forall algo a. AbstractHash algo a -> ByteString
Cole.Crypto.hashToBytes
      (Hash Raw -> GenesisHash) -> Hash Raw -> GenesisHash
forall a b. (a -> b) -> a -> b
$ Hash Raw
h
      where
        impossible :: a
impossible =
          Text -> a
forall a. HasCallStack => Text -> a
panic Text
"fromColeGenesisHash: old and new crypto libs disagree on hash size"



readLeaderCredentials :: Genesis.Config
                      -> Maybe ProtocolFilepaths
                      -> ExceptT ColeProtocolInstantiationError IO
                                 (Maybe ColeLeaderCredentials)
readLeaderCredentials :: Config
-> Maybe ProtocolFilepaths
-> ExceptT
     ColeProtocolInstantiationError IO (Maybe ColeLeaderCredentials)
readLeaderCredentials Config
_ Maybe ProtocolFilepaths
Nothing = Maybe ColeLeaderCredentials
-> ExceptT
     ColeProtocolInstantiationError IO (Maybe ColeLeaderCredentials)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ColeLeaderCredentials
forall a. Maybe a
Nothing
readLeaderCredentials Config
genesisConfig
                      (Just ProtocolFilepaths {
                        Maybe FilePath
coleCertFile :: ProtocolFilepaths -> Maybe FilePath
coleCertFile :: Maybe FilePath
coleCertFile,
                        Maybe FilePath
coleKeyFile :: ProtocolFilepaths -> Maybe FilePath
coleKeyFile :: Maybe FilePath
coleKeyFile
                      }) =
  case (Maybe FilePath
coleCertFile, Maybe FilePath
coleKeyFile) of
    (Maybe FilePath
Nothing, Maybe FilePath
Nothing) -> Maybe ColeLeaderCredentials
-> ExceptT
     ColeProtocolInstantiationError IO (Maybe ColeLeaderCredentials)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ColeLeaderCredentials
forall a. Maybe a
Nothing
    (Just FilePath
_, Maybe FilePath
Nothing) -> ColeProtocolInstantiationError
-> ExceptT
     ColeProtocolInstantiationError IO (Maybe ColeLeaderCredentials)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left ColeProtocolInstantiationError
SigningKeyFilepathNotSpecified
    (Maybe FilePath
Nothing, Just FilePath
_) -> ColeProtocolInstantiationError
-> ExceptT
     ColeProtocolInstantiationError IO (Maybe ColeLeaderCredentials)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left ColeProtocolInstantiationError
DelegationCertificateFilepathNotSpecified
    (Just FilePath
delegCertFile, Just FilePath
signingKeyFile) -> do

         ByteString
signingKeyFileBytes <- IO ByteString
-> ExceptT ColeProtocolInstantiationError IO ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString
 -> ExceptT ColeProtocolInstantiationError IO ByteString)
-> IO ByteString
-> ExceptT ColeProtocolInstantiationError IO ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
LB.readFile FilePath
signingKeyFile
         ByteString
delegCertFileBytes <- IO ByteString
-> ExceptT ColeProtocolInstantiationError IO ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString
 -> ExceptT ColeProtocolInstantiationError IO ByteString)
-> IO ByteString
-> ExceptT ColeProtocolInstantiationError IO ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
LB.readFile FilePath
delegCertFile
         ColeSigningKey signingKey <- ColeProtocolInstantiationError
-> Maybe (SigningKey ColeKey)
-> ExceptT ColeProtocolInstantiationError IO (SigningKey ColeKey)
forall (m :: * -> *) x a. Monad m => x -> Maybe a -> ExceptT x m a
hoistMaybe (FilePath -> ColeProtocolInstantiationError
SigningKeyDeserialiseFailure FilePath
signingKeyFile)
                         (Maybe (SigningKey ColeKey)
 -> ExceptT ColeProtocolInstantiationError IO (SigningKey ColeKey))
-> Maybe (SigningKey ColeKey)
-> ExceptT ColeProtocolInstantiationError IO (SigningKey ColeKey)
forall a b. (a -> b) -> a -> b
$ AsType (SigningKey ColeKey)
-> ByteString -> Maybe (SigningKey ColeKey)
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Maybe a
deserialiseFromRawBytes (AsType ColeKey -> AsType (SigningKey ColeKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType ColeKey
AsColeKey) (ByteString -> Maybe (SigningKey ColeKey))
-> ByteString -> Maybe (SigningKey ColeKey)
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LB.toStrict ByteString
signingKeyFileBytes
         Certificate
delegCert  <- (Text -> ColeProtocolInstantiationError)
-> ExceptT Text IO Certificate
-> ExceptT ColeProtocolInstantiationError IO Certificate
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (FilePath -> Text -> ColeProtocolInstantiationError
CanonicalDecodeFailure FilePath
delegCertFile)
                         (ExceptT Text IO Certificate
 -> ExceptT ColeProtocolInstantiationError IO Certificate)
-> (Either Text Certificate -> ExceptT Text IO Certificate)
-> Either Text Certificate
-> ExceptT ColeProtocolInstantiationError IO Certificate
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Either Text Certificate -> ExceptT Text IO Certificate
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither
                         (Either Text Certificate
 -> ExceptT ColeProtocolInstantiationError IO Certificate)
-> Either Text Certificate
-> ExceptT ColeProtocolInstantiationError IO Certificate
forall a b. (a -> b) -> a -> b
$ ByteString -> Either Text Certificate
forall a.
FromJSON (Either SchemaError) a =>
ByteString -> Either Text a
canonicalDecodePretty ByteString
delegCertFileBytes

         (ColeLeaderCredentialsError -> ColeProtocolInstantiationError)
-> (ColeLeaderCredentials -> Maybe ColeLeaderCredentials)
-> ExceptT ColeLeaderCredentialsError IO ColeLeaderCredentials
-> ExceptT
     ColeProtocolInstantiationError IO (Maybe ColeLeaderCredentials)
forall (m :: * -> *) x y a b.
Functor m =>
(x -> y) -> (a -> b) -> ExceptT x m a -> ExceptT y m b
bimapExceptT ColeLeaderCredentialsError -> ColeProtocolInstantiationError
CredentialsError ColeLeaderCredentials -> Maybe ColeLeaderCredentials
forall a. a -> Maybe a
Just
           (ExceptT ColeLeaderCredentialsError IO ColeLeaderCredentials
 -> ExceptT
      ColeProtocolInstantiationError IO (Maybe ColeLeaderCredentials))
-> (Either ColeLeaderCredentialsError ColeLeaderCredentials
    -> ExceptT ColeLeaderCredentialsError IO ColeLeaderCredentials)
-> Either ColeLeaderCredentialsError ColeLeaderCredentials
-> ExceptT
     ColeProtocolInstantiationError IO (Maybe ColeLeaderCredentials)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Either ColeLeaderCredentialsError ColeLeaderCredentials
-> ExceptT ColeLeaderCredentialsError IO ColeLeaderCredentials
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither
           (Either ColeLeaderCredentialsError ColeLeaderCredentials
 -> ExceptT
      ColeProtocolInstantiationError IO (Maybe ColeLeaderCredentials))
-> Either ColeLeaderCredentialsError ColeLeaderCredentials
-> ExceptT
     ColeProtocolInstantiationError IO (Maybe ColeLeaderCredentials)
forall a b. (a -> b) -> a -> b
$ Config
-> SigningKey
-> Certificate
-> Text
-> Either ColeLeaderCredentialsError ColeLeaderCredentials
mkColeLeaderCredentials Config
genesisConfig SigningKey
signingKey Certificate
delegCert Text
"Cole"



------------------------------------------------------------------------------
-- Cole Errors
--

data ColeProtocolInstantiationError =
    CanonicalDecodeFailure !FilePath !Text
  | GenesisHashMismatch !GenesisHash !GenesisHash -- actual, expected
  | DelegationCertificateFilepathNotSpecified
  | GenesisConfigurationError !FilePath !Genesis.ConfigurationError
  | GenesisReadError !FilePath !Genesis.GenesisDataError
  | CredentialsError !ColeLeaderCredentialsError
  | SigningKeyDeserialiseFailure !FilePath
  | SigningKeyFilepathNotSpecified
  deriving Int -> ColeProtocolInstantiationError -> ShowS
[ColeProtocolInstantiationError] -> ShowS
ColeProtocolInstantiationError -> FilePath
(Int -> ColeProtocolInstantiationError -> ShowS)
-> (ColeProtocolInstantiationError -> FilePath)
-> ([ColeProtocolInstantiationError] -> ShowS)
-> Show ColeProtocolInstantiationError
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ColeProtocolInstantiationError] -> ShowS
$cshowList :: [ColeProtocolInstantiationError] -> ShowS
show :: ColeProtocolInstantiationError -> FilePath
$cshow :: ColeProtocolInstantiationError -> FilePath
showsPrec :: Int -> ColeProtocolInstantiationError -> ShowS
$cshowsPrec :: Int -> ColeProtocolInstantiationError -> ShowS
Show

instance Error ColeProtocolInstantiationError where
  displayError :: ColeProtocolInstantiationError -> FilePath
displayError (CanonicalDecodeFailure FilePath
fp Text
failure) =
        FilePath
"Canonical decode failure in " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
fp
     FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" Canonical failure: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
Text.unpack Text
failure
  displayError (GenesisHashMismatch GenesisHash
actual GenesisHash
expected) =
        FilePath
"Wrong Cole genesis file: the actual hash is " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> GenesisHash -> FilePath
forall a b. (Show a, ConvertText FilePath b) => a -> b
show GenesisHash
actual
     FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
", but the expected Cole genesis hash given in the node configuration "
     FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
"file is " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> GenesisHash -> FilePath
forall a b. (Show a, ConvertText FilePath b) => a -> b
show GenesisHash
expected
  displayError ColeProtocolInstantiationError
DelegationCertificateFilepathNotSpecified =
        FilePath
"Delegation certificate filepath not specified"
    --TODO: Implement configuration error render function in bcc-ledger
  displayError (GenesisConfigurationError FilePath
fp ConfigurationError
genesisConfigError) =
        FilePath
"Genesis configuration error in: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a b. ConvertText a b => a -> b
toS FilePath
fp
     FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" Error: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> ConfigurationError -> FilePath
forall a b. (Show a, ConvertText FilePath b) => a -> b
show ConfigurationError
genesisConfigError
  displayError (GenesisReadError FilePath
fp GenesisDataError
err) =
        FilePath
"There was an error parsing the genesis file: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a b. ConvertText a b => a -> b
toS FilePath
fp
     FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" Error: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> GenesisDataError -> FilePath
forall a b. (Show a, ConvertText FilePath b) => a -> b
show GenesisDataError
err
    -- TODO: Implement ColeLeaderCredentialsError render function in shardagnostic-network
  displayError (CredentialsError ColeLeaderCredentialsError
coleLeaderCredentialsError) =
        FilePath
"Cole leader credentials error: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> ColeLeaderCredentialsError -> FilePath
forall a b. (Show a, ConvertText FilePath b) => a -> b
show ColeLeaderCredentialsError
coleLeaderCredentialsError
  displayError (SigningKeyDeserialiseFailure FilePath
fp) =
        FilePath
"Signing key deserialisation error in: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a b. ConvertText a b => a -> b
toS FilePath
fp
  displayError ColeProtocolInstantiationError
SigningKeyFilepathNotSpecified =
        FilePath
"Signing key filepath not specified"