{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.XRay.GetSamplingRules
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves all sampling rules.
--
-- This operation returns paginated results.
module Amazonka.XRay.GetSamplingRules
  ( -- * Creating a Request
    GetSamplingRules (..),
    newGetSamplingRules,

    -- * Request Lenses
    getSamplingRules_nextToken,

    -- * Destructuring the Response
    GetSamplingRulesResponse (..),
    newGetSamplingRulesResponse,

    -- * Response Lenses
    getSamplingRulesResponse_nextToken,
    getSamplingRulesResponse_samplingRuleRecords,
    getSamplingRulesResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.XRay.Types

-- | /See:/ 'newGetSamplingRules' smart constructor.
data GetSamplingRules = GetSamplingRules'
  { -- | Pagination token.
    GetSamplingRules -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text
  }
  deriving (GetSamplingRules -> GetSamplingRules -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetSamplingRules -> GetSamplingRules -> Bool
$c/= :: GetSamplingRules -> GetSamplingRules -> Bool
== :: GetSamplingRules -> GetSamplingRules -> Bool
$c== :: GetSamplingRules -> GetSamplingRules -> Bool
Prelude.Eq, ReadPrec [GetSamplingRules]
ReadPrec GetSamplingRules
Int -> ReadS GetSamplingRules
ReadS [GetSamplingRules]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetSamplingRules]
$creadListPrec :: ReadPrec [GetSamplingRules]
readPrec :: ReadPrec GetSamplingRules
$creadPrec :: ReadPrec GetSamplingRules
readList :: ReadS [GetSamplingRules]
$creadList :: ReadS [GetSamplingRules]
readsPrec :: Int -> ReadS GetSamplingRules
$creadsPrec :: Int -> ReadS GetSamplingRules
Prelude.Read, Int -> GetSamplingRules -> ShowS
[GetSamplingRules] -> ShowS
GetSamplingRules -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetSamplingRules] -> ShowS
$cshowList :: [GetSamplingRules] -> ShowS
show :: GetSamplingRules -> String
$cshow :: GetSamplingRules -> String
showsPrec :: Int -> GetSamplingRules -> ShowS
$cshowsPrec :: Int -> GetSamplingRules -> ShowS
Prelude.Show, forall x. Rep GetSamplingRules x -> GetSamplingRules
forall x. GetSamplingRules -> Rep GetSamplingRules x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetSamplingRules x -> GetSamplingRules
$cfrom :: forall x. GetSamplingRules -> Rep GetSamplingRules x
Prelude.Generic)

-- |
-- Create a value of 'GetSamplingRules' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'nextToken', 'getSamplingRules_nextToken' - Pagination token.
newGetSamplingRules ::
  GetSamplingRules
newGetSamplingRules :: GetSamplingRules
newGetSamplingRules =
  GetSamplingRules' {$sel:nextToken:GetSamplingRules' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing}

-- | Pagination token.
getSamplingRules_nextToken :: Lens.Lens' GetSamplingRules (Prelude.Maybe Prelude.Text)
getSamplingRules_nextToken :: Lens' GetSamplingRules (Maybe Text)
getSamplingRules_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSamplingRules' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:GetSamplingRules' :: GetSamplingRules -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: GetSamplingRules
s@GetSamplingRules' {} Maybe Text
a -> GetSamplingRules
s {$sel:nextToken:GetSamplingRules' :: Maybe Text
nextToken = Maybe Text
a} :: GetSamplingRules)

instance Core.AWSPager GetSamplingRules where
  page :: GetSamplingRules
-> AWSResponse GetSamplingRules -> Maybe GetSamplingRules
page GetSamplingRules
rq AWSResponse GetSamplingRules
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse GetSamplingRules
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetSamplingRulesResponse (Maybe Text)
getSamplingRulesResponse_nextToken
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse GetSamplingRules
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetSamplingRulesResponse (Maybe [SamplingRuleRecord])
getSamplingRulesResponse_samplingRuleRecords
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ GetSamplingRules
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' GetSamplingRules (Maybe Text)
getSamplingRules_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse GetSamplingRules
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetSamplingRulesResponse (Maybe Text)
getSamplingRulesResponse_nextToken
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just

instance Core.AWSRequest GetSamplingRules where
  type
    AWSResponse GetSamplingRules =
      GetSamplingRulesResponse
  request :: (Service -> Service)
-> GetSamplingRules -> Request GetSamplingRules
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetSamplingRules
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetSamplingRules)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text
-> Maybe [SamplingRuleRecord] -> Int -> GetSamplingRulesResponse
GetSamplingRulesResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"NextToken")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"SamplingRuleRecords"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable GetSamplingRules where
  hashWithSalt :: Int -> GetSamplingRules -> Int
hashWithSalt Int
_salt GetSamplingRules' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:GetSamplingRules' :: GetSamplingRules -> Maybe Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken

instance Prelude.NFData GetSamplingRules where
  rnf :: GetSamplingRules -> ()
rnf GetSamplingRules' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:GetSamplingRules' :: GetSamplingRules -> Maybe Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken

instance Data.ToHeaders GetSamplingRules where
  toHeaders :: GetSamplingRules -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToJSON GetSamplingRules where
  toJSON :: GetSamplingRules -> Value
toJSON GetSamplingRules' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:GetSamplingRules' :: GetSamplingRules -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [(Key
"NextToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
nextToken]
      )

instance Data.ToPath GetSamplingRules where
  toPath :: GetSamplingRules -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/GetSamplingRules"

instance Data.ToQuery GetSamplingRules where
  toQuery :: GetSamplingRules -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newGetSamplingRulesResponse' smart constructor.
data GetSamplingRulesResponse = GetSamplingRulesResponse'
  { -- | Pagination token.
    GetSamplingRulesResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | Rule definitions and metadata.
    GetSamplingRulesResponse -> Maybe [SamplingRuleRecord]
samplingRuleRecords :: Prelude.Maybe [SamplingRuleRecord],
    -- | The response's http status code.
    GetSamplingRulesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetSamplingRulesResponse -> GetSamplingRulesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetSamplingRulesResponse -> GetSamplingRulesResponse -> Bool
$c/= :: GetSamplingRulesResponse -> GetSamplingRulesResponse -> Bool
== :: GetSamplingRulesResponse -> GetSamplingRulesResponse -> Bool
$c== :: GetSamplingRulesResponse -> GetSamplingRulesResponse -> Bool
Prelude.Eq, ReadPrec [GetSamplingRulesResponse]
ReadPrec GetSamplingRulesResponse
Int -> ReadS GetSamplingRulesResponse
ReadS [GetSamplingRulesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetSamplingRulesResponse]
$creadListPrec :: ReadPrec [GetSamplingRulesResponse]
readPrec :: ReadPrec GetSamplingRulesResponse
$creadPrec :: ReadPrec GetSamplingRulesResponse
readList :: ReadS [GetSamplingRulesResponse]
$creadList :: ReadS [GetSamplingRulesResponse]
readsPrec :: Int -> ReadS GetSamplingRulesResponse
$creadsPrec :: Int -> ReadS GetSamplingRulesResponse
Prelude.Read, Int -> GetSamplingRulesResponse -> ShowS
[GetSamplingRulesResponse] -> ShowS
GetSamplingRulesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetSamplingRulesResponse] -> ShowS
$cshowList :: [GetSamplingRulesResponse] -> ShowS
show :: GetSamplingRulesResponse -> String
$cshow :: GetSamplingRulesResponse -> String
showsPrec :: Int -> GetSamplingRulesResponse -> ShowS
$cshowsPrec :: Int -> GetSamplingRulesResponse -> ShowS
Prelude.Show, forall x.
Rep GetSamplingRulesResponse x -> GetSamplingRulesResponse
forall x.
GetSamplingRulesResponse -> Rep GetSamplingRulesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetSamplingRulesResponse x -> GetSamplingRulesResponse
$cfrom :: forall x.
GetSamplingRulesResponse -> Rep GetSamplingRulesResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetSamplingRulesResponse' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'nextToken', 'getSamplingRulesResponse_nextToken' - Pagination token.
--
-- 'samplingRuleRecords', 'getSamplingRulesResponse_samplingRuleRecords' - Rule definitions and metadata.
--
-- 'httpStatus', 'getSamplingRulesResponse_httpStatus' - The response's http status code.
newGetSamplingRulesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetSamplingRulesResponse
newGetSamplingRulesResponse :: Int -> GetSamplingRulesResponse
newGetSamplingRulesResponse Int
pHttpStatus_ =
  GetSamplingRulesResponse'
    { $sel:nextToken:GetSamplingRulesResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:samplingRuleRecords:GetSamplingRulesResponse' :: Maybe [SamplingRuleRecord]
samplingRuleRecords = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetSamplingRulesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Pagination token.
getSamplingRulesResponse_nextToken :: Lens.Lens' GetSamplingRulesResponse (Prelude.Maybe Prelude.Text)
getSamplingRulesResponse_nextToken :: Lens' GetSamplingRulesResponse (Maybe Text)
getSamplingRulesResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSamplingRulesResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:GetSamplingRulesResponse' :: GetSamplingRulesResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: GetSamplingRulesResponse
s@GetSamplingRulesResponse' {} Maybe Text
a -> GetSamplingRulesResponse
s {$sel:nextToken:GetSamplingRulesResponse' :: Maybe Text
nextToken = Maybe Text
a} :: GetSamplingRulesResponse)

