{-# 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).

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

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

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

---------
-- base -
---------
--
---------------------
-- Package: "aeson" -
---------------------
import "aeson" Data.Aeson (ToJSON, Value (String), toJSON, (.=))
-----------------------
-- Package: "iproute" -
-----------------------
import "iproute" Data.IP qualified as IP
---------------------------------
-- Package: "ouroboros-network" -
---------------------------------
-- Needed for `ToJSON Network.Socket.Types.PortNumber`
import "ouroboros-network" Ouroboros.Network.OrphanInstances qualified ()
import "ouroboros-network" Ouroboros.Network.PeerSelection.RootPeersDNS.DNSActions
           (DNSTrace (..))
--------------------
-- Package: "text" -
--------------------
import "text" Data.Text (pack)
--------------------------------
-- Package: "trace-dispatcher" -
--------------------------------
import "trace-dispatcher" Cardano.Logging

-------------------------------------------------------------------------------
-- Types.
-------------------------------------------------------------------------------

-- From: `Cardano.Tracing.OrphanInstances.Network`.
instance ToJSON IP.IP where
  toJSON :: IP -> Value
toJSON IP
ip = Text -> Value
String (String -> Text
pack (String -> Text) -> (IP -> String) -> IP -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IP -> String
forall a. Show a => a -> String
show (IP -> Text) -> IP -> Text
forall a b. (a -> b) -> a -> b
$ IP
ip)

--------------------------------------------------------------------------------
-- DNSTrace Tracer
--------------------------------------------------------------------------------

instance LogFormatting DNSTrace where
  forMachine :: DetailLevel -> DNSTrace -> Object
forMachine DetailLevel
_dtal (DNSLookupResult DNSPeersKind
peerKind Domain
domain Maybe Domain
Nothing [(IP, PortNumber, TTL)]
results) =
    [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
"DNSLookupResult"
            , Key
"peerKind" 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)
-> (DNSPeersKind -> String) -> DNSPeersKind -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DNSPeersKind -> String
forall a. Show a => a -> String
show (DNSPeersKind -> Text) -> DNSPeersKind -> Text
forall a b. (a -> b) -> a -> b
$ DNSPeersKind
peerKind)
            , Key
"domain" 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
domain)
            , Key
"results" Key -> [(IP, PortNumber, TTL)] -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [(IP, PortNumber, TTL)]
results
            ]
  forMachine DetailLevel
_dtal (DNSLookupResult DNSPeersKind
peerKind Domain
domain (Just Domain
srv) [(IP, PortNumber, TTL)]
results) =
    [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
"DNSLookupResult"
            , Key
"peerKind" 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)
-> (DNSPeersKind -> String) -> DNSPeersKind -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DNSPeersKind -> String
forall a. Show a => a -> String
show (DNSPeersKind -> Text) -> DNSPeersKind -> Text
forall a b. (a -> b) -> a -> b
$ DNSPeersKind
peerKind)
            , Key
"domain" 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
domain)
            , Key
"srv" 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
srv)
            , Key
"results" Key -> [(IP, PortNumber, TTL)] -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [(IP, PortNumber, TTL)]
results
            ]
  forMachine DetailLevel
_dtal  (DNSLookupError DNSPeersKind
peerKind Maybe DNSLookupType
lookupType Domain
domain DNSError
dnsError) =
    [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
"DNSLookupError"
            , Key
"peerKind" 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)
-> (DNSPeersKind -> String) -> DNSPeersKind -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DNSPeersKind -> String
forall a. Show a => a -> String
show (DNSPeersKind -> Text) -> DNSPeersKind -> Text
forall a b. (a -> b) -> a -> b
$ DNSPeersKind
peerKind)
            , Key
"lookupKind" 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)
-> (Maybe DNSLookupType -> String) -> Maybe DNSLookupType -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe DNSLookupType -> String
forall a. Show a => a -> String
show (Maybe DNSLookupType -> Text) -> Maybe DNSLookupType -> Text
forall a b. (a -> b) -> a -> b
$ Maybe DNSLookupType
lookupType)
            , Key
