Merge pull request #4931 from IntersectMBO/karknu/ping_tip_host

Log remote address and port in tip message.

Author: karknu

cardano-ping/CHANGELOG.md

@@ -2,6 +2,10 @@
 
 ## next version
 
+### Breaking changes
+
+* Log remote address and port in tip message
+
 ## 0.3.0.0 -- 2024-08-07
 
 ### Breaking changes

cardano-ping/cardano-ping.cabal

@@ -27,6 +27,7 @@ library
                         cborg                         >=0.2.8    && <0.3,
                         bytestring                    >=0.10     && <0.13,
                         contra-tracer                 >=0.1      && <0.3,
+                        iproute,
                         time,
 
                         si-timers                    ^>=1.5,

cardano-ping/src/Cardano/Network/Ping.hs

@@ -36,6 +36,7 @@ import           Data.Aeson.Text (encodeToLazyText)
 import           Data.Bits (clearBit, setBit, testBit)
 import           Data.ByteString.Lazy (ByteString)
 import           Data.Foldable (toList)
+import           Data.IP
 import           Data.List.NonEmpty (NonEmpty (..))
 import           Data.Maybe (fromMaybe,)
 import           Data.TDigest (insert, maximumValue, minimumValue, tdigest, mean, quantile, stddev, TDigest)
@@ -223,7 +224,8 @@ instance ToJSON NodeVersion where
                                                     ["peersharing" .= toJSON peersharing]
 
 data PingTip = PingTip {
-    ptRtt     :: !Double
+    ptHost    :: !(IP, Socket.PortNumber)
+  , ptRtt     :: !Double
   , ptHash    :: !ByteString
   , ptBlockNo :: !Word64
   , ptSlotNo  :: !Word64
@@ -234,8 +236,8 @@ hexStr = LBS.foldr (\b -> (<>) (printf "%02x" b)) ""
 
 instance Show PingTip where
   show PingTip{..} =
-    printf "rtt: %f, hash %s, blockNo: %d slotNo: %d" ptRtt (hexStr ptHash)
-           ptBlockNo ptSlotNo
+    printf "host: %s:%d, rtt: %f, hash %s, blockNo: %d slotNo: %d" (show $ fst ptHost)
+           (fromIntegral $ snd ptHost :: Word16) ptRtt (hexStr ptHash) ptBlockNo ptSlotNo
 
 instance ToJSON PingTip where
   toJSON PingTip{..} =
@@ -244,6 +246,8 @@ instance ToJSON PingTip where
       , "hash"    .= hexStr ptHash
       , "blockNo" .= ptBlockNo
       , "slotNo"  .= ptSlotNo
+      , "addr"    .= (show $ fst $ ptHost :: String)
+      , "port"    .= (fromIntegral $ snd $ ptHost :: Word16)
       ]
 
 keepAliveReqEnc :: NodeVersion -> Word16 -> CBOR.Encoding
@@ -603,6 +607,7 @@ data PingClientError = PingClientDeserialiseFailure DeserialiseFailure String
                      | PingClientKeepAliveProtocolFailure KeepAliveFailure String
                      | PingClientHandshakeFailure HandshakeFailure String
                      | PingClientNegotiationError String [NodeVersion] String
+                     | PingClientIPAddressFailure String
                      deriving Show
 
 instance Exception PingClientError where
@@ -618,6 +623,8 @@ instance Exception PingClientError where
     printf "%s Protocol error: %s" peerStr (show err)
   displayException (PingClientNegotiationError err recVersions peerStr) =
     printf "%s Version negotiation error %s\nReceived versions: %s\n" peerStr err (show recVersions)
+  displayException (PingClientIPAddressFailure peerStr) =
+    printf "%s expected an IP address\n" peerStr
 
 pingClient :: Tracer IO LogMsg -> Tracer IO String -> PingOpts -> [NodeVersion] -> AddrInfo -> IO ()
 pingClient stdout stderr PingOpts{..} versions peer = bracket
@@ -773,9 +780,12 @@ pingClient stdout stderr PingOpts{..} versions peer = bracket
       case CBOR.deserialiseFromBytes chainSyncIntersectNotFoundDec msg of
            Left err -> throwIO (PingClientFindIntersectDeserialiseFailure err peerStr)
            Right (_, (slotNo, blockNo, hash)) ->
-             let tip = PingTip (toSample t_e t_s) hash blockNo slotNo in
-             if pingOptsJson then traceWith stdout $ LogMsg (encode tip)
-                             else traceWith stdout $ LogMsg $ LBS.Char.pack $ show tip <> "\n"
+             case fromSockAddr $ Socket.addrAddress peer of
+                  Nothing -> throwIO (PingClientIPAddressFailure peerStr)
+                  Just host ->
+                    let tip = PingTip host (toSample t_e t_s) hash blockNo slotNo in
+                    if pingOptsJson then traceWith stdout $ LogMsg (encode tip)
+                                    else traceWith stdout $ LogMsg $ LBS.Char.pack $ show tip <> "\n"
 
 isSameVersionAndMagic :: NodeVersion -> NodeVersion -> Bool
 isSameVersionAndMagic v1 v2 = extract v1 == extract v2