{-# LANGUAGE NamedFieldPuns #-}

module Cardano.Node.Protocol.Byron
  (
    -- * Protocol exposing the specific type
    -- | Use this when you need the specific instance
    mkConsensusProtocolByron

    -- * Protocols hiding the specific type
    -- | Use this when you want to handle protocols generically
  , mkSomeConsensusProtocolByron
    -- * Errors
  , ByronProtocolInstantiationError(..)
  , renderByronProtocolInstantiationError

    -- * Reusable parts
  , readGenesis
  , readLeaderCredentials
  ) where


import           Cardano.Prelude

import           Codec.CBOR.Read (DeserialiseFailure, deserialiseFromBytes)
import           Control.Monad.Trans.Except.Extra (bimapExceptT, firstExceptT, hoistEither, left)
import qualified Data.ByteString.Lazy as LB
import qualified Data.Text as Text

import qualified Cardano.Crypto.Hash as Crypto

import qualified Cardano.Crypto.Hashing as Byron.Crypto
import qualified Cardano.Crypto.Signing as Byron.Crypto

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

import           Ouroboros.Consensus.Cardano hiding (Protocol)
import qualified Ouroboros.Consensus.Cardano as Consensus
import           Ouroboros.Consensus.Cardano.ByronHFC

import           Cardano.Node.Types

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

import           Cardano.Node.Protocol.Types


------------------------------------------------------------------------------
-- Byron protocol
--

-- | Make 'SomeConsensusProtocol' using the Byron 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.
--
mkSomeConsensusProtocolByron
  :: NodeByronProtocolConfiguration
  -> Maybe ProtocolFilepaths
  -> ExceptT ByronProtocolInstantiationError IO SomeConsensusProtocol
mkSomeConsensusProtocolByron :: NodeByronProtocolConfiguration
-> Maybe ProtocolFilepaths
-> ExceptT ByronProtocolInstantiationError IO SomeConsensusProtocol
mkSomeConsensusProtocolByron NodeByronProtocolConfiguration
nc Maybe ProtocolFilepaths
files =

    -- Applying the SomeConsensusProtocol here is a check that
    -- the type of mkConsensusProtocolByron fits all the class
    -- constraints we need to run the protocol.
    Protocol IO ByronBlockHFC (HardForkProtocol '[ByronBlock])
-> SomeConsensusProtocol
forall blk.
SomeConsensusProtocolConstraints blk =>
Protocol IO blk (BlockProtocol blk) -> SomeConsensusProtocol
SomeConsensusProtocol (Protocol IO ByronBlockHFC (HardForkProtocol '[ByronBlock])
 -> SomeConsensusProtocol)
-> ExceptT
     ByronProtocolInstantiationError
     IO
     (Protocol IO ByronBlockHFC (HardForkProtocol '[ByronBlock]))
-> ExceptT ByronProtocolInstantiationError IO SomeConsensusProtocol
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NodeByronProtocolConfiguration
-> Maybe ProtocolFilepaths
-> ExceptT
     ByronProtocolInstantiationError
     IO
     (Protocol IO ByronBlockHFC (HardForkProtocol '[ByronBlock]))
mkConsensusProtocolByron NodeByronProtocolConfiguration
nc Maybe ProtocolFilepaths
files


-- | Instantiate 'Consensus.Protocol' for Byron specifically.
--
-- Use this when you need to run the consensus with this specific protocol.
--
mkConsensusProtocolByron
  :: NodeByronProtocolConfiguration
  -> Maybe ProtocolFilepaths
  -> ExceptT ByronProtocolInstantiationError IO
             (Consensus.Protocol IO ByronBlockHFC ProtocolByron)
mkConsensusProtocolByron :: NodeByronProtocolConfiguration
-> Maybe ProtocolFilepaths
-> ExceptT
     ByronProtocolInstantiationError
     IO
     (Protocol IO ByronBlockHFC (HardForkProtocol '[ByronBlock]))
mkConsensusProtocolByron NodeByronProtocolConfiguration {
                           GenesisFile
npcByronGenesisFile :: NodeByronProtocolConfiguration -> GenesisFile
npcByronGenesisFile :: GenesisFile
npcByronGenesisFile,
                           Maybe GenesisHash
npcByronGenesisFileHash :: NodeByronProtocolConfiguration -> Maybe GenesisHash
npcByronGenesisFileHash :: Maybe GenesisHash
npcByronGenesisFileHash,
                           RequiresNetworkMagic
npcByronReqNetworkMagic :: NodeByronProtocolConfiguration -> RequiresNetworkMagic
npcByronReqNetworkMagic :: RequiresNetworkMagic
npcByronReqNetworkMagic,
                           Maybe Double
npcByronPbftSignatureThresh :: NodeByronProtocolConfiguration -> Maybe Double
npcByronPbftSignatureThresh :: Maybe Double
npcByronPbftSignatureThresh,
                           ApplicationName
npcByronApplicationName :: NodeByronProtocolConfiguration -> ApplicationName
npcByronApplicationName :: ApplicationName
npcByronApplicationName,
                           NumSoftwareVersion
npcByronApplicationVersion :: NodeByronProtocolConfiguration -> NumSoftwareVersion
npcByronApplicationVersion :: NumSoftwareVersion
npcByronApplicationVersion,
                           Word16
npcByronSupportedProtocolVersionMajor :: NodeByronProtocolConfiguration -> Word16
npcByronSupportedProtocolVersionMajor :: Word16
npcByronSupportedProtocolVersionMajor,
                           Word16
npcByronSupportedProtocolVersionMinor :: NodeByronProtocolConfiguration -> Word16
npcByronSupportedProtocolVersionMinor :: Word16
npcByronSupportedProtocolVersionMinor,
                           Word8
npcByronSupportedProtocolVersionAlt :: NodeByronProtocolConfiguration -> Word8
npcByronSupportedProtocolVersionAlt :: Word8
npcByronSupportedProtocolVersionAlt
                         }
                         Maybe ProtocolFilepaths
files = do
    Config
genesisConfig <- GenesisFile
-> Maybe GenesisHash
-> RequiresNetworkMagic
-> ExceptT ByronProtocolInstantiationError IO Config
readGenesis GenesisFile
npcByronGenesisFile
                                 Maybe GenesisHash
npcByronGenesisFileHash
                                 RequiresNetworkMagic
npcByronReqNetworkMagic

    Maybe ByronLeaderCredentials
optionalLeaderCredentials <- Config
-> Maybe ProtocolFilepaths
-> ExceptT
     ByronProtocolInstantiationError IO (Maybe ByronLeaderCredentials)
readLeaderCredentials Config
genesisConfig Maybe ProtocolFilepaths
files

    Protocol IO ByronBlockHFC (HardForkProtocol '[ByronBlock])
-> ExceptT
     ByronProtocolInstantiationError
     IO
     (Protocol IO ByronBlockHFC (HardForkProtocol '[ByronBlock]))
forall (m :: * -> *) a. Monad m => a -> m a
return (Protocol IO ByronBlockHFC (HardForkProtocol '[ByronBlock])
 -> ExceptT
      ByronProtocolInstantiationError
      IO
      (Protocol IO ByronBlockHFC (HardForkProtocol '[ByronBlock])))
-> Protocol IO ByronBlockHFC (HardForkProtocol '[ByronBlock])
-> ExceptT
     ByronProtocolInstantiationError
     IO
     (Protocol IO ByronBlockHFC (HardForkProtocol '[ByronBlock]))
forall a b. (a -> b) -> a -> b
$
      ProtocolParamsByron
-> Protocol IO ByronBlockHFC (HardForkProtocol '[ByronBlock])
forall (m :: * -> *).
ProtocolParamsByron
-> Protocol m ByronBlockHFC (HardForkProtocol '[ByronBlock])
Consensus.ProtocolByron (ProtocolParamsByron
 -> Protocol IO ByronBlockHFC (HardForkProtocol '[ByronBlock]))
-> ProtocolParamsByron
-> Protocol IO ByronBlockHFC (HardForkProtocol '[ByronBlock])
forall a b. (a -> b) -> a -> b
$ ProtocolParamsByron :: Config
-> Maybe PBftSignatureThreshold
-> ProtocolVersion
-> SoftwareVersion
-> Maybe ByronLeaderCredentials
-> ProtocolParamsByron
Consensus.ProtocolParamsByron {
        $sel:byronGenesis:ProtocolParamsByron :: Config
byronGenesis = Config
genesisConfig,
        $sel:byronPbftSignatureThreshold:ProtocolParamsByron :: Maybe PBftSignatureThreshold
byronPbftSignatureThreshold =
          Double -> PBftSignatureThreshold
PBftSignatureThreshold (Double -> PBftSignatureThreshold)
-> Maybe Double -> Maybe PBftSignatureThreshold
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Double
npcByronPbftSignatureThresh,
        $sel:byronProtocolVersion:ProtocolParamsByron :: ProtocolVersion
byronProtocolVersion =
          Word16 -> Word16 -> Word8 -> ProtocolVersion
Update.ProtocolVersion
            Word16
npcByronSupportedProtocolVersionMajor
            Word16
npcByronSupportedProtocolVersionMinor
            Word8
npcByronSupportedProtocolVersionAlt,
        $sel:byronSoftwareVersion:ProtocolParamsByron :: SoftwareVersion
byronSoftwareVersion =
          ApplicationName -> NumSoftwareVersion -> SoftwareVersion
Update.SoftwareVersion
            ApplicationName
npcByronApplicationName
            NumSoftwareVersion
npcByronApplicationVersion,
        $sel:byronLeaderCredentials:ProtocolParamsByron :: Maybe ByronLeaderCredentials
byronLeaderCredentials =
          Maybe ByronLeaderCredentials
optionalLeaderCredentials
        }

readGenesis :: GenesisFile
            -> Maybe GenesisHash
            -> RequiresNetworkMagic
            -> ExceptT ByronProtocolInstantiationError IO
                       Genesis.Config
readGenesis :: GenesisFile
-> Maybe GenesisHash
-> RequiresNetworkMagic
-> ExceptT ByronProtocolInstantiationError IO Config
readGenesis (GenesisFile FilePath
file) Maybe GenesisHash
mbExpectedGenesisHash RequiresNetworkMagic
ncReqNetworkMagic = do
    (GenesisData
genesisData, GenesisHash
genesisHash) <- (GenesisDataError -> ByronProtocolInstantiationError)
-> ExceptT GenesisDataError IO (GenesisData, GenesisHash)
-> ExceptT
     ByronProtocolInstantiationError IO (GenesisData, GenesisHash)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (FilePath -> GenesisDataError -> ByronProtocolInstantiationError
GenesisReadError FilePath
file) (ExceptT GenesisDataError IO (GenesisData, GenesisHash)
 -> ExceptT
      ByronProtocolInstantiationError IO (GenesisData, GenesisHash))
-> ExceptT GenesisDataError IO (GenesisData, GenesisHash)
-> ExceptT
     ByronProtocolInstantiationError 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 ByronProtocolInstantiationError IO ()
checkExpectedGenesisHash GenesisHash
genesisHash
    Config -> ExceptT ByronProtocolInstantiationError 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 ByronProtocolInstantiationError IO ()
    checkExpectedGenesisHash :: GenesisHash -> ExceptT ByronProtocolInstantiationError 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 ->
            ByronProtocolInstantiationError
-> ExceptT ByronProtocolInstantiationError IO ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GenesisHash -> GenesisHash -> ByronProtocolInstantiationError
GenesisHashMismatch GenesisHash
actual GenesisHash
expected)
          where
            actual :: GenesisHash
actual = GenesisHash -> GenesisHash
fromByronGenesisHash GenesisHash
actual'

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

    fromByronGenesisHash :: Genesis.GenesisHash -> GenesisHash
    fromByronGenesisHash :: GenesisHash -> GenesisHash
fromByronGenesisHash (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
Byron.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
"fromByronGenesisHash: old and new crypto libs disagree on hash size"



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

         ByteString
signingKeyFileBytes <- IO ByteString
-> ExceptT ByronProtocolInstantiationError IO ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString
 -> ExceptT ByronProtocolInstantiationError IO ByteString)
-> IO ByteString
-> ExceptT ByronProtocolInstantiationError IO ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
LB.readFile FilePath
signingKeyFile
         ByteString
delegCertFileBytes <- IO ByteString
-> ExceptT ByronProtocolInstantiationError IO ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString
 -> ExceptT ByronProtocolInstantiationError IO ByteString)
-> IO ByteString
-> ExceptT ByronProtocolInstantiationError IO ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
LB.readFile FilePath
delegCertFile
         SigningKey
signingKey <- (DeserialiseFailure -> ByronProtocolInstantiationError)
-> ExceptT DeserialiseFailure IO SigningKey
-> ExceptT ByronProtocolInstantiationError IO SigningKey
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (FilePath -> DeserialiseFailure -> ByronProtocolInstantiationError
SigningKeyDeserialiseFailure FilePath
signingKeyFile)
                         (ExceptT DeserialiseFailure IO SigningKey
 -> ExceptT ByronProtocolInstantiationError IO SigningKey)
-> (Either DeserialiseFailure SigningKey
    -> ExceptT DeserialiseFailure IO SigningKey)
-> Either DeserialiseFailure SigningKey
-> ExceptT ByronProtocolInstantiationError IO SigningKey
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Either DeserialiseFailure SigningKey
-> ExceptT DeserialiseFailure IO SigningKey
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither
                         (Either DeserialiseFailure SigningKey
 -> ExceptT ByronProtocolInstantiationError IO SigningKey)
-> Either DeserialiseFailure SigningKey
-> ExceptT ByronProtocolInstantiationError IO SigningKey
forall a b. (a -> b) -> a -> b
$ ByteString -> Either DeserialiseFailure SigningKey
deserialiseSigningKey ByteString
signingKeyFileBytes
         Certificate
delegCert  <- (Text -> ByronProtocolInstantiationError)
-> ExceptT Text IO Certificate
-> ExceptT ByronProtocolInstantiationError IO Certificate
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (FilePath -> Text -> ByronProtocolInstantiationError
CanonicalDecodeFailure FilePath
delegCertFile)
                         (ExceptT Text IO Certificate
 -> ExceptT ByronProtocolInstantiationError IO Certificate)
-> (Either Text Certificate -> ExceptT Text IO Certificate)
-> Either Text Certificate
-> ExceptT ByronProtocolInstantiationError 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 ByronProtocolInstantiationError IO Certificate)
-> Either Text Certificate
-> ExceptT ByronProtocolInstantiationError 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

         (ByronLeaderCredentialsError -> ByronProtocolInstantiationError)
-> (ByronLeaderCredentials -> Maybe ByronLeaderCredentials)
-> ExceptT ByronLeaderCredentialsError IO ByronLeaderCredentials
-> ExceptT
     ByronProtocolInstantiationError IO (Maybe ByronLeaderCredentials)
forall (m :: * -> *) x y a b.
Functor m =>
(x -> y) -> (a -> b) -> ExceptT x m a -> ExceptT y m b
bimapExceptT ByronLeaderCredentialsError -> ByronProtocolInstantiationError
CredentialsError ByronLeaderCredentials -> Maybe ByronLeaderCredentials
forall a. a -> Maybe a
Just
           (ExceptT ByronLeaderCredentialsError IO ByronLeaderCredentials
 -> ExceptT
      ByronProtocolInstantiationError IO (Maybe ByronLeaderCredentials))
-> (Either ByronLeaderCredentialsError ByronLeaderCredentials
    -> ExceptT ByronLeaderCredentialsError IO ByronLeaderCredentials)
-> Either ByronLeaderCredentialsError ByronLeaderCredentials
-> ExceptT
     ByronProtocolInstantiationError IO (Maybe ByronLeaderCredentials)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Either ByronLeaderCredentialsError ByronLeaderCredentials
-> ExceptT ByronLeaderCredentialsError IO ByronLeaderCredentials
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither
           (Either ByronLeaderCredentialsError ByronLeaderCredentials
 -> ExceptT
      ByronProtocolInstantiationError IO (Maybe ByronLeaderCredentials))
-> Either ByronLeaderCredentialsError ByronLeaderCredentials
-> ExceptT
     ByronProtocolInstantiationError IO (Maybe ByronLeaderCredentials)
forall a b. (a -> b) -> a -> b
$ Config
-> SigningKey
-> Certificate
-> Text
-> Either ByronLeaderCredentialsError ByronLeaderCredentials
mkByronLeaderCredentials Config
genesisConfig SigningKey
signingKey Certificate
delegCert Text
"Byron"

  where
    deserialiseSigningKey :: LB.ByteString
                          -> Either DeserialiseFailure Byron.Crypto.SigningKey
    deserialiseSigningKey :: ByteString -> Either DeserialiseFailure SigningKey
deserialiseSigningKey =
        ((ByteString, XPrv) -> SigningKey)
-> Either DeserialiseFailure (ByteString, XPrv)
-> Either DeserialiseFailure SigningKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (XPrv -> SigningKey
Byron.Crypto.SigningKey (XPrv -> SigningKey)
-> ((ByteString, XPrv) -> XPrv) -> (ByteString, XPrv) -> SigningKey
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (ByteString, XPrv) -> XPrv
forall a b. (a, b) -> b
snd)
      (Either DeserialiseFailure (ByteString, XPrv)
 -> Either DeserialiseFailure SigningKey)
-> (ByteString -> Either DeserialiseFailure (ByteString, XPrv))
-> ByteString
-> Either DeserialiseFailure SigningKey
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (forall s. Decoder s XPrv)
-> ByteString -> Either DeserialiseFailure (ByteString, XPrv)
forall a.
(forall s. Decoder s a)
-> ByteString -> Either DeserialiseFailure (ByteString, a)
deserialiseFromBytes forall s. Decoder s XPrv
Byron.Crypto.fromCBORXPrv

------------------------------------------------------------------------------
-- Byron Errors
--

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


renderByronProtocolInstantiationError :: ByronProtocolInstantiationError -> Text
renderByronProtocolInstantiationError :: ByronProtocolInstantiationError -> Text
renderByronProtocolInstantiationError ByronProtocolInstantiationError
pie =
  case ByronProtocolInstantiationError
pie of
    CanonicalDecodeFailure FilePath
fp Text
failure -> Text
"Canonical decode failure in " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
forall a b. ConvertText a b => a -> b
toS FilePath
fp
                                         Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" Canonical failure: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
failure
    GenesisHashMismatch GenesisHash
actual GenesisHash
expected ->
        Text
"Wrong Byron genesis file: the actual hash is " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> GenesisHash -> Text
forall a b. (Show a, ConvertText FilePath b) => a -> b
show GenesisHash
actual
     Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", but the expected Byron genesis hash given in the node configuration "
     Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"file is " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> GenesisHash -> Text
forall a b. (Show a, ConvertText FilePath b) => a -> b
show GenesisHash
expected
    ByronProtocolInstantiationError
DelegationCertificateFilepathNotSpecified -> Text
"Delegation certificate filepath not specified"
    --TODO: Implement configuration error render function in cardano-ledger
    GenesisConfigurationError FilePath
fp ConfigurationError
genesisConfigError -> Text
"Genesis configuration error in: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
forall a b. ConvertText a b => a -> b
toS FilePath
fp
                                                       Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" Error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
Text.pack (ConfigurationError -> FilePath
forall a b. (Show a, ConvertText FilePath b) => a -> b
show ConfigurationError
genesisConfigError)
    GenesisReadError FilePath
fp GenesisDataError
err ->  Text
"There was an error parsing the genesis file: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
forall a b. ConvertText a b => a -> b
toS FilePath
fp
                                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" Error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
Text.pack (GenesisDataError -> FilePath
forall a b. (Show a, ConvertText FilePath b) => a -> b
show GenesisDataError
err)
    -- TODO: Implement ByronLeaderCredentialsError render function in ouroboros-network
    CredentialsError ByronLeaderCredentialsError
byronLeaderCredentialsError -> Text
"Byron leader credentials error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
Text.pack (ByronLeaderCredentialsError -> FilePath
forall a b. (Show a, ConvertText FilePath b) => a -> b
show ByronLeaderCredentialsError
byronLeaderCredentialsError)
    SigningKeyDeserialiseFailure FilePath
fp DeserialiseFailure
deserialiseFailure -> Text
"Signing key deserialisation error in: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
forall a b. ConvertText a b => a -> b
toS FilePath
fp
                                                           Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" Error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
Text.pack (DeserialiseFailure -> FilePath
forall a b. (Show a, ConvertText FilePath b) => a -> b
show DeserialiseFailure
deserialiseFailure)
    ByronProtocolInstantiationError
SigningKeyFilepathNotSpecified -> Text
"Signing key filepath not specified"