{-# 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.GetProject
-- 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 project.
module Amazonka.DeviceFarm.GetProject
  ( -- * Creating a Request
    GetProject (..),
    newGetProject,

    -- * Request Lenses
    getProject_arn,

    -- * Destructuring the Response
    GetProjectResponse (..),
    newGetProjectResponse,

    -- * Response Lenses
    getProjectResponse_project,
    getProjectResponse_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 project operation.
--
-- /See:/ 'newGetProject' smart constructor.
data GetProject = GetProject'
  { -- | The project\'s ARN.
    GetProject -> Text
arn :: Prelude.Text
  }
  deriving (GetProject -> GetProject -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetProject -> GetProject -> Bool
$c/= :: GetProject -> GetProject -> Bool
== :: GetProject -> GetProject -> Bool
$c== :: GetProject -> GetProject -> Bool
Prelude.Eq, ReadPrec [GetProject]
ReadPrec GetProject
Int -> ReadS GetProject
ReadS [GetProject]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetProject]
$creadListPrec :: ReadPrec [GetProject]
readPrec :: ReadPrec GetProject
$creadPrec :: ReadPrec GetProject
readList :: ReadS [GetProject]
$creadList :: ReadS [GetProject]
readsPrec :: Int -> ReadS GetProject
$creadsPrec :: Int -> ReadS GetProject
Prelude.Read, Int -> GetProject -> ShowS
[GetProject] -> ShowS
GetProject -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetProject] -> ShowS
$cshowList :: [GetProject] -> ShowS
show :: GetProject -> String
$cshow :: GetProject -> String
showsPrec :: Int -> GetProject -> ShowS
$cshowsPrec :: Int -> GetProject -> ShowS
Prelude.Show, forall x. Rep GetProject x -> GetProject
forall x. GetProject -> Rep GetProject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetProject x -> GetProject
$cfrom :: forall x. GetProject -> Rep GetProject x
Prelude.Generic)

-- |
-- Create a value of 'GetProject' 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', 'getProject_arn' - The project\'s ARN.
newGetProject ::
  -- | 'arn'
  Prelude.Text ->
  GetProject
newGetProject :: Text -> GetProject
newGetProject Text
pArn_ = GetProject' {$sel:arn:GetProject' :: Text
arn = Text
pArn_}

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

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

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

instance Data.ToHeaders GetProject where
  toHeaders :: GetProject -> 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.GetProject" ::
                          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 GetProject where
  toJSON :: GetProject -> Value
toJSON GetProject' {Text
arn :: Text
$sel:arn:GetProject' :: GetProject -> 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 GetProject where
  toPath :: GetProject -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

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

-- |
-- Create a value of 'GetProjectResponse' 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:
--
-- 'project', 'getProjectResponse_project' - The project to get information about.
--
-- 'httpStatus', 'getProjectResponse_httpStatus' - The response's http status code.
newGetProjectResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetProjectResponse
newGetProjectResponse :: Int -> GetProjectResponse
newGetProjectResponse Int
pHttpStatus_ =
  GetProjectResponse'
    { $sel:project:GetProjectResponse' :: Maybe Project
project = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetProjectResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The project to get information about.
getProjectResponse_project :: Lens.Lens' GetProjectResponse (Prelude.Maybe Project)
getProjectResponse_project :: Lens' GetProjectResponse (Maybe Project)
getProjectResponse_project = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetProjectResponse' {Maybe Project
project :: Maybe Project
$sel:project:GetProjectResponse' :: GetProjectResponse -> Maybe Project
project} -> Maybe Project
project) (\s :: GetProjectResponse
s@GetProjectResponse' {} Maybe Project
a -> GetProjectResponse
s {$sel:project:GetProjectResponse' :: Maybe Project
project = Maybe Project
a} :: GetProjectResponse)

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

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