{-# 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.SSM.GetDefaultPatchBaseline
-- 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 the default patch baseline. Amazon Web Services Systems
-- Manager supports creating multiple default patch baselines. For example,
-- you can create a default patch baseline for each operating system.
--
-- If you don\'t specify an operating system value, the default patch
-- baseline for Windows is returned.
module Amazonka.SSM.GetDefaultPatchBaseline
  ( -- * Creating a Request
    GetDefaultPatchBaseline (..),
    newGetDefaultPatchBaseline,

    -- * Request Lenses
    getDefaultPatchBaseline_operatingSystem,

    -- * Destructuring the Response
    GetDefaultPatchBaselineResponse (..),
    newGetDefaultPatchBaselineResponse,

    -- * Response Lenses
    getDefaultPatchBaselineResponse_baselineId,
    getDefaultPatchBaselineResponse_operatingSystem,
    getDefaultPatchBaselineResponse_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.SSM.Types

-- | /See:/ 'newGetDefaultPatchBaseline' smart constructor.
data GetDefaultPatchBaseline = GetDefaultPatchBaseline'
  { -- | Returns the default patch baseline for the specified operating system.
    GetDefaultPatchBaseline -> Maybe OperatingSystem
operatingSystem :: Prelude.Maybe OperatingSystem
  }
  deriving (GetDefaultPatchBaseline -> GetDefaultPatchBaseline -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetDefaultPatchBaseline -> GetDefaultPatchBaseline -> Bool
$c/= :: GetDefaultPatchBaseline -> GetDefaultPatchBaseline -> Bool
== :: GetDefaultPatchBaseline -> GetDefaultPatchBaseline -> Bool
$c== :: GetDefaultPatchBaseline -> GetDefaultPatchBaseline -> Bool
Prelude.Eq, ReadPrec [GetDefaultPatchBaseline]
ReadPrec GetDefaultPatchBaseline
Int -> ReadS GetDefaultPatchBaseline
ReadS [GetDefaultPatchBaseline]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetDefaultPatchBaseline]
$creadListPrec :: ReadPrec [GetDefaultPatchBaseline]
readPrec :: ReadPrec GetDefaultPatchBaseline
$creadPrec :: ReadPrec GetDefaultPatchBaseline
readList :: ReadS [GetDefaultPatchBaseline]
$creadList :: ReadS [GetDefaultPatchBaseline]
readsPrec :: Int -> ReadS GetDefaultPatchBaseline
$creadsPrec :: Int -> ReadS GetDefaultPatchBaseline
Prelude.Read, Int -> GetDefaultPatchBaseline -> ShowS
[GetDefaultPatchBaseline] -> ShowS
GetDefaultPatchBaseline -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetDefaultPatchBaseline] -> ShowS
$cshowList :: [GetDefaultPatchBaseline] -> ShowS
show :: GetDefaultPatchBaseline -> String
$cshow :: GetDefaultPatchBaseline -> String
showsPrec :: Int -> GetDefaultPatchBaseline -> ShowS
$cshowsPrec :: Int -> GetDefaultPatchBaseline -> ShowS
Prelude.Show, forall x. Rep GetDefaultPatchBaseline x -> GetDefaultPatchBaseline
forall x. GetDefaultPatchBaseline -> Rep GetDefaultPatchBaseline x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetDefaultPatchBaseline x -> GetDefaultPatchBaseline
$cfrom :: forall x. GetDefaultPatchBaseline -> Rep GetDefaultPatchBaseline x
Prelude.Generic)

-- |
-- Create a value of 'GetDefaultPatchBaseline' 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:
--
-- 'operatingSystem', 'getDefaultPatchBaseline_operatingSystem' - Returns the default patch baseline for the specified operating system.
newGetDefaultPatchBaseline ::
  GetDefaultPatchBaseline
newGetDefaultPatchBaseline :: GetDefaultPatchBaseline
newGetDefaultPatchBaseline =
  GetDefaultPatchBaseline'
    { $sel:operatingSystem:GetDefaultPatchBaseline' :: Maybe OperatingSystem
operatingSystem =
        forall a. Maybe a
Prelude.Nothing
    }

-- | Returns the default patch baseline for the specified operating system.
getDefaultPatchBaseline_operatingSystem :: Lens.Lens' GetDefaultPatchBaseline (Prelude.Maybe OperatingSystem)
getDefaultPatchBaseline_operatingSystem :: Lens' GetDefaultPatchBaseline (Maybe OperatingSystem)
getDefaultPatchBaseline_operatingSystem = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDefaultPatchBaseline' {Maybe OperatingSystem
operatingSystem :: Maybe OperatingSystem
$sel:operatingSystem:GetDefaultPatchBaseline' :: GetDefaultPatchBaseline -> Maybe OperatingSystem
operatingSystem} -> Maybe OperatingSystem
operatingSystem) (\s :: GetDefaultPatchBaseline
s@GetDefaultPatchBaseline' {} Maybe OperatingSystem
a -> GetDefaultPatchBaseline
s {$sel:operatingSystem:GetDefaultPatchBaseline' :: Maybe OperatingSystem
operatingSystem = Maybe OperatingSystem
a} :: GetDefaultPatchBaseline)

