{-# 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.Lightsail.GetDistributionLatestCacheReset
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns the timestamp and status of the last cache reset of a specific
-- Amazon Lightsail content delivery network (CDN) distribution.
module Amazonka.Lightsail.GetDistributionLatestCacheReset
  ( -- * Creating a Request
    GetDistributionLatestCacheReset (..),
    newGetDistributionLatestCacheReset,

    -- * Request Lenses
    getDistributionLatestCacheReset_distributionName,

    -- * Destructuring the Response
    GetDistributionLatestCacheResetResponse (..),
    newGetDistributionLatestCacheResetResponse,

    -- * Response Lenses
    getDistributionLatestCacheResetResponse_createTime,
    getDistributionLatestCacheResetResponse_status,
    getDistributionLatestCacheResetResponse_httpStatus,
  )
where

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

-- | /See:/ 'newGetDistributionLatestCacheReset' smart constructor.
data GetDistributionLatestCacheReset = GetDistributionLatestCacheReset'
  { -- | The name of the distribution for which to return the timestamp of the
    -- last cache reset.
    --
    -- Use the @GetDistributions@ action to get a list of distribution names
    -- that you can specify.
    --
    -- When omitted, the response includes the latest cache reset timestamp of
    -- all your distributions.
    GetDistributionLatestCacheReset -> Maybe Text
distributionName :: Prelude.Maybe Prelude.Text
  }
  deriving (GetDistributionLatestCacheReset
-> GetDistributionLatestCacheReset -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetDistributionLatestCacheReset
-> GetDistributionLatestCacheReset -> Bool
$c/= :: GetDistributionLatestCacheReset
-> GetDistributionLatestCacheReset -> Bool
== :: GetDistributionLatestCacheReset
-> GetDistributionLatestCacheReset -> Bool
$c== :: GetDistributionLatestCacheReset
-> GetDistributionLatestCacheReset -> Bool
Prelude.Eq, ReadPrec [GetDistributionLatestCacheReset]
ReadPrec GetDistributionLatestCacheReset
Int -> ReadS GetDistributionLatestCacheReset
ReadS [GetDistributionLatestCacheReset]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetDistributionLatestCacheReset]
$creadListPrec :: ReadPrec [GetDistributionLatestCacheReset]
readPrec :: ReadPrec GetDistributionLatestCacheReset
$creadPrec :: ReadPrec GetDistributionLatestCacheReset
readList :: ReadS [GetDistributionLatestCacheReset]
$creadList :: ReadS [GetDistributionLatestCacheReset]
readsPrec :: Int -> ReadS GetDistributionLatestCacheReset
$creadsPrec :: Int -> ReadS GetDistributionLatestCacheReset
Prelude.Read, Int -> GetDistributionLatestCacheReset -> ShowS
[GetDistributionLatestCacheReset] -> ShowS
GetDistributionLatestCacheReset -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetDistributionLatestCacheReset] -> ShowS
$cshowList :: [GetDistributionLatestCacheReset] -> ShowS
show :: GetDistributionLatestCacheReset -> String
$cshow :: GetDistributionLatestCacheReset -> String
showsPrec :: Int -> GetDistributionLatestCacheReset -> ShowS
$cshowsPrec :: Int -> GetDistributionLatestCacheReset -> ShowS
Prelude.Show, forall x.
Rep GetDistributionLatestCacheReset x
-> GetDistributionLatestCacheReset
forall x.
GetDistributionLatestCacheReset
-> Rep GetDistributionLatestCacheReset x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetDistributionLatestCacheReset x
-> GetDistributionLatestCacheReset
$cfrom :: forall x.
GetDistributionLatestCacheReset
-> Rep GetDistributionLatestCacheReset x
Prelude.Generic)

-- |
-- Create a value of 'GetDistributionLatestCacheReset' 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:
--
-- 'distributionName', 'getDistributionLatestCacheReset_distributionName' - The name of the distribution for which to return the timestamp of the
-- last cache reset.
--
-- Use the @GetDistributions@ action to get a list of distribution names
-- that you can specify.
--
-- When omitted, the response includes the latest cache reset timestamp of
-- all your distributions.
newGetDistributionLatestCacheReset ::
  GetDistributionLatestCacheReset
newGetDistributionLatestCacheReset :: GetDistributionLatestCacheReset
newGetDistributionLatestCacheReset =
  GetDistributionLatestCacheReset'
    { $sel:distributionName:GetDistributionLatestCacheReset' :: Maybe Text
distributionName =
        forall a. Maybe a
Prelude.Nothing
    }

-- | The name of the distribution for which to return the timestamp of the
-- last cache reset.
--
-- Use the @GetDistributions@ action to get a list of distribution names
-- that you can specify.
--
-- When omitted, the response includes the latest cache reset timestamp of
-- all your distributions.
getDistributionLatestCacheReset_distributionName :: Lens.Lens' GetDistributionLatestCacheReset (Prelude.Maybe Prelude.Text)
getDistributionLatestCacheReset_distributionName :: Lens' GetDistributionLatestCacheReset (Maybe Text)
getDistributionLatestCacheReset_distributionName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDistributionLatestCacheReset' {Maybe Text
distributionName :: Maybe Text
$sel:distributionName:GetDistributionLatestCacheReset' :: GetDistributionLatestCacheReset -> Maybe Text
distributionName} -> Maybe Text
distributionName) (\s :: GetDistributionLatestCacheReset
s@GetDistributionLatestCacheReset' {} Maybe Text
a -> GetDistributionLatestCacheReset
s {$sel:distributionName:GetDistributionLatestCacheReset' :: Maybe Text
distributionName = Maybe Text
a} :: GetDistributionLatestCacheReset)

instance
  Core.AWSRequest
    GetDistributionLatestCacheReset
  where
  type
    AWSResponse GetDistributionLatestCacheReset =
      GetDistributionLatestCacheResetResponse
  request :: (Service -> Service)
-> GetDistributionLatestCacheReset
-> Request GetDistributionLatestCacheReset
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 GetDistributionLatestCacheReset
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse GetDistributionLatestCacheReset)))
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 POSIX
-> Maybe Text -> Int -> GetDistributionLatestCacheResetResponse
GetDistributionLatestCacheResetResponse'
            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
"createTime")
            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
"status")
            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
    GetDistributionLatestCacheReset
  where
  hashWithSalt :: Int -> GetDistributionLatestCacheReset -> Int
hashWithSalt
    Int
_salt
    GetDistributionLatestCacheReset' {Maybe Text
distributionName :: Maybe Text
$sel:distributionName:GetDistributionLatestCacheReset' :: GetDistributionLatestCacheReset -> Maybe Text
..} =
      Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
distributionName

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

instance
  Data.ToHeaders
    GetDistributionLatestCacheReset
  where
  toHeaders :: GetDistributionLatestCacheReset -> 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
"Lightsail_20161128.GetDistributionLatestCacheReset" ::
                          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 GetDistributionLatestCacheReset where
  toJSON :: GetDistributionLatestCacheReset -> Value
toJSON GetDistributionLatestCacheReset' {Maybe Text
distributionName :: Maybe Text
$sel:distributionName:GetDistributionLatestCacheReset' :: GetDistributionLatestCacheReset -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"distributionName" 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
distributionName
          ]
      )

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

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

-- | /See:/ 'newGetDistributionLatestCacheResetResponse' smart constructor.
data GetDistributionLatestCacheResetResponse = GetDistributionLatestCacheResetResponse'
  { -- | The timestamp of the last cache reset (e.g., @1479734909.17@) in Unix
    -- time format.
    GetDistributionLatestCacheResetResponse -> Maybe POSIX
createTime :: Prelude.Maybe Data.POSIX,
    -- | The status of the last cache reset.
    GetDistributionLatestCacheResetResponse -> Maybe Text
status :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetDistributionLatestCacheResetResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetDistributionLatestCacheResetResponse
-> GetDistributionLatestCacheResetResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetDistributionLatestCacheResetResponse
-> GetDistributionLatestCacheResetResponse -> Bool
$c/= :: GetDistributionLatestCacheResetResponse
-> GetDistributionLatestCacheResetResponse -> Bool
== :: GetDistributionLatestCacheResetResponse
-> GetDistributionLatestCacheResetResponse -> Bool
$c== :: GetDistributionLatestCacheResetResponse
-> GetDistributionLatestCacheResetResponse -> Bool
Prelude.Eq, ReadPrec [GetDistributionLatestCacheResetResponse]
ReadPrec GetDistributionLatestCacheResetResponse
Int -> ReadS GetDistributionLatestCacheResetResponse
ReadS [GetDistributionLatestCacheResetResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetDistributionLatestCacheResetResponse]
$creadListPrec :: ReadPrec [GetDistributionLatestCacheResetResponse]
readPrec :: ReadPrec GetDistributionLatestCacheResetResponse
$creadPrec :: ReadPrec GetDistributionLatestCacheResetResponse
readList :: ReadS [GetDistributionLatestCacheResetResponse]
$creadList :: ReadS [GetDistributionLatestCacheResetResponse]
readsPrec :: Int -> ReadS GetDistributionLatestCacheResetResponse
$creadsPrec :: Int -> ReadS GetDistributionLatestCacheResetResponse
Prelude.Read, Int -> GetDistributionLatestCacheResetResponse -> ShowS
[GetDistributionLatestCacheResetResponse] -> ShowS
GetDistributionLatestCacheResetResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetDistributionLatestCacheResetResponse] -> ShowS
$cshowList :: [GetDistributionLatestCacheResetResponse] -> ShowS
show :: GetDistributionLatestCacheResetResponse -> String
$cshow :: GetDistributionLatestCacheResetResponse -> String
showsPrec :: Int -> GetDistributionLatestCacheResetResponse -> ShowS
$cshowsPrec :: Int -> GetDistributionLatestCacheResetResponse -> ShowS
Prelude.Show, forall x.
Rep GetDistributionLatestCacheResetResponse x
-> GetDistributionLatestCacheResetResponse
forall x.
GetDistributionLatestCacheResetResponse
-> Rep GetDistributionLatestCacheResetResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetDistributionLatestCacheResetResponse x
-> GetDistributionLatestCacheResetResponse
$cfrom :: forall x.
GetDistributionLatestCacheResetResponse
-> Rep GetDistributionLatestCacheResetResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetDistributionLatestCacheResetResponse' 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:
--
-- 'createTime', 'getDistributionLatestCacheResetResponse_createTime' - The timestamp of the last cache reset (e.g., @1479734909.17@) in Unix
-- time format.
--
-- 'status', 'getDistributionLatestCacheResetResponse_status' - The status of the last cache reset.
--
-- 'httpStatus', 'getDistributionLatestCacheResetResponse_httpStatus' - The response's http status code.
newGetDistributionLatestCacheResetResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetDistributionLatestCacheResetResponse
newGetDistributionLatestCacheResetResponse :: Int -> GetDistributionLatestCacheResetResponse
newGetDistributionLatestCacheResetResponse
  Int
pHttpStatus_ =
    GetDistributionLatestCacheResetResponse'
      { $sel:createTime:GetDistributionLatestCacheResetResponse' :: Maybe POSIX
createTime =
          forall a. Maybe a
Prelude.Nothing,
        $sel:status:GetDistributionLatestCacheResetResponse' :: Maybe Text
status = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:GetDistributionLatestCacheResetResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | The timestamp of the last cache reset (e.g., @1479734909.17@) in Unix
-- time format.
getDistributionLatestCacheResetResponse_createTime :: Lens.Lens' GetDistributionLatestCacheResetResponse (Prelude.Maybe Prelude.UTCTime)
getDistributionLatestCacheResetResponse_createTime :: Lens' GetDistributionLatestCacheResetResponse (Maybe UTCTime)
getDistributionLatestCacheResetResponse_createTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDistributionLatestCacheResetResponse' {Maybe POSIX
createTime :: Maybe POSIX
$sel:createTime:GetDistributionLatestCacheResetResponse' :: GetDistributionLatestCacheResetResponse -> Maybe POSIX
createTime} -> Maybe POSIX
createTime) (\s :: GetDistributionLatestCacheResetResponse
s@GetDistributionLatestCacheResetResponse' {} Maybe POSIX
a -> GetDistributionLatestCacheResetResponse
s {$sel:createTime:GetDistributionLatestCacheResetResponse' :: Maybe POSIX
createTime = Maybe POSIX
a} :: GetDistributionLatestCacheResetResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The status of the last cache reset.
getDistributionLatestCacheResetResponse_status :: Lens.Lens' GetDistributionLatestCacheResetResponse (Prelude.Maybe Prelude.Text)
getDistributionLatestCacheResetResponse_status :: Lens' GetDistributionLatestCacheResetResponse (Maybe Text)
getDistributionLatestCacheResetResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDistributionLatestCacheResetResponse' {Maybe Text
status :: Maybe Text
$sel:status:GetDistributionLatestCacheResetResponse' :: GetDistributionLatestCacheResetResponse -> Maybe Text
status} -> Maybe Text
status) (\s :: GetDistributionLatestCacheResetResponse
s@GetDistributionLatestCacheResetResponse' {} Maybe Text
a -> GetDistributionLatestCacheResetResponse
s {$sel:status:GetDistributionLatestCacheResetResponse' :: Maybe Text
status = Maybe Text
a} :: GetDistributionLatestCacheResetResponse)

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

instance
  Prelude.NFData
    GetDistributionLatestCacheResetResponse
  where
  rnf :: GetDistributionLatestCacheResetResponse -> ()
rnf GetDistributionLatestCacheResetResponse' {Int
Maybe Text
Maybe POSIX
httpStatus :: Int
status :: Maybe Text
createTime :: Maybe POSIX
$sel:httpStatus:GetDistributionLatestCacheResetResponse' :: GetDistributionLatestCacheResetResponse -> Int
$sel:status:GetDistributionLatestCacheResetResponse' :: GetDistributionLatestCacheResetResponse -> Maybe Text
$sel:createTime:GetDistributionLatestCacheResetResponse' :: GetDistributionLatestCacheResetResponse -> Maybe POSIX
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
createTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus