log: Warp exceptions omnibus

chainweb.cabal

@@ -394,6 +394,7 @@ library
         , hashable >= 1.4
         , heaps >= 0.3
         , hourglass >=0.2
+        , http2 >= 5.2.1
         , http-client >= 0.5
         , http-client-tls >=0.3
         , http-media >= 0.7

changes/2024-05-30T145807-0400.txt

@@ -0,0 +1 @@
+Unify HTTP error logging across service and P2P APIs

changes/2024-05-30T150038-0400.txt

@@ -0,0 +1 @@
+Stop logging ConnectionIsClosed

src/Chainweb/Chainweb.hs

@@ -123,6 +123,7 @@ import qualified Data.Vector as V
 import GHC.Generics
 
 import qualified Network.HTTP.Client as HTTP
+import qualified Network.HTTP2.Client as HTTP2
 import Network.Socket (Socket)
 import Network.Wai
 import Network.Wai.Handler.Warp hiding (Port)
@@ -774,21 +775,30 @@ 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
+        -- this isn't really an error, this is a graceful close.
+        -- see https://github.com/kazu-yamamoto/http2/issues/102
+        | Just HTTP2.ConnectionIsClosed <- fromException e =
+            return ()
+        | 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 +871,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