{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports    #-}

--------------------------------------------------------------------------------

-- Orphan instances module for Cardano tracer.
{-# OPTIONS_GHC -Wno-orphans #-}
-- Extracted from "cardano-node" `Cardano.Node.Tracing.Tracers.P2P`.
-- Branch "master" (2026-02-11, 85869e9dd21d9dac7c4381418346e97259c3303b).

{- TODO: All references to package "cardano-diffusion" were removed.
--       See all the TODO annotations.
--}

--------------------------------------------------------------------------------

module Ouroboros.Network.Tracing.PeerSelection.RootPeersDNS.LocalRootPeers () where

--------------------------------------------------------------------------------

---------
-- base -
---------
import Control.Exception (displayException)
---------------------
-- Package: "aeson" -
---------------------
import "aeson" Data.Aeson (ToJSON, ToJSONKey, Value (String), toJSON, (.=))
---------------------------------
-- Package: "ouroboros-network" -
---------------------------------
-- Needed for `ToJSON PeerSelection.State.LocalRootPeers.LocalRootConfig`
import "ouroboros-network" Ouroboros.Network.OrphanInstances qualified ()
import "ouroboros-network" Ouroboros.Network.PeerSelection.RootPeersDNS.LocalRootPeers
           (TraceLocalRootPeers (..))
--------------------
-- Package: "text" -
--------------------
import "text" Data.Text (pack)
--------------------------------
-- Package: "trace-dispatcher" -
--------------------------------
import "trace-dispatcher" Cardano.Logging

--------------------------------------------------------------------------------
-- LocalRootPeers Tracer
--------------------------------------------------------------------------------

{-- TODO: Before "cardano-diffusion" removal:
instance
  ( ToJSONKey ntnAddr
  , ToJSON ntnAddr
  , ToJSONKey RelayAccessPoint
  , Show ntnAddr
  ) => LogFormatting (TraceLocalRootPeers PeerTrustable ntnAddr) where
 -- TODO: That later changed in f550a6eb503cc81807419795ab2360e6042ce9d5:
instance LogFormatting CardanoTraceLocalRootPeers where
--}
instance
  ( ToJSONKey ntnAddr
  , ToJSON ntnAddr
  , ToJSON extraFlags
  , Show ntnAddr
  , Show extraFlags
  ) => LogFormatting (TraceLocalRootPeers extraFlags ntnAddr) where
  forMachine :: DetailLevel -> TraceLocalRootPeers extraFlags ntnAddr -> Object
forMachine DetailLevel
_dtal (TraceLocalRootDomains Config extraFlags RelayAccessPoint
groups) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"LocalRootDomains"
             , Key
"localRootDomains" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Config extraFlags RelayAccessPoint -> Value
forall a. ToJSON a => a -> Value
toJSON Config extraFlags RelayAccessPoint
groups
             ]
  forMachine DetailLevel
_dtal (TraceLocalRootWaiting RelayAccessPoint
d DiffTime
dt) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"LocalRootWaiting"
             , Key
"domainAddress" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= RelayAccessPoint -> Value
forall a. ToJSON a => a -> Value
toJSON RelayAccessPoint
d
             , Key
"diffTime" Key -> String -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DiffTime -> String
forall a. Show a => a -> String
show DiffTime
dt
             ]
  forMachine DetailLevel
_dtal (TraceLocalRootGroups Config extraFlags ntnAddr
groups) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"LocalRootGroups"
             , Key
"localRootGroups" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Config extraFlags ntnAddr -> Value
forall a. ToJSON a => a -> Value
toJSON Config extraFlags ntnAddr
groups
             ]
  forMachine DetailLevel
_dtal (TraceLocalRootFailure RelayAccessPoint
d DNSorIOError
exception) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"LocalRootFailure"
             , Key
"domainAddress" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= RelayAccessPoint -> Value
forall a. ToJSON a => a -> Value
toJSON RelayAccessPoint
d
             , Key
"reason" Key -> String -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DNSorIOError -> String
forall e. Exception e => e -> String
displayException DNSorIOError
exception
             ]
  forMachine DetailLevel
_dtal (TraceLocalRootError Domain
d SomeException
exception) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"LocalRootError"
             , Key
"domainAddress" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (String -> Text
pack (String -> Text) -> (Domain -> String) -> Domain -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Domain -> String
forall a. Show a => a -> String
show (Domain -> Text) -> Domain -> Text
forall a b. (a -> b) -> a -> b
$ Domain
d)
             , Key
"reason" Key -> String -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SomeException -> String
forall e. Exception e => e -> String
displayException SomeException
exception
             ]
  forMachine DetailLevel
_dtal (TraceLocalRootReconfigured Config extraFlags RelayAccessPoint
d Config extraFlags RelayAccessPoint
exception) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"LocalRootReconfigured"
             , Key
"domainAddress" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Config extraFlags RelayAccessPoint -> Value
forall a. ToJSON a => a -> Value
toJSON Config extraFlags RelayAccessPoint
d
             , Key
"reason" Key -> String -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Config extraFlags RelayAccessPoint -> String
forall a. Show a => a -> String
show Config extraFlags RelayAccessPoint
exception
             ]
  forMachine DetailLevel
_dtal (TraceLocalRootDNSMap Map RelayAccessPoint [ntnAddr]
dnsMap) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceLocalRootDNSMap"
      , Key
"dnsMap" Key -> Map RelayAccessPoint [ntnAddr] -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map RelayAccessPoint [ntnAddr]
dnsMap
      ]
  forHuman :: TraceLocalRootPeers extraFlags ntnAddr -> Text
forHuman = String -> Text
pack (String -> Text)
-> (TraceLocalRootPeers extraFlags ntnAddr -> String)
-> TraceLocalRootPeers extraFlags ntnAddr
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraceLocalRootPeers extraFlags ntnAddr -> String
forall a. Show a => a -> String
show

instance MetaTrace (TraceLocalRootPeers ntnAddr extraFlags) where
  namespaceFor :: TraceLocalRootPeers ntnAddr extraFlags
-> Namespace (TraceLocalRootPeers ntnAddr extraFlags)
namespaceFor = \case
    TraceLocalRootDomains {}      -> [Text]
-> [Text] -> Namespace (TraceLocalRootPeers ntnAddr extraFlags)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"LocalRootDomains"]
    TraceLocalRootWaiting {}      -> [Text]
-> [Text] -> Namespace (TraceLocalRootPeers ntnAddr extraFlags)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"LocalRootWaiting"]
    TraceLocalRootGroups {}       -> [Text]
-> [Text] -> Namespace (TraceLocalRootPeers ntnAddr extraFlags)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"LocalRootGroups"]
    TraceLocalRootFailure {}      -> [Text]
-> [Text] -> Namespace (TraceLocalRootPeers ntnAddr extraFlags)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"LocalRootFailure"]
    TraceLocalRootError {}        -> [Text]
-> [Text] -> Namespace (TraceLocalRootPeers ntnAddr extraFlags)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"LocalRootError"]
    TraceLocalRootReconfigured {} -> [Text]
-> [Text] -> Namespace (TraceLocalRootPeers ntnAddr extraFlags)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"LocalRootReconfigured"]
    TraceLocalRootDNSMap {}       -> [Text]
-> [Text] -> Namespace (TraceLocalRootPeers ntnAddr extraFlags)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"LocalRootDNSMap"]

  severityFor :: Namespace (TraceLocalRootPeers ntnAddr extraFlags)
-> Maybe (TraceLocalRootPeers ntnAddr extraFlags)
-> Maybe SeverityS
severityFor (Namespace [] [Text
"LocalRootDomains"]) Maybe (TraceLocalRootPeers ntnAddr extraFlags)
_      = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
  severityFor (Namespace [] [Text
"LocalRootWaiting"]) Maybe (TraceLocalRootPeers ntnAddr extraFlags)
_      = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
  severityFor (Namespace [] [Text
"LocalRootGroups"]) Maybe (TraceLocalRootPeers ntnAddr extraFlags)
_       = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
  severityFor (Namespace [] [Text
"LocalRootFailure"]) Maybe (TraceLocalRootPeers ntnAddr extraFlags)
_      = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
  severityFor (Namespace [] [Text
"LocalRootError"]) Maybe (TraceLocalRootPeers ntnAddr extraFlags)
_        = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
  severityFor (Namespace [] [Text
"LocalRootReconfigured"]) Maybe (TraceLocalRootPeers ntnAddr extraFlags)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
  severityFor (Namespace [] [Text
"LocalRootDNSMap"]) Maybe (TraceLocalRootPeers ntnAddr extraFlags)
_       = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
  severityFor Namespace (TraceLocalRootPeers ntnAddr extraFlags)
_ Maybe (TraceLocalRootPeers ntnAddr extraFlags)
_                                        = Maybe SeverityS
forall a. Maybe a
Nothing

  documentFor :: Namespace (TraceLocalRootPeers ntnAddr extraFlags) -> Maybe Text
documentFor (Namespace [] [Text
"LocalRootDomains"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just
    Text
""
  documentFor (Namespace [] [Text
"LocalRootWaiting"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just
    Text
""
  documentFor (Namespace [] [Text
"LocalRootGroups"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just
    Text
""
  documentFor (Namespace [] [Text
"LocalRootFailure"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just
    Text
""
  documentFor (Namespace [] [Text
"LocalRootError"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just
    Text
""
  documentFor (Namespace [] [Text
"LocalRootReconfigured"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just
    Text
""
  documentFor (Namespace [] [Text
"LocalRootDNSMap"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just
    Text
""
  documentFor Namespace (TraceLocalRootPeers ntnAddr extraFlags)
_ = Maybe Text
forall a. Maybe a
Nothing

  allNamespaces :: [Namespace (TraceLocalRootPeers ntnAddr extraFlags)]
allNamespaces =
    [ [Text]
-> [Text] -> Namespace (TraceLocalRootPeers ntnAddr extraFlags)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"LocalRootDomains"]
    , [Text]
-> [Text] -> Namespace (TraceLocalRootPeers ntnAddr extraFlags)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"LocalRootWaiting"]
    , [Text]
-> [Text] -> Namespace (TraceLocalRootPeers ntnAddr extraFlags)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"LocalRootGroups"]
    , [Text]
-> [Text] -> Namespace (TraceLocalRootPeers ntnAddr extraFlags)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"LocalRootFailure"]
    , [Text]
-> [Text] -> Namespace (TraceLocalRootPeers ntnAddr extraFlags)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"LocalRootError"]
    , [Text]
-> [Text] -> Namespace (TraceLocalRootPeers ntnAddr extraFlags)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"LocalRootReconfigured"]
    , [Text]
-> [Text] -> Namespace (TraceLocalRootPeers ntnAddr extraFlags)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"LocalRootDNSMap"]
    ]