refactor: Unify logging warp exceptions across service and P2P

Change-Id: I406b9b29783f39caef76a3fd920133cddf5ea5fd
kadena-io · May 30, 2024 · b937bce · b937bce
1 parent 440760f
commit b937bce
Show file tree

Hide file tree

Showing 2 changed files with 42 additions and 37 deletions.
diff --git a/changes/2024-05-30T145807-0400.txt b/changes/2024-05-30T145807-0400.txt
@@ -0,0 +1 @@
+Unify HTTP error logging across service and P2P APIs
diff --git a/src/Chainweb/Chainweb.hs b/src/Chainweb/Chainweb.hs
@@ -774,21 +774,26 @@ runChainweb cw nowServing = do
     pactDbsToServe :: [(ChainId, PactServerData logger tbl)]
     pactDbsToServe = _chainwebPactData cw
 
+    loggServerError msg (Just r) e =
+        "HTTP server error (" <> msg <> "): " <> sshow e <> ". Request: " <> sshow r
+    loggServerError msg Nothing e =
+        "HTTP server error (" <> msg <> "): " <> sshow e
+
+    logWarpException msg clientClosedConnectionsCounter r e
+        | Just InsecureConnectionDenied <- fromException e =
+            return ()
+        | Just ClientClosedConnectionPrematurely <- fromException e =
+            inc clientClosedConnectionsCounter
+        | otherwise =
+            when (defaultShouldDisplayException e) $
+                logg Warn $ loggServerError msg r e
+
     -- P2P Server
 
     serverSettings :: Counter "clientClosedConnections" -> Settings
-    serverSettings closedConnectionsCounter =
+    serverSettings clientClosedConnectionsCounter =
         peerServerSettings (_peerResPeer $ _chainwebPeer cw)
-        & setOnException
-            (\r e -> if
-                | Just InsecureConnectionDenied <- fromException e ->
-                    return ()
-                | Just ClientClosedConnectionPrematurely <- fromException e ->
-                    inc closedConnectionsCounter
-                | otherwise ->
-                    when (defaultShouldDisplayException e) $
-                        logg Warn $ loggServerError r e
-            )
+        & setOnException (logWarpException "P2P API" clientClosedConnectionsCounter)
         & setBeforeMainLoop (nowServing (nowServingP2PAPI .~ True))
 
     monitorConnectionsClosedByClient :: Counter "clientClosedConnections" -> IO ()
@@ -861,48 +866,47 @@ runChainweb cw nowServing = do
     httpLog :: Middleware
     httpLog = requestResponseLogger $ setComponent "http:p2p-api" (_chainwebLogger cw)
 
-    loggServerError (Just r) e = "HTTP server error: " <> sshow e <> ". Request: " <> sshow r
-    loggServerError Nothing e = "HTTP server error: " <> sshow e
-
     -- Service API Server
 
-    serviceApiServerSettings :: Port -> HostPreference -> Settings
-    serviceApiServerSettings port interface = defaultSettings
+    serviceApiServerSettings
+        :: Counter "clientClosedConnections"
+        -> Port -> HostPreference -> Settings
+    serviceApiServerSettings clientClosedConnectionsCounter port interface = defaultSettings
         & setPort (int port)
         & setHost interface
         & setOnException
-            (\r e -> when (defaultShouldDisplayException e) (logg Warn $ loggServiceApiServerError r e))
+            (logWarpException "Service API" clientClosedConnectionsCounter)
         & setBeforeMainLoop (nowServing (nowServingServiceAPI .~ True))
 
     serviceApiHost = _serviceApiConfigInterface $ _configServiceApi $ _chainwebConfig cw
 
     backupApiEnabled = _enableConfigEnabled $ _configBackupApi $ _configBackup $ _chainwebConfig cw
 
     serveServiceApi :: Middleware -> IO ()
-    serveServiceApi = serveServiceApiSocket
-        (serviceApiServerSettings (fst $ _chainwebServiceSocket cw) serviceApiHost)
-        (snd $ _chainwebServiceSocket cw)
-        (_chainwebVersion cw)
-        ChainwebServerDbs
-            { _chainwebServerCutDb = Just cutDb
-            , _chainwebServerBlockHeaderDbs = chainDbsToServe
-            , _chainwebServerMempools = mempoolsToServe
-            , _chainwebServerPayloadDbs = payloadDbsToServe
-            , _chainwebServerPeerDbs = (CutNetwork, cutPeerDb) : memP2pToServe
-            }
-        pactDbsToServe
-        (_chainwebCoordinator cw)
-        (HeaderStream . _configHeaderStream $ _chainwebConfig cw)
-        (Rosetta . _configRosetta $ _chainwebConfig cw)
-        (_chainwebBackup cw <$ guard backupApiEnabled)
-        (_serviceApiPayloadBatchLimit . _configServiceApi $ _chainwebConfig cw)
+    serveServiceApi mw = do
+        clientClosedConnectionsCounter <- newCounter
+        serveServiceApiSocket
+            (serviceApiServerSettings clientClosedConnectionsCounter (fst $ _chainwebServiceSocket cw) serviceApiHost)
+            (snd $ _chainwebServiceSocket cw)
+            (_chainwebVersion cw)
+            ChainwebServerDbs
+                { _chainwebServerCutDb = Just cutDb
+                , _chainwebServerBlockHeaderDbs = chainDbsToServe
+                , _chainwebServerMempools = mempoolsToServe
+                , _chainwebServerPayloadDbs = payloadDbsToServe
+                , _chainwebServerPeerDbs = (CutNetwork, cutPeerDb) : memP2pToServe
+                }
+            pactDbsToServe
+            (_chainwebCoordinator cw)
+            (HeaderStream . _configHeaderStream $ _chainwebConfig cw)
+            (Rosetta . _configRosetta $ _chainwebConfig cw)
+            (_chainwebBackup cw <$ guard backupApiEnabled)
+            (_serviceApiPayloadBatchLimit . _configServiceApi $ _chainwebConfig cw)
+            mw
 
     serviceHttpLog :: Middleware
     serviceHttpLog = requestResponseLogger $ setComponent "http:service-api" (_chainwebLogger cw)
 
-    loggServiceApiServerError (Just r) e = "HTTP service API server error: " <> sshow e <> ". Request: " <> sshow r
-    loggServiceApiServerError Nothing e = "HTTP service API server error: " <> sshow e
-
     -- HTTP Request Logger
 
     -- Cut DB and Miner
Original file line number	Diff line number	Diff line change
		@@ -0,0 +1 @@
		Unify HTTP error logging across service and P2P APIs