{-# LANGUAGE DeriveGeneric #-}
{-|
Module      : Instana.SDK.Config
Description : Provides configuration records that can be used to control the initialization of the SDK
-}
module Instana.SDK.Config
  -- Maintenance note: accessor functions need to be reexported in SDK.hs
  ( Config(..)
  , defaultConfig
  ) where


import           GHC.Generics


{-| Configuration for the Instana SDK. Please use the 'defaultConfig'
function and then modify individual settings via record syntax For more
information, see <http://www.yesodweb.com/book/settings-types>.
-}
data Config = Config
  { -- | IP or host name of the Instana agent
    Config -> Maybe String
agentHost                   :: Maybe String
    -- | Port of the Instana agent
  , Config -> Maybe Int
agentPort                   :: Maybe Int
    -- | Overrides the default service name that is used in Instana.
  , Config -> Maybe String
serviceName                 :: Maybe String
    -- | Spans are usually buffered before being transmitted to the agent. This
    -- setting forces the transmission of all buffered spans after the given
    -- amount of milliseconds. Default: 1000.
  , Config -> Maybe Int
forceTransmissionAfter      :: Maybe Int
    -- | This setting forces the transmission of all buffered spans when the
    -- given number of spans has been buffered.
  , Config -> Maybe Int
forceTransmissionStartingAt :: Maybe Int
    -- | Limits the number of spans to buffer. When the limit is reached, spans
    -- will be dropped. This setting is a safe guard against memory leaks from
    -- buffering excessive amounts of spans. It must be larger than
    -- forceTransmissionStartingAt.
  , Config -> Maybe Int
maxBufferedSpans            :: Maybe Int
    -- | Disables continuing traces from W3C trace context (traceparent header).
  , Config -> Bool
disableW3cTraceCorrelation  :: Bool
  } deriving (Config -> Config -> Bool
(Config -> Config -> Bool)
-> (Config -> Config -> Bool) -> Eq Config
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Config -> Config -> Bool
$c/= :: Config -> Config -> Bool
== :: Config -> Config -> Bool
$c== :: Config -> Config -> Bool
Eq, (forall x. Config -> Rep Config x)
-> (forall x. Rep Config x -> Config) -> Generic Config
forall x. Rep Config x -> Config
forall x. Config -> Rep Config x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Config x -> Config
$cfrom :: forall x. Config -> Rep Config x
Generic)


{-| Populates all config values as Nothing, so that the Instana SDK relies on
environment variables or on its default config values (in this order)
internally.
-}
defaultConfig :: Config
defaultConfig :: Config
defaultConfig =
  Config :: Maybe String
-> Maybe Int
-> Maybe String
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Bool
-> Config
Config
    { agentHost :: Maybe String
agentHost = Maybe String
forall a. Maybe a
Nothing
    , agentPort :: Maybe Int
agentPort = Maybe Int
forall a. Maybe a
Nothing
    , serviceName :: Maybe String
serviceName = Maybe String
forall a. Maybe a
Nothing
    , forceTransmissionAfter :: Maybe Int
forceTransmissionAfter = Maybe Int
forall a. Maybe a
Nothing
    , forceTransmissionStartingAt :: Maybe Int
forceTransmissionStartingAt = Maybe Int
forall a. Maybe a
Nothing
    , maxBufferedSpans :: Maybe Int
maxBufferedSpans = Maybe Int
forall a. Maybe a
Nothing
    , disableW3cTraceCorrelation :: Bool
disableW3cTraceCorrelation = Bool
False
    }