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

module Bcc.Node.Protocol.Sophie
  ( mkSomeConsensusProtocolSophie

    -- * Errors
  , SophieProtocolInstantiationError(..)
  , GenesisReadError(..)
  , GenesisValidationError(..)
  , OptimumLeaderCredentialsError(..)

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

import           Bcc.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,
                   newExceptT)

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

import qualified Shardagnostic.Consensus.Bcc as Consensus
import qualified Shardagnostic.Consensus.Mempool.TxLimits as TxLimits
import           Shardagnostic.Consensus.Sophie.Eras (StandardSophie)
import           Shardagnostic.Consensus.Sophie.Node (Nonce (..), ProtocolParamsSophie (..),
                   ProtocolParamsSophieBased (..), TOptimumLeaderCredentials (..))
import           Shardagnostic.Consensus.Sophie.Protocol (TOptimumCanBeLeader (..))

import qualified Sophie.Spec.Ledger.Genesis as Sophie
import           Sophie.Spec.Ledger.PParams (ProtVer (..))

import qualified Bcc.Api as Api (FileError (..))
import           Bcc.Api.Orphans ()
import qualified Bcc.Api.Protocol.Types as Protocol
import           Bcc.Api.Sophie hiding (FileError)


import           Bcc.Node.Types

import           Bcc.Tracing.OrphanInstances.HardFork ()
import           Bcc.Tracing.OrphanInstances.Sophie ()

import           Bcc.Node.Protocol.Types

------------------------------------------------------------------------------
-- Sophie protocol
--

-- | Make 'SomeConsensusProtocol' using the Sophie 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.
mkSomeConsensusProtocolSophie
  :: NodeSophieProtocolConfiguration
  -> Maybe ProtocolFilepaths
  -> ExceptT SophieProtocolInstantiationError IO SomeConsensusProtocol
mkSomeConsensusProtocolSophie :: NodeSophieProtocolConfiguration
-> Maybe ProtocolFilepaths
-> ExceptT
     SophieProtocolInstantiationError IO SomeConsensusProtocol
mkSomeConsensusProtocolSophie NodeSophieProtocolConfiguration {
                                  GenesisFile
npcSophieGenesisFile :: NodeSophieProtocolConfiguration -> GenesisFile
npcSophieGenesisFile :: GenesisFile
npcSophieGenesisFile,
                                  Maybe GenesisHash
npcSophieGenesisFileHash :: NodeSophieProtocolConfiguration -> Maybe GenesisHash
npcSophieGenesisFileHash :: Maybe GenesisHash
npcSophieGenesisFileHash
                                }
                          Maybe ProtocolFilepaths
files = do
    (SophieGenesis StandardSophie
genesis, GenesisHash
genesisHash) <- (GenesisReadError -> SophieProtocolInstantiationError)
-> ExceptT
     GenesisReadError IO (SophieGenesis StandardSophie, GenesisHash)
-> ExceptT
     SophieProtocolInstantiationError
     IO
     (SophieGenesis StandardSophie, GenesisHash)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT GenesisReadError -> SophieProtocolInstantiationError
GenesisReadError (ExceptT
   GenesisReadError IO (SophieGenesis StandardSophie, GenesisHash)
 -> ExceptT
      SophieProtocolInstantiationError
      IO
      (SophieGenesis StandardSophie, GenesisHash))
-> ExceptT
     GenesisReadError IO (SophieGenesis StandardSophie, GenesisHash)
-> ExceptT
     SophieProtocolInstantiationError
     IO
     (SophieGenesis StandardSophie, GenesisHash)
forall a b. (a -> b) -> a -> b
$
                              GenesisFile
-> Maybe GenesisHash
-> ExceptT
     GenesisReadError IO (SophieGenesis StandardSophie, GenesisHash)
readGenesis GenesisFile
npcSophieGenesisFile
                                          Maybe GenesisHash
npcSophieGenesisFileHash
    (GenesisValidationError -> SophieProtocolInstantiationError)
-> ExceptT GenesisValidationError IO ()
-> ExceptT SophieProtocolInstantiationError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT GenesisValidationError -> SophieProtocolInstantiationError
GenesisValidationError (ExceptT GenesisValidationError IO ()
 -> ExceptT SophieProtocolInstantiationError IO ())
-> ExceptT GenesisValidationError IO ()
-> ExceptT SophieProtocolInstantiationError IO ()
forall a b. (a -> b) -> a -> b
$ SophieGenesis StandardSophie
-> ExceptT GenesisValidationError IO ()
validateGenesis SophieGenesis StandardSophie
genesis
    [TOptimumLeaderCredentials StandardCrypto]
leaderCredentials <- (OptimumLeaderCredentialsError -> SophieProtocolInstantiationError)
-> ExceptT
     OptimumLeaderCredentialsError
     IO
     [TOptimumLeaderCredentials StandardCrypto]
-> ExceptT
     SophieProtocolInstantiationError
     IO
     [TOptimumLeaderCredentials StandardCrypto]
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT OptimumLeaderCredentialsError -> SophieProtocolInstantiationError
OptimumLeaderCredentialsError (ExceptT
   OptimumLeaderCredentialsError
   IO
   [TOptimumLeaderCredentials StandardCrypto]
 -> ExceptT
      SophieProtocolInstantiationError
      IO
      [TOptimumLeaderCredentials StandardCrypto])
-> ExceptT
     OptimumLeaderCredentialsError
     IO
     [TOptimumLeaderCredentials StandardCrypto]
-> ExceptT
     SophieProtocolInstantiationError
     IO
     [TOptimumLeaderCredentials StandardCrypto]
forall a b. (a -> b) -> a -> b
$
                         Maybe ProtocolFilepaths
-> ExceptT
     OptimumLeaderCredentialsError
     IO
     [TOptimumLeaderCredentials StandardCrypto]
readLeaderCredentials Maybe ProtocolFilepaths
files

    SomeConsensusProtocol
-> ExceptT
     SophieProtocolInstantiationError IO SomeConsensusProtocol
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeConsensusProtocol
 -> ExceptT
      SophieProtocolInstantiationError IO SomeConsensusProtocol)
-> SomeConsensusProtocol
-> ExceptT
     SophieProtocolInstantiationError IO SomeConsensusProtocol
forall a b. (a -> b) -> a -> b
$ BlockType (HardForkBlock '[SophieBlock StandardSophie])
-> ProtocolInfoArgs
     IO (HardForkBlock '[SophieBlock StandardSophie])
-> SomeConsensusProtocol
forall blk.
(Protocol IO blk, HasKESMetricsData blk, HasKESInfo blk,
 TraceConstraints blk) =>
BlockType blk -> ProtocolInfoArgs IO blk -> SomeConsensusProtocol
SomeConsensusProtocol BlockType (HardForkBlock '[SophieBlock StandardSophie])
Protocol.SophieBlockType (ProtocolInfoArgs IO (HardForkBlock '[SophieBlock StandardSophie])
 -> SomeConsensusProtocol)
-> ProtocolInfoArgs
     IO (HardForkBlock '[SophieBlock StandardSophie])
-> SomeConsensusProtocol
forall a b. (a -> b) -> a -> b
$ ProtocolParamsSophieBased StandardSophie
-> ProtocolParamsSophie StandardCrypto
-> ProtocolInfoArgs
     IO (HardForkBlock '[SophieBlock StandardSophie])
forall (m :: * -> *).
ProtocolParamsSophieBased StandardSophie
-> ProtocolParamsSophie StandardCrypto
-> ProtocolInfoArgs m (HardForkBlock '[SophieBlock StandardSophie])
Protocol.ProtocolInfoArgsSophie
      ProtocolParamsSophieBased :: forall era.
SophieGenesis era
-> Nonce
-> [TOptimumLeaderCredentials (EraCrypto era)]
-> ProtocolParamsSophieBased era
Consensus.ProtocolParamsSophieBased {
        $sel:sophieBasedGenesis:ProtocolParamsSophieBased :: SophieGenesis StandardSophie
sophieBasedGenesis = SophieGenesis StandardSophie
genesis,
        $sel:sophieBasedInitialNonce:ProtocolParamsSophieBased :: Nonce
sophieBasedInitialNonce = GenesisHash -> Nonce
genesisHashToOptimumNonce GenesisHash
genesisHash,
        $sel:sophieBasedLeaderCredentials:ProtocolParamsSophieBased :: [TOptimumLeaderCredentials (EraCrypto StandardSophie)]
sophieBasedLeaderCredentials =
            [TOptimumLeaderCredentials StandardCrypto]
[TOptimumLeaderCredentials (EraCrypto StandardSophie)]
leaderCredentials
      }
      ProtocolParamsSophie :: forall c.
ProtVer
-> Overrides (SophieBlock (SophieEra c)) -> ProtocolParamsSophie c
Consensus.ProtocolParamsSophie {
        $sel:sophieProtVer:ProtocolParamsSophie :: ProtVer
sophieProtVer =
          Natural -> Natural -> ProtVer
ProtVer Natural
2 Natural
0,
        $sel:sophieMaxTxCapacityOverrides:ProtocolParamsSophie :: Overrides (SophieBlock StandardSophie)
sophieMaxTxCapacityOverrides =
          TxMeasure (SophieBlock StandardSophie)
-> Overrides (SophieBlock StandardSophie)
forall blk. TxMeasure blk -> Overrides blk
TxLimits.mkOverrides TxMeasure (SophieBlock StandardSophie)
forall a. BoundedMeasure a => a
TxLimits.noOverridesMeasure
      }

genesisHashToOptimumNonce :: GenesisHash -> Nonce
genesisHashToOptimumNonce :: GenesisHash -> Nonce
genesisHashToOptimumNonce (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
                       (SophieGenesis StandardSophie, GenesisHash)
readGenesis :: GenesisFile
-> Maybe GenesisHash
-> ExceptT
     GenesisReadError IO (SophieGenesis StandardSophie, GenesisHash)
readGenesis = GenesisFile
-> Maybe GenesisHash
-> ExceptT
     GenesisReadError IO (SophieGenesis StandardSophie, 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 :: SophieGenesis StandardSophie
                -> ExceptT GenesisValidationError IO ()
validateGenesis :: SophieGenesis StandardSophie
-> ExceptT GenesisValidationError IO ()
validateGenesis SophieGenesis StandardSophie
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
$
      SophieGenesis StandardSophie -> Either [ValidationErr] ()
forall era.
Era era =>
SophieGenesis era -> Either [ValidationErr] ()
Sophie.validateGenesis SophieGenesis StandardSophie
genesis

readLeaderCredentials :: Maybe ProtocolFilepaths
                      -> ExceptT OptimumLeaderCredentialsError IO
                                 [TOptimumLeaderCredentials StandardCrypto]
readLeaderCredentials :: Maybe ProtocolFilepaths
-> ExceptT
     OptimumLeaderCredentialsError
     IO
     [TOptimumLeaderCredentials StandardCrypto]
readLeaderCredentials Maybe ProtocolFilepaths
Nothing = [TOptimumLeaderCredentials StandardCrypto]
-> ExceptT
     OptimumLeaderCredentialsError
     IO
     [TOptimumLeaderCredentials 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.
  [TOptimumLeaderCredentials StandardCrypto]
-> [TOptimumLeaderCredentials StandardCrypto]
-> [TOptimumLeaderCredentials StandardCrypto]
forall a. Semigroup a => a -> a -> a
(<>) ([TOptimumLeaderCredentials StandardCrypto]
 -> [TOptimumLeaderCredentials StandardCrypto]
 -> [TOptimumLeaderCredentials StandardCrypto])
-> ExceptT
     OptimumLeaderCredentialsError
     IO
     [TOptimumLeaderCredentials StandardCrypto]
-> ExceptT
     OptimumLeaderCredentialsError
     IO
     ([TOptimumLeaderCredentials StandardCrypto]
      -> [TOptimumLeaderCredentials StandardCrypto])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtocolFilepaths
-> ExceptT
     OptimumLeaderCredentialsError
     IO
     [TOptimumLeaderCredentials StandardCrypto]
readLeaderCredentialsSingleton ProtocolFilepaths
pfp
       ExceptT
  OptimumLeaderCredentialsError
  IO
  ([TOptimumLeaderCredentials StandardCrypto]
   -> [TOptimumLeaderCredentials StandardCrypto])
-> ExceptT
     OptimumLeaderCredentialsError
     IO
     [TOptimumLeaderCredentials StandardCrypto]
-> ExceptT
     OptimumLeaderCredentialsError
     IO
     [TOptimumLeaderCredentials StandardCrypto]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ProtocolFilepaths
-> ExceptT
     OptimumLeaderCredentialsError
     IO
     [TOptimumLeaderCredentials StandardCrypto]
readLeaderCredentialsBulk      ProtocolFilepaths
pfp

readLeaderCredentialsSingleton ::
     ProtocolFilepaths ->
     ExceptT OptimumLeaderCredentialsError IO
             [TOptimumLeaderCredentials StandardCrypto]
-- It's OK to supply none of the files on the CLI
readLeaderCredentialsSingleton :: ProtocolFilepaths
-> ExceptT
     OptimumLeaderCredentialsError
     IO
     [TOptimumLeaderCredentials StandardCrypto]
readLeaderCredentialsSingleton
   ProtocolFilepaths
     { sophieCertFile :: ProtocolFilepaths -> Maybe FilePath
sophieCertFile      = Maybe FilePath
Nothing,
       sophieVRFFile :: ProtocolFilepaths -> Maybe FilePath
sophieVRFFile       = Maybe FilePath
Nothing,
       sophieKESFile :: ProtocolFilepaths -> Maybe FilePath
sophieKESFile       = Maybe FilePath
Nothing
     } = [TOptimumLeaderCredentials StandardCrypto]
-> ExceptT
     OptimumLeaderCredentialsError
     IO
     [TOptimumLeaderCredentials StandardCrypto]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
-- Or to supply all of the files
readLeaderCredentialsSingleton
   ProtocolFilepaths
     { sophieCertFile :: ProtocolFilepaths -> Maybe FilePath
sophieCertFile      = Just FilePath
certFile,
       sophieVRFFile :: ProtocolFilepaths -> Maybe FilePath
sophieVRFFile       = Just FilePath
vrfFile,
       sophieKESFile :: ProtocolFilepaths -> Maybe FilePath
sophieKESFile       = Just FilePath
kesFile
     } =
     (TOptimumLeaderCredentials StandardCrypto
 -> [TOptimumLeaderCredentials StandardCrypto])
-> ExceptT
     OptimumLeaderCredentialsError
     IO
     (TOptimumLeaderCredentials StandardCrypto)
-> ExceptT
     OptimumLeaderCredentialsError
     IO
     [TOptimumLeaderCredentials StandardCrypto]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TOptimumLeaderCredentials StandardCrypto
-> [TOptimumLeaderCredentials StandardCrypto]
-> [TOptimumLeaderCredentials StandardCrypto]
forall a. a -> [a] -> [a]
:[]) (ExceptT
   OptimumLeaderCredentialsError
   IO
   (TOptimumLeaderCredentials StandardCrypto)
 -> ExceptT
      OptimumLeaderCredentialsError
      IO
      [TOptimumLeaderCredentials StandardCrypto])
-> ExceptT
     OptimumLeaderCredentialsError
     IO
     (TOptimumLeaderCredentials StandardCrypto)
-> ExceptT
     OptimumLeaderCredentialsError
     IO
     [TOptimumLeaderCredentials StandardCrypto]
forall a b. (a -> b) -> a -> b
$
     OperationalCertificate
-> SigningKey VrfKey
-> SigningKey KesKey
-> TOptimumLeaderCredentials StandardCrypto
mkOptimumLeaderCredentials
       (OperationalCertificate
 -> SigningKey VrfKey
 -> SigningKey KesKey
 -> TOptimumLeaderCredentials StandardCrypto)
-> ExceptT OptimumLeaderCredentialsError IO OperationalCertificate
-> ExceptT
     OptimumLeaderCredentialsError
     IO
     (SigningKey VrfKey
      -> SigningKey KesKey -> TOptimumLeaderCredentials StandardCrypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FileError TextEnvelopeError -> OptimumLeaderCredentialsError)
-> ExceptT (FileError TextEnvelopeError) IO OperationalCertificate
-> ExceptT OptimumLeaderCredentialsError IO OperationalCertificate
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> OptimumLeaderCredentialsError
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)
       ExceptT
  OptimumLeaderCredentialsError
  IO
  (SigningKey VrfKey
   -> SigningKey KesKey -> TOptimumLeaderCredentials StandardCrypto)
-> ExceptT OptimumLeaderCredentialsError IO (SigningKey VrfKey)
-> ExceptT
     OptimumLeaderCredentialsError
     IO
     (SigningKey KesKey -> TOptimumLeaderCredentials StandardCrypto)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (FileError TextEnvelopeError -> OptimumLeaderCredentialsError)
-> ExceptT (FileError TextEnvelopeError) IO (SigningKey VrfKey)
-> ExceptT OptimumLeaderCredentialsError IO (SigningKey VrfKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> OptimumLeaderCredentialsError
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)
       ExceptT
  OptimumLeaderCredentialsError
  IO
  (SigningKey KesKey -> TOptimumLeaderCredentials StandardCrypto)
-> ExceptT OptimumLeaderCredentialsError IO (SigningKey KesKey)
-> ExceptT
     OptimumLeaderCredentialsError
     IO
     (TOptimumLeaderCredentials StandardCrypto)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (FileError TextEnvelopeError -> OptimumLeaderCredentialsError)
-> ExceptT (FileError TextEnvelopeError) IO (SigningKey KesKey)
-> ExceptT OptimumLeaderCredentialsError IO (SigningKey KesKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> OptimumLeaderCredentialsError
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)
-- But not OK to supply some of the files without the others.
readLeaderCredentialsSingleton ProtocolFilepaths {sophieCertFile :: ProtocolFilepaths -> Maybe FilePath
sophieCertFile = Maybe FilePath
Nothing} =
     OptimumLeaderCredentialsError
-> ExceptT
     OptimumLeaderCredentialsError
     IO
     [TOptimumLeaderCredentials StandardCrypto]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError OptimumLeaderCredentialsError
OCertNotSpecified
readLeaderCredentialsSingleton ProtocolFilepaths {sophieVRFFile :: ProtocolFilepaths -> Maybe FilePath
sophieVRFFile = Maybe FilePath
Nothing} =
     OptimumLeaderCredentialsError
-> ExceptT
     OptimumLeaderCredentialsError
     IO
     [TOptimumLeaderCredentials StandardCrypto]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError OptimumLeaderCredentialsError
VRFKeyNotSpecified
readLeaderCredentialsSingleton ProtocolFilepaths {sophieKESFile :: ProtocolFilepaths -> Maybe FilePath
sophieKESFile = Maybe FilePath
Nothing} =
     OptimumLeaderCredentialsError
-> ExceptT
     OptimumLeaderCredentialsError
     IO
     [TOptimumLeaderCredentials StandardCrypto]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError OptimumLeaderCredentialsError
KESKeyNotSpecified

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

readLeaderCredentialsBulk ::
     ProtocolFilepaths
  -> ExceptT OptimumLeaderCredentialsError IO
             [TOptimumLeaderCredentials StandardCrypto]
readLeaderCredentialsBulk :: ProtocolFilepaths
-> ExceptT
     OptimumLeaderCredentialsError
     IO
     [TOptimumLeaderCredentials StandardCrypto]
readLeaderCredentialsBulk ProtocolFilepaths { sophieBulkCredsFile :: ProtocolFilepaths -> Maybe FilePath
sophieBulkCredsFile = Maybe FilePath
mfp } =
  (SophieCredentials
 -> ExceptT
      OptimumLeaderCredentialsError
      IO
      (TOptimumLeaderCredentials StandardCrypto))
-> [SophieCredentials]
-> ExceptT
     OptimumLeaderCredentialsError
     IO
     [TOptimumLeaderCredentials StandardCrypto]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM SophieCredentials
-> ExceptT
     OptimumLeaderCredentialsError
     IO
     (TOptimumLeaderCredentials StandardCrypto)
parseSophieCredentials ([SophieCredentials]
 -> ExceptT
      OptimumLeaderCredentialsError
      IO
      [TOptimumLeaderCredentials StandardCrypto])
-> ExceptT OptimumLeaderCredentialsError IO [SophieCredentials]
-> ExceptT
     OptimumLeaderCredentialsError
     IO
     [TOptimumLeaderCredentials StandardCrypto]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe FilePath
-> ExceptT OptimumLeaderCredentialsError IO [SophieCredentials]
readBulkFile Maybe FilePath
mfp
 where
   parseSophieCredentials ::
        SophieCredentials
     -> ExceptT OptimumLeaderCredentialsError IO
                (TOptimumLeaderCredentials StandardCrypto)
   parseSophieCredentials :: SophieCredentials
-> ExceptT
     OptimumLeaderCredentialsError
     IO
     (TOptimumLeaderCredentials StandardCrypto)
parseSophieCredentials SophieCredentials { (TextEnvelope, FilePath)
scCert :: (TextEnvelope, FilePath)
scCert :: SophieCredentials -> (TextEnvelope, FilePath)
scCert, (TextEnvelope, FilePath)
scVrf :: (TextEnvelope, FilePath)
scVrf :: SophieCredentials -> (TextEnvelope, FilePath)
scVrf, (TextEnvelope, FilePath)
scKes :: (TextEnvelope, FilePath)
scKes :: SophieCredentials -> (TextEnvelope, FilePath)
scKes } = do
     OperationalCertificate
-> SigningKey VrfKey
-> SigningKey KesKey
-> TOptimumLeaderCredentials StandardCrypto
mkOptimumLeaderCredentials
       (OperationalCertificate
 -> SigningKey VrfKey
 -> SigningKey KesKey
 -> TOptimumLeaderCredentials StandardCrypto)
-> ExceptT OptimumLeaderCredentialsError IO OperationalCertificate
-> ExceptT
     OptimumLeaderCredentialsError
     IO
     (SigningKey VrfKey
      -> SigningKey KesKey -> TOptimumLeaderCredentials StandardCrypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AsType OperationalCertificate
-> (TextEnvelope, FilePath)
-> ExceptT OptimumLeaderCredentialsError IO OperationalCertificate
forall a.
HasTextEnvelope a =>
AsType a
-> (TextEnvelope, FilePath)
-> ExceptT OptimumLeaderCredentialsError IO a
parseEnvelope AsType OperationalCertificate
AsOperationalCertificate (TextEnvelope, FilePath)
scCert
       ExceptT
  OptimumLeaderCredentialsError
  IO
  (SigningKey VrfKey
   -> SigningKey KesKey -> TOptimumLeaderCredentials StandardCrypto)
-> ExceptT OptimumLeaderCredentialsError IO (SigningKey VrfKey)
-> ExceptT
     OptimumLeaderCredentialsError
     IO
     (SigningKey KesKey -> TOptimumLeaderCredentials StandardCrypto)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AsType (SigningKey VrfKey)
-> (TextEnvelope, FilePath)
-> ExceptT OptimumLeaderCredentialsError IO (SigningKey VrfKey)
forall a.
HasTextEnvelope a =>
AsType a
-> (TextEnvelope, FilePath)
-> ExceptT OptimumLeaderCredentialsError IO a
parseEnvelope (AsType VrfKey -> AsType (SigningKey VrfKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType VrfKey
AsVrfKey) (TextEnvelope, FilePath)
scVrf
       ExceptT
  OptimumLeaderCredentialsError
  IO
  (SigningKey KesKey -> TOptimumLeaderCredentials StandardCrypto)
-> ExceptT OptimumLeaderCredentialsError IO (SigningKey KesKey)
-> ExceptT
     OptimumLeaderCredentialsError
     IO
     (TOptimumLeaderCredentials StandardCrypto)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AsType (SigningKey KesKey)
-> (TextEnvelope, FilePath)
-> ExceptT OptimumLeaderCredentialsError IO (SigningKey KesKey)
forall a.
HasTextEnvelope a =>
AsType a
-> (TextEnvelope, FilePath)
-> ExceptT OptimumLeaderCredentialsError 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 OptimumLeaderCredentialsError IO
                           [SophieCredentials]
   readBulkFile :: Maybe FilePath
-> ExceptT OptimumLeaderCredentialsError IO [SophieCredentials]
readBulkFile Maybe FilePath
Nothing = [SophieCredentials]
-> ExceptT OptimumLeaderCredentialsError IO [SophieCredentials]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
   readBulkFile (Just FilePath
fp) = do
     ByteString
content <- (IOException -> OptimumLeaderCredentialsError)
-> IO ByteString
-> ExceptT OptimumLeaderCredentialsError IO ByteString
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FilePath -> IOException -> OptimumLeaderCredentialsError
CredentialsReadError FilePath
fp) (IO ByteString
 -> ExceptT OptimumLeaderCredentialsError IO ByteString)
-> IO ByteString
-> ExceptT OptimumLeaderCredentialsError IO ByteString
forall a b. (a -> b) -> a -> b
$
                  FilePath -> IO ByteString
BS.readFile FilePath
fp
     [(TextEnvelope, TextEnvelope, TextEnvelope)]
envelopes <- (FilePath -> OptimumLeaderCredentialsError)
-> ExceptT FilePath IO [(TextEnvelope, TextEnvelope, TextEnvelope)]
-> ExceptT
     OptimumLeaderCredentialsError
     IO
     [(TextEnvelope, TextEnvelope, TextEnvelope)]
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (FilePath -> FilePath -> OptimumLeaderCredentialsError
EnvelopeParseError FilePath
fp) (ExceptT FilePath IO [(TextEnvelope, TextEnvelope, TextEnvelope)]
 -> ExceptT
      OptimumLeaderCredentialsError
      IO
      [(TextEnvelope, TextEnvelope, TextEnvelope)])
-> ExceptT FilePath IO [(TextEnvelope, TextEnvelope, TextEnvelope)]
-> ExceptT
     OptimumLeaderCredentialsError
     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
     [SophieCredentials]
-> ExceptT OptimumLeaderCredentialsError IO [SophieCredentials]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([SophieCredentials]
 -> ExceptT OptimumLeaderCredentialsError IO [SophieCredentials])
-> [SophieCredentials]
-> ExceptT OptimumLeaderCredentialsError IO [SophieCredentials]
forall a b. (a -> b) -> a -> b
$ (Int
 -> (TextEnvelope, TextEnvelope, TextEnvelope) -> SophieCredentials)
-> (Int, (TextEnvelope, TextEnvelope, TextEnvelope))
-> SophieCredentials
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int
-> (TextEnvelope, TextEnvelope, TextEnvelope) -> SophieCredentials
mkCredentials ((Int, (TextEnvelope, TextEnvelope, TextEnvelope))
 -> SophieCredentials)
-> [(Int, (TextEnvelope, TextEnvelope, TextEnvelope))]
-> [SophieCredentials]
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)
                    -> SophieCredentials
      mkCredentials :: Int
-> (TextEnvelope, TextEnvelope, TextEnvelope) -> SophieCredentials
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)
-> SophieCredentials
SophieCredentials (TextEnvelope
teCert, FilePath -> FilePath
loc FilePath
"cert")
                             (TextEnvelope
teVrf,  FilePath -> FilePath
loc FilePath
"vrf")
                             (TextEnvelope
teKes,  FilePath -> FilePath
loc FilePath
"kes")

mkOptimumLeaderCredentials ::
     OperationalCertificate
  -> SigningKey VrfKey
  -> SigningKey KesKey
  -> TOptimumLeaderCredentials StandardCrypto
mkOptimumLeaderCredentials :: OperationalCertificate
-> SigningKey VrfKey
-> SigningKey KesKey
-> TOptimumLeaderCredentials StandardCrypto
mkOptimumLeaderCredentials
    (OperationalCertificate OCert StandardCrypto
opcert (StakePoolVerificationKey vkey))
    (VrfSigningKey vrfKey)
    (KesSigningKey kesKey) =
    TOptimumLeaderCredentials :: forall c.
SignKeyKES c
-> TOptimumCanBeLeader c -> Text -> TOptimumLeaderCredentials c
TOptimumLeaderCredentials
    { $sel:toptimumLeaderCredentialsCanBeLeader:TOptimumLeaderCredentials :: TOptimumCanBeLeader StandardCrypto
toptimumLeaderCredentialsCanBeLeader =
        TOptimumCanBeLeader :: forall c.
OCert c
-> VKey 'BlockIssuer c -> SignKeyVRF c -> TOptimumCanBeLeader c
TOptimumCanBeLeader {
        toptimumCanBeLeaderOpCert :: OCert StandardCrypto
toptimumCanBeLeaderOpCert     = OCert StandardCrypto
opcert,
          toptimumCanBeLeaderColdVerKey :: VKey 'BlockIssuer StandardCrypto
toptimumCanBeLeaderColdVerKey = 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,
          toptimumCanBeLeaderSignKeyVRF :: SignKeyVRF StandardCrypto
toptimumCanBeLeaderSignKeyVRF = SignKeyVRF StandardCrypto
vrfKey
        },
      $sel:toptimumLeaderCredentialsInitSignKey:TOptimumLeaderCredentials :: SignKeyKES StandardCrypto
toptimumLeaderCredentialsInitSignKey = SignKeyKES StandardCrypto
kesKey,
      $sel:toptimumLeaderCredentialsLabel:TOptimumLeaderCredentials :: Text
toptimumLeaderCredentialsLabel = Text
"Sophie"
    }

parseEnvelope ::
     HasTextEnvelope a
  => AsType a
  -> (TextEnvelope, String)
  -> ExceptT OptimumLeaderCredentialsError IO a
parseEnvelope :: AsType a
-> (TextEnvelope, FilePath)
-> ExceptT OptimumLeaderCredentialsError IO a
parseEnvelope AsType a
as (TextEnvelope
te, FilePath
loc) =
  (TextEnvelopeError -> OptimumLeaderCredentialsError)
-> ExceptT TextEnvelopeError IO a
-> ExceptT OptimumLeaderCredentialsError IO a
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (FileError TextEnvelopeError -> OptimumLeaderCredentialsError
FileError (FileError TextEnvelopeError -> OptimumLeaderCredentialsError)
-> (TextEnvelopeError -> FileError TextEnvelopeError)
-> TextEnvelopeError
-> OptimumLeaderCredentialsError
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 OptimumLeaderCredentialsError IO a)
-> (Either TextEnvelopeError a -> ExceptT TextEnvelopeError IO a)
-> Either TextEnvelopeError a
-> ExceptT OptimumLeaderCredentialsError 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 OptimumLeaderCredentialsError IO a)
-> Either TextEnvelopeError a
-> ExceptT OptimumLeaderCredentialsError 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 SophieProtocolInstantiationError =
       GenesisReadError GenesisReadError
     | GenesisValidationError GenesisValidationError
     | OptimumLeaderCredentialsError OptimumLeaderCredentialsError
  deriving Int -> SophieProtocolInstantiationError -> FilePath -> FilePath
[SophieProtocolInstantiationError] -> FilePath -> FilePath
SophieProtocolInstantiationError -> FilePath
(Int -> SophieProtocolInstantiationError -> FilePath -> FilePath)
-> (SophieProtocolInstantiationError -> FilePath)
-> ([SophieProtocolInstantiationError] -> FilePath -> FilePath)
-> Show SophieProtocolInstantiationError
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [SophieProtocolInstantiationError] -> FilePath -> FilePath
$cshowList :: [SophieProtocolInstantiationError] -> FilePath -> FilePath
show :: SophieProtocolInstantiationError -> FilePath
$cshow :: SophieProtocolInstantiationError -> FilePath
showsPrec :: Int -> SophieProtocolInstantiationError -> FilePath -> FilePath
$cshowsPrec :: Int -> SophieProtocolInstantiationError -> FilePath -> FilePath
Show

instance Error SophieProtocolInstantiationError where
  displayError :: SophieProtocolInstantiationError -> 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 (OptimumLeaderCredentialsError OptimumLeaderCredentialsError
err) = OptimumLeaderCredentialsError -> FilePath
forall e. Error e => e -> FilePath
displayError OptimumLeaderCredentialsError
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 [Sophie.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
Sophie.describeValidationErr [ValidationErr]
vErrs))


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

     | OCertNotSpecified
     | VRFKeyNotSpecified
     | KESKeyNotSpecified
  deriving Int -> OptimumLeaderCredentialsError -> FilePath -> FilePath
[OptimumLeaderCredentialsError] -> FilePath -> FilePath
OptimumLeaderCredentialsError -> FilePath
(Int -> OptimumLeaderCredentialsError -> FilePath -> FilePath)
-> (OptimumLeaderCredentialsError -> FilePath)
-> ([OptimumLeaderCredentialsError] -> FilePath -> FilePath)
-> Show OptimumLeaderCredentialsError
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [OptimumLeaderCredentialsError] -> FilePath -> FilePath
$cshowList :: [OptimumLeaderCredentialsError] -> FilePath -> FilePath
show :: OptimumLeaderCredentialsError -> FilePath
$cshow :: OptimumLeaderCredentialsError -> FilePath
showsPrec :: Int -> OptimumLeaderCredentialsError -> FilePath -> FilePath
$cshowsPrec :: Int -> OptimumLeaderCredentialsError -> FilePath -> FilePath
Show

instance Error OptimumLeaderCredentialsError where
  displayError :: OptimumLeaderCredentialsError -> 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 OptimumLeaderCredentialsError
OCertNotSpecified  = FilePath -> FilePath
missingFlagMessage FilePath
"sophie-operational-certificate"
  displayError OptimumLeaderCredentialsError
VRFKeyNotSpecified = FilePath -> FilePath
missingFlagMessage FilePath
"sophie-vrf-key"
  displayError OptimumLeaderCredentialsError
KESKeyNotSpecified = FilePath -> FilePath
missingFlagMessage FilePath
"sophie-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"