{-# LANGUAGE DeriveGeneric #-}
{-|
Module      : Instana.SDK.Internal.AgentConnection.Json.AnnounceResponse
Description : Aeson type for the agent's announce response
-}
module Instana.SDK.Internal.AgentConnection.Json.AnnounceResponse
    ( AnnounceResponse(..)
    , TracingConfig(..)
    ) where


import           Data.Aeson                   (FromJSON)
import qualified Data.Aeson                   as Aeson
import           Data.Aeson.Casing            as AesonCasing
import           Data.Text                    (Text)
import           GHC.Generics

import           Instana.SDK.Internal.Secrets (SecretsMatcher)


-- |Holds the agent's response to the announce request.
data AnnounceResponse = AnnounceResponse
  { AnnounceResponse -> Int
pid          :: Int
  , AnnounceResponse -> Text
agentUuid    :: Text
  , AnnounceResponse -> Maybe TracingConfig
tracing      :: Maybe TracingConfig
  , AnnounceResponse -> Maybe [String]
extraHeaders :: Maybe [String]
  , AnnounceResponse -> SecretsMatcher
secrets      :: SecretsMatcher
  } deriving (AnnounceResponse -> AnnounceResponse -> Bool
(AnnounceResponse -> AnnounceResponse -> Bool)
-> (AnnounceResponse -> AnnounceResponse -> Bool)
-> Eq AnnounceResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AnnounceResponse -> AnnounceResponse -> Bool
$c/= :: AnnounceResponse -> AnnounceResponse -> Bool
== :: AnnounceResponse -> AnnounceResponse -> Bool
$c== :: AnnounceResponse -> AnnounceResponse -> Bool
Eq, Int -> AnnounceResponse -> ShowS
[AnnounceResponse] -> ShowS
AnnounceResponse -> String
(Int -> AnnounceResponse -> ShowS)
-> (AnnounceResponse -> String)
-> ([AnnounceResponse] -> ShowS)
-> Show AnnounceResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AnnounceResponse] -> ShowS
$cshowList :: [AnnounceResponse] -> ShowS
show :: AnnounceResponse -> String
$cshow :: AnnounceResponse -> String
showsPrec :: Int -> AnnounceResponse -> ShowS
$cshowsPrec :: Int -> AnnounceResponse -> ShowS
Show, (forall x. AnnounceResponse -> Rep AnnounceResponse x)
-> (forall x. Rep AnnounceResponse x -> AnnounceResponse)
-> Generic AnnounceResponse
forall x. Rep AnnounceResponse x -> AnnounceResponse
forall x. AnnounceResponse -> Rep AnnounceResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AnnounceResponse x -> AnnounceResponse
$cfrom :: forall x. AnnounceResponse -> Rep AnnounceResponse x
Generic)

instance FromJSON AnnounceResponse


data TracingConfig = TracingConfig
  { TracingConfig -> Maybe [String]
extraHttpHeaders :: Maybe [String]
  } deriving (TracingConfig -> TracingConfig -> Bool
(TracingConfig -> TracingConfig -> Bool)
-> (TracingConfig -> TracingConfig -> Bool) -> Eq TracingConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TracingConfig -> TracingConfig -> Bool
$c/= :: TracingConfig -> TracingConfig -> Bool
== :: TracingConfig -> TracingConfig -> Bool
$c== :: TracingConfig -> TracingConfig -> Bool
Eq, Int -> TracingConfig -> ShowS
[TracingConfig] -> ShowS
TracingConfig -> String
(Int -> TracingConfig -> ShowS)
-> (TracingConfig -> String)
-> ([TracingConfig] -> ShowS)
-> Show TracingConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TracingConfig] -> ShowS
$cshowList :: [TracingConfig] -> ShowS
show :: TracingConfig -> String
$cshow :: TracingConfig -> String
showsPrec :: Int -> TracingConfig -> ShowS
$cshowsPrec :: Int -> TracingConfig -> ShowS
Show, (forall x. TracingConfig -> Rep TracingConfig x)
-> (forall x. Rep TracingConfig x -> TracingConfig)
-> Generic TracingConfig
forall x. Rep TracingConfig x -> TracingConfig
forall x. TracingConfig -> Rep TracingConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TracingConfig x -> TracingConfig
$cfrom :: forall x. TracingConfig -> Rep TracingConfig x
Generic)

instance FromJSON TracingConfig where
   parseJSON :: Value -> Parser TracingConfig
parseJSON = Options -> Value -> Parser TracingConfig
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Aeson.genericParseJSON (Options -> Value -> Parser TracingConfig)
-> Options -> Value -> Parser TracingConfig
forall a b. (a -> b) -> a -> b
$
     Int -> ShowS -> Options
AesonCasing.aesonDrop 0 ShowS
AesonCasing.trainCase