otel-effectful-1.0.0: src/Effectful/OpenTelemetry/Protocol/HTTP.hs

module Effectful.OpenTelemetry.Protocol.HTTP {-# WARNING in "x-unstable-interface" "This is an unstable interface." #-} where

import Codec.Compression.GZip qualified as GZip
import Control.Monad (void)
import Data.ByteString.Lazy (LazyByteString)
import Data.Maybe (maybeToList)
import Effectful
import Effectful.Error.Static (Error, throwError)
import Effectful.Exception (handle)
import Effectful.HttpClient
    ( HttpClient
    , HttpException
    , RequestBody (..)
    , ResponseTimeout
    , httpNoBody
    , method
    , requestBody
    , requestFromURI_
    , requestHeaders
    , responseTimeout
    )
import Effectful.OpenTelemetry.Protocol.Transport (Compression (..), Encoding)
import Effectful.OpenTelemetry.Protocol.Transport qualified as Transport
import Network.URI (URI)
import Network.URI.Static (uri)
import Prelude

-- | Default OTLP HTTP endpoint URI: @http:\/\/localhost:4318@.
defaultEndpoint :: URI
defaultEndpoint = [uri|http://localhost:4318|]

sendPayload
    :: (HttpClient :> es, Error HttpException :> es)
    => URI
    -> Encoding
    -> Compression
    -> ResponseTimeout
    -> LazyByteString
    -> Eff es ()
sendPayload endpoint encoding compression responseTimeout body =
    void
        . handle @HttpException throwError
        . httpNoBody
        $ (requestFromURI_ endpoint)
            { method = "POST"
            , requestBody = RequestBodyLBS (compress body)
            , requestHeaders =
                Transport.contentType encoding
                    : maybeToList (Transport.contentEncoding compression)
            , responseTimeout
            }
  where
    compress = case compression of
        NoCompression -> id
        GZip -> GZip.compress