{-# 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.IoTDeviceAdvisor.GetSuiteRunReport
-- 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 a report download link for a successful Device Advisor qualifying
-- test suite run.
--
-- Requires permission to access the
-- <https://docs.aws.amazon.com/service-authorization/latest/reference/list_awsiot.html#awsiot-actions-as-permissions GetSuiteRunReport>
-- action.
module Amazonka.IoTDeviceAdvisor.GetSuiteRunReport
  ( -- * Creating a Request
    GetSuiteRunReport (..),
    newGetSuiteRunReport,

    -- * Request Lenses
    getSuiteRunReport_suiteDefinitionId,
    getSuiteRunReport_suiteRunId,

    -- * Destructuring the Response
    GetSuiteRunReportResponse (..),
    newGetSuiteRunReportResponse,

    -- * Response Lenses
    getSuiteRunReportResponse_qualificationReportDownloadUrl,
    getSuiteRunReportResponse_httpStatus,
  )
where

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

-- | /See:/ 'newGetSuiteRunReport' smart constructor.
data GetSuiteRunReport = GetSuiteRunReport'
  { -- | Suite definition ID of the test suite.
    GetSuiteRunReport -> Text
suiteDefinitionId :: Prelude.Text,
    -- | Suite run ID of the test suite run.
    GetSuiteRunReport -> Text
suiteRunId :: Prelude.Text
  }
  deriving (GetSuiteRunReport -> GetSuiteRunReport -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetSuiteRunReport -> GetSuiteRunReport -> Bool
$c/= :: GetSuiteRunReport -> GetSuiteRunReport -> Bool
== :: GetSuiteRunReport -> GetSuiteRunReport -> Bool
$c== :: GetSuiteRunReport -> GetSuiteRunReport -> Bool
Prelude.Eq, ReadPrec [GetSuiteRunReport]
ReadPrec GetSuiteRunReport
Int -> ReadS GetSuiteRunReport
ReadS [GetSuiteRunReport]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetSuiteRunReport]
$creadListPrec :: ReadPrec [GetSuiteRunReport]
readPrec :: ReadPrec GetSuiteRunReport
$creadPrec :: ReadPrec GetSuiteRunReport
readList :: ReadS [GetSuiteRunReport]
$creadList :: ReadS [GetSuiteRunReport]
readsPrec :: Int -> ReadS GetSuiteRunReport
$creadsPrec :: Int -> ReadS GetSuiteRunReport
Prelude.Read, Int -> GetSuiteRunReport -> ShowS
[GetSuiteRunReport] -> ShowS
GetSuiteRunReport -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetSuiteRunReport] -> ShowS
$cshowList :: [GetSuiteRunReport] -> ShowS
show :: GetSuiteRunReport -> String
$cshow :: GetSuiteRunReport -> String
showsPrec :: Int -> GetSuiteRunReport -> ShowS
$cshowsPrec :: Int -> GetSuiteRunReport -> ShowS
Prelude.Show, forall x. Rep GetSuiteRunReport x -> GetSuiteRunReport
forall x. GetSuiteRunReport -> Rep GetSuiteRunReport x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetSuiteRunReport x -> GetSuiteRunReport
$cfrom :: forall x. GetSuiteRunReport -> Rep GetSuiteRunReport x
Prelude.Generic)

-- |
-- Create a value of 'GetSuiteRunReport' 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:
--
-- 'suiteDefinitionId', 'getSuiteRunReport_suiteDefinitionId' - Suite definition ID of the test suite.
--
-- 'suiteRunId', 'getSuiteRunReport_suiteRunId' - Suite run ID of the test suite run.
newGetSuiteRunReport ::
  -- | 'suiteDefinitionId'
  Prelude.Text ->
  -- | 'suiteRunId'
  Prelude.Text ->
  GetSuiteRunReport
newGetSuiteRunReport :: Text -> Text -> GetSuiteRunReport
newGetSuiteRunReport Text
pSuiteDefinitionId_ Text
pSuiteRunId_ =
  GetSuiteRunReport'
    { $sel:suiteDefinitionId:GetSuiteRunReport' :: Text
suiteDefinitionId =
        Text
pSuiteDefinitionId_,
      $sel:suiteRunId:GetSuiteRunReport' :: Text
suiteRunId = Text
pSuiteRunId_
    }

-- | Suite definition ID of the test suite.
getSuiteRunReport_suiteDefinitionId :: Lens.Lens' GetSuiteRunReport Prelude.Text
getSuiteRunReport_suiteDefinitionId :: Lens' GetSuiteRunReport Text
getSuiteRunReport_suiteDefinitionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSuiteRunReport' {Text
suiteDefinitionId :: Text
$sel:suiteDefinitionId:GetSuiteRunReport' :: GetSuiteRunReport -> Text
suiteDefinitionId} -> Text
suiteDefinitionId) (\s :: GetSuiteRunReport
s@GetSuiteRunReport' {} Text
a -> GetSuiteRunReport
s {$sel:suiteDefinitionId:GetSuiteRunReport' :: Text
suiteDefinitionId = Text
a} :: GetSuiteRunReport)

-- | Suite run ID of the test suite run.
getSuiteRunReport_suiteRunId :: Lens.Lens' GetSuiteRunReport Prelude.Text
getSuiteRunReport_suiteRunId :: Lens' GetSuiteRunReport Text
getSuiteRunReport_suiteRunId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSuiteRunReport' {Text
suiteRunId :: Text
$sel:suiteRunId:GetSuiteRunReport' :: GetSuiteRunReport -> Text
suiteRunId} -> Text
suiteRunId) (\s :: GetSuiteRunReport
s@GetSuiteRunReport' {} Text
a -> GetSuiteRunReport
s {$sel:suiteRunId:GetSuiteRunReport' :: Text
suiteRunId = Text
a} :: GetSuiteRunReport)

instance Core.AWSRequest GetSuiteRunReport where
  type
    AWSResponse GetSuiteRunReport =
      GetSuiteRunReportResponse
  request :: (Service -> Service)
-> GetSuiteRunReport -> Request GetSuiteRunReport
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetSuiteRunReport
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetSuiteRunReport)))
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 Text -> Int -> GetSuiteRunReportResponse
GetSuiteRunReportResponse'
            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
"qualificationReportDownloadUrl")
            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 GetSuiteRunReport where
  hashWithSalt :: Int -> GetSuiteRunReport -> Int
hashWithSalt Int
_salt GetSuiteRunReport' {Text
suiteRunId :: Text
suiteDefinitionId :: Text
$sel:suiteRunId:GetSuiteRunReport' :: GetSuiteRunReport -> Text
$sel:suiteDefinitionId:GetSuiteRunReport' :: GetSuiteRunReport -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
suiteDefinitionId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
suiteRunId

instance Prelude.NFData GetSuiteRunReport where
  rnf :: GetSuiteRunReport -> ()
rnf GetSuiteRunReport' {Text
suiteRunId :: Text
suiteDefinitionId :: Text
$sel:suiteRunId:GetSuiteRunReport' :: GetSuiteRunReport -> Text
$sel:suiteDefinitionId:GetSuiteRunReport' :: GetSuiteRunReport -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
suiteDefinitionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
suiteRunId

instance Data.ToHeaders GetSuiteRunReport where
  toHeaders :: GetSuiteRunReport -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToPath GetSuiteRunReport where
  toPath :: GetSuiteRunReport -> ByteString
toPath GetSuiteRunReport' {Text
suiteRunId :: Text
suiteDefinitionId :: Text
$sel:suiteRunId:GetSuiteRunReport' :: GetSuiteRunReport -> Text
$sel:suiteDefinitionId:GetSuiteRunReport' :: GetSuiteRunReport -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/suiteDefinitions/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
suiteDefinitionId,
        ByteString
"/suiteRuns/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
suiteRunId,
        ByteString
"/report"
      ]

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

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

-- |
-- Create a value of 'GetSuiteRunReportResponse' 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:
--
-- 'qualificationReportDownloadUrl', 'getSuiteRunReportResponse_qualificationReportDownloadUrl' - Download URL of the qualification report.
--
-- 'httpStatus', 'getSuiteRunReportResponse_httpStatus' - The response's http status code.
newGetSuiteRunReportResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetSuiteRunReportResponse
newGetSuiteRunReportResponse :: Int -> GetSuiteRunReportResponse
newGetSuiteRunReportResponse Int
pHttpStatus_ =
  GetSuiteRunReportResponse'
    { $sel:qualificationReportDownloadUrl:GetSuiteRunReportResponse' :: Maybe Text
qualificationReportDownloadUrl =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetSuiteRunReportResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Download URL of the qualification report.
getSuiteRunReportResponse_qualificationReportDownloadUrl :: Lens.Lens' GetSuiteRunReportResponse (Prelude.Maybe Prelude.Text)
getSuiteRunReportResponse_qualificationReportDownloadUrl :: Lens' GetSuiteRunReportResponse (Maybe Text)
getSuiteRunReportResponse_qualificationReportDownloadUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSuiteRunReportResponse' {Maybe Text
qualificationReportDownloadUrl :: Maybe Text
$sel:qualificationReportDownloadUrl:GetSuiteRunReportResponse' :: GetSuiteRunReportResponse -> Maybe Text
qualificationReportDownloadUrl} -> Maybe Text
qualificationReportDownloadUrl) (\s :: GetSuiteRunReportResponse
s@GetSuiteRunReportResponse' {} Maybe Text
a -> GetSuiteRunReportResponse
s {$sel:qualificationReportDownloadUrl:GetSuiteRunReportResponse' :: Maybe Text
qualificationReportDownloadUrl = Maybe Text
a} :: GetSuiteRunReportResponse)

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

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