{-# 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.GetTest
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets information about a test.
module Amazonka.DeviceFarm.GetTest
  ( -- * Creating a Request
    GetTest (..),
    newGetTest,

    -- * Request Lenses
    getTest_arn,

    -- * Destructuring the Response
    GetTestResponse (..),
    newGetTestResponse,

    -- * Response Lenses
    getTestResponse_test,
    getTestResponse_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

-- | Represents a request to the get test operation.
--
-- /See:/ 'newGetTest' smart constructor.
data GetTest = GetTest'
  { -- | The test\'s ARN.
    GetTest -> Text
arn :: Prelude.Text
  }
  deriving (GetTest -> GetTest -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetTest -> GetTest -> Bool
$c/= :: GetTest -> GetTest -> Bool
== :: GetTest -> GetTest -> Bool
$c== :: GetTest -> GetTest -> Bool
Prelude.Eq, ReadPrec [GetTest]
ReadPrec GetTest
Int -> ReadS GetTest
ReadS [GetTest]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetTest]
$creadListPrec :: ReadPrec [GetTest]
readPrec :: ReadPrec GetTest
$creadPrec :: ReadPrec GetTest
readList :: ReadS [GetTest]
$creadList :: ReadS [GetTest]
readsPrec :: Int -> ReadS GetTest
$creadsPrec :: Int -> ReadS GetTest
Prelude.Read, Int -> GetTest -> ShowS
[GetTest] -> ShowS
GetTest -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetTest] -> ShowS
$cshowList :: [GetTest] -> ShowS
show :: GetTest -> String
$cshow :: GetTest -> String
showsPrec :: Int -> GetTest -> ShowS
$cshowsPrec :: Int -> GetTest -> ShowS
Prelude.Show, forall x. Rep GetTest x -> GetTest
forall x. GetTest -> Rep GetTest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetTest x -> GetTest
$cfrom :: forall x. GetTest -> Rep GetTest x
Prelude.Generic)

-- |
-- Create a value of 'GetTest' 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:
--
-- 'arn', 'getTest_arn' - The test\'s ARN.
newGetTest ::
  -- | 'arn'
  Prelude.Text ->
  GetTest
newGetTest :: Text -> GetTest
newGetTest Text
pArn_ = GetTest' {$sel:arn:GetTest' :: Text
arn = Text
pArn_}

-- | The test\'s ARN.
getTest_arn :: Lens.Lens' GetTest Prelude.Text
getTest_arn :: Lens' GetTest Text
getTest_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTest' {Text
arn :: Text
$sel:arn:GetTest' :: GetTest -> Text
arn} -> Text
arn) (\s :: GetTest
s@GetTest' {} Text
a -> GetTest
s {$sel:arn:GetTest' :: Text
arn = Text
a} :: GetTest)

instance Core.AWSRequest GetTest where
  type AWSResponse GetTest = GetTestResponse
  request :: (Service -> Service) -> GetTest -> Request GetTest
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 GetTest
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetTest)))
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 Test -> Int -> GetTestResponse
GetTestResponse'
            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
"test")
            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 GetTest where
  hashWithSalt :: Int -> GetTest -> Int
hashWithSalt Int
_salt GetTest' {Text
arn :: Text
$sel:arn:GetTest' :: GetTest -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
arn

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

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

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

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

-- | Represents the result of a get test request.
--
-- /See:/ 'newGetTestResponse' smart constructor.
data GetTestResponse = GetTestResponse'
  { -- | A test condition that is evaluated.
    GetTestResponse -> Maybe Test
test :: Prelude.Maybe Test,
    -- | The response's http status code.
    GetTestResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetTestResponse -> GetTestResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetTestResponse -> GetTestResponse -> Bool
$c/= :: GetTestResponse -> GetTestResponse -> Bool
== :: GetTestResponse -> GetTestResponse -> Bool
$c== :: GetTestResponse -> GetTestResponse -> Bool
Prelude.Eq, ReadPrec [GetTestResponse]
ReadPrec GetTestResponse
Int -> ReadS GetTestResponse
ReadS [GetTestResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetTestResponse]
$creadListPrec :: ReadPrec [GetTestResponse]
readPrec :: ReadPrec GetTestResponse
$creadPrec :: ReadPrec GetTestResponse
readList :: ReadS [GetTestResponse]
$creadList :: ReadS [GetTestResponse]
readsPrec :: Int -> ReadS GetTestResponse
$creadsPrec :: Int -> ReadS GetTestResponse
Prelude.Read, Int -> GetTestResponse -> ShowS
[GetTestResponse] -> ShowS
GetTestResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetTestResponse] -> ShowS
$cshowList :: [GetTestResponse] -> ShowS
show :: GetTestResponse -> String
$cshow :: GetTestResponse -> String
showsPrec :: Int -> GetTestResponse -> ShowS
$cshowsPrec :: Int -> GetTestResponse -> ShowS
Prelude.Show, forall x. Rep GetTestResponse x -> GetTestResponse
forall x. GetTestResponse -> Rep GetTestResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetTestResponse x -> GetTestResponse
$cfrom :: forall x. GetTestResponse -> Rep GetTestResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetTestResponse' 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:
--
-- 'test', 'getTestResponse_test' - A test condition that is evaluated.
--
-- 'httpStatus', 'getTestResponse_httpStatus' - The response's http status code.
newGetTestResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetTestResponse
newGetTestResponse :: Int -> GetTestResponse
newGetTestResponse Int
pHttpStatus_ =
  GetTestResponse'
    { $sel:test:GetTestResponse' :: Maybe Test
test = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetTestResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A test condition that is evaluated.
getTestResponse_test :: Lens.Lens' GetTestResponse (Prelude.Maybe Test)
getTestResponse_test :: Lens' GetTestResponse (Maybe Test)
getTestResponse_test = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTestResponse' {Maybe Test
test :: Maybe Test
$sel:test:GetTestResponse' :: GetTestResponse -> Maybe Test
test} -> Maybe Test
test) (\s :: GetTestResponse
s@GetTestResponse' {} Maybe Test
a -> GetTestResponse
s {$sel:test:GetTestResponse' :: Maybe Test
test = Maybe Test
a} :: GetTestResponse)

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

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