{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}


{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Network.OrphanInstances () where

import Data.Aeson
import Data.Aeson qualified as Aeson
import Data.Map qualified as Map

import Cardano.Network.NodeToClient (NodeToClientVersion (..),
           NodeToClientVersionData (..))
import Cardano.Network.NodeToNode (NodeToNodeVersion (..),
           NodeToNodeVersionData (..))
import Cardano.Network.PeerSelection.Bootstrap
import Cardano.Network.PeerSelection.PeerTrustable (PeerTrustable (..))
import Cardano.Network.PeerSelection.PublicRootPeers (CardanoPublicRootPeers,
           getBootstrapPeers, getPublicConfigPeers)
import Cardano.Network.Types

import Ouroboros.Network.Diffusion.Topology
import Ouroboros.Network.Magic (NetworkMagic (..))
import Ouroboros.Network.OrphanInstances (localRootPeersGroupsFromJSON,
           networkTopologyFromJSON, networkTopologyToJSON)
import Ouroboros.Network.PeerSelection.PublicRootPeers

instance ToJSON LedgerStateJudgement where
  toJSON :: LedgerStateJudgement -> Value
toJSON LedgerStateJudgement
YoungEnough = Text -> Value
String Text
"YoungEnough"
  toJSON LedgerStateJudgement
TooOld      = Text -> Value
String Text
"TooOld"

instance FromJSON LedgerStateJudgement where
  parseJSON :: Value -> Parser LedgerStateJudgement
parseJSON (String Text
"YoungEnough") = LedgerStateJudgement -> Parser LedgerStateJudgement
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LedgerStateJudgement
YoungEnough
  parseJSON (String Text
"TooOld")      = LedgerStateJudgement -> Parser LedgerStateJudgement
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LedgerStateJudgement
TooOld
  parseJSON Value
_                      = String -> Parser LedgerStateJudgement
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid JSON for LedgerStateJudgement"

instance ToJSON UseBootstrapPeers where
  toJSON :: UseBootstrapPeers -> Value
toJSON UseBootstrapPeers
DontUseBootstrapPeers   = Value
Null
  toJSON (UseBootstrapPeers [RelayAccessPoint]
dps) = [RelayAccessPoint] -> Value
forall a. ToJSON a => a -> Value
toJSON [RelayAccessPoint]
dps

instance FromJSON UseBootstrapPeers where
  parseJSON :: Value -> Parser UseBootstrapPeers
parseJSON Value
Null = UseBootstrapPeers -> Parser UseBootstrapPeers
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UseBootstrapPeers
DontUseBootstrapPeers
  parseJSON Value
v    = [RelayAccessPoint] -> UseBootstrapPeers
UseBootstrapPeers ([RelayAccessPoint] -> UseBootstrapPeers)
-> Parser [RelayAccessPoint] -> Parser UseBootstrapPeers
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser [RelayAccessPoint]
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

instance ToJSON peerAddr => ToJSON (CardanoPublicRootPeers peerAddr) where
  toJSON :: CardanoPublicRootPeers peerAddr -> Value
toJSON CardanoPublicRootPeers peerAddr
prp =
    [Pair] -> Value
object [ Key
"kind"              Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"PublicRootPeers"
           , Key
"bootstrapPeers"    Key -> Set peerAddr -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CardanoPublicRootPeers peerAddr -> Set peerAddr
forall peeraddr. CardanoPublicRootPeers peeraddr -> Set peeraddr
getBootstrapPeers CardanoPublicRootPeers peerAddr
prp
           , Key
"ledgerPeers"       Key -> Set peerAddr -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CardanoPublicRootPeers peerAddr -> Set peerAddr
forall extraPeers peeraddr.
PublicRootPeers extraPeers peeraddr -> Set peeraddr
getLedgerPeers CardanoPublicRootPeers peerAddr
prp
           , Key
"bigLedgerPeers"    Key -> Set peerAddr -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CardanoPublicRootPeers peerAddr -> Set peerAddr
forall extraPeers peeraddr.
PublicRootPeers extraPeers peeraddr -> Set peeraddr
getBigLedgerPeers CardanoPublicRootPeers peerAddr
prp
           , Key
"publicConfigPeers" Key -> Set peerAddr -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map peerAddr PeerAdvertise -> Set peerAddr
forall k a. Map k a -> Set k
Map.keysSet (CardanoPublicRootPeers peerAddr -> Map peerAddr PeerAdvertise
forall peeraddr.
CardanoPublicRootPeers peeraddr -> Map peeraddr PeerAdvertise
getPublicConfigPeers CardanoPublicRootPeers peerAddr
prp)
           ]

instance FromJSON PeerTrustable where
  parseJSON :: Value -> Parser PeerTrustable
parseJSON = String
-> (Bool -> Parser PeerTrustable) -> Value -> Parser PeerTrustable
forall a. String -> (Bool -> Parser a) -> Value -> Parser a
Aeson.withBool String
"PeerTrustable" ((Bool -> Parser PeerTrustable) -> Value -> Parser PeerTrustable)
-> (Bool -> Parser PeerTrustable) -> Value -> Parser PeerTrustable
forall a b. (a -> b) -> a -> b
$ \Bool
b ->
    PeerTrustable -> Parser PeerTrustable
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PeerTrustable -> Parser PeerTrustable)
-> PeerTrustable -> Parser PeerTrustable
forall a b. (a -> b) -> a -> b
$ if Bool
b then PeerTrustable
IsTrustable
                else PeerTrustable
IsNotTrustable

instance ToJSON PeerTrustable where
  toJSON :: PeerTrustable -> Value
toJSON PeerTrustable
IsTrustable    = Bool -> Value
Bool Bool
True
  toJSON PeerTrustable
IsNotTrustable = Bool -> Value
Bool Bool
False

instance ToJSONKey PeerTrustable where

instance FromJSON NodeToNodeVersion where
  parseJSON :: Value -> Parser NodeToNodeVersion
parseJSON = \case
    Number Scientific
14 -> NodeToNodeVersion -> Parser NodeToNodeVersion
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NodeToNodeVersion
NodeToNodeV_14
    Number Scientific
15 -> NodeToNodeVersion -> Parser NodeToNodeVersion
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NodeToNodeVersion
NodeToNodeV_15
    Number Scientific
x  -> String -> Parser NodeToNodeVersion
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser NodeToNodeVersion)
-> String -> Parser NodeToNodeVersion
forall a b. (a -> b) -> a -> b
$ String
"FromJSON.NodeToNodeVersion: unsupported node-to-node protocol version " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Scientific -> String
forall a. Show a => a -> String
show Scientific
x
    Value
x         -> String -> Parser NodeToNodeVersion
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser NodeToNodeVersion)
-> String -> Parser NodeToNodeVersion
forall a b. (a -> b) -> a -> b
$ String
"FromJSON.NodeToNodeVersion: error parsing NodeToNodeVersion: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Value -> String
forall a. Show a => a -> String
show Value
x

instance ToJSON NodeToNodeVersion where
  toJSON :: NodeToNodeVersion -> Value
toJSON NodeToNodeVersion
NodeToNodeV_14 = Scientific -> Value
Number Scientific
14
  toJSON NodeToNodeVersion
NodeToNodeV_15 = Scientific -> Value
Number Scientific
15

instance FromJSON NodeToClientVersion where
  parseJSON :: Value -> Parser NodeToClientVersion
parseJSON = \case
    Number Scientific
16 -> NodeToClientVersion -> Parser NodeToClientVersion
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NodeToClientVersion
NodeToClientV_16
    Number Scientific
17 -> NodeToClientVersion -> Parser NodeToClientVersion
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NodeToClientVersion
NodeToClientV_17
    Number Scientific
18 -> NodeToClientVersion -> Parser NodeToClientVersion
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NodeToClientVersion
NodeToClientV_18
    Number Scientific
19 -> NodeToClientVersion -> Parser NodeToClientVersion
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NodeToClientVersion
NodeToClientV_19
    Number Scientific
20 -> NodeToClientVersion -> Parser NodeToClientVersion
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NodeToClientVersion
NodeToClientV_20
    Number Scientific
21 -> NodeToClientVersion -> Parser NodeToClientVersion
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NodeToClientVersion
NodeToClientV_21
    Number Scientific
22 -> NodeToClientVersion -> Parser NodeToClientVersion
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NodeToClientVersion
NodeToClientV_22
    Number Scientific
x  -> String -> Parser NodeToClientVersion
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser NodeToClientVersion)
-> String -> Parser NodeToClientVersion
forall a b. (a -> b) -> a -> b
$ String
"FromJSON.NodeToClientVersion: unsupported node-to-client protocol version " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Scientific -> String
forall a. Show a => a -> String
show Scientific
x
    Value
x         -> String -> Parser NodeToClientVersion
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser NodeToClientVersion)
-> String -> Parser NodeToClientVersion
forall a b. (a -> b) -> a -> b
$ String
"FromJSON.NodeToClientVersion: error parsing NodeToClientVersion: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Value -> String
forall a. Show a => a -> String
show Value
x

instance ToJSON NodeToClientVersion where
  toJSON :: NodeToClientVersion -> Value
toJSON = \case
    NodeToClientVersion
NodeToClientV_16 -> Scientific -> Value
Number Scientific
16
    NodeToClientVersion
NodeToClientV_17 -> Scientific -> Value
Number Scientific
17
    NodeToClientVersion
NodeToClientV_18 -> Scientific -> Value
Number Scientific
18
    NodeToClientVersion
NodeToClientV_19 -> Scientific -> Value
Number Scientific
19
    NodeToClientVersion
NodeToClientV_20 -> Scientific -> Value
Number Scientific
20
    NodeToClientVersion
NodeToClientV_21 -> Scientific -> Value
Number Scientific
21
    NodeToClientVersion
NodeToClientV_22 -> Scientific -> Value
Number Scientific
22

instance ToJSON NodeToNodeVersionData where
  toJSON :: NodeToNodeVersionData -> Value
toJSON (NodeToNodeVersionData (NetworkMagic Word32
m) DiffusionMode
dm PeerSharing
ps Bool
q) = [Pair] -> Value
object
    [ Key
"networkMagic"  Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word32 -> Value
forall a. ToJSON a => a -> Value
toJSON Word32
m
    , Key
"diffusionMode" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DiffusionMode -> String
forall a. Show a => a -> String
show DiffusionMode
dm
    , Key
"peerSharing"   Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PeerSharing -> String
forall a. Show a => a -> String
show PeerSharing
ps
    , Key
"query"         Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool -> Value
forall a. ToJSON a => a -> Value
toJSON Bool
q
    ]

instance ToJSON NodeToClientVersionData where
  toJSON :: NodeToClientVersionData -> Value
toJSON (NodeToClientVersionData (NetworkMagic Word32
m) Bool
q) = [Pair] -> Value
object
    [ Key
"networkMagic" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word32 -> Value
forall a. ToJSON a => a -> Value
toJSON Word32
m
    , Key
"query"        Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool -> Value
forall a. ToJSON a => a -> Value
toJSON Bool
q
    ]

instance FromJSON (NetworkTopology UseBootstrapPeers PeerTrustable) where
  parseJSON :: Value -> Parser (NetworkTopology UseBootstrapPeers PeerTrustable)
parseJSON = (Value -> Parser (LocalRootPeersGroups PeerTrustable))
-> (Object -> Parser UseBootstrapPeers)
-> Value
-> Parser (NetworkTopology UseBootstrapPeers PeerTrustable)
forall extraFlags extraConfig.
(Value -> Parser (LocalRootPeersGroups extraFlags))
-> (Object -> Parser extraConfig)
-> Value
-> Parser (NetworkTopology extraConfig extraFlags)
networkTopologyFromJSON
                ((Object -> Parser PeerTrustable)
-> Value -> Parser (LocalRootPeersGroups PeerTrustable)
forall extraFlags.
(Object -> Parser extraFlags)
-> Value -> Parser (LocalRootPeersGroups extraFlags)
localRootPeersGroupsFromJSON (\Object
o -> Object
o Object -> Key -> Parser (Maybe PeerTrustable)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"trustable" Parser (Maybe PeerTrustable)
-> PeerTrustable -> Parser PeerTrustable
forall a. Parser (Maybe a) -> a -> Parser a
.!= PeerTrustable
IsNotTrustable))
                (\Object
o -> Object
o Object -> Key -> Parser (Maybe UseBootstrapPeers)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"bootstrapPeers" Parser (Maybe UseBootstrapPeers)
-> UseBootstrapPeers -> Parser UseBootstrapPeers
forall a. Parser (Maybe a) -> a -> Parser a
.!= UseBootstrapPeers
DontUseBootstrapPeers)

instance ToJSON (NetworkTopology UseBootstrapPeers PeerTrustable) where
  toJSON :: NetworkTopology UseBootstrapPeers PeerTrustable -> Value
toJSON = (UseBootstrapPeers -> Maybe Pair)
-> (PeerTrustable -> Maybe Pair)
-> NetworkTopology UseBootstrapPeers PeerTrustable
-> Value
forall extraConfig extraFlags.
(extraConfig -> Maybe Pair)
-> (extraFlags -> Maybe Pair)
-> NetworkTopology extraConfig extraFlags
-> Value
networkTopologyToJSON
             (\UseBootstrapPeers
useBootstrapPeers -> Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Key
"bootstrapPeers", UseBootstrapPeers -> Value
forall a. ToJSON a => a -> Value
toJSON UseBootstrapPeers
useBootstrapPeers))
             (\PeerTrustable
peerTrustable     -> Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Key
"trustable", PeerTrustable -> Value
forall a. ToJSON a => a -> Value
toJSON PeerTrustable
peerTrustable))