{-# 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.EC2.GetPasswordData
-- 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 encrypted administrator password for a running Windows
-- instance.
--
-- The Windows password is generated at boot by the @EC2Config@ service or
-- @EC2Launch@ scripts (Windows Server 2016 and later). This usually only
-- happens the first time an instance is launched. For more information,
-- see
-- <https://docs.aws.amazon.com/AWSEC2/latest/WindowsGuide/UsingConfig_WinAMI.html EC2Config>
-- and
-- <https://docs.aws.amazon.com/AWSEC2/latest/WindowsGuide/ec2launch.html EC2Launch>
-- in the /Amazon EC2 User Guide/.
--
-- For the @EC2Config@ service, the password is not generated for rebundled
-- AMIs unless @Ec2SetPassword@ is enabled before bundling.
--
-- The password is encrypted using the key pair that you specified when you
-- launched the instance. You must provide the corresponding key pair file.
--
-- When you launch an instance, password generation and encryption may take
-- a few minutes. If you try to retrieve the password before it\'s
-- available, the output returns an empty string. We recommend that you
-- wait up to 15 minutes after launching an instance before trying to
-- retrieve the generated password.
module Amazonka.EC2.GetPasswordData
  ( -- * Creating a Request
    GetPasswordData (..),
    newGetPasswordData,

    -- * Request Lenses
    getPasswordData_dryRun,
    getPasswordData_instanceId,

    -- * Destructuring the Response
    GetPasswordDataResponse (..),
    newGetPasswordDataResponse,

    -- * Response Lenses
    getPasswordDataResponse_httpStatus,
    getPasswordDataResponse_instanceId,
    getPasswordDataResponse_passwordData,
    getPasswordDataResponse_timestamp,
  )
where

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

-- | /See:/ 'newGetPasswordData' smart constructor.
data GetPasswordData = GetPasswordData'
  { -- | Checks whether you have the required permissions for the action, without
    -- actually making the request, and provides an error response. If you have
    -- the required permissions, the error response is @DryRunOperation@.
    -- Otherwise, it is @UnauthorizedOperation@.
    GetPasswordData -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The ID of the Windows instance.
    GetPasswordData -> Text
instanceId :: Prelude.Text
  }
  deriving (GetPasswordData -> GetPasswordData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetPasswordData -> GetPasswordData -> Bool
$c/= :: GetPasswordData -> GetPasswordData -> Bool
== :: GetPasswordData -> GetPasswordData -> Bool
$c== :: GetPasswordData -> GetPasswordData -> Bool
Prelude.Eq, ReadPrec [GetPasswordData]
ReadPrec GetPasswordData
Int -> ReadS GetPasswordData
ReadS [GetPasswordData]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetPasswordData]
$creadListPrec :: ReadPrec [GetPasswordData]
readPrec :: ReadPrec GetPasswordData
$creadPrec :: ReadPrec GetPasswordData
readList :: ReadS [GetPasswordData]
$creadList :: ReadS [GetPasswordData]
readsPrec :: Int -> ReadS GetPasswordData
$creadsPrec :: Int -> ReadS GetPasswordData
Prelude.Read, Int -> GetPasswordData -> ShowS
[GetPasswordData] -> ShowS
GetPasswordData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetPasswordData] -> ShowS
$cshowList :: [GetPasswordData] -> ShowS
show :: GetPasswordData -> String
$cshow :: GetPasswordData -> String
showsPrec :: Int -> GetPasswordData -> ShowS
$cshowsPrec :: Int -> GetPasswordData -> ShowS
Prelude.Show, forall x. Rep GetPasswordData x -> GetPasswordData
forall x. GetPasswordData -> Rep GetPasswordData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetPasswordData x -> GetPasswordData
$cfrom :: forall x. GetPasswordData -> Rep GetPasswordData x
Prelude.Generic)

-- |
-- Create a value of 'GetPasswordData' 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:
--
-- 'dryRun', 'getPasswordData_dryRun' - Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
--
-- 'instanceId', 'getPasswordData_instanceId' - The ID of the Windows instance.
newGetPasswordData ::
  -- | 'instanceId'
  Prelude.Text ->
  GetPasswordData
newGetPasswordData :: Text -> GetPasswordData
newGetPasswordData Text
pInstanceId_ =
  GetPasswordData'
    { $sel:dryRun:GetPasswordData' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceId:GetPasswordData' :: Text
instanceId = Text
pInstanceId_
    }

-- | Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
getPasswordData_dryRun :: Lens.Lens' GetPasswordData (Prelude.Maybe Prelude.Bool)
getPasswordData_dryRun :: Lens' GetPasswordData (Maybe Bool)
getPasswordData_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPasswordData' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:GetPasswordData' :: GetPasswordData -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: GetPasswordData
s@GetPasswordData' {} Maybe Bool
a -> GetPasswordData
s {$sel:dryRun:GetPasswordData' :: Maybe Bool
dryRun = Maybe Bool
a} :: GetPasswordData)

-- | The ID of the Windows instance.
getPasswordData_instanceId :: Lens.Lens' GetPasswordData Prelude.Text
getPasswordData_instanceId :: Lens' GetPasswordData Text
getPasswordData_instanceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPasswordData' {Text
instanceId :: Text
$sel:instanceId:GetPasswordData' :: GetPasswordData -> Text
instanceId} -> Text
instanceId) (\s :: GetPasswordData
s@GetPasswordData' {} Text
a -> GetPasswordData
s {$sel:instanceId:GetPasswordData' :: Text
instanceId = Text
a} :: GetPasswordData)

instance Core.AWSRequest GetPasswordData where
  type
    AWSResponse GetPasswordData =
      GetPasswordDataResponse
  request :: (Service -> Service) -> GetPasswordData -> Request GetPasswordData
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetPasswordData
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetPasswordData)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXML
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Int -> Text -> Text -> ISO8601 -> GetPasswordDataResponse
GetPasswordDataResponse'
            forall (f :: * -> *) a b. Functor 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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"instanceId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"passwordData")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"timestamp")
      )

instance Prelude.Hashable GetPasswordData where
  hashWithSalt :: Int -> GetPasswordData -> Int
hashWithSalt Int
_salt GetPasswordData' {Maybe Bool
Text
instanceId :: Text
dryRun :: Maybe Bool
$sel:instanceId:GetPasswordData' :: GetPasswordData -> Text
$sel:dryRun:GetPasswordData' :: GetPasswordData -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
instanceId

instance Prelude.NFData GetPasswordData where
  rnf :: GetPasswordData -> ()
rnf GetPasswordData' {Maybe Bool
Text
instanceId :: Text
dryRun :: Maybe Bool
$sel:instanceId:GetPasswordData' :: GetPasswordData -> Text
$sel:dryRun:GetPasswordData' :: GetPasswordData -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
dryRun
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
instanceId

instance Data.ToHeaders GetPasswordData where
  toHeaders :: GetPasswordData -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery GetPasswordData where
  toQuery :: GetPasswordData -> QueryString
toQuery GetPasswordData' {Maybe Bool
Text
instanceId :: Text
dryRun :: Maybe Bool
$sel:instanceId:GetPasswordData' :: GetPasswordData -> Text
$sel:dryRun:GetPasswordData' :: GetPasswordData -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"GetPasswordData" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        ByteString
"InstanceId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
instanceId
      ]

-- | /See:/ 'newGetPasswordDataResponse' smart constructor.
data GetPasswordDataResponse = GetPasswordDataResponse'
  { -- | The response's http status code.
    GetPasswordDataResponse -> Int
httpStatus :: Prelude.Int,
    -- | The ID of the Windows instance.
    GetPasswordDataResponse -> Text
instanceId :: Prelude.Text,
    -- | The password of the instance. Returns an empty string if the password is
    -- not available.
    GetPasswordDataResponse -> Text
passwordData :: Prelude.Text,
    -- | The time the data was last updated.
    GetPasswordDataResponse -> ISO8601
timestamp :: Data.ISO8601
  }
  deriving (GetPasswordDataResponse -> GetPasswordDataResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetPasswordDataResponse -> GetPasswordDataResponse -> Bool
$c/= :: GetPasswordDataResponse -> GetPasswordDataResponse -> Bool
== :: GetPasswordDataResponse -> GetPasswordDataResponse -> Bool
$c== :: GetPasswordDataResponse -> GetPasswordDataResponse -> Bool
Prelude.Eq, ReadPrec [GetPasswordDataResponse]
ReadPrec GetPasswordDataResponse
Int -> ReadS GetPasswordDataResponse
ReadS [GetPasswordDataResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetPasswordDataResponse]
$creadListPrec :: ReadPrec [GetPasswordDataResponse]
readPrec :: ReadPrec GetPasswordDataResponse
$creadPrec :: ReadPrec GetPasswordDataResponse
readList :: ReadS [GetPasswordDataResponse]
$creadList :: ReadS [GetPasswordDataResponse]
readsPrec :: Int -> ReadS GetPasswordDataResponse
$creadsPrec :: Int -> ReadS GetPasswordDataResponse
Prelude.Read, Int -> GetPasswordDataResponse -> ShowS
[GetPasswordDataResponse] -> ShowS
GetPasswordDataResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetPasswordDataResponse] -> ShowS
$cshowList :: [GetPasswordDataResponse] -> ShowS
show :: GetPasswordDataResponse -> String
$cshow :: GetPasswordDataResponse -> String
showsPrec :: Int -> GetPasswordDataResponse -> ShowS
$cshowsPrec :: Int -> GetPasswordDataResponse -> ShowS
Prelude.Show, forall x. Rep GetPasswordDataResponse x -> GetPasswordDataResponse
forall x. GetPasswordDataResponse -> Rep GetPasswordDataResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetPasswordDataResponse x -> GetPasswordDataResponse
$cfrom :: forall x. GetPasswordDataResponse -> Rep GetPasswordDataResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetPasswordDataResponse' 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:
--
-- 'httpStatus', 'getPasswordDataResponse_httpStatus' - The response's http status code.
--
-- 'instanceId', 'getPasswordDataResponse_instanceId' - The ID of the Windows instance.
--
-- 'passwordData', 'getPasswordDataResponse_passwordData' - The password of the instance. Returns an empty string if the password is
-- not available.
--
-- 'timestamp', 'getPasswordDataResponse_timestamp' - The time the data was last updated.
newGetPasswordDataResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'instanceId'
  Prelude.Text ->
  -- | 'passwordData'
  Prelude.Text ->
  -- | 'timestamp'
  Prelude.UTCTime ->
  GetPasswordDataResponse
newGetPasswordDataResponse :: Int -> Text -> Text -> UTCTime -> GetPasswordDataResponse
newGetPasswordDataResponse
  Int
pHttpStatus_
  Text
pInstanceId_
  Text
pPasswordData_
  UTCTime
pTimestamp_ =
    GetPasswordDataResponse'
      { $sel:httpStatus:GetPasswordDataResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:instanceId:GetPasswordDataResponse' :: Text
instanceId = Text
pInstanceId_,
        $sel:passwordData:GetPasswordDataResponse' :: Text
passwordData = Text
pPasswordData_,
        $sel:timestamp:GetPasswordDataResponse' :: ISO8601
timestamp = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pTimestamp_
      }

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

-- | The ID of the Windows instance.
getPasswordDataResponse_instanceId :: Lens.Lens' GetPasswordDataResponse Prelude.Text
getPasswordDataResponse_instanceId :: Lens' GetPasswordDataResponse Text
getPasswordDataResponse_instanceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPasswordDataResponse' {Text
instanceId :: Text
$sel:instanceId:GetPasswordDataResponse' :: GetPasswordDataResponse -> Text
instanceId} -> Text
instanceId) (\s :: GetPasswordDataResponse
s@GetPasswordDataResponse' {} Text
a -> GetPasswordDataResponse
s {$sel:instanceId:GetPasswordDataResponse' :: Text
instanceId = Text
a} :: GetPasswordDataResponse)

-- | The password of the instance. Returns an empty string if the password is
-- not available.
getPasswordDataResponse_passwordData :: Lens.Lens' GetPasswordDataResponse Prelude.Text
getPasswordDataResponse_passwordData :: Lens' GetPasswordDataResponse Text
getPasswordDataResponse_passwordData = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPasswordDataResponse' {Text
passwordData :: Text
$sel:passwordData:GetPasswordDataResponse' :: GetPasswordDataResponse -> Text
passwordData} -> Text
passwordData) (\s :: GetPasswordDataResponse
s@GetPasswordDataResponse' {} Text
a -> GetPasswordDataResponse
s {$sel:passwordData:GetPasswordDataResponse' :: Text
passwordData = Text
a} :: GetPasswordDataResponse)

-- | The time the data was last updated.
getPasswordDataResponse_timestamp :: Lens.Lens' GetPasswordDataResponse Prelude.UTCTime
getPasswordDataResponse_timestamp :: Lens' GetPasswordDataResponse UTCTime
getPasswordDataResponse_timestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPasswordDataResponse' {ISO8601
timestamp :: ISO8601
$sel:timestamp:GetPasswordDataResponse' :: GetPasswordDataResponse -> ISO8601
timestamp} -> ISO8601
timestamp) (\s :: GetPasswordDataResponse
s@GetPasswordDataResponse' {} ISO8601
a -> GetPasswordDataResponse
s {$sel:timestamp:GetPasswordDataResponse' :: ISO8601
timestamp = ISO8601
a} :: GetPasswordDataResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

instance Prelude.NFData GetPasswordDataResponse where
  rnf :: GetPasswordDataResponse -> ()
rnf GetPasswordDataResponse' {Int
Text
ISO8601
timestamp :: ISO8601
passwordData :: Text
instanceId :: Text
httpStatus :: Int
$sel:timestamp:GetPasswordDataResponse' :: GetPasswordDataResponse -> ISO8601
$sel:passwordData:GetPasswordDataResponse' :: GetPasswordDataResponse -> Text
$sel:instanceId:GetPasswordDataResponse' :: GetPasswordDataResponse -> Text
$sel:httpStatus:GetPasswordDataResponse' :: GetPasswordDataResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
instanceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
passwordData
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ISO8601
timestamp