"domain" 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
domain)
            , Key
"dnsError" 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) -> (DNSError -> String) -> DNSError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DNSError -> String
forall a. Show a => a -> String
show (DNSError -> Text) -> DNSError -> Text
forall a b. (a -> b) -> a -> b
$ DNSError
dnsError)
            ]
  forMachine DetailLevel
_dtal (SRVLookupResult DNSPeersKind
peerKind Domain
domain [(Domain, Word16, Word16, Word16, TTL)]
results) =
    [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
"SRVLookupResult"
            , Key
"peerKind" 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)
-> (DNSPeersKind -> String) -> DNSPeersKind -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DNSPeersKind -> String
forall a. Show a => a -> String
show (DNSPeersKind -> Text) -> DNSPeersKind -> Text
forall a b. (a -> b) -> a -> b
$ DNSPeersKind
peerKind)
            , Key
"domain" 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
domain)
            , Key
"results" Key -> [(String, Word16, Word16, Word16, TTL)] -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [ (Domain -> String
forall a. Show a => a -> String
show Domain
a, Word16
b, Word16
c, Word16
d, TTL
e)
                           | (Domain
a, Word16
b, Word16
c, Word16
d, TTL
e) <- [(Domain, Word16, Word16, Word16, TTL)]
results
                           ]
            ]
  forMachine DetailLevel
_dtal  (SRVLookupError DNSPeersKind
peerKind Domain
domain) =
    [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
"SRVLookupError"
            , Key
"peerKind" 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)
-> (DNSPeersKind -> String) -> DNSPeersKind -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DNSPeersKind -> String
forall a. Show a => a -> String
show (DNSPeersKind -> Text) -> DNSPeersKind -> Text
forall a b. (a -> b) -> a -> b
$ DNSPeersKind
peerKind)
            , Key
"domain" 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
domain)
            ]

instance MetaTrace DNSTrace where
  namespaceFor :: DNSTrace -> Namespace DNSTrace
namespaceFor DNSLookupResult {} =
    [Text] -> [Text] -> Namespace DNSTrace
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"DNSLookupResult"]
  namespaceFor DNSLookupError {} =
    [Text] -> [Text] -> Namespace DNSTrace
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"DNSLookupError"]
  namespaceFor SRVLookupResult {} =
    [Text] -> [Text] -> Namespace DNSTrace
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"SRVLookupResult"]
  namespaceFor SRVLookupError {} =
    [Text] -> [Text] -> Namespace DNSTrace
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"SRVLookupError"]

  severityFor :: Namespace DNSTrace -> Maybe DNSTrace -> Maybe SeverityS
severityFor Namespace DNSTrace
_ (Just DNSLookupResult {}) = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
  severityFor Namespace DNSTrace
_ (Just DNSLookupError {})  = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
  severityFor Namespace DNSTrace
_ (Just SRVLookupResult{})  = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
  severityFor Namespace DNSTrace
_ (Just SRVLookupError{})   = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
  severityFor Namespace DNSTrace
_ Maybe DNSTrace
Nothing                   = Maybe SeverityS
forall a. Maybe a
Nothing

  documentFor :: Namespace DNSTrace -> Maybe Text
documentFor Namespace DNSTrace
_ = Maybe Text
forall a. Maybe a
Nothing

  allNamespaces :: [Namespace DNSTrace]
allNamespaces = [
      [Text] -> [Text] -> Namespace DNSTrace
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"DNSLookupResult"]
    , [Text] -> [Text] -> Namespace DNSTrace
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"DNSLookupError"]
    , [Text] -> [Text] -> Namespace DNSTrace
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"SRVLookupResult"]
    , [Text] -> [Text] -> Namespace DNSTrace
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"SRVLookupError"]
    ]