instance Core.AWSRequest GetDefaultPatchBaseline where
  type
    AWSResponse GetDefaultPatchBaseline =
      GetDefaultPatchBaselineResponse
  request :: (Service -> Service)
-> GetDefaultPatchBaseline -> Request GetDefaultPatchBaseline
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 GetDefaultPatchBaseline
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetDefaultPatchBaseline)))
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 OperatingSystem -> Int -> GetDefaultPatchBaselineResponse
GetDefaultPatchBaselineResponse'
            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
"BaselineId")
            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
"OperatingSystem")
            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 GetDefaultPatchBaseline where
  hashWithSalt :: Int -> GetDefaultPatchBaseline -> Int
hashWithSalt Int
_salt GetDefaultPatchBaseline' {Maybe OperatingSystem
operatingSystem :: Maybe OperatingSystem
$sel:operatingSystem:GetDefaultPatchBaseline' :: GetDefaultPatchBaseline -> Maybe OperatingSystem
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OperatingSystem
operatingSystem

instance Prelude.NFData GetDefaultPatchBaseline where
  rnf :: GetDefaultPatchBaseline -> ()
rnf GetDefaultPatchBaseline' {Maybe OperatingSystem
operatingSystem :: Maybe OperatingSystem
$sel:operatingSystem:GetDefaultPatchBaseline' :: GetDefaultPatchBaseline -> Maybe OperatingSystem
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe OperatingSystem
operatingSystem

instance Data.ToHeaders GetDefaultPatchBaseline where
  toHeaders :: GetDefaultPatchBaseline -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"AmazonSSM.GetDefaultPatchBaseline" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON GetDefaultPatchBaseline where
  toJSON :: GetDefaultPatchBaseline -> Value
toJSON GetDefaultPatchBaseline' {Maybe OperatingSystem
operatingSystem :: Maybe OperatingSystem
$sel:operatingSystem:GetDefaultPatchBaseline' :: GetDefaultPatchBaseline -> Maybe OperatingSystem
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"OperatingSystem" 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 OperatingSystem
operatingSystem
          ]
      )

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

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

