{-# 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.DeviceFarm.GetTestGridSession
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- A session is an instance of a browser created through a
-- @RemoteWebDriver@ with the URL from CreateTestGridUrlResult$url. You can
-- use the following to look up sessions:
--
-- -   The session ARN (GetTestGridSessionRequest$sessionArn).
--
-- -   The project ARN and a session ID
--     (GetTestGridSessionRequest$projectArn and
--     GetTestGridSessionRequest$sessionId).
module Amazonka.DeviceFarm.GetTestGridSession
  ( -- * Creating a Request
    GetTestGridSession (..),
    newGetTestGridSession,

    -- * Request Lenses
    getTestGridSession_projectArn,
    getTestGridSession_sessionArn,
    getTestGridSession_sessionId,

    -- * Destructuring the Response
    GetTestGridSessionResponse (..),
    newGetTestGridSessionResponse,

    -- * Response Lenses
    getTestGridSessionResponse_testGridSession,
    getTestGridSessionResponse_httpStatus,
  )
where

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

-- | /See:/ 'newGetTestGridSession' smart constructor.
data GetTestGridSession = GetTestGridSession'
  { -- | The ARN for the project that this session belongs to. See
    -- CreateTestGridProject and ListTestGridProjects.
    GetTestGridSession -> Maybe Text
projectArn :: Prelude.Maybe Prelude.Text,
    -- | An ARN that uniquely identifies a TestGridSession.
    GetTestGridSession -> Maybe Text
sessionArn :: Prelude.Maybe Prelude.Text,
    -- | An ID associated with this session.
    GetTestGridSession -> Maybe Text
sessionId :: Prelude.Maybe Prelude.Text
  }
  deriving (GetTestGridSession -> GetTestGridSession -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetTestGridSession -> GetTestGridSession -> Bool
$c/= :: GetTestGridSession -> GetTestGridSession -> Bool
== :: GetTestGridSession -> GetTestGridSession -> Bool
$c== :: GetTestGridSession -> GetTestGridSession -> Bool
Prelude.Eq, ReadPrec [GetTestGridSession]
ReadPrec GetTestGridSession
Int -> ReadS GetTestGridSession
ReadS [GetTestGridSession]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetTestGridSession]
$creadListPrec :: ReadPrec [GetTestGridSession]
readPrec :: ReadPrec GetTestGridSession
$creadPrec :: ReadPrec GetTestGridSession
readList :: ReadS [GetTestGridSession]
$creadList :: ReadS [GetTestGridSession]
readsPrec :: Int -> ReadS GetTestGridSession
$creadsPrec :: Int -> ReadS GetTestGridSession
Prelude.Read, Int -> GetTestGridSession -> ShowS
[GetTestGridSession] -> ShowS
GetTestGridSession -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetTestGridSession] -> ShowS
$cshowList :: [GetTestGridSession] -> ShowS
show :: GetTestGridSession -> String
$cshow :: GetTestGridSession -> String
showsPrec :: Int -> GetTestGridSession -> ShowS
$cshowsPrec :: Int -> GetTestGridSession -> ShowS
Prelude.Show, forall x. Rep GetTestGridSession x -> GetTestGridSession
forall x. GetTestGridSession -> Rep GetTestGridSession x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetTestGridSession x -> GetTestGridSession
$cfrom :: forall x. GetTestGridSession -> Rep GetTestGridSession x
Prelude.Generic)

-- |
-- Create a value of 'GetTestGridSession' 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:
--
-- 'projectArn', 'getTestGridSession_projectArn' - The ARN for the project that this session belongs to. See
-- CreateTestGridProject and ListTestGridProjects.
--
-- 'sessionArn', 'getTestGridSession_sessionArn' - An ARN that uniquely identifies a TestGridSession.
--
-- 'sessionId', 'getTestGridSession_sessionId' - An ID associated with this session.
newGetTestGridSession ::
  GetTestGridSession
newGetTestGridSession :: GetTestGridSession
newGetTestGridSession =
  GetTestGridSession'
    { $sel:projectArn:GetTestGridSession' :: Maybe Text
projectArn = forall a. Maybe a
Prelude.Nothing,
      $sel:sessionArn:GetTestGridSession' :: Maybe Text
sessionArn = forall a. Maybe a
Prelude.Nothing,
      $sel:sessionId:GetTestGridSession' :: Maybe Text
sessionId = forall a. Maybe a
Prelude.Nothing
    }

-- | The ARN for the project that this session belongs to. See
-- CreateTestGridProject and ListTestGridProjects.
getTestGridSession_projectArn :: Lens.Lens' GetTestGridSession (Prelude.Maybe Prelude.Text)
getTestGridSession_projectArn :: Lens' GetTestGridSession (Maybe Text)
getTestGridSession_projectArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTestGridSession' {Maybe Text
projectArn :: Maybe Text
$sel:projectArn:GetTestGridSession' :: GetTestGridSession -> Maybe Text
projectArn} -> Maybe Text
projectArn) (\s :: GetTestGridSession
s@GetTestGridSession' {} Maybe Text
a -> GetTestGridSession
s {$sel:projectArn:GetTestGridSession' :: Maybe Text
projectArn = Maybe Text
a} :: GetTestGridSession)

-- | An ARN that uniquely identifies a TestGridSession.
getTestGridSession_sessionArn :: Lens.Lens' GetTestGridSession (Prelude.Maybe Prelude.Text)
getTestGridSession_sessionArn :: Lens' GetTestGridSession (Maybe Text)
getTestGridSession_sessionArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTestGridSession' {Maybe Text
sessionArn :: Maybe Text
$sel:sessionArn:GetTestGridSession' :: GetTestGridSession -> Maybe Text
sessionArn} -> Maybe Text
sessionArn) (\s :: GetTestGridSession
s@GetTestGridSession' {} Maybe Text
a -> GetTestGridSession
s {$sel:sessionArn:GetTestGridSession' :: Maybe Text
sessionArn = Maybe Text
a} :: GetTestGridSession)

-- | An ID associated with this session.
getTestGridSession_sessionId :: Lens.Lens' GetTestGridSession (Prelude.Maybe Prelude.Text)
getTestGridSession_sessionId :: Lens' GetTestGridSession (Maybe Text)
getTestGridSession_sessionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTestGridSession' {Maybe Text
sessionId :: Maybe Text
$sel:sessionId:GetTestGridSession' :: GetTestGridSession -> Maybe Text
sessionId} -> Maybe Text
sessionId) (\s :: GetTestGridSession
s@GetTestGridSession' {} Maybe Text
a -> GetTestGridSession
s {$sel:sessionId:GetTestGridSession' :: Maybe Text
sessionId = Maybe Text
a} :: GetTestGridSession)

instance Core.AWSRequest GetTestGridSession where
  type
    AWSResponse GetTestGridSession =
      GetTestGridSessionResponse
  request :: (Service -> Service)
-> GetTestGridSession -> Request GetTestGridSession
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 GetTestGridSession
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetTestGridSession)))
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 TestGridSession -> Int -> GetTestGridSessionResponse
GetTestGridSessionResponse'
            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
"testGridSession")
            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 GetTestGridSession where
  hashWithSalt :: Int -> GetTestGridSession -> Int
hashWithSalt Int
_salt GetTestGridSession' {Maybe Text
sessionId :: Maybe Text
sessionArn :: Maybe Text
projectArn :: Maybe Text
$sel:sessionId:GetTestGridSession' :: GetTestGridSession -> Maybe Text
$sel:sessionArn:GetTestGridSession' :: GetTestGridSession -> Maybe Text
$sel:projectArn:GetTestGridSession' :: GetTestGridSession -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
projectArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
sessionArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
sessionId

instance Prelude.NFData GetTestGridSession where
  rnf :: GetTestGridSession -> ()
rnf GetTestGridSession' {Maybe Text
sessionId :: Maybe Text
sessionArn :: Maybe Text
projectArn :: Maybe Text
$sel:sessionId:GetTestGridSession' :: GetTestGridSession -> Maybe Text
$sel:sessionArn:GetTestGridSession' :: GetTestGridSession -> Maybe Text
$sel:projectArn:GetTestGridSession' :: GetTestGridSession -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
projectArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sessionArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sessionId

instance Data.ToHeaders GetTestGridSession where
  toHeaders :: GetTestGridSession -> 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
"DeviceFarm_20150623.GetTestGridSession" ::
                          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 GetTestGridSession where
  toJSON :: GetTestGridSession -> Value
toJSON GetTestGridSession' {Maybe Text
sessionId :: Maybe Text
sessionArn :: Maybe Text
projectArn :: Maybe Text
$sel:sessionId:GetTestGridSession' :: GetTestGridSession -> Maybe Text
$sel:sessionArn:GetTestGridSession' :: GetTestGridSession -> Maybe Text
$sel:projectArn:GetTestGridSession' :: GetTestGridSession -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"projectArn" 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 Text
projectArn,
            (Key
"sessionArn" 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 Text
sessionArn,
            (Key
"sessionId" 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 Text
sessionId
          ]
      )

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

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

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

-- |
-- Create a value of 'GetTestGridSessionResponse' 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:
--
-- 'testGridSession', 'getTestGridSessionResponse_testGridSession' - The TestGridSession that was requested.
--
-- 'httpStatus', 'getTestGridSessionResponse_httpStatus' - The response's http status code.
newGetTestGridSessionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetTestGridSessionResponse
newGetTestGridSessionResponse :: Int -> GetTestGridSessionResponse
newGetTestGridSessionResponse Int
pHttpStatus_ =
  GetTestGridSessionResponse'
    { $sel:testGridSession:GetTestGridSessionResponse' :: Maybe TestGridSession
testGridSession =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetTestGridSessionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The TestGridSession that was requested.
getTestGridSessionResponse_testGridSession :: Lens.Lens' GetTestGridSessionResponse (Prelude.Maybe TestGridSession)
getTestGridSessionResponse_testGridSession :: Lens' GetTestGridSessionResponse (Maybe TestGridSession)
getTestGridSessionResponse_testGridSession = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTestGridSessionResponse' {Maybe TestGridSession
testGridSession :: Maybe TestGridSession
$sel:testGridSession:GetTestGridSessionResponse' :: GetTestGridSessionResponse -> Maybe TestGridSession
testGridSession} -> Maybe TestGridSession
testGridSession) (\s :: GetTestGridSessionResponse
s@GetTestGridSessionResponse' {} Maybe TestGridSession
a -> GetTestGridSessionResponse
s {$sel:testGridSession:GetTestGridSessionResponse' :: Maybe TestGridSession
testGridSession = Maybe TestGridSession
a} :: GetTestGridSessionResponse)

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

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