{-# 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.OpsWorks.GrantAccess
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- This action can be used only with Windows stacks.
--
-- Grants RDP access to a Windows instance for a specified time period.
module Amazonka.OpsWorks.GrantAccess
  ( -- * Creating a Request
    GrantAccess (..),
    newGrantAccess,

    -- * Request Lenses
    grantAccess_validForInMinutes,
    grantAccess_instanceId,

    -- * Destructuring the Response
    GrantAccessResponse (..),
    newGrantAccessResponse,

    -- * Response Lenses
    grantAccessResponse_temporaryCredential,
    grantAccessResponse_httpStatus,
  )
where

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

-- | /See:/ 'newGrantAccess' smart constructor.
data GrantAccess = GrantAccess'
  { -- | The length of time (in minutes) that the grant is valid. When the grant
    -- expires at the end of this period, the user will no longer be able to
    -- use the credentials to log in. If the user is logged in at the time, he
    -- or she automatically will be logged out.
    GrantAccess -> Maybe Natural
validForInMinutes :: Prelude.Maybe Prelude.Natural,
    -- | The instance\'s AWS OpsWorks Stacks ID.
    GrantAccess -> Text
instanceId :: Prelude.Text
  }
  deriving (GrantAccess -> GrantAccess -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GrantAccess -> GrantAccess -> Bool
$c/= :: GrantAccess -> GrantAccess -> Bool
== :: GrantAccess -> GrantAccess -> Bool
$c== :: GrantAccess -> GrantAccess -> Bool
Prelude.Eq, ReadPrec [GrantAccess]
ReadPrec GrantAccess
Int -> ReadS GrantAccess
ReadS [GrantAccess]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GrantAccess]
$creadListPrec :: ReadPrec [GrantAccess]
readPrec :: ReadPrec GrantAccess
$creadPrec :: ReadPrec GrantAccess
readList :: ReadS [GrantAccess]
$creadList :: ReadS [GrantAccess]
readsPrec :: Int -> ReadS GrantAccess
$creadsPrec :: Int -> ReadS GrantAccess
Prelude.Read, Int -> GrantAccess -> ShowS
[GrantAccess] -> ShowS
GrantAccess -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GrantAccess] -> ShowS
$cshowList :: [GrantAccess] -> ShowS
show :: GrantAccess -> String
$cshow :: GrantAccess -> String
showsPrec :: Int -> GrantAccess -> ShowS
$cshowsPrec :: Int -> GrantAccess -> ShowS
Prelude.Show, forall x. Rep GrantAccess x -> GrantAccess
forall x. GrantAccess -> Rep GrantAccess x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GrantAccess x -> GrantAccess
$cfrom :: forall x. GrantAccess -> Rep GrantAccess x
Prelude.Generic)

-- |
-- Create a value of 'GrantAccess' 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:
--
-- 'validForInMinutes', 'grantAccess_validForInMinutes' - The length of time (in minutes) that the grant is valid. When the grant
-- expires at the end of this period, the user will no longer be able to
-- use the credentials to log in. If the user is logged in at the time, he
-- or she automatically will be logged out.
--
-- 'instanceId', 'grantAccess_instanceId' - The instance\'s AWS OpsWorks Stacks ID.
newGrantAccess ::
  -- | 'instanceId'
  Prelude.Text ->
  GrantAccess
newGrantAccess :: Text -> GrantAccess
newGrantAccess Text
pInstanceId_ =
  GrantAccess'
    { $sel:validForInMinutes:GrantAccess' :: Maybe Natural
validForInMinutes = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceId:GrantAccess' :: Text
instanceId = Text
pInstanceId_
    }

-- | The length of time (in minutes) that the grant is valid. When the grant
-- expires at the end of this period, the user will no longer be able to
-- use the credentials to log in. If the user is logged in at the time, he
-- or she automatically will be logged out.
grantAccess_validForInMinutes :: Lens.Lens' GrantAccess (Prelude.Maybe Prelude.Natural)
grantAccess_validForInMinutes :: Lens' GrantAccess (Maybe Natural)
grantAccess_validForInMinutes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GrantAccess' {Maybe Natural
validForInMinutes :: Maybe Natural
$sel:validForInMinutes:GrantAccess' :: GrantAccess -> Maybe Natural
validForInMinutes} -> Maybe Natural
validForInMinutes) (\s :: GrantAccess
s@GrantAccess' {} Maybe Natural
a -> GrantAccess
s {$sel:validForInMinutes:GrantAccess' :: Maybe Natural
validForInMinutes = Maybe Natural
a} :: GrantAccess)

-- | The instance\'s AWS OpsWorks Stacks ID.
grantAccess_instanceId :: Lens.Lens' GrantAccess Prelude.Text
grantAccess_instanceId :: Lens' GrantAccess Text
grantAccess_instanceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GrantAccess' {Text
instanceId :: Text
$sel:instanceId:GrantAccess' :: GrantAccess -> Text
instanceId} -> Text
instanceId) (\s :: GrantAccess
s@GrantAccess' {} Text
a -> GrantAccess
s {$sel:instanceId:GrantAccess' :: Text
instanceId = Text
a} :: GrantAccess)

instance Core.AWSRequest GrantAccess where
  type AWSResponse GrantAccess = GrantAccessResponse
  request :: (Service -> Service) -> GrantAccess -> Request GrantAccess
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 GrantAccess
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GrantAccess)))
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 TemporaryCredential -> Int -> GrantAccessResponse
GrantAccessResponse'
            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
"TemporaryCredential")
            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 GrantAccess where
  hashWithSalt :: Int -> GrantAccess -> Int
hashWithSalt Int
_salt GrantAccess' {Maybe Natural
Text
instanceId :: Text
validForInMinutes :: Maybe Natural
$sel:instanceId:GrantAccess' :: GrantAccess -> Text
$sel:validForInMinutes:GrantAccess' :: GrantAccess -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
validForInMinutes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
instanceId

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

instance Data.ToHeaders GrantAccess where
  toHeaders :: GrantAccess -> 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
"OpsWorks_20130218.GrantAccess" ::
                          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 GrantAccess where
  toJSON :: GrantAccess -> Value
toJSON GrantAccess' {Maybe Natural
Text
instanceId :: Text
validForInMinutes :: Maybe Natural
$sel:instanceId:GrantAccess' :: GrantAccess -> Text
$sel:validForInMinutes:GrantAccess' :: GrantAccess -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ValidForInMinutes" 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 Natural
validForInMinutes,
            forall a. a -> Maybe a
Prelude.Just (Key
"InstanceId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
instanceId)
          ]
      )

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

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

-- | Contains the response to a @GrantAccess@ request.
--
-- /See:/ 'newGrantAccessResponse' smart constructor.
data GrantAccessResponse = GrantAccessResponse'
  { -- | A @TemporaryCredential@ object that contains the data needed to log in
    -- to the instance by RDP clients, such as the Microsoft Remote Desktop
    -- Connection.
    GrantAccessResponse -> Maybe TemporaryCredential
temporaryCredential :: Prelude.Maybe TemporaryCredential,
    -- | The response's http status code.
    GrantAccessResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GrantAccessResponse -> GrantAccessResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GrantAccessResponse -> GrantAccessResponse -> Bool
$c/= :: GrantAccessResponse -> GrantAccessResponse -> Bool
== :: GrantAccessResponse -> GrantAccessResponse -> Bool
$c== :: GrantAccessResponse -> GrantAccessResponse -> Bool
Prelude.Eq, ReadPrec [GrantAccessResponse]
ReadPrec GrantAccessResponse
Int -> ReadS GrantAccessResponse
ReadS [GrantAccessResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GrantAccessResponse]
$creadListPrec :: ReadPrec [GrantAccessResponse]
readPrec :: ReadPrec GrantAccessResponse
$creadPrec :: ReadPrec GrantAccessResponse
readList :: ReadS [GrantAccessResponse]
$creadList :: ReadS [GrantAccessResponse]
readsPrec :: Int -> ReadS GrantAccessResponse
$creadsPrec :: Int -> ReadS GrantAccessResponse
Prelude.Read, Int -> GrantAccessResponse -> ShowS
[GrantAccessResponse] -> ShowS
GrantAccessResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GrantAccessResponse] -> ShowS
$cshowList :: [GrantAccessResponse] -> ShowS
show :: GrantAccessResponse -> String
$cshow :: GrantAccessResponse -> String
showsPrec :: Int -> GrantAccessResponse -> ShowS
$cshowsPrec :: Int -> GrantAccessResponse -> ShowS
Prelude.Show, forall x. Rep GrantAccessResponse x -> GrantAccessResponse
forall x. GrantAccessResponse -> Rep GrantAccessResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GrantAccessResponse x -> GrantAccessResponse
$cfrom :: forall x. GrantAccessResponse -> Rep GrantAccessResponse x
Prelude.Generic)

-- |
-- Create a value of 'GrantAccessResponse' 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:
--
-- 'temporaryCredential', 'grantAccessResponse_temporaryCredential' - A @TemporaryCredential@ object that contains the data needed to log in
-- to the instance by RDP clients, such as the Microsoft Remote Desktop
-- Connection.
--
-- 'httpStatus', 'grantAccessResponse_httpStatus' - The response's http status code.
newGrantAccessResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GrantAccessResponse
newGrantAccessResponse :: Int -> GrantAccessResponse
newGrantAccessResponse Int
pHttpStatus_ =
  GrantAccessResponse'
    { $sel:temporaryCredential:GrantAccessResponse' :: Maybe TemporaryCredential
temporaryCredential =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GrantAccessResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A @TemporaryCredential@ object that contains the data needed to log in
-- to the instance by RDP clients, such as the Microsoft Remote Desktop
-- Connection.
grantAccessResponse_temporaryCredential :: Lens.Lens' GrantAccessResponse (Prelude.Maybe TemporaryCredential)
grantAccessResponse_temporaryCredential :: Lens' GrantAccessResponse (Maybe TemporaryCredential)
grantAccessResponse_temporaryCredential = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GrantAccessResponse' {Maybe TemporaryCredential
temporaryCredential :: Maybe TemporaryCredential
$sel:temporaryCredential:GrantAccessResponse' :: GrantAccessResponse -> Maybe TemporaryCredential
temporaryCredential} -> Maybe TemporaryCredential
temporaryCredential) (\s :: GrantAccessResponse
s@GrantAccessResponse' {} Maybe TemporaryCredential
a -> GrantAccessResponse
s {$sel:temporaryCredential:GrantAccessResponse' :: Maybe TemporaryCredential
temporaryCredential = Maybe TemporaryCredential
a} :: GrantAccessResponse)

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

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