-- | /See:/ 'newGetDefaultPatchBaselineResponse' smart constructor.
data GetDefaultPatchBaselineResponse = GetDefaultPatchBaselineResponse'
  { -- | The ID of the default patch baseline.
    GetDefaultPatchBaselineResponse -> Maybe Text
baselineId :: Prelude.Maybe Prelude.Text,
    -- | The operating system for the returned patch baseline.
    GetDefaultPatchBaselineResponse -> Maybe OperatingSystem
operatingSystem :: Prelude.Maybe OperatingSystem,
    -- | The response's http status code.
    GetDefaultPatchBaselineResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetDefaultPatchBaselineResponse
-> GetDefaultPatchBaselineResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetDefaultPatchBaselineResponse
-> GetDefaultPatchBaselineResponse -> Bool
$c/= :: GetDefaultPatchBaselineResponse
-> GetDefaultPatchBaselineResponse -> Bool
== :: GetDefaultPatchBaselineResponse
-> GetDefaultPatchBaselineResponse -> Bool
$c== :: GetDefaultPatchBaselineResponse
-> GetDefaultPatchBaselineResponse -> Bool
Prelude.Eq, ReadPrec [GetDefaultPatchBaselineResponse]
ReadPrec GetDefaultPatchBaselineResponse
Int -> ReadS GetDefaultPatchBaselineResponse
ReadS [GetDefaultPatchBaselineResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetDefaultPatchBaselineResponse]
$creadListPrec :: ReadPrec [GetDefaultPatchBaselineResponse]
readPrec :: ReadPrec GetDefaultPatchBaselineResponse
$creadPrec :: ReadPrec GetDefaultPatchBaselineResponse
readList :: ReadS [GetDefaultPatchBaselineResponse]
$creadList :: ReadS [GetDefaultPatchBaselineResponse]
readsPrec :: Int -> ReadS GetDefaultPatchBaselineResponse
$creadsPrec :: Int -> ReadS GetDefaultPatchBaselineResponse
Prelude.Read, Int -> GetDefaultPatchBaselineResponse -> ShowS
[GetDefaultPatchBaselineResponse] -> ShowS
GetDefaultPatchBaselineResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetDefaultPatchBaselineResponse] -> ShowS
$cshowList :: [GetDefaultPatchBaselineResponse] -> ShowS
show :: GetDefaultPatchBaselineResponse -> String
$cshow :: GetDefaultPatchBaselineResponse -> String
showsPrec :: Int -> GetDefaultPatchBaselineResponse -> ShowS
$cshowsPrec :: Int -> GetDefaultPatchBaselineResponse -> ShowS
Prelude.Show, forall x.
Rep GetDefaultPatchBaselineResponse x
-> GetDefaultPatchBaselineResponse
forall x.
GetDefaultPatchBaselineResponse
-> Rep GetDefaultPatchBaselineResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetDefaultPatchBaselineResponse x
-> GetDefaultPatchBaselineResponse
$cfrom :: forall x.
GetDefaultPatchBaselineResponse
-> Rep GetDefaultPatchBaselineResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetDefaultPatchBaselineResponse' 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:
--
-- 'baselineId', 'getDefaultPatchBaselineResponse_baselineId' - The ID of the default patch baseline.
--
-- 'operatingSystem', 'getDefaultPatchBaselineResponse_operatingSystem' - The operating system for the returned patch baseline.
--
-- 'httpStatus', 'getDefaultPatchBaselineResponse_httpStatus' - The response's http status code.
newGetDefaultPatchBaselineResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetDefaultPatchBaselineResponse
newGetDefaultPatchBaselineResponse :: Int -> GetDefaultPatchBaselineResponse
newGetDefaultPatchBaselineResponse Int
pHttpStatus_ =
  GetDefaultPatchBaselineResponse'
    { $sel:baselineId:GetDefaultPatchBaselineResponse' :: Maybe Text
baselineId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:operatingSystem:GetDefaultPatchBaselineResponse' :: Maybe OperatingSystem
operatingSystem = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetDefaultPatchBaselineResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ID of the default patch baseline.
getDefaultPatchBaselineResponse_baselineId :: Lens.Lens' GetDefaultPatchBaselineResponse (Prelude.Maybe Prelude.Text)
getDefaultPatchBaselineResponse_baselineId :: Lens' GetDefaultPatchBaselineResponse (Maybe Text)
getDefaultPatchBaselineResponse_baselineId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDefaultPatchBaselineResponse' {Maybe Text
baselineId :: Maybe Text
$sel:baselineId:GetDefaultPatchBaselineResponse' :: GetDefaultPatchBaselineResponse -> Maybe Text
baselineId} -> Maybe Text
baselineId) (\s :: GetDefaultPatchBaselineResponse
s@GetDefaultPatchBaselineResponse' {} Maybe Text
a -> GetDefaultPatchBaselineResponse
s {$sel:baselineId:GetDefaultPatchBaselineResponse' :: Maybe Text
baselineId = Maybe Text
a} :: GetDefaultPatchBaselineResponse)

-- | The operating system for the returned patch baseline.
getDefaultPatchBaselineResponse_operatingSystem :: Lens.Lens' GetDefaultPatchBaselineResponse (Prelude.Maybe OperatingSystem)
getDefaultPatchBaselineResponse_operatingSystem :: Lens' GetDefaultPatchBaselineResponse (Maybe OperatingSystem)
getDefaultPatchBaselineResponse_operatingSystem = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDefaultPatchBaselineResponse' {Maybe OperatingSystem
operatingSystem :: Maybe OperatingSystem
$sel:operatingSystem:GetDefaultPatchBaselineResponse' :: GetDefaultPatchBaselineResponse -> Maybe OperatingSystem
operatingSystem} -> Maybe OperatingSystem
operatingSystem) (\s :: GetDefaultPatchBaselineResponse
s@GetDefaultPatchBaselineResponse' {} Maybe OperatingSystem
a -> GetDefaultPatchBaselineResponse
s {$sel:operatingSystem:GetDefaultPatchBaselineResponse' :: Maybe OperatingSystem
operatingSystem = Maybe OperatingSystem
a} :: GetDefaultPatchBaselineResponse)

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

instance
  Prelude.NFData
    GetDefaultPatchBaselineResponse
  where
  rnf :: GetDefaultPatchBaselineResponse -> ()
rnf GetDefaultPatchBaselineResponse' {Int
Maybe Text
Maybe OperatingSystem
httpStatus :: Int
operatingSystem :: Maybe OperatingSystem
baselineId :: Maybe Text
$sel:httpStatus:GetDefaultPatchBaselineResponse' :: GetDefaultPatchBaselineResponse -> Int
$sel:operatingSystem:GetDefaultPatchBaselineResponse' :: GetDefaultPatchBaselineResponse -> Maybe OperatingSystem
$sel:baselineId:GetDefaultPatchBaselineResponse' :: GetDefaultPatchBaselineResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
baselineId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe OperatingSystem
operatingSystem
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus