{-# 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.ResetDistributionCache
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deletes currently cached content from your Amazon Lightsail content
-- delivery network (CDN) distribution.
--
-- After resetting the cache, the next time a content request is made, your
-- distribution pulls, serves, and caches it from the origin.
module Amazonka.Lightsail.ResetDistributionCache
  ( -- * Creating a Request
    ResetDistributionCache (..),
    newResetDistributionCache,

    -- * Request Lenses
    resetDistributionCache_distributionName,

    -- * Destructuring the Response
    ResetDistributionCacheResponse (..),
    newResetDistributionCacheResponse,

    -- * Response Lenses
    resetDistributionCacheResponse_createTime,
    resetDistributionCacheResponse_operation,
    resetDistributionCacheResponse_status,
    resetDistributionCacheResponse_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:/ 'newResetDistributionCache' smart constructor.
data ResetDistributionCache = ResetDistributionCache'
  { -- | The name of the distribution for which to reset cache.
    --
    -- Use the @GetDistributions@ action to get a list of distribution names
    -- that you can specify.
    ResetDistributionCache -> Maybe Text
distributionName :: Prelude.Maybe Prelude.Text
  }
  deriving (ResetDistributionCache -> ResetDistributionCache -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResetDistributionCache -> ResetDistributionCache -> Bool
$c/= :: ResetDistributionCache -> ResetDistributionCache -> Bool
== :: ResetDistributionCache -> ResetDistributionCache -> Bool
$c== :: ResetDistributionCache -> ResetDistributionCache -> Bool
Prelude.Eq, ReadPrec [ResetDistributionCache]
ReadPrec ResetDistributionCache
Int -> ReadS ResetDistributionCache
ReadS [ResetDistributionCache]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ResetDistributionCache]
$creadListPrec :: ReadPrec [ResetDistributionCache]
readPrec :: ReadPrec ResetDistributionCache
$creadPrec :: ReadPrec ResetDistributionCache
readList :: ReadS [ResetDistributionCache]
$creadList :: ReadS [ResetDistributionCache]
readsPrec :: Int -> ReadS ResetDistributionCache
$creadsPrec :: Int -> ReadS ResetDistributionCache
Prelude.Read, Int -> ResetDistributionCache -> ShowS
[ResetDistributionCache] -> ShowS
ResetDistributionCache -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResetDistributionCache] -> ShowS
$cshowList :: [ResetDistributionCache] -> ShowS
show :: ResetDistributionCache -> String
$cshow :: ResetDistributionCache -> String
showsPrec :: Int -> ResetDistributionCache -> ShowS
$cshowsPrec :: Int -> ResetDistributionCache -> ShowS
Prelude.Show, forall x. Rep ResetDistributionCache x -> ResetDistributionCache
forall x. ResetDistributionCache -> Rep ResetDistributionCache x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ResetDistributionCache x -> ResetDistributionCache
$cfrom :: forall x. ResetDistributionCache -> Rep ResetDistributionCache x
Prelude.Generic)

-- |
-- Create a value of 'ResetDistributionCache' 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', 'resetDistributionCache_distributionName' - The name of the distribution for which to reset cache.
--
-- Use the @GetDistributions@ action to get a list of distribution names
-- that you can specify.
newResetDistributionCache ::
  ResetDistributionCache
newResetDistributionCache :: ResetDistributionCache
newResetDistributionCache =
  ResetDistributionCache'
    { $sel:distributionName:ResetDistributionCache' :: Maybe Text
distributionName =
        forall a. Maybe a
Prelude.Nothing
    }

-- | The name of the distribution for which to reset cache.
--
-- Use the @GetDistributions@ action to get a list of distribution names
-- that you can specify.
resetDistributionCache_distributionName :: Lens.Lens' ResetDistributionCache (Prelude.Maybe Prelude.Text)
resetDistributionCache_distributionName :: Lens' ResetDistributionCache (Maybe Text)
resetDistributionCache_distributionName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResetDistributionCache' {Maybe Text
distributionName :: Maybe Text
$sel:distributionName:ResetDistributionCache' :: ResetDistributionCache -> Maybe Text
distributionName} -> Maybe Text
distributionName) (\s :: ResetDistributionCache
s@ResetDistributionCache' {} Maybe Text
a -> ResetDistributionCache
s {$sel:distributionName:ResetDistributionCache' :: Maybe Text
distributionName = Maybe Text
a} :: ResetDistributionCache)

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

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

instance Data.ToHeaders ResetDistributionCache where
  toHeaders :: ResetDistributionCache -> 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.ResetDistributionCache" ::
                          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 ResetDistributionCache where
  toJSON :: ResetDistributionCache -> Value
toJSON ResetDistributionCache' {Maybe Text
distributionName :: Maybe Text
$sel:distributionName:ResetDistributionCache' :: ResetDistributionCache -> 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 ResetDistributionCache where
  toPath :: ResetDistributionCache -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newResetDistributionCacheResponse' smart constructor.