-- | Rule definitions and metadata.
getSamplingRulesResponse_samplingRuleRecords :: Lens.Lens' GetSamplingRulesResponse (Prelude.Maybe [SamplingRuleRecord])
getSamplingRulesResponse_samplingRuleRecords :: Lens' GetSamplingRulesResponse (Maybe [SamplingRuleRecord])
getSamplingRulesResponse_samplingRuleRecords = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSamplingRulesResponse' {Maybe [SamplingRuleRecord]
samplingRuleRecords :: Maybe [SamplingRuleRecord]
$sel:samplingRuleRecords:GetSamplingRulesResponse' :: GetSamplingRulesResponse -> Maybe [SamplingRuleRecord]
samplingRuleRecords} -> Maybe [SamplingRuleRecord]
samplingRuleRecords) (\s :: GetSamplingRulesResponse
s@GetSamplingRulesResponse' {} Maybe [SamplingRuleRecord]
a -> GetSamplingRulesResponse
s {$sel:samplingRuleRecords:GetSamplingRulesResponse' :: Maybe [SamplingRuleRecord]
samplingRuleRecords = Maybe [SamplingRuleRecord]
a} :: GetSamplingRulesResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The response's http status code.
getSamplingRulesResponse_httpStatus :: Lens.Lens' GetSamplingRulesResponse Prelude.Int
getSamplingRulesResponse_httpStatus :: Lens' GetSamplingRulesResponse Int
getSamplingRulesResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSamplingRulesResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetSamplingRulesResponse' :: GetSamplingRulesResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetSamplingRulesResponse
s@GetSamplingRulesResponse' {} Int
a -> GetSamplingRulesResponse
s {$sel:httpStatus:GetSamplingRulesResponse' :: Int
httpStatus = Int
a} :: GetSamplingRulesResponse)

instance Prelude.NFData GetSamplingRulesResponse where
  rnf :: GetSamplingRulesResponse -> ()
rnf GetSamplingRulesResponse' {Int
Maybe [SamplingRuleRecord]
Maybe Text
httpStatus :: Int
samplingRuleRecords :: Maybe [SamplingRuleRecord]
nextToken :: Maybe Text
$sel:httpStatus:GetSamplingRulesResponse' :: GetSamplingRulesResponse -> Int
$sel:samplingRuleRecords:GetSamplingRulesResponse' :: GetSamplingRulesResponse -> Maybe [SamplingRuleRecord]
$sel:nextToken:GetSamplingRulesResponse' :: GetSamplingRulesResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [SamplingRuleRecord]
samplingRuleRecords
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus