{-# 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.StorageGateway.ResetCache
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Resets all cache disks that have encountered an error and makes the
-- disks available for reconfiguration as cache storage. If your cache disk
-- encounters an error, the gateway prevents read and write operations on
-- virtual tapes in the gateway. For example, an error can occur when a
-- disk is corrupted or removed from the gateway. When a cache is reset,
-- the gateway loses its cache storage. At this point, you can reconfigure
-- the disks as cache disks. This operation is only supported in the cached
-- volume and tape types.
--
-- If the cache disk you are resetting contains data that has not been
-- uploaded to Amazon S3 yet, that data can be lost. After you reset cache
-- disks, there will be no configured cache disks left in the gateway, so
-- you must configure at least one new cache disk for your gateway to
-- function properly.
module Amazonka.StorageGateway.ResetCache
  ( -- * Creating a Request
    ResetCache (..),
    newResetCache,

    -- * Request Lenses
    resetCache_gatewayARN,

    -- * Destructuring the Response
    ResetCacheResponse (..),
    newResetCacheResponse,

    -- * Response Lenses
    resetCacheResponse_gatewayARN,
    resetCacheResponse_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.StorageGateway.Types

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

-- |
-- Create a value of 'ResetCache' 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:
--
-- 'gatewayARN', 'resetCache_gatewayARN' - Undocumented member.
newResetCache ::
  -- | 'gatewayARN'
  Prelude.Text ->
  ResetCache
newResetCache :: Text -> ResetCache
newResetCache Text
pGatewayARN_ =
  ResetCache' {$sel:gatewayARN:ResetCache' :: Text
gatewayARN = Text
pGatewayARN_}

-- | Undocumented member.
resetCache_gatewayARN :: Lens.Lens' ResetCache Prelude.Text
resetCache_gatewayARN :: Lens' ResetCache Text
resetCache_gatewayARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResetCache' {Text
gatewayARN :: Text
$sel:gatewayARN:ResetCache' :: ResetCache -> Text
gatewayARN} -> Text
gatewayARN) (\s :: ResetCache
s@ResetCache' {} Text
a -> ResetCache
s {$sel:gatewayARN:ResetCache' :: Text
gatewayARN = Text
a} :: ResetCache)

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

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

instance Data.ToHeaders ResetCache where
  toHeaders :: ResetCache -> 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
"StorageGateway_20130630.ResetCache" ::
                          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 ResetCache where
  toJSON :: ResetCache -> Value
toJSON ResetCache' {Text
gatewayARN :: Text
$sel:gatewayARN:ResetCache' :: ResetCache -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"GatewayARN" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
gatewayARN)]
      )

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

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

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

-- |
-- Create a value of 'ResetCacheResponse' 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:
--
-- 'gatewayARN', 'resetCacheResponse_gatewayARN' - Undocumented member.
--
-- 'httpStatus', 'resetCacheResponse_httpStatus' - The response's http status code.
newResetCacheResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ResetCacheResponse
newResetCacheResponse :: Int -> ResetCacheResponse
newResetCacheResponse Int
pHttpStatus_ =
  ResetCacheResponse'
    { $sel:gatewayARN:ResetCacheResponse' :: Maybe Text
gatewayARN = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ResetCacheResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
resetCacheResponse_gatewayARN :: Lens.Lens' ResetCacheResponse (Prelude.Maybe Prelude.Text)
resetCacheResponse_gatewayARN :: Lens' ResetCacheResponse (Maybe Text)
resetCacheResponse_gatewayARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResetCacheResponse' {Maybe Text
gatewayARN :: Maybe Text
$sel:gatewayARN:ResetCacheResponse' :: ResetCacheResponse -> Maybe Text
gatewayARN} -> Maybe Text
gatewayARN) (\s :: ResetCacheResponse
s@ResetCacheResponse' {} Maybe Text
a -> ResetCacheResponse
s {$sel:gatewayARN:ResetCacheResponse' :: Maybe Text
gatewayARN = Maybe Text
a} :: ResetCacheResponse)

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

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