{-# 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.AttachDisk
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Attaches a block storage disk to a running or stopped Lightsail instance
-- and exposes it to the instance with the specified disk name.
--
-- The @attach disk@ operation supports tag-based access control via
-- resource tags applied to the resource identified by @disk name@. For
-- more information, see the
-- <https://lightsail.aws.amazon.com/ls/docs/en_us/articles/amazon-lightsail-controlling-access-using-tags Amazon Lightsail Developer Guide>.
module Amazonka.Lightsail.AttachDisk
  ( -- * Creating a Request
    AttachDisk (..),
    newAttachDisk,

    -- * Request Lenses
    attachDisk_diskName,
    attachDisk_instanceName,
    attachDisk_diskPath,

    -- * Destructuring the Response
    AttachDiskResponse (..),
    newAttachDiskResponse,

    -- * Response Lenses
    attachDiskResponse_operations,
    attachDiskResponse_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:/ 'newAttachDisk' smart constructor.
data AttachDisk = AttachDisk'
  { -- | The unique Lightsail disk name (e.g., @my-disk@).
    AttachDisk -> Text
diskName :: Prelude.Text,
    -- | The name of the Lightsail instance where you want to utilize the storage
    -- disk.
    AttachDisk -> Text
instanceName :: Prelude.Text,
    -- | The disk path to expose to the instance (e.g., @\/dev\/xvdf@).
    AttachDisk -> Text
diskPath :: Prelude.Text
  }
  deriving (AttachDisk -> AttachDisk -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttachDisk -> AttachDisk -> Bool
$c/= :: AttachDisk -> AttachDisk -> Bool
== :: AttachDisk -> AttachDisk -> Bool
$c== :: AttachDisk -> AttachDisk -> Bool
Prelude.Eq, ReadPrec [AttachDisk]
ReadPrec AttachDisk
Int -> ReadS AttachDisk
ReadS [AttachDisk]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AttachDisk]
$creadListPrec :: ReadPrec [AttachDisk]
readPrec :: ReadPrec AttachDisk
$creadPrec :: ReadPrec AttachDisk
readList :: ReadS [AttachDisk]
$creadList :: ReadS [AttachDisk]
readsPrec :: Int -> ReadS AttachDisk
$creadsPrec :: Int -> ReadS AttachDisk
Prelude.Read, Int -> AttachDisk -> ShowS
[AttachDisk] -> ShowS
AttachDisk -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttachDisk] -> ShowS
$cshowList :: [AttachDisk] -> ShowS
show :: AttachDisk -> String
$cshow :: AttachDisk -> String
showsPrec :: Int -> AttachDisk -> ShowS
$cshowsPrec :: Int -> AttachDisk -> ShowS
Prelude.Show, forall x. Rep AttachDisk x -> AttachDisk
forall x. AttachDisk -> Rep AttachDisk x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AttachDisk x -> AttachDisk
$cfrom :: forall x. AttachDisk -> Rep AttachDisk x
Prelude.Generic)

-- |
-- Create a value of 'AttachDisk' 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:
--
-- 'diskName', 'attachDisk_diskName' - The unique Lightsail disk name (e.g., @my-disk@).
--
-- 'instanceName', 'attachDisk_instanceName' - The name of the Lightsail instance where you want to utilize the storage
-- disk.
--
-- 'diskPath', 'attachDisk_diskPath' - The disk path to expose to the instance (e.g., @\/dev\/xvdf@).
newAttachDisk ::
  -- | 'diskName'
  Prelude.Text ->
  -- | 'instanceName'
  Prelude.Text ->
  -- | 'diskPath'
  Prelude.Text ->
  AttachDisk
newAttachDisk :: Text -> Text -> Text -> AttachDisk
newAttachDisk Text
pDiskName_ Text
pInstanceName_ Text
pDiskPath_ =
  AttachDisk'
    { $sel:diskName:AttachDisk' :: Text
diskName = Text
pDiskName_,
      $sel:instanceName:AttachDisk' :: Text
instanceName = Text
pInstanceName_,
      $sel:diskPath:AttachDisk' :: Text
diskPath = Text
pDiskPath_
    }

-- | The unique Lightsail disk name (e.g., @my-disk@).
attachDisk_diskName :: Lens.Lens' AttachDisk Prelude.Text
attachDisk_diskName :: Lens' AttachDisk Text
attachDisk_diskName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AttachDisk' {Text
diskName :: Text
$sel:diskName:AttachDisk' :: AttachDisk -> Text
diskName} -> Text
diskName) (\s :: AttachDisk
s@AttachDisk' {} Text
a -> AttachDisk
s {$sel:diskName:AttachDisk' :: Text
diskName = Text
a} :: AttachDisk)

-- | The name of the Lightsail instance where you want to utilize the storage
-- disk.
attachDisk_instanceName :: Lens.Lens' AttachDisk Prelude.Text
attachDisk_instanceName :: Lens' AttachDisk Text
attachDisk_instanceName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AttachDisk' {Text
instanceName :: Text
$sel:instanceName:AttachDisk' :: AttachDisk -> Text
instanceName} -> Text
instanceName) (\s :: AttachDisk
s@AttachDisk' {} Text
a -> AttachDisk
s {$sel:instanceName:AttachDisk' :: Text
instanceName = Text
a} :: AttachDisk)

-- | The disk path to expose to the instance (e.g., @\/dev\/xvdf@).
attachDisk_diskPath :: Lens.Lens' AttachDisk Prelude.Text
attachDisk_diskPath :: Lens' AttachDisk Text
attachDisk_diskPath = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AttachDisk' {Text
diskPath :: Text
$sel:diskPath:AttachDisk' :: AttachDisk -> Text
diskPath} -> Text
diskPath) (\s :: AttachDisk
s@AttachDisk' {} Text
a -> AttachDisk
s {$sel:diskPath:AttachDisk' :: Text
diskPath = Text
a} :: AttachDisk)

instance Core.AWSRequest AttachDisk where
  type AWSResponse AttachDisk = AttachDiskResponse
  request :: (Service -> Service) -> AttachDisk -> Request AttachDisk
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 AttachDisk
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse AttachDisk)))
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 [Operation] -> Int -> AttachDiskResponse
AttachDiskResponse'
            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
"operations" 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 AttachDisk where
  hashWithSalt :: Int -> AttachDisk -> Int
hashWithSalt Int
_salt AttachDisk' {Text
diskPath :: Text
instanceName :: Text
diskName :: Text
$sel:diskPath:AttachDisk' :: AttachDisk -> Text
$sel:instanceName:AttachDisk' :: AttachDisk -> Text
$sel:diskName:AttachDisk' :: AttachDisk -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
diskName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
instanceName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
diskPath

instance Prelude.NFData AttachDisk where
  rnf :: AttachDisk -> ()
rnf AttachDisk' {Text
diskPath :: Text
instanceName :: Text
diskName :: Text
$sel:diskPath:AttachDisk' :: AttachDisk -> Text
$sel:instanceName:AttachDisk' :: AttachDisk -> Text
$sel:diskName:AttachDisk' :: AttachDisk -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
diskName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
instanceName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
diskPath

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

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

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

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

-- |
-- Create a value of 'AttachDiskResponse' 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:
--
-- 'operations', 'attachDiskResponse_operations' - 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.
--
-- 'httpStatus', 'attachDiskResponse_httpStatus' - The response's http status code.
newAttachDiskResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AttachDiskResponse
newAttachDiskResponse :: Int -> AttachDiskResponse
newAttachDiskResponse Int
pHttpStatus_ =
  AttachDiskResponse'
    { $sel:operations:AttachDiskResponse' :: Maybe [Operation]
operations = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:AttachDiskResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | 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.
attachDiskResponse_operations :: Lens.Lens' AttachDiskResponse (Prelude.Maybe [Operation])
attachDiskResponse_operations :: Lens' AttachDiskResponse (Maybe [Operation])
attachDiskResponse_operations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AttachDiskResponse' {Maybe [Operation]
operations :: Maybe [Operation]
$sel:operations:AttachDiskResponse' :: AttachDiskResponse -> Maybe [Operation]
operations} -> Maybe [Operation]
operations) (\s :: AttachDiskResponse
s@AttachDiskResponse' {} Maybe [Operation]
a -> AttachDiskResponse
s {$sel:operations:AttachDiskResponse' :: Maybe [Operation]
operations = Maybe [Operation]
a} :: AttachDiskResponse) 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.
attachDiskResponse_httpStatus :: Lens.Lens' AttachDiskResponse Prelude.Int
attachDiskResponse_httpStatus :: Lens' AttachDiskResponse Int
attachDiskResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AttachDiskResponse' {Int
httpStatus :: Int
$sel:httpStatus:AttachDiskResponse' :: AttachDiskResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: AttachDiskResponse
s@AttachDiskResponse' {} Int
a -> AttachDiskResponse
s {$sel:httpStatus:AttachDiskResponse' :: Int
httpStatus = Int
a} :: AttachDiskResponse)

instance Prelude.NFData AttachDiskResponse where
  rnf :: AttachDiskResponse -> ()
rnf AttachDiskResponse' {Int
Maybe [Operation]
httpStatus :: Int
operations :: Maybe [Operation]
$sel:httpStatus:AttachDiskResponse' :: AttachDiskResponse -> Int
$sel:operations:AttachDiskResponse' :: AttachDiskResponse -> Maybe [Operation]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Operation]
operations
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus