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

module Bcc.Node.Types
  ( -- * Configuration
    AdjustFilePaths(..)
  , ConfigError(..)
  , ConfigYamlFilePath(..)
  , DbFile(..)
  , GenesisFile(..)
  , ProtocolFilepaths (..)
  , GenesisHash(..)
  , MaxConcurrencyBulkSync(..)
  , MaxConcurrencyDeadline(..)
    -- * Node addresses
  , NodeAddress'(..)
  , NodeIPAddress
  , nodeAddressToSockAddr
  , NodeIPv4Address
  , NodeIPv6Address
  , NodeDnsAddress
  , nodeIPv4ToIPAddress
  , nodeIPv6ToIPAddress
  , nodeDnsAddressToDomainAddress
  , NodeHostIPAddress (..)
  , nodeHostIPAddressToSockAddr
  , NodeHostIPv4Address (..)
  , NodeHostIPv6Address (..)
  , nodeHostIPv4AddressToIPAddress
  , nodeHostIPv6AddressToIPAddress
  , NodeHostDnsAddress (..)
  , nodeHostDnsAddressToDomain
  , PortNumber
  , SocketPath(..)
  , TopologyFile(..)
  , NodeDiffusionMode (..)
    -- * Consensus protocol configuration
  , NodeColeProtocolConfiguration(..)
  , NodeHardForkProtocolConfiguration(..)
  , NodeProtocolConfiguration(..)
  , NodeSophieProtocolConfiguration(..)
  , NodeAurumProtocolConfiguration(..)
  , VRFPrivateKeyFilePermissionError(..)
  , protocolName
  , renderVRFPrivateKeyFilePermissionError
  ) where

import           Bcc.Prelude
import           Prelude (String, fail)

import           Data.Aeson
import           Data.IP (IP (..), IPv4, IPv6)
import qualified Data.IP as IP
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Network.DNS as DNS (Domain)
import           Network.Socket (PortNumber, SockAddr (..))

import           Bcc.Api
import qualified Bcc.Chain.Update as Cole
import           Bcc.Crypto (RequiresNetworkMagic (..))
import qualified Bcc.Crypto.Hash as Crypto
import           Bcc.Node.Protocol.Types (Protocol (..))
import           Shardagnostic.Network.PeerSelection.RootPeersDNS (DomainAddress (..))

--TODO: things will probably be clearer if we don't use these newtype wrappers and instead
-- use records with named fields in the CLI code.
import           Shardagnostic.Network.NodeToNode (DiffusionMode (..))

-- | Errors for the bcc-config module.
newtype ConfigError = ConfigErrorFileNotFound FilePath
    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
showList :: [ConfigError] -> ShowS
$cshowList :: [ConfigError] -> ShowS
show :: ConfigError -> String
$cshow :: ConfigError -> String
showsPrec :: Int -> ConfigError -> ShowS
$cshowsPrec :: Int -> ConfigError -> ShowS
Show

-- | Filepath of the configuration yaml file. This file determines
-- all the configuration settings required for the bcc 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
/= :: ConfigYamlFilePath -> ConfigYamlFilePath -> Bool
$c/= :: ConfigYamlFilePath -> ConfigYamlFilePath -> Bool
== :: ConfigYamlFilePath -> ConfigYamlFilePath -> Bool
$c== :: 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
showList :: [ConfigYamlFilePath] -> ShowS
$cshowList :: [ConfigYamlFilePath] -> ShowS
show :: ConfigYamlFilePath -> String
$cshow :: ConfigYamlFilePath -> String
showsPrec :: Int -> ConfigYamlFilePath -> ShowS
$cshowsPrec :: Int -> 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
/= :: DbFile -> DbFile -> Bool
$c/= :: DbFile -> DbFile -> Bool
== :: DbFile -> DbFile -> Bool
$c== :: 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
showList :: [DbFile] -> ShowS
$cshowList :: [DbFile] -> ShowS
show :: DbFile -> String
$cshow :: DbFile -> String
showsPrec :: Int -> DbFile -> ShowS
$cshowsPrec :: Int -> 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
/= :: GenesisFile -> GenesisFile -> Bool
$c/= :: GenesisFile -> GenesisFile -> Bool
== :: GenesisFile -> GenesisFile -> Bool
$c== :: 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
min :: GenesisFile -> GenesisFile -> GenesisFile
$cmin :: GenesisFile -> GenesisFile -> GenesisFile
max :: GenesisFile -> GenesisFile -> GenesisFile
$cmax :: GenesisFile -> GenesisFile -> GenesisFile
>= :: GenesisFile -> GenesisFile -> Bool
$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
compare :: GenesisFile -> GenesisFile -> Ordering
$ccompare :: GenesisFile -> GenesisFile -> Ordering
$cp1Ord :: Eq GenesisFile
Ord)
  deriving newtype (String -> GenesisFile
(String -> GenesisFile) -> IsString GenesisFile
forall a. (String -> a) -> IsString a
fromString :: String -> GenesisFile
$cfromString :: 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
showList :: [GenesisFile] -> ShowS
$cshowList :: [GenesisFile] -> ShowS
show :: GenesisFile -> String
$cshow :: GenesisFile -> String
showsPrec :: Int -> GenesisFile -> ShowS
$cshowsPrec :: Int -> GenesisFile -> ShowS
Show)

instance FromJSON GenesisFile where
  parseJSON :: Value -> Parser GenesisFile
parseJSON (String Text
genFp) = GenesisFile -> Parser GenesisFile
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenesisFile -> Parser GenesisFile)
-> (String -> GenesisFile) -> String -> Parser GenesisFile
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 (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 b. (Show a, ConvertText String b) => a -> b
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
/= :: MaxConcurrencyBulkSync -> MaxConcurrencyBulkSync -> Bool
$c/= :: MaxConcurrencyBulkSync -> MaxConcurrencyBulkSync -> Bool
== :: MaxConcurrencyBulkSync -> MaxConcurrencyBulkSync -> Bool
$c== :: 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
min :: MaxConcurrencyBulkSync
-> MaxConcurrencyBulkSync -> MaxConcurrencyBulkSync
$cmin :: MaxConcurrencyBulkSync
-> MaxConcurrencyBulkSync -> MaxConcurrencyBulkSync
max :: MaxConcurrencyBulkSync
-> MaxConcurrencyBulkSync -> MaxConcurrencyBulkSync
$cmax :: MaxConcurrencyBulkSync
-> MaxConcurrencyBulkSync -> MaxConcurrencyBulkSync
>= :: MaxConcurrencyBulkSync -> MaxConcurrencyBulkSync -> Bool
$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
compare :: MaxConcurrencyBulkSync -> MaxConcurrencyBulkSync -> Ordering
$ccompare :: MaxConcurrencyBulkSync -> MaxConcurrencyBulkSync -> Ordering
$cp1Ord :: Eq MaxConcurrencyBulkSync
Ord)
  deriving newtype (Value -> Parser [MaxConcurrencyBulkSync]
Value -> Parser MaxConcurrencyBulkSync
(Value -> Parser MaxConcurrencyBulkSync)
-> (Value -> Parser [MaxConcurrencyBulkSync])
-> FromJSON MaxConcurrencyBulkSync
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [MaxConcurrencyBulkSync]
$cparseJSONList :: Value -> Parser [MaxConcurrencyBulkSync]
parseJSON :: Value -> Parser MaxConcurrencyBulkSync
$cparseJSON :: Value -> Parser 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
showList :: [MaxConcurrencyBulkSync] -> ShowS
$cshowList :: [MaxConcurrencyBulkSync] -> ShowS
show :: MaxConcurrencyBulkSync -> String
$cshow :: MaxConcurrencyBulkSync -> String
showsPrec :: Int -> MaxConcurrencyBulkSync -> ShowS
$cshowsPrec :: Int -> 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
/= :: MaxConcurrencyDeadline -> MaxConcurrencyDeadline -> Bool
$c/= :: MaxConcurrencyDeadline -> MaxConcurrencyDeadline -> Bool
== :: MaxConcurrencyDeadline -> MaxConcurrencyDeadline -> Bool
$c== :: 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
min :: MaxConcurrencyDeadline
-> MaxConcurrencyDeadline -> MaxConcurrencyDeadline
$cmin :: MaxConcurrencyDeadline
-> MaxConcurrencyDeadline -> MaxConcurrencyDeadline
max :: MaxConcurrencyDeadline
-> MaxConcurrencyDeadline -> MaxConcurrencyDeadline
$cmax :: MaxConcurrencyDeadline
-> MaxConcurrencyDeadline -> MaxConcurrencyDeadline
>= :: MaxConcurrencyDeadline -> MaxConcurrencyDeadline -> Bool
$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
compare :: MaxConcurrencyDeadline -> MaxConcurrencyDeadline -> Ordering
$ccompare :: MaxConcurrencyDeadline -> MaxConcurrencyDeadline -> Ordering
$cp1Ord :: Eq MaxConcurrencyDeadline
Ord)
  deriving newtype (Value -> Parser [MaxConcurrencyDeadline]
Value -> Parser MaxConcurrencyDeadline
(Value -> Parser MaxConcurrencyDeadline)
-> (Value -> Parser [MaxConcurrencyDeadline])
-> FromJSON MaxConcurrencyDeadline
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [MaxConcurrencyDeadline]
$cparseJSONList :: Value -> Parser [MaxConcurrencyDeadline]
parseJSON :: Value -> Parser MaxConcurrencyDeadline
$cparseJSON :: Value -> Parser 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
showList :: [MaxConcurrencyDeadline] -> ShowS
$cshowList :: [MaxConcurrencyDeadline] -> ShowS
show :: MaxConcurrencyDeadline -> String
$cshow :: MaxConcurrencyDeadline -> String
showsPrec :: Int -> MaxConcurrencyDeadline -> ShowS
$cshowsPrec :: Int -> MaxConcurrencyDeadline -> ShowS
Show)


-- | IPv4 or IPv6 address with a port number.
data NodeAddress' addr = NodeAddress
  { NodeAddress' addr -> addr
naHostAddress :: !addr
  , NodeAddress' addr -> PortNumber
naPort :: !PortNumber
  } deriving (NodeAddress' addr -> NodeAddress' addr -> Bool
(NodeAddress' addr -> NodeAddress' addr -> Bool)
-> (NodeAddress' addr -> NodeAddress' addr -> Bool)
-> Eq (NodeAddress' addr)
forall addr.
Eq addr =>
NodeAddress' addr -> NodeAddress' addr -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeAddress' addr -> NodeAddress' addr -> Bool
$c/= :: forall addr.
Eq addr =>
NodeAddress' addr -> NodeAddress' addr -> Bool
== :: NodeAddress' addr -> NodeAddress' addr -> Bool
$c== :: forall addr.
Eq addr =>
NodeAddress' addr -> NodeAddress' addr -> Bool
Eq, Eq (NodeAddress' addr)
Eq (NodeAddress' addr)
-> (NodeAddress' addr -> NodeAddress' addr -> Ordering)
-> (NodeAddress' addr -> NodeAddress' addr -> Bool)
-> (NodeAddress' addr -> NodeAddress' addr -> Bool)
-> (NodeAddress' addr -> NodeAddress' addr -> Bool)
-> (NodeAddress' addr -> NodeAddress' addr -> Bool)
-> (NodeAddress' addr -> NodeAddress' addr -> NodeAddress' addr)
-> (NodeAddress' addr -> NodeAddress' addr -> NodeAddress' addr)
-> Ord (NodeAddress' addr)
NodeAddress' addr -> NodeAddress' addr -> Bool
NodeAddress' addr -> NodeAddress' addr -> Ordering
NodeAddress' addr -> NodeAddress' addr -> NodeAddress' addr
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
forall addr. Ord addr => Eq (NodeAddress' addr)
forall addr.
Ord addr =>
NodeAddress' addr -> NodeAddress' addr -> Bool
forall addr.
Ord addr =>
NodeAddress' addr -> NodeAddress' addr -> Ordering
forall addr.
Ord addr =>
NodeAddress' addr -> NodeAddress' addr -> NodeAddress' addr
min :: NodeAddress' addr -> NodeAddress' addr -> NodeAddress' addr
$cmin :: forall addr.
Ord addr =>
NodeAddress' addr -> NodeAddress' addr -> NodeAddress' addr
max :: NodeAddress' addr -> NodeAddress' addr -> NodeAddress' addr
$cmax :: forall addr.
Ord addr =>
NodeAddress' addr -> NodeAddress' addr -> NodeAddress' addr
>= :: NodeAddress' addr -> NodeAddress' addr -> Bool
$c>= :: forall addr.
Ord addr =>
NodeAddress' addr -> NodeAddress' addr -> Bool
> :: NodeAddress' addr -> NodeAddress' addr -> Bool
$c> :: forall addr.
Ord addr =>
NodeAddress' addr -> NodeAddress' addr -> Bool
<= :: NodeAddress' addr -> NodeAddress' addr -> Bool
$c<= :: forall addr.
Ord addr =>
NodeAddress' addr -> NodeAddress' addr -> Bool
< :: NodeAddress' addr -> NodeAddress' addr -> Bool
$c< :: forall addr.
Ord addr =>
NodeAddress' addr -> NodeAddress' addr -> Bool
compare :: NodeAddress' addr -> NodeAddress' addr -> Ordering
$ccompare :: forall addr.
Ord addr =>
NodeAddress' addr -> NodeAddress' addr -> Ordering
$cp1Ord :: forall addr. Ord addr => Eq (NodeAddress' addr)
Ord, Int -> NodeAddress' addr -> ShowS
[NodeAddress' addr] -> ShowS
NodeAddress' addr -> String
(Int -> NodeAddress' addr -> ShowS)
-> (NodeAddress' addr -> String)
-> ([NodeAddress' addr] -> ShowS)
-> Show (NodeAddress' addr)
forall addr. Show addr => Int -> NodeAddress' addr -> ShowS
forall addr. Show addr => [NodeAddress' addr] -> ShowS
forall addr. Show addr => NodeAddress' addr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeAddress' addr] -> ShowS
$cshowList :: forall addr. Show addr => [NodeAddress' addr] -> ShowS
show :: NodeAddress' addr -> String
$cshow :: forall addr. Show addr => NodeAddress' addr -> String
showsPrec :: Int -> NodeAddress' addr -> ShowS
$cshowsPrec :: forall addr. Show addr => Int -> NodeAddress' addr -> ShowS
Show, a -> NodeAddress' b -> NodeAddress' a
(a -> b) -> NodeAddress' a -> NodeAddress' b
(forall a b. (a -> b) -> NodeAddress' a -> NodeAddress' b)
-> (forall a b. a -> NodeAddress' b -> NodeAddress' a)
-> Functor NodeAddress'
forall a b. a -> NodeAddress' b -> NodeAddress' a
forall a b. (a -> b) -> NodeAddress' a -> NodeAddress' b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> NodeAddress' b -> NodeAddress' a
$c<$ :: forall a b. a -> NodeAddress' b -> NodeAddress' a
fmap :: (a -> b) -> NodeAddress' a -> NodeAddress' b
$cfmap :: forall a b. (a -> b) -> NodeAddress' a -> NodeAddress' b
Functor)

type NodeIPAddress   = NodeAddress' NodeHostIPAddress
type NodeIPv4Address = NodeAddress' NodeHostIPv4Address
type NodeIPv6Address = NodeAddress' NodeHostIPv6Address
type NodeDnsAddress  = NodeAddress' NodeHostDnsAddress


instance FromJSON addr => FromJSON (NodeAddress' addr) where
  parseJSON :: Value -> Parser (NodeAddress' addr)
parseJSON = String
-> (Object -> Parser (NodeAddress' addr))
-> Value
-> Parser (NodeAddress' addr)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"NodeAddress" ((Object -> Parser (NodeAddress' addr))
 -> Value -> Parser (NodeAddress' addr))
-> (Object -> Parser (NodeAddress' addr))
-> Value
-> Parser (NodeAddress' addr)
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    addr -> PortNumber -> NodeAddress' addr
forall addr. addr -> PortNumber -> NodeAddress' addr
NodeAddress
      (addr -> PortNumber -> NodeAddress' addr)
-> Parser addr -> Parser (PortNumber -> NodeAddress' addr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser addr
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"addr"
      Parser (PortNumber -> NodeAddress' addr)
-> Parser PortNumber -> Parser (NodeAddress' addr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Int -> PortNumber
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> PortNumber) (Int -> PortNumber) -> Parser Int -> Parser PortNumber
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"port")

instance ToJSON addr => ToJSON (NodeAddress' addr) where
  toJSON :: NodeAddress' addr -> Value
toJSON NodeAddress' addr
na =
    [Pair] -> Value
object
      [ Text
"addr" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= addr -> Value
forall a. ToJSON a => a -> Value
toJSON (NodeAddress' addr -> addr
forall addr. NodeAddress' addr -> addr
naHostAddress NodeAddress' addr
na)
      , Text
"port" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (PortNumber -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (NodeAddress' addr -> PortNumber
forall addr. NodeAddress' addr -> PortNumber
naPort NodeAddress' addr
na) :: Int)
      ]


nodeIPv4ToIPAddress :: NodeIPv4Address -> NodeIPAddress
nodeIPv4ToIPAddress :: NodeIPv4Address -> NodeIPAddress
nodeIPv4ToIPAddress = (NodeHostIPv4Address -> NodeHostIPAddress)
-> NodeIPv4Address -> NodeIPAddress
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NodeHostIPv4Address -> NodeHostIPAddress
nodeHostIPv4AddressToIPAddress

nodeIPv6ToIPAddress :: NodeIPv6Address -> NodeIPAddress
nodeIPv6ToIPAddress :: NodeIPv6Address -> NodeIPAddress
nodeIPv6ToIPAddress = (NodeHostIPv6Address -> NodeHostIPAddress)
-> NodeIPv6Address -> NodeIPAddress
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NodeHostIPv6Address -> NodeHostIPAddress
nodeHostIPv6AddressToIPAddress

nodeDnsAddressToDomainAddress :: NodeDnsAddress -> DomainAddress
nodeDnsAddressToDomainAddress :: NodeDnsAddress -> DomainAddress
nodeDnsAddressToDomainAddress NodeAddress { naHostAddress :: forall addr. NodeAddress' addr -> addr
naHostAddress = NodeHostDnsAddress Text
dns, PortNumber
naPort :: PortNumber
naPort :: forall addr. NodeAddress' addr -> PortNumber
naPort }
  = Domain -> PortNumber -> DomainAddress
DomainAddress (Text -> Domain
Text.encodeUtf8 Text
dns) PortNumber
naPort

nodeAddressToSockAddr :: NodeIPAddress -> SockAddr
nodeAddressToSockAddr :: NodeIPAddress -> SockAddr
nodeAddressToSockAddr (NodeAddress NodeHostIPAddress
addr PortNumber
port) =
  case NodeHostIPAddress -> IP
unNodeHostIPAddress NodeHostIPAddress
addr of
    IP.IPv4 IPv4
ipv4 -> PortNumber -> HostAddress -> SockAddr
SockAddrInet  PortNumber
port   (IPv4 -> HostAddress
IP.toHostAddress IPv4
ipv4)
    IP.IPv6 IPv6
ipv6 -> PortNumber
-> HostAddress -> HostAddress6 -> HostAddress -> SockAddr
SockAddrInet6 PortNumber
port HostAddress
0 (IPv6 -> HostAddress6
IP.toHostAddress6 IPv6
ipv6) HostAddress
0

nodeHostIPAddressToSockAddr :: NodeIPAddress -> SockAddr
nodeHostIPAddressToSockAddr :: NodeIPAddress -> SockAddr
nodeHostIPAddressToSockAddr NodeAddress { naHostAddress :: forall addr. NodeAddress' addr -> addr
naHostAddress = NodeHostIPAddress IP
ip, PortNumber
naPort :: PortNumber
naPort :: forall addr. NodeAddress' addr -> PortNumber
naPort } =
    case IP
ip of
      IPv4 IPv4
ipv4 -> PortNumber -> HostAddress -> SockAddr
SockAddrInet  (PortNumber -> PortNumber
forall a b. (Integral a, Num b) => a -> b
fromIntegral PortNumber
naPort)   (IPv4 -> HostAddress
IP.toHostAddress IPv4
ipv4)
      IPv6 IPv6
ipv6 -> PortNumber
-> HostAddress -> HostAddress6 -> HostAddress -> SockAddr
SockAddrInet6 (PortNumber -> PortNumber
forall a b. (Integral a, Num b) => a -> b
fromIntegral PortNumber
naPort) HostAddress
0 (IPv6 -> HostAddress6
IP.toHostAddress6 IPv6
ipv6) HostAddress
0


newtype NodeHostIPv4Address
  = NodeHostIPv4Address { NodeHostIPv4Address -> IPv4
unNodeHostIPv4Address :: IPv4 }
  deriving newtype Int -> NodeHostIPv4Address -> ShowS
[NodeHostIPv4Address] -> ShowS
NodeHostIPv4Address -> String
(Int -> NodeHostIPv4Address -> ShowS)
-> (NodeHostIPv4Address -> String)
-> ([NodeHostIPv4Address] -> ShowS)
-> Show NodeHostIPv4Address
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeHostIPv4Address] -> ShowS
$cshowList :: [NodeHostIPv4Address] -> ShowS
show :: NodeHostIPv4Address -> String
$cshow :: NodeHostIPv4Address -> String
showsPrec :: Int -> NodeHostIPv4Address -> ShowS
$cshowsPrec :: Int -> NodeHostIPv4Address -> ShowS
Show
  deriving (NodeHostIPv4Address -> NodeHostIPv4Address -> Bool
(NodeHostIPv4Address -> NodeHostIPv4Address -> Bool)
-> (NodeHostIPv4Address -> NodeHostIPv4Address -> Bool)
-> Eq NodeHostIPv4Address
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeHostIPv4Address -> NodeHostIPv4Address -> Bool
$c/= :: NodeHostIPv4Address -> NodeHostIPv4Address -> Bool
== :: NodeHostIPv4Address -> NodeHostIPv4Address -> Bool
$c== :: NodeHostIPv4Address -> NodeHostIPv4Address -> Bool
Eq, Eq NodeHostIPv4Address
Eq NodeHostIPv4Address
-> (NodeHostIPv4Address -> NodeHostIPv4Address -> Ordering)
-> (NodeHostIPv4Address -> NodeHostIPv4Address -> Bool)
-> (NodeHostIPv4Address -> NodeHostIPv4Address -> Bool)
-> (NodeHostIPv4Address -> NodeHostIPv4Address -> Bool)
-> (NodeHostIPv4Address -> NodeHostIPv4Address -> Bool)
-> (NodeHostIPv4Address
    -> NodeHostIPv4Address -> NodeHostIPv4Address)
-> (NodeHostIPv4Address
    -> NodeHostIPv4Address -> NodeHostIPv4Address)
-> Ord NodeHostIPv4Address
NodeHostIPv4Address -> NodeHostIPv4Address -> Bool
NodeHostIPv4Address -> NodeHostIPv4Address -> Ordering
NodeHostIPv4Address -> NodeHostIPv4Address -> NodeHostIPv4Address
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
min :: NodeHostIPv4Address -> NodeHostIPv4Address -> NodeHostIPv4Address
$cmin :: NodeHostIPv4Address -> NodeHostIPv4Address -> NodeHostIPv4Address
max :: NodeHostIPv4Address -> NodeHostIPv4Address -> NodeHostIPv4Address
$cmax :: NodeHostIPv4Address -> NodeHostIPv4Address -> NodeHostIPv4Address
>= :: NodeHostIPv4Address -> NodeHostIPv4Address -> Bool
$c>= :: NodeHostIPv4Address -> NodeHostIPv4Address -> Bool
> :: NodeHostIPv4Address -> NodeHostIPv4Address -> Bool
$c> :: NodeHostIPv4Address -> NodeHostIPv4Address -> Bool
<= :: NodeHostIPv4Address -> NodeHostIPv4Address -> Bool
$c<= :: NodeHostIPv4Address -> NodeHostIPv4Address -> Bool
< :: NodeHostIPv4Address -> NodeHostIPv4Address -> Bool
$c< :: NodeHostIPv4Address -> NodeHostIPv4Address -> Bool
compare :: NodeHostIPv4Address -> NodeHostIPv4Address -> Ordering
$ccompare :: NodeHostIPv4Address -> NodeHostIPv4Address -> Ordering
$cp1Ord :: Eq NodeHostIPv4Address
Ord)

instance FromJSON NodeHostIPv4Address where
  parseJSON :: Value -> Parser NodeHostIPv4Address
parseJSON (String Text
ipStr) =
    case String -> Maybe IPv4
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe IPv4) -> String -> Maybe IPv4
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack Text
ipStr of
      Just IPv4
ip -> NodeHostIPv4Address -> Parser NodeHostIPv4Address
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NodeHostIPv4Address -> Parser NodeHostIPv4Address)
-> NodeHostIPv4Address -> Parser NodeHostIPv4Address
forall a b. (a -> b) -> a -> b
$ IPv4 -> NodeHostIPv4Address
NodeHostIPv4Address IPv4
ip
      Maybe IPv4
Nothing -> String -> Parser NodeHostIPv4Address
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser NodeHostIPv4Address)
-> String -> Parser NodeHostIPv4Address
forall a b. (a -> b) -> a -> b
$ String
"Parsing of IPv4 failed: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
ipStr
  parseJSON Value
invalid = String -> Parser NodeHostIPv4Address
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser NodeHostIPv4Address)
-> String -> Parser NodeHostIPv4Address
forall a b. (a -> b) -> a -> b
$ String
"Parsing of IPv4 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 b. (Show a, ConvertText String b) => a -> b
show Value
invalid String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n"

instance ToJSON NodeHostIPv4Address where
  toJSON :: NodeHostIPv4Address -> Value
toJSON (NodeHostIPv4Address IPv4
ip) = Text -> Value
String (String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ IPv4 -> String
forall a b. (Show a, ConvertText String b) => a -> b
show IPv4
ip)


newtype NodeHostIPv6Address
  = NodeHostIPv6Address { NodeHostIPv6Address -> IPv6
unNodeHostIPv6Address :: IPv6 }
  deriving newtype Int -> NodeHostIPv6Address -> ShowS
[NodeHostIPv6Address] -> ShowS
NodeHostIPv6Address -> String
(Int -> NodeHostIPv6Address -> ShowS)
-> (NodeHostIPv6Address -> String)
-> ([NodeHostIPv6Address] -> ShowS)
-> Show NodeHostIPv6Address
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeHostIPv6Address] -> ShowS
$cshowList :: [NodeHostIPv6Address] -> ShowS
show :: NodeHostIPv6Address -> String
$cshow :: NodeHostIPv6Address -> String
showsPrec :: Int -> NodeHostIPv6Address -> ShowS
$cshowsPrec :: Int -> NodeHostIPv6Address -> ShowS
Show
  deriving (NodeHostIPv6Address -> NodeHostIPv6Address -> Bool
(NodeHostIPv6Address -> NodeHostIPv6Address -> Bool)
-> (NodeHostIPv6Address -> NodeHostIPv6Address -> Bool)
-> Eq NodeHostIPv6Address
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeHostIPv6Address -> NodeHostIPv6Address -> Bool
$c/= :: NodeHostIPv6Address -> NodeHostIPv6Address -> Bool
== :: NodeHostIPv6Address -> NodeHostIPv6Address -> Bool
$c== :: NodeHostIPv6Address -> NodeHostIPv6Address -> Bool
Eq, Eq NodeHostIPv6Address
Eq NodeHostIPv6Address
-> (NodeHostIPv6Address -> NodeHostIPv6Address -> Ordering)
-> (NodeHostIPv6Address -> NodeHostIPv6Address -> Bool)
-> (NodeHostIPv6Address -> NodeHostIPv6Address -> Bool)
-> (NodeHostIPv6Address -> NodeHostIPv6Address -> Bool)
-> (NodeHostIPv6Address -> NodeHostIPv6Address -> Bool)
-> (NodeHostIPv6Address
    -> NodeHostIPv6Address -> NodeHostIPv6Address)
-> (NodeHostIPv6Address
    -> NodeHostIPv6Address -> NodeHostIPv6Address)
-> Ord NodeHostIPv6Address
NodeHostIPv6Address -> NodeHostIPv6Address -> Bool
NodeHostIPv6Address -> NodeHostIPv6Address -> Ordering
NodeHostIPv6Address -> NodeHostIPv6Address -> NodeHostIPv6Address
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
min :: NodeHostIPv6Address -> NodeHostIPv6Address -> NodeHostIPv6Address
$cmin :: NodeHostIPv6Address -> NodeHostIPv6Address -> NodeHostIPv6Address
max :: NodeHostIPv6Address -> NodeHostIPv6Address -> NodeHostIPv6Address
$cmax :: NodeHostIPv6Address -> NodeHostIPv6Address -> NodeHostIPv6Address
>= :: NodeHostIPv6Address -> NodeHostIPv6Address -> Bool
$c>= :: NodeHostIPv6Address -> NodeHostIPv6Address -> Bool
> :: NodeHostIPv6Address -> NodeHostIPv6Address -> Bool
$c> :: NodeHostIPv6Address -> NodeHostIPv6Address -> Bool
<= :: NodeHostIPv6Address -> NodeHostIPv6Address -> Bool
$c<= :: NodeHostIPv6Address -> NodeHostIPv6Address -> Bool
< :: NodeHostIPv6Address -> NodeHostIPv6Address -> Bool
$c< :: NodeHostIPv6Address -> NodeHostIPv6Address -> Bool
compare :: NodeHostIPv6Address -> NodeHostIPv6Address -> Ordering
$ccompare :: NodeHostIPv6Address -> NodeHostIPv6Address -> Ordering
$cp1Ord :: Eq NodeHostIPv6Address
Ord)

instance FromJSON NodeHostIPv6Address where
  parseJSON :: Value -> Parser NodeHostIPv6Address
parseJSON (String Text
ipStr) =
    case String -> Maybe IPv6
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe IPv6) -> String -> Maybe IPv6
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack Text
ipStr of
      Just IPv6
ip -> NodeHostIPv6Address -> Parser NodeHostIPv6Address
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NodeHostIPv6Address -> Parser NodeHostIPv6Address)
-> NodeHostIPv6Address -> Parser NodeHostIPv6Address
forall a b. (a -> b) -> a -> b
$ IPv6 -> NodeHostIPv6Address
NodeHostIPv6Address IPv6
ip
      Maybe IPv6
Nothing -> String -> Parser NodeHostIPv6Address
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser NodeHostIPv6Address)
-> String -> Parser NodeHostIPv6Address
forall a b. (a -> b) -> a -> b
$ String
"Parsing of IPv6 failed: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
ipStr
  parseJSON Value
invalid = String -> Parser NodeHostIPv6Address
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser NodeHostIPv6Address)
-> String -> Parser NodeHostIPv6Address
forall a b. (a -> b) -> a -> b
$ String
"Parsing of IPv6 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 b. (Show a, ConvertText String b) => a -> b
show Value
invalid String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n"
instance ToJSON NodeHostIPv6Address where
  toJSON :: NodeHostIPv6Address -> Value
toJSON (NodeHostIPv6Address IPv6
ip) = Text -> Value
String (String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ IPv6 -> String
forall a b. (Show a, ConvertText String b) => a -> b
show IPv6
ip)


newtype NodeHostIPAddress
  = NodeHostIPAddress { NodeHostIPAddress -> IP
unNodeHostIPAddress :: IP }
  deriving newtype Int -> NodeHostIPAddress -> ShowS
[NodeHostIPAddress] -> ShowS
NodeHostIPAddress -> String
(Int -> NodeHostIPAddress -> ShowS)
-> (NodeHostIPAddress -> String)
-> ([NodeHostIPAddress] -> ShowS)
-> Show NodeHostIPAddress
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeHostIPAddress] -> ShowS
$cshowList :: [NodeHostIPAddress] -> ShowS
show :: NodeHostIPAddress -> String
$cshow :: NodeHostIPAddress -> String
showsPrec :: Int -> NodeHostIPAddress -> ShowS
$cshowsPrec :: Int -> NodeHostIPAddress -> ShowS
Show
  deriving (NodeHostIPAddress -> NodeHostIPAddress -> Bool
(NodeHostIPAddress -> NodeHostIPAddress -> Bool)
-> (NodeHostIPAddress -> NodeHostIPAddress -> Bool)
-> Eq NodeHostIPAddress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeHostIPAddress -> NodeHostIPAddress -> Bool
$c/= :: NodeHostIPAddress -> NodeHostIPAddress -> Bool
== :: NodeHostIPAddress -> NodeHostIPAddress -> Bool
$c== :: NodeHostIPAddress -> NodeHostIPAddress -> Bool
Eq, Eq NodeHostIPAddress
Eq NodeHostIPAddress
-> (NodeHostIPAddress -> NodeHostIPAddress -> Ordering)
-> (NodeHostIPAddress -> NodeHostIPAddress -> Bool)
-> (NodeHostIPAddress -> NodeHostIPAddress -> Bool)
-> (NodeHostIPAddress -> NodeHostIPAddress -> Bool)
-> (NodeHostIPAddress -> NodeHostIPAddress -> Bool)
-> (NodeHostIPAddress -> NodeHostIPAddress -> NodeHostIPAddress)
-> (NodeHostIPAddress -> NodeHostIPAddress -> NodeHostIPAddress)
-> Ord NodeHostIPAddress
NodeHostIPAddress -> NodeHostIPAddress -> Bool
NodeHostIPAddress -> NodeHostIPAddress -> Ordering
NodeHostIPAddress -> NodeHostIPAddress -> NodeHostIPAddress
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
min :: NodeHostIPAddress -> NodeHostIPAddress -> NodeHostIPAddress
$cmin :: NodeHostIPAddress -> NodeHostIPAddress -> NodeHostIPAddress
max :: NodeHostIPAddress -> NodeHostIPAddress -> NodeHostIPAddress
$cmax :: NodeHostIPAddress -> NodeHostIPAddress -> NodeHostIPAddress
>= :: NodeHostIPAddress -> NodeHostIPAddress -> Bool
$c>= :: NodeHostIPAddress -> NodeHostIPAddress -> Bool
> :: NodeHostIPAddress -> NodeHostIPAddress -> Bool
$c> :: NodeHostIPAddress -> NodeHostIPAddress -> Bool
<= :: NodeHostIPAddress -> NodeHostIPAddress -> Bool
$c<= :: NodeHostIPAddress -> NodeHostIPAddress -> Bool
< :: NodeHostIPAddress -> NodeHostIPAddress -> Bool
$c< :: NodeHostIPAddress -> NodeHostIPAddress -> Bool
compare :: NodeHostIPAddress -> NodeHostIPAddress -> Ordering
$ccompare :: NodeHostIPAddress -> NodeHostIPAddress -> Ordering
$cp1Ord :: Eq NodeHostIPAddress
Ord)

instance FromJSON NodeHostIPAddress where
  parseJSON :: Value -> Parser NodeHostIPAddress
parseJSON (String Text
ipStr) =
    case String -> Maybe IP
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe IP) -> String -> Maybe IP
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack Text
ipStr of
      Just IP
ip -> NodeHostIPAddress -> Parser NodeHostIPAddress
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NodeHostIPAddress -> Parser NodeHostIPAddress)
-> NodeHostIPAddress -> Parser NodeHostIPAddress
forall a b. (a -> b) -> a -> b
$ IP -> NodeHostIPAddress
NodeHostIPAddress IP
ip
      Maybe IP
Nothing -> String -> Parser NodeHostIPAddress
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser NodeHostIPAddress)
-> String -> Parser NodeHostIPAddress
forall a b. (a -> b) -> a -> b
$ String
"Parsing of IP failed: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
ipStr
  parseJSON Value
invalid = String -> Parser NodeHostIPAddress
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser NodeHostIPAddress)
-> String -> Parser NodeHostIPAddress
forall a b. (a -> b) -> a -> b
$ String
"Parsing of IP 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 b. (Show a, ConvertText String b) => a -> b
show Value
invalid String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n"

instance ToJSON NodeHostIPAddress where
  toJSON :: NodeHostIPAddress -> Value
toJSON (NodeHostIPAddress IP
ip) = Text -> Value
String (String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ IP -> String
forall a b. (Show a, ConvertText String b) => a -> b
show IP
ip)


nodeHostIPv6AddressToIPAddress :: NodeHostIPv6Address -> NodeHostIPAddress
nodeHostIPv6AddressToIPAddress :: NodeHostIPv6Address -> NodeHostIPAddress
nodeHostIPv6AddressToIPAddress (NodeHostIPv6Address IPv6
ip) = IP -> NodeHostIPAddress
NodeHostIPAddress (IPv6 -> IP
IPv6 IPv6
ip)

nodeHostIPv4AddressToIPAddress :: NodeHostIPv4Address -> NodeHostIPAddress
nodeHostIPv4AddressToIPAddress :: NodeHostIPv4Address -> NodeHostIPAddress
nodeHostIPv4AddressToIPAddress (NodeHostIPv4Address IPv4
ip) = IP -> NodeHostIPAddress
NodeHostIPAddress (IPv4 -> IP
IPv4 IPv4
ip)


-- | Domain name.
--
newtype NodeHostDnsAddress
  = NodeHostDnsAddress { NodeHostDnsAddress -> Text
unNodeHostDnsAddress :: Text }
  deriving newtype Int -> NodeHostDnsAddress -> ShowS
[NodeHostDnsAddress] -> ShowS
NodeHostDnsAddress -> String
(Int -> NodeHostDnsAddress -> ShowS)
-> (NodeHostDnsAddress -> String)
-> ([NodeHostDnsAddress] -> ShowS)
-> Show NodeHostDnsAddress
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeHostDnsAddress] -> ShowS
$cshowList :: [NodeHostDnsAddress] -> ShowS
show :: NodeHostDnsAddress -> String
$cshow :: NodeHostDnsAddress -> String
showsPrec :: Int -> NodeHostDnsAddress -> ShowS
$cshowsPrec :: Int -> NodeHostDnsAddress -> ShowS
Show
  deriving (NodeHostDnsAddress -> NodeHostDnsAddress -> Bool
(NodeHostDnsAddress -> NodeHostDnsAddress -> Bool)
-> (NodeHostDnsAddress -> NodeHostDnsAddress -> Bool)
-> Eq NodeHostDnsAddress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeHostDnsAddress -> NodeHostDnsAddress -> Bool
$c/= :: NodeHostDnsAddress -> NodeHostDnsAddress -> Bool
== :: NodeHostDnsAddress -> NodeHostDnsAddress -> Bool
$c== :: NodeHostDnsAddress -> NodeHostDnsAddress -> Bool
Eq, Eq NodeHostDnsAddress
Eq NodeHostDnsAddress
-> (NodeHostDnsAddress -> NodeHostDnsAddress -> Ordering)
-> (NodeHostDnsAddress -> NodeHostDnsAddress -> Bool)
-> (NodeHostDnsAddress -> NodeHostDnsAddress -> Bool)
-> (NodeHostDnsAddress -> NodeHostDnsAddress -> Bool)
-> (NodeHostDnsAddress -> NodeHostDnsAddress -> Bool)
-> (NodeHostDnsAddress -> NodeHostDnsAddress -> NodeHostDnsAddress)
-> (NodeHostDnsAddress -> NodeHostDnsAddress -> NodeHostDnsAddress)
-> Ord NodeHostDnsAddress
NodeHostDnsAddress -> NodeHostDnsAddress -> Bool
NodeHostDnsAddress -> NodeHostDnsAddress -> Ordering
NodeHostDnsAddress -> NodeHostDnsAddress -> NodeHostDnsAddress
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
min :: NodeHostDnsAddress -> NodeHostDnsAddress -> NodeHostDnsAddress
$cmin :: NodeHostDnsAddress -> NodeHostDnsAddress -> NodeHostDnsAddress
max :: NodeHostDnsAddress -> NodeHostDnsAddress -> NodeHostDnsAddress
$cmax :: NodeHostDnsAddress -> NodeHostDnsAddress -> NodeHostDnsAddress
>= :: NodeHostDnsAddress -> NodeHostDnsAddress -> Bool
$c>= :: NodeHostDnsAddress -> NodeHostDnsAddress -> Bool
> :: NodeHostDnsAddress -> NodeHostDnsAddress -> Bool
$c> :: NodeHostDnsAddress -> NodeHostDnsAddress -> Bool
<= :: NodeHostDnsAddress -> NodeHostDnsAddress -> Bool
$c<= :: NodeHostDnsAddress -> NodeHostDnsAddress -> Bool
< :: NodeHostDnsAddress -> NodeHostDnsAddress -> Bool
$c< :: NodeHostDnsAddress -> NodeHostDnsAddress -> Bool
compare :: NodeHostDnsAddress -> NodeHostDnsAddress -> Ordering
$ccompare :: NodeHostDnsAddress -> NodeHostDnsAddress -> Ordering
$cp1Ord :: Eq NodeHostDnsAddress
Ord)

nodeHostDnsAddressToDomain :: NodeHostDnsAddress -> DNS.Domain
nodeHostDnsAddressToDomain :: NodeHostDnsAddress -> Domain
nodeHostDnsAddressToDomain = Text -> Domain
Text.encodeUtf8 (Text -> Domain)
-> (NodeHostDnsAddress -> Text) -> NodeHostDnsAddress -> Domain
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NodeHostDnsAddress -> Text
unNodeHostDnsAddress


-- | Newtype wrapper which provides 'FromJSON' instance for 'DiffusionMode'.
--
newtype NodeDiffusionMode
  = NodeDiffusionMode { NodeDiffusionMode -> DiffusionMode
getDiffusionMode :: DiffusionMode }
  deriving newtype Int -> NodeDiffusionMode -> ShowS
[NodeDiffusionMode] -> ShowS
NodeDiffusionMode -> String
(Int -> NodeDiffusionMode -> ShowS)
-> (NodeDiffusionMode -> String)
-> ([NodeDiffusionMode] -> ShowS)
-> Show NodeDiffusionMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeDiffusionMode] -> ShowS
$cshowList :: [NodeDiffusionMode] -> ShowS
show :: NodeDiffusionMode -> String
$cshow :: NodeDiffusionMode -> String
showsPrec :: Int -> NodeDiffusionMode -> ShowS
$cshowsPrec :: Int -> NodeDiffusionMode -> ShowS
Show

instance FromJSON NodeDiffusionMode where
    parseJSON :: Value -> Parser NodeDiffusionMode
parseJSON (String Text
str) =
      case Text
str of
        Text
"InitiatorOnly"
          -> NodeDiffusionMode -> Parser NodeDiffusionMode
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NodeDiffusionMode -> Parser NodeDiffusionMode)
-> NodeDiffusionMode -> Parser NodeDiffusionMode
forall a b. (a -> b) -> a -> b
$ DiffusionMode -> NodeDiffusionMode
NodeDiffusionMode DiffusionMode
InitiatorOnlyDiffusionMode
        Text
"InitiatorAndResponder"
          -> NodeDiffusionMode -> Parser NodeDiffusionMode
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NodeDiffusionMode -> Parser NodeDiffusionMode)
-> NodeDiffusionMode -> Parser NodeDiffusionMode
forall a b. (a -> b) -> a -> b
$ DiffusionMode -> NodeDiffusionMode
NodeDiffusionMode DiffusionMode
InitiatorAndResponderDiffusionMode
        Text
_ -> String -> Parser NodeDiffusionMode
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Parsing NodeDiffusionMode failed: can be either 'InitiatorOnly' or 'InitiatorAndResponder'"
    parseJSON Value
_ = String -> Parser NodeDiffusionMode
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Parsing NodeDiffusionMode failed"

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


data ProtocolFilepaths =
     ProtocolFilepaths {
       ProtocolFilepaths -> Maybe String
coleCertFile        :: !(Maybe FilePath)
     , ProtocolFilepaths -> Maybe String
coleKeyFile         :: !(Maybe FilePath)
     , ProtocolFilepaths -> Maybe String
sophieKESFile       :: !(Maybe FilePath)
     , ProtocolFilepaths -> Maybe String
sophieVRFFile       :: !(Maybe FilePath)
     , ProtocolFilepaths -> Maybe String
sophieCertFile      :: !(Maybe FilePath)
     , ProtocolFilepaths -> Maybe String
sophieBulkCredsFile :: !(Maybe FilePath)
     } deriving (ProtocolFilepaths -> ProtocolFilepaths -> Bool
(ProtocolFilepaths -> ProtocolFilepaths -> Bool)
-> (ProtocolFilepaths -> ProtocolFilepaths -> Bool)
-> Eq ProtocolFilepaths
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProtocolFilepaths -> ProtocolFilepaths -> Bool
$c/= :: ProtocolFilepaths -> ProtocolFilepaths -> Bool
== :: ProtocolFilepaths -> ProtocolFilepaths -> Bool
$c== :: 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
showList :: [ProtocolFilepaths] -> ShowS
$cshowList :: [ProtocolFilepaths] -> ShowS
show :: ProtocolFilepaths -> String
$cshow :: ProtocolFilepaths -> String
showsPrec :: Int -> ProtocolFilepaths -> ShowS
$cshowsPrec :: Int -> ProtocolFilepaths -> ShowS
Show)

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

data NodeProtocolConfiguration =
       NodeProtocolConfigurationCole   NodeColeProtocolConfiguration
     | NodeProtocolConfigurationSophie NodeSophieProtocolConfiguration
     | NodeProtocolConfigurationBcc NodeColeProtocolConfiguration
                                        NodeSophieProtocolConfiguration
                                        NodeAurumProtocolConfiguration
                                        NodeHardForkProtocolConfiguration
  deriving (NodeProtocolConfiguration -> NodeProtocolConfiguration -> Bool
(NodeProtocolConfiguration -> NodeProtocolConfiguration -> Bool)
-> (NodeProtocolConfiguration -> NodeProtocolConfiguration -> Bool)
-> Eq NodeProtocolConfiguration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeProtocolConfiguration -> NodeProtocolConfiguration -> Bool
$c/= :: NodeProtocolConfiguration -> NodeProtocolConfiguration -> Bool
== :: NodeProtocolConfiguration -> NodeProtocolConfiguration -> Bool
$c== :: 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
showList :: [NodeProtocolConfiguration] -> ShowS
$cshowList :: [NodeProtocolConfiguration] -> ShowS
show :: NodeProtocolConfiguration -> String
$cshow :: NodeProtocolConfiguration -> String
showsPrec :: Int -> NodeProtocolConfiguration -> ShowS
$cshowsPrec :: Int -> NodeProtocolConfiguration -> ShowS
Show)

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

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

data NodeColeProtocolConfiguration =
     NodeColeProtocolConfiguration {
       NodeColeProtocolConfiguration -> GenesisFile
npcColeGenesisFile         :: !GenesisFile
     , NodeColeProtocolConfiguration -> Maybe GenesisHash
npcColeGenesisFileHash     :: !(Maybe GenesisHash)
     , NodeColeProtocolConfiguration -> RequiresNetworkMagic
npcColeReqNetworkMagic     :: !RequiresNetworkMagic
     , NodeColeProtocolConfiguration -> Maybe Double
npcColePbftSignatureThresh :: !(Maybe Double)

       --TODO: eliminate these two: it can be hard-coded
       -- | Update application name.
     , NodeColeProtocolConfiguration -> ApplicationName
npcColeApplicationName     :: !Cole.ApplicationName

       -- | Application (ie software) version.
     , NodeColeProtocolConfiguration -> HostAddress
npcColeApplicationVersion  :: !Cole.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.
       --
     , NodeColeProtocolConfiguration -> Word16
npcColeSupportedProtocolVersionMajor :: !Word16
     , NodeColeProtocolConfiguration -> Word16
npcColeSupportedProtocolVersionSentry  :: !Word16
     }
  deriving (NodeColeProtocolConfiguration
-> NodeColeProtocolConfiguration -> Bool
(NodeColeProtocolConfiguration
 -> NodeColeProtocolConfiguration -> Bool)
-> (NodeColeProtocolConfiguration
    -> NodeColeProtocolConfiguration -> Bool)
-> Eq NodeColeProtocolConfiguration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeColeProtocolConfiguration
-> NodeColeProtocolConfiguration -> Bool
$c/= :: NodeColeProtocolConfiguration
-> NodeColeProtocolConfiguration -> Bool
== :: NodeColeProtocolConfiguration
-> NodeColeProtocolConfiguration -> Bool
$c== :: NodeColeProtocolConfiguration
-> NodeColeProtocolConfiguration -> Bool
Eq, Int -> NodeColeProtocolConfiguration -> ShowS
[NodeColeProtocolConfiguration] -> ShowS
NodeColeProtocolConfiguration -> String
(Int -> NodeColeProtocolConfiguration -> ShowS)
-> (NodeColeProtocolConfiguration -> String)
-> ([NodeColeProtocolConfiguration] -> ShowS)
-> Show NodeColeProtocolConfiguration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeColeProtocolConfiguration] -> ShowS
$cshowList :: [NodeColeProtocolConfiguration] -> ShowS
show :: NodeColeProtocolConfiguration -> String
$cshow :: NodeColeProtocolConfiguration -> String
showsPrec :: Int -> NodeColeProtocolConfiguration -> ShowS
$cshowsPrec :: Int -> NodeColeProtocolConfiguration -> 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
npcTestSophieHardForkAtEpoch :: Maybe EpochNo

       -- | For testing purposes we support specifying that the hard fork
       -- happens at a given major protocol version. For example this can be
       -- used to cause the Sophie hard fork to occur at the transition from
       -- protocol version 0 to version 1 (rather than the default of from 1 to
       -- 2) which can make the test setup simpler.
       --
       -- Obviously if this is used, all the nodes in the test cluster must be
       -- configured the same, or they will disagree.
       --
     , NodeHardForkProtocolConfiguration -> Maybe Word
npcTestSophieHardForkAtVersion :: Maybe Word

       -- | 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
npcTestEvieHardForkAtEpoch :: Maybe EpochNo

       -- | For testing purposes we support specifying that the hard fork
       -- happens at a given major protocol version.
       --
       -- Obviously if this is used, all the nodes in the test cluster must be
       -- configured the same, or they will disagree.
       --
     , NodeHardForkProtocolConfiguration -> Maybe Word
npcTestEvieHardForkAtVersion :: Maybe Word

       -- | 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
npcTestJenHardForkAtEpoch :: Maybe EpochNo

       -- | For testing purposes we support specifying that the hard fork
       -- happens at a given major protocol version.
       --
       -- Obviously if this is used, all the nodes in the test cluster must be
       -- configured the same, or they will disagree.
       --
       --
     , NodeHardForkProtocolConfiguration -> Maybe Word
npcTestJenHardForkAtVersion :: Maybe Word

       -- | 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
npcTestAurumHardForkAtEpoch :: Maybe EpochNo

       -- | For testing purposes we support specifying that the hard fork
       -- happens at a given major protocol version.
       --
       -- Obviously if this is used, all the nodes in the test cluster must be
       -- configured the same, or they will disagree.
       --
     , NodeHardForkProtocolConfiguration -> Maybe Word
npcTestAurumHardForkAtVersion :: Maybe Word
     }
  deriving (NodeHardForkProtocolConfiguration
-> NodeHardForkProtocolConfiguration -> Bool
(NodeHardForkProtocolConfiguration
 -> NodeHardForkProtocolConfiguration -> Bool)
-> (NodeHardForkProtocolConfiguration
    -> NodeHardForkProtocolConfiguration -> Bool)
-> Eq NodeHardForkProtocolConfiguration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeHardForkProtocolConfiguration
-> NodeHardForkProtocolConfiguration -> Bool
$c/= :: NodeHardForkProtocolConfiguration
-> NodeHardForkProtocolConfiguration -> Bool
== :: NodeHardForkProtocolConfiguration
-> NodeHardForkProtocolConfiguration -> Bool
$c== :: 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
showList :: [NodeHardForkProtocolConfiguration] -> ShowS
$cshowList :: [NodeHardForkProtocolConfiguration] -> ShowS
show :: NodeHardForkProtocolConfiguration -> String
$cshow :: NodeHardForkProtocolConfiguration -> String
showsPrec :: Int -> NodeHardForkProtocolConfiguration -> ShowS
$cshowsPrec :: Int -> NodeHardForkProtocolConfiguration -> ShowS
Show)

newtype SocketPath = SocketPath
  { SocketPath -> String
unSocketPath :: FilePath }
  deriving stock (SocketPath -> SocketPath -> Bool
(SocketPath -> SocketPath -> Bool)
-> (SocketPath -> SocketPath -> Bool) -> Eq SocketPath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SocketPath -> SocketPath -> Bool
$c/= :: SocketPath -> SocketPath -> Bool
== :: SocketPath -> SocketPath -> Bool
$c== :: SocketPath -> SocketPath -> Bool
Eq, Eq SocketPath
Eq SocketPath
-> (SocketPath -> SocketPath -> Ordering)
-> (SocketPath -> SocketPath -> Bool)
-> (SocketPath -> SocketPath -> Bool)
-> (SocketPath -> SocketPath -> Bool)
-> (SocketPath -> SocketPath -> Bool)
-> (SocketPath -> SocketPath -> SocketPath)
-> (SocketPath -> SocketPath -> SocketPath)
-> Ord SocketPath
SocketPath -> SocketPath -> Bool
SocketPath -> SocketPath -> Ordering
SocketPath -> SocketPath -> SocketPath
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
min :: SocketPath -> SocketPath -> SocketPath
$cmin :: SocketPath -> SocketPath -> SocketPath
max :: SocketPath -> SocketPath -> SocketPath
$cmax :: SocketPath -> SocketPath -> SocketPath
>= :: SocketPath -> SocketPath -> Bool
$c>= :: SocketPath -> SocketPath -> Bool
> :: SocketPath -> SocketPath -> Bool
$c> :: SocketPath -> SocketPath -> Bool
<= :: SocketPath -> SocketPath -> Bool
$c<= :: SocketPath -> SocketPath -> Bool
< :: SocketPath -> SocketPath -> Bool
$c< :: SocketPath -> SocketPath -> Bool
compare :: SocketPath -> SocketPath -> Ordering
$ccompare :: SocketPath -> SocketPath -> Ordering
$cp1Ord :: Eq SocketPath
Ord)
  deriving newtype (Value -> Parser [SocketPath]
Value -> Parser SocketPath
(Value -> Parser SocketPath)
-> (Value -> Parser [SocketPath]) -> FromJSON SocketPath
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [SocketPath]
$cparseJSONList :: Value -> Parser [SocketPath]
parseJSON :: Value -> Parser SocketPath
$cparseJSON :: Value -> Parser SocketPath
FromJSON, String -> SocketPath
(String -> SocketPath) -> IsString SocketPath
forall a. (String -> a) -> IsString a
fromString :: String -> SocketPath
$cfromString :: String -> SocketPath
IsString, Int -> SocketPath -> ShowS
[SocketPath] -> ShowS
SocketPath -> String
(Int -> SocketPath -> ShowS)
-> (SocketPath -> String)
-> ([SocketPath] -> ShowS)
-> Show SocketPath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SocketPath] -> ShowS
$cshowList :: [SocketPath] -> ShowS
show :: SocketPath -> String
$cshow :: SocketPath -> String
showsPrec :: Int -> SocketPath -> ShowS
$cshowsPrec :: Int -> SocketPath -> ShowS
Show)

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

instance AdjustFilePaths NodeProtocolConfiguration where

  adjustFilePaths :: ShowS -> NodeProtocolConfiguration -> NodeProtocolConfiguration
adjustFilePaths ShowS
f (NodeProtocolConfigurationCole NodeColeProtocolConfiguration
pc) =
    NodeColeProtocolConfiguration -> NodeProtocolConfiguration
NodeProtocolConfigurationCole (ShowS
-> NodeColeProtocolConfiguration -> NodeColeProtocolConfiguration
forall a. AdjustFilePaths a => ShowS -> a -> a
adjustFilePaths ShowS
f NodeColeProtocolConfiguration
pc)

  adjustFilePaths ShowS
f (NodeProtocolConfigurationSophie NodeSophieProtocolConfiguration
pc) =
    NodeSophieProtocolConfiguration -> NodeProtocolConfiguration
NodeProtocolConfigurationSophie (ShowS
-> NodeSophieProtocolConfiguration
-> NodeSophieProtocolConfiguration
forall a. AdjustFilePaths a => ShowS -> a -> a
adjustFilePaths ShowS
f NodeSophieProtocolConfiguration
pc)

  adjustFilePaths ShowS
f (NodeProtocolConfigurationBcc NodeColeProtocolConfiguration
pcb NodeSophieProtocolConfiguration
pcs NodeAurumProtocolConfiguration
pca NodeHardForkProtocolConfiguration
pch) =
    NodeColeProtocolConfiguration
-> NodeSophieProtocolConfiguration
-> NodeAurumProtocolConfiguration
-> NodeHardForkProtocolConfiguration
-> NodeProtocolConfiguration
NodeProtocolConfigurationBcc (ShowS
-> NodeColeProtocolConfiguration -> NodeColeProtocolConfiguration
forall a. AdjustFilePaths a => ShowS -> a -> a
adjustFilePaths ShowS
f NodeColeProtocolConfiguration
pcb)
                                     (ShowS
-> NodeSophieProtocolConfiguration
-> NodeSophieProtocolConfiguration
forall a. AdjustFilePaths a => ShowS -> a -> a
adjustFilePaths ShowS
f NodeSophieProtocolConfiguration
pcs)
                                     (ShowS
-> NodeAurumProtocolConfiguration -> NodeAurumProtocolConfiguration
forall a. AdjustFilePaths a => ShowS -> a -> a
adjustFilePaths ShowS
f NodeAurumProtocolConfiguration
pca)
                                     NodeHardForkProtocolConfiguration
pch

instance AdjustFilePaths NodeColeProtocolConfiguration where
  adjustFilePaths :: ShowS
-> NodeColeProtocolConfiguration -> NodeColeProtocolConfiguration
adjustFilePaths ShowS
f x :: NodeColeProtocolConfiguration
x@NodeColeProtocolConfiguration {
                        GenesisFile
npcColeGenesisFile :: GenesisFile
npcColeGenesisFile :: NodeColeProtocolConfiguration -> GenesisFile
npcColeGenesisFile
                      } =
    NodeColeProtocolConfiguration
x { npcColeGenesisFile :: GenesisFile
npcColeGenesisFile = ShowS -> GenesisFile -> GenesisFile
forall a. AdjustFilePaths a => ShowS -> a -> a
adjustFilePaths ShowS
f GenesisFile
npcColeGenesisFile }

instance AdjustFilePaths NodeSophieProtocolConfiguration where
  adjustFilePaths :: ShowS
-> NodeSophieProtocolConfiguration
-> NodeSophieProtocolConfiguration
adjustFilePaths ShowS
f x :: NodeSophieProtocolConfiguration
x@NodeSophieProtocolConfiguration {
                        GenesisFile
npcSophieGenesisFile :: GenesisFile
npcSophieGenesisFile :: NodeSophieProtocolConfiguration -> GenesisFile
npcSophieGenesisFile
                      } =
    NodeSophieProtocolConfiguration
x { npcSophieGenesisFile :: GenesisFile
npcSophieGenesisFile = ShowS -> GenesisFile -> GenesisFile
forall a. AdjustFilePaths a => ShowS -> a -> a
adjustFilePaths ShowS
f GenesisFile
npcSophieGenesisFile }

instance AdjustFilePaths NodeAurumProtocolConfiguration where
  adjustFilePaths :: ShowS
-> NodeAurumProtocolConfiguration -> NodeAurumProtocolConfiguration
adjustFilePaths ShowS
f x :: NodeAurumProtocolConfiguration
x@NodeAurumProtocolConfiguration {
                        GenesisFile
npcAurumGenesisFile :: GenesisFile
npcAurumGenesisFile :: NodeAurumProtocolConfiguration -> GenesisFile
npcAurumGenesisFile
                      } =
    NodeAurumProtocolConfiguration
x { npcAurumGenesisFile :: GenesisFile
npcAurumGenesisFile = ShowS -> GenesisFile -> GenesisFile
forall a. AdjustFilePaths a => ShowS -> a -> a
adjustFilePaths ShowS
f GenesisFile
npcAurumGenesisFile }

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

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 (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)


instance AdjustFilePaths (Last NodeProtocolConfiguration) where

  adjustFilePaths :: ShowS
-> Last NodeProtocolConfiguration -> Last NodeProtocolConfiguration
adjustFilePaths ShowS
f (Last (Just NodeProtocolConfiguration
npc)) =
    Maybe NodeProtocolConfiguration -> Last NodeProtocolConfiguration
forall a. Maybe a -> Last a
Last (Maybe NodeProtocolConfiguration -> Last NodeProtocolConfiguration)
-> (NodeProtocolConfiguration -> Maybe NodeProtocolConfiguration)
-> NodeProtocolConfiguration
-> Last NodeProtocolConfiguration
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NodeProtocolConfiguration -> Maybe NodeProtocolConfiguration
forall a. a -> Maybe a
Just (NodeProtocolConfiguration -> Last NodeProtocolConfiguration)
-> NodeProtocolConfiguration -> Last NodeProtocolConfiguration
forall a b. (a -> b) -> a -> b
$ ShowS -> NodeProtocolConfiguration -> NodeProtocolConfiguration
forall a. AdjustFilePaths a => ShowS -> a -> a
adjustFilePaths ShowS
f NodeProtocolConfiguration
npc

  adjustFilePaths ShowS
_ (Last Maybe NodeProtocolConfiguration
Nothing) = Maybe NodeProtocolConfiguration -> Last NodeProtocolConfiguration
forall a. Maybe a -> Last a
Last Maybe NodeProtocolConfiguration
forall a. Maybe a
Nothing

instance AdjustFilePaths (Last SocketPath) where
  adjustFilePaths :: ShowS -> Last SocketPath -> Last SocketPath
adjustFilePaths ShowS
f (Last (Just (SocketPath String
p))) = Maybe SocketPath -> Last SocketPath
forall a. Maybe a -> Last a
Last (Maybe SocketPath -> Last SocketPath)
-> (SocketPath -> Maybe SocketPath)
-> SocketPath
-> Last SocketPath
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. SocketPath -> Maybe SocketPath
forall a. a -> Maybe a
Just (SocketPath -> Last SocketPath) -> SocketPath -> Last SocketPath
forall a b. (a -> b) -> a -> b
$ String -> SocketPath
SocketPath (ShowS
f String
p)
  adjustFilePaths ShowS
_ (Last Maybe SocketPath
Nothing) = Maybe SocketPath -> Last SocketPath
forall a. Maybe a -> Last a
Last Maybe SocketPath
forall a. Maybe a
Nothing

-- | A human readable name for the protocol
--
protocolName :: Protocol -> String
protocolName :: Protocol -> String
protocolName Protocol
ColeProtocol   = String
"Cole"
protocolName Protocol
SophieProtocol = String
"Sophie"
protocolName Protocol
BccProtocol = String
"Cole; Sophie"


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
showList :: [VRFPrivateKeyFilePermissionError] -> ShowS
$cshowList :: [VRFPrivateKeyFilePermissionError] -> ShowS
show :: VRFPrivateKeyFilePermissionError -> String
$cshow :: VRFPrivateKeyFilePermissionError -> String
showsPrec :: Int -> VRFPrivateKeyFilePermissionError -> ShowS
$cshowsPrec :: Int -> 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."