{-# 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.AppStream.ExpireSession
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Immediately stops the specified streaming session.
module Amazonka.AppStream.ExpireSession
  ( -- * Creating a Request
    ExpireSession (..),
    newExpireSession,

    -- * Request Lenses
    expireSession_sessionId,

    -- * Destructuring the Response
    ExpireSessionResponse (..),
    newExpireSessionResponse,

    -- * Response Lenses
    expireSessionResponse_httpStatus,
  )
where

import Amazonka.AppStream.Types
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

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

-- |
-- Create a value of 'ExpireSession' 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:
--
-- 'sessionId', 'expireSession_sessionId' - The identifier of the streaming session.
newExpireSession ::
  -- | 'sessionId'
  Prelude.Text ->
  ExpireSession
newExpireSession :: Text -> ExpireSession
newExpireSession Text
pSessionId_ =
  ExpireSession' {$sel:sessionId:ExpireSession' :: Text
sessionId = Text
pSessionId_}

-- | The identifier of the streaming session.
expireSession_sessionId :: Lens.Lens' ExpireSession Prelude.Text
expireSession_sessionId :: Lens' ExpireSession Text
expireSession_sessionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExpireSession' {Text
sessionId :: Text
$sel:sessionId:ExpireSession' :: ExpireSession -> Text
sessionId} -> Text
sessionId) (\s :: ExpireSession
s@ExpireSession' {} Text
a -> ExpireSession
s {$sel:sessionId:ExpireSession' :: Text
sessionId = Text
a} :: ExpireSession)

instance Core.AWSRequest ExpireSession where
  type
    AWSResponse ExpireSession =
      ExpireSessionResponse
  request :: (Service -> Service) -> ExpireSession -> Request ExpireSession
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 ExpireSession
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ExpireSession)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> ExpireSessionResponse
ExpireSessionResponse'
            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))
      )

instance Prelude.Hashable ExpireSession where
  hashWithSalt :: Int -> ExpireSession -> Int
hashWithSalt Int
_salt ExpireSession' {Text
sessionId :: Text
$sel:sessionId:ExpireSession' :: ExpireSession -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
sessionId

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

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

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

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

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

-- |
-- Create a value of 'ExpireSessionResponse' 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', 'expireSessionResponse_httpStatus' - The response's http status code.
newExpireSessionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ExpireSessionResponse
newExpireSessionResponse :: Int -> ExpireSessionResponse
newExpireSessionResponse Int
pHttpStatus_ =
  ExpireSessionResponse' {$sel:httpStatus:ExpireSessionResponse' :: Int
httpStatus = Int
pHttpStatus_}

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

instance Prelude.NFData ExpireSessionResponse where
  rnf :: ExpireSessionResponse -> ()
rnf ExpireSessionResponse' {Int
httpStatus :: Int
$sel:httpStatus:ExpireSessionResponse' :: ExpireSessionResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus