From 723b3810839bc19aadc535312e685c1636209e70 Mon Sep 17 00:00:00 2001
From: parsonsmatt <parsonsmatt@gmail.com>
Date: Fri, 8 Sep 2023 17:11:48 -0600
Subject: [PATCH 1/2] Swallow localhost errors

---
 .../otlp/src/OpenTelemetry/Exporter/OTLP.hs   | 23 +++++++++++++++++--
 1 file changed, 21 insertions(+), 2 deletions(-)

diff --git a/exporters/otlp/src/OpenTelemetry/Exporter/OTLP.hs b/exporters/otlp/src/OpenTelemetry/Exporter/OTLP.hs
index be26b403..31820b54 100644
--- a/exporters/otlp/src/OpenTelemetry/Exporter/OTLP.hs
+++ b/exporters/otlp/src/OpenTelemetry/Exporter/OTLP.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedStrings #-}
@@ -65,6 +66,7 @@ import qualified Data.Vector as V
 import qualified Data.Vector as Vector
 import Lens.Micro
 import Network.HTTP.Client
+import qualified Network.HTTP.Client as HTTPClient
 import Network.HTTP.Simple (httpBS)
 import Network.HTTP.Types.Header
 import Network.HTTP.Types.Status
@@ -198,7 +200,10 @@ otlpExporter :: (MonadIO m) => OTLPExporterConfig -> m (Exporter OT.ImmutableSpa
 otlpExporter conf = do
   -- TODO, url parsing is janky
   -- TODO configurable retryDelay, maximum retry counts
-  req <- liftIO $ parseRequest (maybe "http://localhost:4318/v1/traces" (<> "/v1/traces") (otlpEndpoint conf))
+  let
+    defaultHost = "http://localhost:4318"
+    host = fromMaybe defaultHost $ otlpEndpoint conf
+  req <- liftIO $ parseRequest (host <> "/v1/traces")
 
   let (encodingHeader, encoder) =
         maybe
@@ -238,7 +243,21 @@ otlpExporter conf = do
                     Just (SomeAsyncException _) ->
                       throwIO err
                     Nothing ->
-                      pure $ Failure $ Just err
+                      -- The "default" case is to export to localhost.
+                      -- However, if localhost doesn't have a collector
+                      -- running, then we get a socket error.
+                      -- Instead of printing out that huge error, we'll
+                      -- just swallow it.
+                      case fromException err of
+                        Just (httpException :: HttpException)
+                          | HttpExceptionRequest req httpExceptionContent <- httpException
+                          , HTTPClient.host req == "localhost"
+                          , HTTPClient.port req == 4138
+                          , ConnectionFailure someExn <- httpExceptionContent
+                          ->
+                            pure $ Failure Nothing
+                        Nothing ->
+                          pure $ Failure $ Just err
                 Right ok -> pure ok
             else pure Success
       , exporterShutdown = pure ()

From da04eede49e659fde15ce8382e9294a6d6732930 Mon Sep 17 00:00:00 2001
From: parsonsmatt <parsonsmatt@gmail.com>
Date: Fri, 8 Sep 2023 17:31:38 -0600
Subject: [PATCH 2/2] lol

---
 .../otlp/src/OpenTelemetry/Exporter/OTLP.hs   | 34 +++++++------------
 1 file changed, 12 insertions(+), 22 deletions(-)

diff --git a/exporters/otlp/src/OpenTelemetry/Exporter/OTLP.hs b/exporters/otlp/src/OpenTelemetry/Exporter/OTLP.hs
index 31820b54..dbf475ff 100644
--- a/exporters/otlp/src/OpenTelemetry/Exporter/OTLP.hs
+++ b/exporters/otlp/src/OpenTelemetry/Exporter/OTLP.hs
@@ -240,24 +240,10 @@ otlpExporter conf = do
                   -- calling code will swallow the exception and cause
                   -- a problem.
                   case fromException err of
-                    Just (SomeAsyncException _) ->
+                    Just (SomeAsyncException _) -> do
                       throwIO err
                     Nothing ->
-                      -- The "default" case is to export to localhost.
-                      -- However, if localhost doesn't have a collector
-                      -- running, then we get a socket error.
-                      -- Instead of printing out that huge error, we'll
-                      -- just swallow it.
-                      case fromException err of
-                        Just (httpException :: HttpException)
-                          | HttpExceptionRequest req httpExceptionContent <- httpException
-                          , HTTPClient.host req == "localhost"
-                          , HTTPClient.port req == 4138
-                          , ConnectionFailure someExn <- httpExceptionContent
-                          ->
-                            pure $ Failure Nothing
-                        Nothing ->
-                          pure $ Failure $ Just err
+                      pure $ Failure $ Just err
                 Right ok -> pure ok
             else pure Success
       , exporterShutdown = pure ()
@@ -293,13 +279,17 @@ otlpExporter conf = do
                 threadDelay (retryDelay `shiftL` backoffCount)
                 sendReq req (backoffCount + 1)
 
-      either print (\_ -> pure ()) eResp
-
       case eResp of
-        Left err@(HttpExceptionRequest _ e) ->
-          if isRetryableException e
-            then exponentialBackoff
-            else pure $ Failure $ Just $ SomeException err
+        Left err@(HttpExceptionRequest req e)
+          | HTTPClient.host req == "localhost"
+          , HTTPClient.port req == 4317 || HTTPClient.port req == 4318
+          , ConnectionFailure _someExn <- e
+            -> do
+              pure $ Failure Nothing
+          | otherwise ->
+            if isRetryableException e
+              then exponentialBackoff
+              else pure $ Failure $ Just $ SomeException err
         Left err -> do
           pure $ Failure $ Just $ SomeException err
         Right resp ->