data ResetDistributionCacheResponse = ResetDistributionCacheResponse'
  { -- | The timestamp of the reset cache request (e.g., @1479734909.17@) in Unix
    -- time format.
    ResetDistributionCacheResponse -> Maybe POSIX
createTime :: Prelude.Maybe Data.POSIX,
    -- | An array of objects that describe the result of the action, such as the
    -- status of the request, the timestamp of the request, and the resources
    -- affected by the request.
    ResetDistributionCacheResponse -> Maybe Operation
operation :: Prelude.Maybe Operation,
    -- | The status of the reset cache request.
    ResetDistributionCacheResponse -> Maybe Text
status :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ResetDistributionCacheResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ResetDistributionCacheResponse
-> ResetDistributionCacheResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResetDistributionCacheResponse
-> ResetDistributionCacheResponse -> Bool
$c/= :: ResetDistributionCacheResponse
-> ResetDistributionCacheResponse -> Bool
== :: ResetDistributionCacheResponse
-> ResetDistributionCacheResponse -> Bool
$c== :: ResetDistributionCacheResponse
-> ResetDistributionCacheResponse -> Bool
Prelude.Eq, ReadPrec [ResetDistributionCacheResponse]
ReadPrec ResetDistributionCacheResponse
Int -> ReadS ResetDistributionCacheResponse
ReadS [ResetDistributionCacheResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ResetDistributionCacheResponse]
$creadListPrec :: ReadPrec [ResetDistributionCacheResponse]
readPrec :: ReadPrec ResetDistributionCacheResponse
$creadPrec :: ReadPrec ResetDistributionCacheResponse
readList :: ReadS [ResetDistributionCacheResponse]
$creadList :: ReadS [ResetDistributionCacheResponse]
readsPrec :: Int -> ReadS ResetDistributionCacheResponse
$creadsPrec :: Int -> ReadS ResetDistributionCacheResponse
Prelude.Read, Int -> ResetDistributionCacheResponse -> ShowS
[ResetDistributionCacheResponse] -> ShowS
ResetDistributionCacheResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResetDistributionCacheResponse] -> ShowS
$cshowList :: [ResetDistributionCacheResponse] -> ShowS
show :: ResetDistributionCacheResponse -> String
$cshow :: ResetDistributionCacheResponse -> String
showsPrec :: Int -> ResetDistributionCacheResponse -> ShowS
$cshowsPrec :: Int -> ResetDistributionCacheResponse -> ShowS
Prelude.Show, forall x.
Rep ResetDistributionCacheResponse x
-> ResetDistributionCacheResponse
forall x.
ResetDistributionCacheResponse
-> Rep ResetDistributionCacheResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ResetDistributionCacheResponse x
-> ResetDistributionCacheResponse
$cfrom :: forall x.
ResetDistributionCacheResponse
-> Rep ResetDistributionCacheResponse x
Prelude.Generic)

-- |
-- Create a value of 'ResetDistributionCacheResponse' 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', 'resetDistributionCacheResponse_createTime' - The timestamp of the reset cache request (e.g., @1479734909.17@) in Unix
-- time format.
--
-- 'operation', 'resetDistributionCacheResponse_operation' - An array of objects that describe the result of the action, such as the
-- status of the request, the timestamp of the request, and the resources
-- affected by the request.
--
-- 'status', 'resetDistributionCacheResponse_status' - The status of the reset cache request.
--
-- 'httpStatus', 'resetDistributionCacheResponse_httpStatus' - The response's http status code.
newResetDistributionCacheResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ResetDistributionCacheResponse
newResetDistributionCacheResponse :: Int -> ResetDistributionCacheResponse
newResetDistributionCacheResponse Int
pHttpStatus_ =
  ResetDistributionCacheResponse'
    { $sel:createTime:ResetDistributionCacheResponse' :: Maybe POSIX
createTime =
        forall a. Maybe a
Prelude.Nothing,
      $sel:operation:ResetDistributionCacheResponse' :: Maybe Operation
operation = forall a. Maybe a
Prelude.Nothing,
      $sel:status:ResetDistributionCacheResponse' :: Maybe Text
status = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ResetDistributionCacheResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

-- | An array of objects that describe the result of the action, such as the
-- status of the request, the timestamp of the request, and the resources
-- affected by the request.
resetDistributionCacheResponse_operation :: Lens.Lens' ResetDistributionCacheResponse (Prelude.Maybe Operation)
resetDistributionCacheResponse_operation :: Lens' ResetDistributionCacheResponse (Maybe Operation)
resetDistributionCacheResponse_operation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResetDistributionCacheResponse' {Maybe Operation
operation :: Maybe Operation
$sel:operation:ResetDistributionCacheResponse' :: ResetDistributionCacheResponse -> Maybe Operation
operation} -> Maybe Operation
operation) (\s :: ResetDistributionCacheResponse
s@ResetDistributionCacheResponse' {} Maybe Operation
a -> ResetDistributionCacheResponse
s {$sel:operation:ResetDistributionCacheResponse' :: Maybe Operation
operation = Maybe Operation
a} :: ResetDistributionCacheResponse)

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

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

instance
  Prelude.NFData
    ResetDistributionCacheResponse
  where
  rnf :: ResetDistributionCacheResponse -> ()
rnf ResetDistributionCacheResponse' {Int
Maybe Text
Maybe POSIX
Maybe Operation
httpStatus :: Int
status :: Maybe Text
operation :: Maybe Operation
createTime :: Maybe POSIX
$sel:httpStatus:ResetDistributionCacheResponse' :: ResetDistributionCacheResponse -> Int
$sel:status:ResetDistributionCacheResponse' :: ResetDistributionCacheResponse -> Maybe Text
$sel:operation:ResetDistributionCacheResponse' :: ResetDistributionCacheResponse -> Maybe Operation
$sel:createTime:ResetDistributionCacheResponse' :: ResetDistributionCacheResponse -> 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 Operation
operation
      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