{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}

-- DUPLICATE -- adapted from: cardano-node/src/Cardano/Node/Types.hs

module Cardano.Node.Types (
    -- * Configuration
    AdjustFilePaths (..)
  , ConfigError (..)
  , ConfigYamlFilePath (..)
  , DbFile (..)
  , GenesisFile (..)
  , GenesisHash (..)
  , MaxConcurrencyBulkSync (..)
  , MaxConcurrencyDeadline (..)
  , ProtocolFilepaths (..)
    -- * Consensus protocol configuration
  , NodeAlonzoProtocolConfiguration (..)
  , NodeByronProtocolConfiguration (..)
  , NodeConwayProtocolConfiguration (..)
  , NodeHardForkProtocolConfiguration (..)
  , NodeProtocolConfiguration (..)
  , NodeShelleyProtocolConfiguration (..)
  , VRFPrivateKeyFilePermissionError (..)
  , renderVRFPrivateKeyFilePermissionError
  ) where

import qualified Cardano.Chain.Update as Byron
import           Cardano.Crypto (RequiresNetworkMagic)
import qualified Cardano.Crypto.Hash as Crypto
import           Data.Aeson
import           Data.String (IsString)
import           Data.Text as Text (Text, pack, unpack)
import           Data.Word (Word16, Word8)
import           Ouroboros.Consensus.Block.Abstract (EpochNo)


-- | Errors for the cardano-config module.
data ConfigError =
    ConfigErrorFileNotFound FilePath
  | ConfigErrorNoEKG
    deriving Int -> ConfigError -> ShowS
[ConfigError] -> ShowS
ConfigError -> String
(Int -> ConfigError -> ShowS)
-> (ConfigError -> String)
-> ([ConfigError] -> ShowS)
-> Show ConfigError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConfigError -> ShowS
showsPrec :: Int -> ConfigError -> ShowS
$cshow :: ConfigError -> String
show :: ConfigError -> String
$cshowList :: [ConfigError] -> ShowS
showList :: [ConfigError] -> ShowS
Show

-- | Filepath of the configuration yaml file. This file determines
-- all the configuration settings required for the cardano node
-- (logging, tracing, protocol, slot length etc)
newtype ConfigYamlFilePath = ConfigYamlFilePath
  { ConfigYamlFilePath -> String
unConfigPath :: FilePath }
  deriving newtype (ConfigYamlFilePath -> ConfigYamlFilePath -> Bool
(ConfigYamlFilePath -> ConfigYamlFilePath -> Bool)
-> (ConfigYamlFilePath -> ConfigYamlFilePath -> Bool)
-> Eq ConfigYamlFilePath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConfigYamlFilePath -> ConfigYamlFilePath -> Bool
== :: ConfigYamlFilePath -> ConfigYamlFilePath -> Bool
$c/= :: ConfigYamlFilePath -> ConfigYamlFilePath -> Bool
/= :: ConfigYamlFilePath -> ConfigYamlFilePath -> Bool
Eq, Int -> ConfigYamlFilePath -> ShowS
[ConfigYamlFilePath] -> ShowS
ConfigYamlFilePath -> String
(Int -> ConfigYamlFilePath -> ShowS)
-> (ConfigYamlFilePath -> String)
-> ([ConfigYamlFilePath] -> ShowS)
-> Show ConfigYamlFilePath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConfigYamlFilePath -> ShowS
showsPrec :: Int -> ConfigYamlFilePath -> ShowS
$cshow :: ConfigYamlFilePath -> String
show :: ConfigYamlFilePath -> String
$cshowList :: [ConfigYamlFilePath] -> ShowS
showList :: [ConfigYamlFilePath] -> ShowS
Show)

newtype DbFile = DbFile
  { DbFile -> String
unDB :: FilePath }
  deriving newtype (DbFile -> DbFile -> Bool
(DbFile -> DbFile -> Bool)
-> (DbFile -> DbFile -> Bool) -> Eq DbFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DbFile -> DbFile -> Bool
== :: DbFile -> DbFile -> Bool
$c/= :: DbFile -> DbFile -> Bool
/= :: DbFile -> DbFile -> Bool
Eq, Int -> DbFile -> ShowS
[DbFile] -> ShowS
DbFile -> String
(Int -> DbFile -> ShowS)
-> (DbFile -> String) -> ([DbFile] -> ShowS) -> Show DbFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DbFile -> ShowS
showsPrec :: Int -> DbFile -> ShowS
$cshow :: DbFile -> String
show :: DbFile -> String
$cshowList :: [DbFile] -> ShowS
showList :: [DbFile] -> ShowS
Show)

newtype GenesisFile = GenesisFile
  { GenesisFile -> String
unGenesisFile :: FilePath }
  deriving stock (GenesisFile -> GenesisFile -> Bool
(GenesisFile -> GenesisFile -> Bool)
-> (GenesisFile -> GenesisFile -> Bool) -> Eq GenesisFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenesisFile -> GenesisFile -> Bool
== :: GenesisFile -> GenesisFile -> Bool
$c/= :: GenesisFile -> GenesisFile -> Bool
/= :: GenesisFile -> GenesisFile -> Bool
Eq, Eq GenesisFile
Eq GenesisFile =>
(GenesisFile -> GenesisFile -> Ordering)
-> (GenesisFile -> GenesisFile -> Bool)
-> (GenesisFile -> GenesisFile -> Bool)
-> (GenesisFile -> GenesisFile -> Bool)
-> (GenesisFile -> GenesisFile -> Bool)
-> (GenesisFile -> GenesisFile -> GenesisFile)
-> (GenesisFile -> GenesisFile -> GenesisFile)
-> Ord GenesisFile
GenesisFile -> GenesisFile -> Bool
GenesisFile -> GenesisFile -> Ordering
GenesisFile -> GenesisFile -> GenesisFile
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: GenesisFile -> GenesisFile -> Ordering
compare :: GenesisFile -> GenesisFile -> Ordering
$c< :: GenesisFile -> GenesisFile -> Bool
< :: GenesisFile -> GenesisFile -> Bool
$c<= :: GenesisFile -> GenesisFile -> Bool
<= :: GenesisFile -> GenesisFile -> Bool
$c> :: GenesisFile -> GenesisFile -> Bool
> :: GenesisFile -> GenesisFile -> Bool
$c>= :: GenesisFile -> GenesisFile -> Bool
>= :: GenesisFile -> GenesisFile -> Bool
$cmax :: GenesisFile -> GenesisFile -> GenesisFile
max :: GenesisFile -> GenesisFile -> GenesisFile
$cmin :: GenesisFile -> GenesisFile -> GenesisFile
min :: GenesisFile -> GenesisFile -> GenesisFile
Ord)
  deriving newtype (String -> GenesisFile
(String -> GenesisFile) -> IsString GenesisFile
forall a. (String -> a) -> IsString a
$cfromString :: String -> GenesisFile
fromString :: String -> GenesisFile
IsString, Int -> GenesisFile -> ShowS
[GenesisFile] -> ShowS
GenesisFile -> String
(Int -> GenesisFile -> ShowS)
-> (GenesisFile -> String)
-> ([GenesisFile] -> ShowS)
-> Show GenesisFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenesisFile -> ShowS
showsPrec :: Int -> GenesisFile -> ShowS
$cshow :: GenesisFile -> String
show :: GenesisFile -> String
$cshowList :: [GenesisFile] -> ShowS
showList :: [GenesisFile] -> ShowS
Show)

instance FromJSON GenesisFile where
  parseJSON :: Value -> Parser GenesisFile
parseJSON (String Text
genFp) = GenesisFile -> Parser GenesisFile
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenesisFile -> Parser GenesisFile)
-> (String -> GenesisFile) -> String -> Parser GenesisFile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> GenesisFile
GenesisFile (String -> Parser GenesisFile) -> String -> Parser GenesisFile
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack Text
genFp
  parseJSON Value
invalid = String -> Parser GenesisFile
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser GenesisFile) -> String -> Parser GenesisFile
forall a b. (a -> b) -> a -> b
$ String
"Parsing of GenesisFile failed due to type mismatch. "
                          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"Encountered: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Value -> String
forall a. Show a => a -> String
show Value
invalid

newtype MaxConcurrencyBulkSync = MaxConcurrencyBulkSync
  { MaxConcurrencyBulkSync -> Word
unMaxConcurrencyBulkSync :: Word }
  deriving stock (MaxConcurrencyBulkSync -> MaxConcurrencyBulkSync -> Bool
(MaxConcurrencyBulkSync -> MaxConcurrencyBulkSync -> Bool)
-> (MaxConcurrencyBulkSync -> MaxConcurrencyBulkSync -> Bool)
-> Eq MaxConcurrencyBulkSync
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MaxConcurrencyBulkSync -> MaxConcurrencyBulkSync -> Bool
== :: MaxConcurrencyBulkSync -> MaxConcurrencyBulkSync -> Bool
$c/= :: MaxConcurrencyBulkSync -> MaxConcurrencyBulkSync -> Bool
/= :: MaxConcurrencyBulkSync -> MaxConcurrencyBulkSync -> Bool
Eq, Eq MaxConcurrencyBulkSync
Eq MaxConcurrencyBulkSync =>
(MaxConcurrencyBulkSync -> MaxConcurrencyBulkSync -> Ordering)
-> (MaxConcurrencyBulkSync -> MaxConcurrencyBulkSync -> Bool)
-> (MaxConcurrencyBulkSync -> MaxConcurrencyBulkSync -> Bool)
-> (MaxConcurrencyBulkSync -> MaxConcurrencyBulkSync -> Bool)
-> (MaxConcurrencyBulkSync -> MaxConcurrencyBulkSync -> Bool)
-> (MaxConcurrencyBulkSync
    -> MaxConcurrencyBulkSync -> MaxConcurrencyBulkSync)
-> (MaxConcurrencyBulkSync
    -> MaxConcurrencyBulkSync -> MaxConcurrencyBulkSync)
-> Ord MaxConcurrencyBulkSync
MaxConcurrencyBulkSync -> MaxConcurrencyBulkSync -> Bool
MaxConcurrencyBulkSync -> MaxConcurrencyBulkSync -> Ordering
MaxConcurrencyBulkSync
-> MaxConcurrencyBulkSync -> MaxConcurrencyBulkSync
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MaxConcurrencyBulkSync -> MaxConcurrencyBulkSync -> Ordering
compare :: MaxConcurrencyBulkSync -> MaxConcurrencyBulkSync -> Ordering
$c< :: MaxConcurrencyBulkSync -> MaxConcurrencyBulkSync -> Bool
< :: MaxConcurrencyBulkSync -> MaxConcurrencyBulkSync -> Bool
$c<= :: MaxConcurrencyBulkSync -> MaxConcurrencyBulkSync -> Bool
<= :: MaxConcurrencyBulkSync -> MaxConcurrencyBulkSync -> Bool
$c> :: MaxConcurrencyBulkSync -> MaxConcurrencyBulkSync -> Bool
> :: MaxConcurrencyBulkSync -> MaxConcurrencyBulkSync -> Bool
$c>= :: MaxConcurrencyBulkSync -> MaxConcurrencyBulkSync -> Bool
>= :: MaxConcurrencyBulkSync -> MaxConcurrencyBulkSync -> Bool
$cmax :: MaxConcurrencyBulkSync
-> MaxConcurrencyBulkSync -> MaxConcurrencyBulkSync
max :: MaxConcurrencyBulkSync
-> MaxConcurrencyBulkSync -> MaxConcurrencyBulkSync
$cmin :: MaxConcurrencyBulkSync
-> MaxConcurrencyBulkSync -> MaxConcurrencyBulkSync
min :: MaxConcurrencyBulkSync
-> MaxConcurrencyBulkSync -> MaxConcurrencyBulkSync
Ord)
  deriving newtype (Maybe MaxConcurrencyBulkSync
Value -> Parser [MaxConcurrencyBulkSync]
Value -> Parser MaxConcurrencyBulkSync
(Value -> Parser MaxConcurrencyBulkSync)
-> (Value -> Parser [MaxConcurrencyBulkSync])
-> Maybe MaxConcurrencyBulkSync
-> FromJSON MaxConcurrencyBulkSync
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser MaxConcurrencyBulkSync
parseJSON :: Value -> Parser MaxConcurrencyBulkSync
$cparseJSONList :: Value -> Parser [MaxConcurrencyBulkSync]
parseJSONList :: Value -> Parser [MaxConcurrencyBulkSync]
$comittedField :: Maybe MaxConcurrencyBulkSync
omittedField :: Maybe MaxConcurrencyBulkSync
FromJSON, Int -> MaxConcurrencyBulkSync -> ShowS
[MaxConcurrencyBulkSync] -> ShowS
MaxConcurrencyBulkSync -> String
(Int -> MaxConcurrencyBulkSync -> ShowS)
-> (MaxConcurrencyBulkSync -> String)
-> ([MaxConcurrencyBulkSync] -> ShowS)
-> Show MaxConcurrencyBulkSync
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MaxConcurrencyBulkSync -> ShowS
showsPrec :: Int -> MaxConcurrencyBulkSync -> ShowS
$cshow :: MaxConcurrencyBulkSync -> String
show :: MaxConcurrencyBulkSync -> String
$cshowList :: [MaxConcurrencyBulkSync] -> ShowS
showList :: [MaxConcurrencyBulkSync] -> ShowS
Show)

newtype MaxConcurrencyDeadline = MaxConcurrencyDeadline
  { MaxConcurrencyDeadline -> Word
unMaxConcurrencyDeadline :: Word }
  deriving stock (MaxConcurrencyDeadline -> MaxConcurrencyDeadline -> Bool
(MaxConcurrencyDeadline -> MaxConcurrencyDeadline -> Bool)
-> (MaxConcurrencyDeadline -> MaxConcurrencyDeadline -> Bool)
-> Eq MaxConcurrencyDeadline
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MaxConcurrencyDeadline -> MaxConcurrencyDeadline -> Bool
== :: MaxConcurrencyDeadline -> MaxConcurrencyDeadline -> Bool
$c/= :: MaxConcurrencyDeadline -> MaxConcurrencyDeadline -> Bool
/= :: MaxConcurrencyDeadline -> MaxConcurrencyDeadline -> Bool
Eq, Eq MaxConcurrencyDeadline
Eq MaxConcurrencyDeadline =>
(MaxConcurrencyDeadline -> MaxConcurrencyDeadline -> Ordering)
-> (MaxConcurrencyDeadline -> MaxConcurrencyDeadline -> Bool)
-> (MaxConcurrencyDeadline -> MaxConcurrencyDeadline -> Bool)
-> (MaxConcurrencyDeadline -> MaxConcurrencyDeadline -> Bool)
-> (MaxConcurrencyDeadline -> MaxConcurrencyDeadline -> Bool)
-> (MaxConcurrencyDeadline
    -> MaxConcurrencyDeadline -> MaxConcurrencyDeadline)
-> (MaxConcurrencyDeadline
    -> MaxConcurrencyDeadline -> MaxConcurrencyDeadline)
-> Ord MaxConcurrencyDeadline
MaxConcurrencyDeadline -> MaxConcurrencyDeadline -> Bool
MaxConcurrencyDeadline -> MaxConcurrencyDeadline -> Ordering
MaxConcurrencyDeadline
-> MaxConcurrencyDeadline -> MaxConcurrencyDeadline
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MaxConcurrencyDeadline -> MaxConcurrencyDeadline -> Ordering
compare :: MaxConcurrencyDeadline -> MaxConcurrencyDeadline -> Ordering
$c< :: MaxConcurrencyDeadline -> MaxConcurrencyDeadline -> Bool
< :: MaxConcurrencyDeadline -> MaxConcurrencyDeadline -> Bool
$c<= :: MaxConcurrencyDeadline -> MaxConcurrencyDeadline -> Bool
<= :: MaxConcurrencyDeadline -> MaxConcurrencyDeadline -> Bool
$c> :: MaxConcurrencyDeadline -> MaxConcurrencyDeadline -> Bool
> :: MaxConcurrencyDeadline -> MaxConcurrencyDeadline -> Bool
$c>= :: MaxConcurrencyDeadline -> MaxConcurrencyDeadline -> Bool
>= :: MaxConcurrencyDeadline -> MaxConcurrencyDeadline -> Bool
$cmax :: MaxConcurrencyDeadline
-> MaxConcurrencyDeadline -> MaxConcurrencyDeadline
max :: MaxConcurrencyDeadline
-> MaxConcurrencyDeadline -> MaxConcurrencyDeadline
$cmin :: MaxConcurrencyDeadline
-> MaxConcurrencyDeadline -> MaxConcurrencyDeadline
min :: MaxConcurrencyDeadline
-> MaxConcurrencyDeadline -> MaxConcurrencyDeadline
Ord)
  deriving newtype (Maybe MaxConcurrencyDeadline
Value -> Parser [MaxConcurrencyDeadline]
Value -> Parser MaxConcurrencyDeadline
(Value -> Parser MaxConcurrencyDeadline)
-> (Value -> Parser [MaxConcurrencyDeadline])
-> Maybe MaxConcurrencyDeadline
-> FromJSON MaxConcurrencyDeadline
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser MaxConcurrencyDeadline
parseJSON :: Value -> Parser MaxConcurrencyDeadline
$cparseJSONList :: Value -> Parser [MaxConcurrencyDeadline]
parseJSONList :: Value -> Parser [MaxConcurrencyDeadline]
$comittedField :: Maybe MaxConcurrencyDeadline
omittedField :: Maybe MaxConcurrencyDeadline
FromJSON, Int -> MaxConcurrencyDeadline -> ShowS
[MaxConcurrencyDeadline] -> ShowS
MaxConcurrencyDeadline -> String
(Int -> MaxConcurrencyDeadline -> ShowS)
-> (MaxConcurrencyDeadline -> String)
-> ([MaxConcurrencyDeadline] -> ShowS)
-> Show MaxConcurrencyDeadline
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MaxConcurrencyDeadline -> ShowS
showsPrec :: Int -> MaxConcurrencyDeadline -> ShowS
$cshow :: MaxConcurrencyDeadline -> String
show :: MaxConcurrencyDeadline -> String
$cshowList :: [MaxConcurrencyDeadline] -> ShowS
showList :: [MaxConcurrencyDeadline] -> ShowS
Show)

{-
-- | Newtype wrapper which provides 'FromJSON' instance for 'DiffusionMode'.
--
newtype NodeDiffusionMode
  = NodeDiffusionMode { getDiffusionMode :: DiffusionMode }
  deriving newtype Show

instance FromJSON NodeDiffusionMode where
    parseJSON (String str) =
      case str of
        "InitiatorOnly"
          -> pure $ NodeDiffusionMode InitiatorOnlyDiffusionMode
        "InitiatorAndResponder"
          -> pure $ NodeDiffusionMode InitiatorAndResponderDiffusionMode
        _ -> fail "Parsing NodeDiffusionMode failed: can be either 'InitiatorOnly' or 'InitiatorAndResponder'"
    parseJSON _ = fail "Parsing NodeDiffusionMode failed"
-}

class AdjustFilePaths a where
  adjustFilePaths :: (FilePath -> FilePath) -> a -> a


data ProtocolFilepaths =
     ProtocolFilepaths {
       ProtocolFilepaths -> Maybe String
byronCertFile        :: !(Maybe FilePath)
     , ProtocolFilepaths -> Maybe String
byronKeyFile         :: !(Maybe FilePath)
     , ProtocolFilepaths -> Maybe String
shelleyKESFile       :: !(Maybe FilePath)
     , ProtocolFilepaths -> Maybe String
shelleyVRFFile       :: !(Maybe FilePath)
     , ProtocolFilepaths -> Maybe String
shelleyCertFile      :: !(Maybe FilePath)
     , ProtocolFilepaths -> Maybe String
shelleyBulkCredsFile :: !(Maybe FilePath)
     } deriving (ProtocolFilepaths -> ProtocolFilepaths -> Bool
(ProtocolFilepaths -> ProtocolFilepaths -> Bool)
-> (ProtocolFilepaths -> ProtocolFilepaths -> Bool)
-> Eq ProtocolFilepaths
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProtocolFilepaths -> ProtocolFilepaths -> Bool
== :: ProtocolFilepaths -> ProtocolFilepaths -> Bool
$c/= :: ProtocolFilepaths -> ProtocolFilepaths -> Bool
/= :: ProtocolFilepaths -> ProtocolFilepaths -> Bool
Eq, Int -> ProtocolFilepaths -> ShowS
[ProtocolFilepaths] -> ShowS
ProtocolFilepaths -> String
(Int -> ProtocolFilepaths -> ShowS)
-> (ProtocolFilepaths -> String)
-> ([ProtocolFilepaths] -> ShowS)
-> Show ProtocolFilepaths
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProtocolFilepaths -> ShowS
showsPrec :: Int -> ProtocolFilepaths -> ShowS
$cshow :: ProtocolFilepaths -> String
show :: ProtocolFilepaths -> String
$cshowList :: [ProtocolFilepaths] -> ShowS
showList :: [ProtocolFilepaths] -> ShowS
Show)

newtype GenesisHash = GenesisHash (Crypto.Hash Crypto.Blake2b_256 Crypto.ByteString)
  deriving newtype (GenesisHash -> GenesisHash -> Bool
(GenesisHash -> GenesisHash -> Bool)
-> (GenesisHash -> GenesisHash -> Bool) -> Eq GenesisHash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenesisHash -> GenesisHash -> Bool
== :: GenesisHash -> GenesisHash -> Bool
$c/= :: GenesisHash -> GenesisHash -> Bool
/= :: GenesisHash -> GenesisHash -> Bool
Eq, Int -> GenesisHash -> ShowS
[GenesisHash] -> ShowS
GenesisHash -> String
(Int -> GenesisHash -> ShowS)
-> (GenesisHash -> String)
-> ([GenesisHash] -> ShowS)
-> Show GenesisHash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenesisHash -> ShowS
showsPrec :: Int -> GenesisHash -> ShowS
$cshow :: GenesisHash -> String
show :: GenesisHash -> String
$cshowList :: [GenesisHash] -> ShowS
showList :: [GenesisHash] -> ShowS
Show, [GenesisHash] -> Value
[GenesisHash] -> Encoding
GenesisHash -> Bool
GenesisHash -> Value
GenesisHash -> Encoding
(GenesisHash -> Value)
-> (GenesisHash -> Encoding)
-> ([GenesisHash] -> Value)
-> ([GenesisHash] -> Encoding)
-> (GenesisHash -> Bool)
-> ToJSON GenesisHash
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: GenesisHash -> Value
toJSON :: GenesisHash -> Value
$ctoEncoding :: GenesisHash -> Encoding
toEncoding :: GenesisHash -> Encoding
$ctoJSONList :: [GenesisHash] -> Value
toJSONList :: [GenesisHash] -> Value
$ctoEncodingList :: [GenesisHash] -> Encoding
toEncodingList :: [GenesisHash] -> Encoding
$comitField :: GenesisHash -> Bool
omitField :: GenesisHash -> Bool
ToJSON, Maybe GenesisHash
Value -> Parser [GenesisHash]
Value -> Parser GenesisHash
(Value -> Parser GenesisHash)
-> (Value -> Parser [GenesisHash])
-> Maybe GenesisHash
-> FromJSON GenesisHash
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser GenesisHash
parseJSON :: Value -> Parser GenesisHash
$cparseJSONList :: Value -> Parser [GenesisHash]
parseJSONList :: Value -> Parser [GenesisHash]
$comittedField :: Maybe GenesisHash
omittedField :: Maybe GenesisHash
FromJSON)

data NodeProtocolConfiguration =
       NodeProtocolConfigurationByron   NodeByronProtocolConfiguration
     | NodeProtocolConfigurationShelley NodeShelleyProtocolConfiguration
     | NodeProtocolConfigurationCardano NodeByronProtocolConfiguration
                                        NodeShelleyProtocolConfiguration
                                        NodeAlonzoProtocolConfiguration
                                        NodeConwayProtocolConfiguration
                                        NodeHardForkProtocolConfiguration
  deriving (NodeProtocolConfiguration -> NodeProtocolConfiguration -> Bool
(NodeProtocolConfiguration -> NodeProtocolConfiguration -> Bool)
-> (NodeProtocolConfiguration -> NodeProtocolConfiguration -> Bool)
-> Eq NodeProtocolConfiguration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NodeProtocolConfiguration -> NodeProtocolConfiguration -> Bool
== :: NodeProtocolConfiguration -> NodeProtocolConfiguration -> Bool
$c/= :: NodeProtocolConfiguration -> NodeProtocolConfiguration -> Bool
/= :: NodeProtocolConfiguration -> NodeProtocolConfiguration -> Bool
Eq, Int -> NodeProtocolConfiguration -> ShowS
[NodeProtocolConfiguration] -> ShowS
NodeProtocolConfiguration -> String
(Int -> NodeProtocolConfiguration -> ShowS)
-> (NodeProtocolConfiguration -> String)
-> ([NodeProtocolConfiguration] -> ShowS)
-> Show NodeProtocolConfiguration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NodeProtocolConfiguration -> ShowS
showsPrec :: Int -> NodeProtocolConfiguration -> ShowS
$cshow :: NodeProtocolConfiguration -> String
show :: NodeProtocolConfiguration -> String
$cshowList :: [NodeProtocolConfiguration] -> ShowS
showList :: [NodeProtocolConfiguration] -> ShowS
Show)

data NodeShelleyProtocolConfiguration =
     NodeShelleyProtocolConfiguration {
       NodeShelleyProtocolConfiguration -> GenesisFile
npcShelleyGenesisFile     :: !GenesisFile
     , NodeShelleyProtocolConfiguration -> Maybe GenesisHash
npcShelleyGenesisFileHash :: !(Maybe GenesisHash)
     }
  deriving (NodeShelleyProtocolConfiguration
-> NodeShelleyProtocolConfiguration -> Bool
(NodeShelleyProtocolConfiguration
 -> NodeShelleyProtocolConfiguration -> Bool)
-> (NodeShelleyProtocolConfiguration
    -> NodeShelleyProtocolConfiguration -> Bool)
-> Eq NodeShelleyProtocolConfiguration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NodeShelleyProtocolConfiguration
-> NodeShelleyProtocolConfiguration -> Bool
== :: NodeShelleyProtocolConfiguration
-> NodeShelleyProtocolConfiguration -> Bool
$c/= :: NodeShelleyProtocolConfiguration
-> NodeShelleyProtocolConfiguration -> Bool
/= :: NodeShelleyProtocolConfiguration
-> NodeShelleyProtocolConfiguration -> Bool
Eq, Int -> NodeShelleyProtocolConfiguration -> ShowS
[NodeShelleyProtocolConfiguration] -> ShowS
NodeShelleyProtocolConfiguration -> String
(Int -> NodeShelleyProtocolConfiguration -> ShowS)
-> (NodeShelleyProtocolConfiguration -> String)
-> ([NodeShelleyProtocolConfiguration] -> ShowS)
-> Show NodeShelleyProtocolConfiguration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NodeShelleyProtocolConfiguration -> ShowS
showsPrec :: Int -> NodeShelleyProtocolConfiguration -> ShowS
$cshow :: NodeShelleyProtocolConfiguration -> String
show :: NodeShelleyProtocolConfiguration -> String
$cshowList :: [NodeShelleyProtocolConfiguration] -> ShowS
showList :: [NodeShelleyProtocolConfiguration] -> ShowS
Show)

data NodeAlonzoProtocolConfiguration =
     NodeAlonzoProtocolConfiguration {
       NodeAlonzoProtocolConfiguration -> GenesisFile
npcAlonzoGenesisFile     :: !GenesisFile
     , NodeAlonzoProtocolConfiguration -> Maybe GenesisHash
npcAlonzoGenesisFileHash :: !(Maybe GenesisHash)
     }
  deriving (NodeAlonzoProtocolConfiguration
-> NodeAlonzoProtocolConfiguration -> Bool
(NodeAlonzoProtocolConfiguration
 -> NodeAlonzoProtocolConfiguration -> Bool)
-> (NodeAlonzoProtocolConfiguration
    -> NodeAlonzoProtocolConfiguration -> Bool)
-> Eq NodeAlonzoProtocolConfiguration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NodeAlonzoProtocolConfiguration
-> NodeAlonzoProtocolConfiguration -> Bool
== :: NodeAlonzoProtocolConfiguration
-> NodeAlonzoProtocolConfiguration -> Bool
$c/= :: NodeAlonzoProtocolConfiguration
-> NodeAlonzoProtocolConfiguration -> Bool
/= :: NodeAlonzoProtocolConfiguration
-> NodeAlonzoProtocolConfiguration -> Bool
Eq, Int -> NodeAlonzoProtocolConfiguration -> ShowS
[NodeAlonzoProtocolConfiguration] -> ShowS
NodeAlonzoProtocolConfiguration -> String
(Int -> NodeAlonzoProtocolConfiguration -> ShowS)
-> (NodeAlonzoProtocolConfiguration -> String)
-> ([NodeAlonzoProtocolConfiguration] -> ShowS)
-> Show NodeAlonzoProtocolConfiguration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NodeAlonzoProtocolConfiguration -> ShowS
showsPrec :: Int -> NodeAlonzoProtocolConfiguration -> ShowS
$cshow :: NodeAlonzoProtocolConfiguration -> String
show :: NodeAlonzoProtocolConfiguration -> String
$cshowList :: [NodeAlonzoProtocolConfiguration] -> ShowS
showList :: [NodeAlonzoProtocolConfiguration] -> ShowS
Show)

data NodeByronProtocolConfiguration =
     NodeByronProtocolConfiguration {
       NodeByronProtocolConfiguration -> GenesisFile
npcByronGenesisFile                   :: !GenesisFile
     , NodeByronProtocolConfiguration -> Maybe GenesisHash
npcByronGenesisFileHash               :: !(Maybe GenesisHash)
     , NodeByronProtocolConfiguration -> RequiresNetworkMagic
npcByronReqNetworkMagic               :: !RequiresNetworkMagic
     , NodeByronProtocolConfiguration -> Maybe Double
npcByronPbftSignatureThresh           :: !(Maybe Double)

       --TODO: eliminate these two: it can be hard-coded
       -- | Update application name.
     , NodeByronProtocolConfiguration -> ApplicationName
npcByronApplicationName               :: !Byron.ApplicationName

       -- | Application (ie software) version.
     , NodeByronProtocolConfiguration -> NumSoftwareVersion
npcByronApplicationVersion            :: !Byron.NumSoftwareVersion

       --TODO: eliminate these: it can be done automatically in consensus
       -- | These declare the version of the protocol that the node is prepared
       -- to run. This is usually the version of the protocol in use on the
       -- chain now, but during protocol updates this version will be the one
       -- that we declare that we are ready to move to. This is the endorsement
       -- mechanism for determining when enough block producers are ready to
       -- move to the next version.
       --
     , NodeByronProtocolConfiguration -> Word16
npcByronSupportedProtocolVersionMajor :: !Word16
     , NodeByronProtocolConfiguration -> Word16
npcByronSupportedProtocolVersionMinor :: !Word16
     , NodeByronProtocolConfiguration -> Word8
npcByronSupportedProtocolVersionAlt   :: !Word8
     }
  deriving (NodeByronProtocolConfiguration
-> NodeByronProtocolConfiguration -> Bool
(NodeByronProtocolConfiguration
 -> NodeByronProtocolConfiguration -> Bool)
-> (NodeByronProtocolConfiguration
    -> NodeByronProtocolConfiguration -> Bool)
-> Eq NodeByronProtocolConfiguration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NodeByronProtocolConfiguration
-> NodeByronProtocolConfiguration -> Bool
== :: NodeByronProtocolConfiguration
-> NodeByronProtocolConfiguration -> Bool
$c/= :: NodeByronProtocolConfiguration
-> NodeByronProtocolConfiguration -> Bool
/= :: NodeByronProtocolConfiguration
-> NodeByronProtocolConfiguration -> Bool
Eq, Int -> NodeByronProtocolConfiguration -> ShowS
[NodeByronProtocolConfiguration] -> ShowS
NodeByronProtocolConfiguration -> String
(Int -> NodeByronProtocolConfiguration -> ShowS)
-> (NodeByronProtocolConfiguration -> String)
-> ([NodeByronProtocolConfiguration] -> ShowS)
-> Show NodeByronProtocolConfiguration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NodeByronProtocolConfiguration -> ShowS
showsPrec :: Int -> NodeByronProtocolConfiguration -> ShowS
$cshow :: NodeByronProtocolConfiguration -> String
show :: NodeByronProtocolConfiguration -> String
$cshowList :: [NodeByronProtocolConfiguration] -> ShowS
showList :: [NodeByronProtocolConfiguration] -> ShowS
Show)

data NodeConwayProtocolConfiguration =
     NodeConwayProtocolConfiguration {
       NodeConwayProtocolConfiguration -> GenesisFile
npcConwayGenesisFile     :: !GenesisFile
     , NodeConwayProtocolConfiguration -> Maybe GenesisHash
npcConwayGenesisFileHash :: !(Maybe GenesisHash)
     }
  deriving (NodeConwayProtocolConfiguration
-> NodeConwayProtocolConfiguration -> Bool
(NodeConwayProtocolConfiguration
 -> NodeConwayProtocolConfiguration -> Bool)
-> (NodeConwayProtocolConfiguration
    -> NodeConwayProtocolConfiguration -> Bool)
-> Eq NodeConwayProtocolConfiguration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NodeConwayProtocolConfiguration
-> NodeConwayProtocolConfiguration -> Bool
== :: NodeConwayProtocolConfiguration
-> NodeConwayProtocolConfiguration -> Bool
$c/= :: NodeConwayProtocolConfiguration
-> NodeConwayProtocolConfiguration -> Bool
/= :: NodeConwayProtocolConfiguration
-> NodeConwayProtocolConfiguration -> Bool
Eq, Int -> NodeConwayProtocolConfiguration -> ShowS
[NodeConwayProtocolConfiguration] -> ShowS
NodeConwayProtocolConfiguration -> String
(Int -> NodeConwayProtocolConfiguration -> ShowS)
-> (NodeConwayProtocolConfiguration -> String)
-> ([NodeConwayProtocolConfiguration] -> ShowS)
-> Show NodeConwayProtocolConfiguration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NodeConwayProtocolConfiguration -> ShowS
showsPrec :: Int -> NodeConwayProtocolConfiguration -> ShowS
$cshow :: NodeConwayProtocolConfiguration -> String
show :: NodeConwayProtocolConfiguration -> String
$cshowList :: [NodeConwayProtocolConfiguration] -> ShowS
showList :: [NodeConwayProtocolConfiguration] -> ShowS
Show)

-- | Configuration relating to a hard forks themselves, not the specific eras.
--
data NodeHardForkProtocolConfiguration =
     NodeHardForkProtocolConfiguration {

       -- | During the development and integration of new eras we wish to be
       -- able to test the hard fork transition into the new era, but we do not
       -- wish to generally have the node advertise that it understands the new
       -- era. Avoiding advertising new development eras until they are ready
       -- makes it practical to include new not-yet-ready eras into the main
       -- release version of the node without the danger that operators on the
       -- mainnet will prematurely advertise that their nodes are capable of
       -- crossing the next hard fork.
       --
       -- It should /always/ remain at the default of false for nodes running
       -- on the mainnet.
       --
       -- This flag should be set to true for nodes taking part in testnets for
       -- testing the new era.
       --
       NodeHardForkProtocolConfiguration -> Bool
npcTestEnableDevelopmentHardForkEras :: Bool

       -- | For testing purposes we support specifying that the hard fork
       -- happens at an exact epoch number (ie the first epoch of the new era).
       --
       -- Obviously if this is used, all the nodes in the test cluster must be
       -- configured the same, or they will disagree.
       --
     , NodeHardForkProtocolConfiguration -> Maybe EpochNo
npcTestShelleyHardForkAtEpoch        :: Maybe EpochNo

       -- | For testing purposes we support specifying that the hard fork
       -- happens at an exact epoch number (ie the first epoch of the new era).
       --
       -- Obviously if this is used, all the nodes in the test cluster must be
       -- configured the same, or they will disagree.
       --
     , NodeHardForkProtocolConfiguration -> Maybe EpochNo
npcTestAllegraHardForkAtEpoch        :: Maybe EpochNo

       -- | For testing purposes we support specifying that the hard fork
       -- happens at an exact epoch number (ie the first epoch of the new era).
       --
       -- Obviously if this is used, all the nodes in the test cluster must be
       -- configured the same, or they will disagree.
       --
     , NodeHardForkProtocolConfiguration -> Maybe EpochNo
npcTestMaryHardForkAtEpoch           :: Maybe EpochNo

       -- | For testing purposes we support specifying that the hard fork
       -- happens at an exact epoch number (ie the first epoch of the new era).
       --
       -- Obviously if this is used, all the nodes in the test cluster must be
       -- configured the same, or they will disagree.
       --
     , NodeHardForkProtocolConfiguration -> Maybe EpochNo
npcTestAlonzoHardForkAtEpoch         :: Maybe EpochNo

     , NodeHardForkProtocolConfiguration -> Maybe EpochNo
npcTestBabbageHardForkAtEpoch        :: Maybe EpochNo

     , NodeHardForkProtocolConfiguration -> Maybe EpochNo
npcTestConwayHardForkAtEpoch         :: Maybe EpochNo
     }
  deriving (NodeHardForkProtocolConfiguration
-> NodeHardForkProtocolConfiguration -> Bool
(NodeHardForkProtocolConfiguration
 -> NodeHardForkProtocolConfiguration -> Bool)
-> (NodeHardForkProtocolConfiguration
    -> NodeHardForkProtocolConfiguration -> Bool)
-> Eq NodeHardForkProtocolConfiguration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NodeHardForkProtocolConfiguration
-> NodeHardForkProtocolConfiguration -> Bool
== :: NodeHardForkProtocolConfiguration
-> NodeHardForkProtocolConfiguration -> Bool
$c/= :: NodeHardForkProtocolConfiguration
-> NodeHardForkProtocolConfiguration -> Bool
/= :: NodeHardForkProtocolConfiguration
-> NodeHardForkProtocolConfiguration -> Bool
Eq, Int -> NodeHardForkProtocolConfiguration -> ShowS
[NodeHardForkProtocolConfiguration] -> ShowS
NodeHardForkProtocolConfiguration -> String
(Int -> NodeHardForkProtocolConfiguration -> ShowS)
-> (NodeHardForkProtocolConfiguration -> String)
-> ([NodeHardForkProtocolConfiguration] -> ShowS)
-> Show NodeHardForkProtocolConfiguration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NodeHardForkProtocolConfiguration -> ShowS
showsPrec :: Int -> NodeHardForkProtocolConfiguration -> ShowS
$cshow :: NodeHardForkProtocolConfiguration -> String
show :: NodeHardForkProtocolConfiguration -> String
$cshowList :: [NodeHardForkProtocolConfiguration] -> ShowS
showList :: [NodeHardForkProtocolConfiguration] -> ShowS
Show)


instance AdjustFilePaths NodeProtocolConfiguration where

  adjustFilePaths :: ShowS -> NodeProtocolConfiguration -> NodeProtocolConfiguration
adjustFilePaths ShowS
f (NodeProtocolConfigurationByron NodeByronProtocolConfiguration
pc) =
    NodeByronProtocolConfiguration -> NodeProtocolConfiguration
NodeProtocolConfigurationByron (ShowS
-> NodeByronProtocolConfiguration -> NodeByronProtocolConfiguration
forall a. AdjustFilePaths a => ShowS -> a -> a
adjustFilePaths ShowS
f NodeByronProtocolConfiguration
pc)

  adjustFilePaths ShowS
f (NodeProtocolConfigurationShelley NodeShelleyProtocolConfiguration
pc) =
    NodeShelleyProtocolConfiguration -> NodeProtocolConfiguration
NodeProtocolConfigurationShelley (ShowS
-> NodeShelleyProtocolConfiguration
-> NodeShelleyProtocolConfiguration
forall a. AdjustFilePaths a => ShowS -> a -> a
adjustFilePaths ShowS
f NodeShelleyProtocolConfiguration
pc)

  adjustFilePaths ShowS
f (NodeProtocolConfigurationCardano NodeByronProtocolConfiguration
pcb NodeShelleyProtocolConfiguration
pcs NodeAlonzoProtocolConfiguration
pca NodeConwayProtocolConfiguration
pcc NodeHardForkProtocolConfiguration
pch) =
    NodeByronProtocolConfiguration
-> NodeShelleyProtocolConfiguration
-> NodeAlonzoProtocolConfiguration
-> NodeConwayProtocolConfiguration
-> NodeHardForkProtocolConfiguration
-> NodeProtocolConfiguration
NodeProtocolConfigurationCardano (ShowS
-> NodeByronProtocolConfiguration -> NodeByronProtocolConfiguration
forall a. AdjustFilePaths a => ShowS -> a -> a
adjustFilePaths ShowS
f NodeByronProtocolConfiguration
pcb)
                                     (ShowS
-> NodeShelleyProtocolConfiguration
-> NodeShelleyProtocolConfiguration
forall a. AdjustFilePaths a => ShowS -> a -> a
adjustFilePaths ShowS
f NodeShelleyProtocolConfiguration
pcs)
                                     (ShowS
-> NodeAlonzoProtocolConfiguration
-> NodeAlonzoProtocolConfiguration
forall a. AdjustFilePaths a => ShowS -> a -> a
adjustFilePaths ShowS
f NodeAlonzoProtocolConfiguration
pca)
                                     (ShowS
-> NodeConwayProtocolConfiguration
-> NodeConwayProtocolConfiguration
forall a. AdjustFilePaths a => ShowS -> a -> a
adjustFilePaths ShowS
f NodeConwayProtocolConfiguration
pcc)
                                     NodeHardForkProtocolConfiguration
pch

instance AdjustFilePaths NodeByronProtocolConfiguration where
  adjustFilePaths :: ShowS
-> NodeByronProtocolConfiguration -> NodeByronProtocolConfiguration
adjustFilePaths ShowS
f x :: NodeByronProtocolConfiguration
x@NodeByronProtocolConfiguration {
                        GenesisFile
npcByronGenesisFile :: NodeByronProtocolConfiguration -> GenesisFile
npcByronGenesisFile :: GenesisFile
npcByronGenesisFile
                      } =
    NodeByronProtocolConfiguration
x { npcByronGenesisFile = adjustFilePaths f npcByronGenesisFile }

instance AdjustFilePaths NodeShelleyProtocolConfiguration where
  adjustFilePaths :: ShowS
-> NodeShelleyProtocolConfiguration
-> NodeShelleyProtocolConfiguration
adjustFilePaths ShowS
f x :: NodeShelleyProtocolConfiguration
x@NodeShelleyProtocolConfiguration {
                        GenesisFile
npcShelleyGenesisFile :: NodeShelleyProtocolConfiguration -> GenesisFile
npcShelleyGenesisFile :: GenesisFile
npcShelleyGenesisFile
                      } =
    NodeShelleyProtocolConfiguration
x { npcShelleyGenesisFile = adjustFilePaths f npcShelleyGenesisFile }

instance AdjustFilePaths NodeAlonzoProtocolConfiguration where
  adjustFilePaths :: ShowS
-> NodeAlonzoProtocolConfiguration
-> NodeAlonzoProtocolConfiguration
adjustFilePaths ShowS
f x :: NodeAlonzoProtocolConfiguration
x@NodeAlonzoProtocolConfiguration {
                        GenesisFile
npcAlonzoGenesisFile :: NodeAlonzoProtocolConfiguration -> GenesisFile
npcAlonzoGenesisFile :: GenesisFile
npcAlonzoGenesisFile
                      } =
    NodeAlonzoProtocolConfiguration
x { npcAlonzoGenesisFile = adjustFilePaths f npcAlonzoGenesisFile }

instance AdjustFilePaths NodeConwayProtocolConfiguration where
  adjustFilePaths :: ShowS
-> NodeConwayProtocolConfiguration
-> NodeConwayProtocolConfiguration
adjustFilePaths ShowS
f x :: NodeConwayProtocolConfiguration
x@NodeConwayProtocolConfiguration {
                        GenesisFile
npcConwayGenesisFile :: NodeConwayProtocolConfiguration -> GenesisFile
npcConwayGenesisFile :: GenesisFile
npcConwayGenesisFile
                      } =
    NodeConwayProtocolConfiguration
x { npcConwayGenesisFile = adjustFilePaths f npcConwayGenesisFile }

instance AdjustFilePaths GenesisFile where
  adjustFilePaths :: ShowS -> GenesisFile -> GenesisFile
adjustFilePaths ShowS
f (GenesisFile String
p) = String -> GenesisFile
GenesisFile (ShowS
f String
p)

instance AdjustFilePaths a => AdjustFilePaths (Maybe a) where
  adjustFilePaths :: ShowS -> Maybe a -> Maybe a
adjustFilePaths ShowS
f = (a -> a) -> Maybe a -> Maybe a
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ShowS -> a -> a
forall a. AdjustFilePaths a => ShowS -> a -> a
adjustFilePaths ShowS
f)


data VRFPrivateKeyFilePermissionError
  = OtherPermissionsExist FilePath
  | GroupPermissionsExist FilePath
  | GenericPermissionsExist FilePath
  deriving Int -> VRFPrivateKeyFilePermissionError -> ShowS
[VRFPrivateKeyFilePermissionError] -> ShowS
VRFPrivateKeyFilePermissionError -> String
(Int -> VRFPrivateKeyFilePermissionError -> ShowS)
-> (VRFPrivateKeyFilePermissionError -> String)
-> ([VRFPrivateKeyFilePermissionError] -> ShowS)
-> Show VRFPrivateKeyFilePermissionError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VRFPrivateKeyFilePermissionError -> ShowS
showsPrec :: Int -> VRFPrivateKeyFilePermissionError -> ShowS
$cshow :: VRFPrivateKeyFilePermissionError -> String
show :: VRFPrivateKeyFilePermissionError -> String
$cshowList :: [VRFPrivateKeyFilePermissionError] -> ShowS
showList :: [VRFPrivateKeyFilePermissionError] -> ShowS
Show

renderVRFPrivateKeyFilePermissionError :: VRFPrivateKeyFilePermissionError -> Text
renderVRFPrivateKeyFilePermissionError :: VRFPrivateKeyFilePermissionError -> Text
renderVRFPrivateKeyFilePermissionError VRFPrivateKeyFilePermissionError
err =
  case VRFPrivateKeyFilePermissionError
err of
    OtherPermissionsExist String
fp ->
      Text
"VRF private key file at: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack String
fp
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" has \"other\" file permissions. Please remove all \"other\" file permissions."

    GroupPermissionsExist String
fp ->
      Text
"VRF private key file at: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack String
fp
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"has \"group\" file permissions. Please remove all \"group\" file permissions."
    GenericPermissionsExist String
fp ->
      Text
"VRF private key file at: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack String
fp
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"has \"generic\" file permissions. Please remove all \"generic\" file permissions."