{-# 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.Personalize.DescribeAlgorithm
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Describes the given algorithm.
module Amazonka.Personalize.DescribeAlgorithm
  ( -- * Creating a Request
    DescribeAlgorithm (..),
    newDescribeAlgorithm,

    -- * Request Lenses
    describeAlgorithm_algorithmArn,

    -- * Destructuring the Response
    DescribeAlgorithmResponse (..),
    newDescribeAlgorithmResponse,

    -- * Response Lenses
    describeAlgorithmResponse_algorithm,
    describeAlgorithmResponse_httpStatus,
  )
where

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

-- | /See:/ 'newDescribeAlgorithm' smart constructor.
data DescribeAlgorithm = DescribeAlgorithm'
  { -- | The Amazon Resource Name (ARN) of the algorithm to describe.
    DescribeAlgorithm -> Text
algorithmArn :: Prelude.Text
  }
  deriving (DescribeAlgorithm -> DescribeAlgorithm -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeAlgorithm -> DescribeAlgorithm -> Bool
$c/= :: DescribeAlgorithm -> DescribeAlgorithm -> Bool
== :: DescribeAlgorithm -> DescribeAlgorithm -> Bool
$c== :: DescribeAlgorithm -> DescribeAlgorithm -> Bool
Prelude.Eq, ReadPrec [DescribeAlgorithm]
ReadPrec DescribeAlgorithm
Int -> ReadS DescribeAlgorithm
ReadS [DescribeAlgorithm]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeAlgorithm]
$creadListPrec :: ReadPrec [DescribeAlgorithm]
readPrec :: ReadPrec DescribeAlgorithm
$creadPrec :: ReadPrec DescribeAlgorithm
readList :: ReadS [DescribeAlgorithm]
$creadList :: ReadS [DescribeAlgorithm]
readsPrec :: Int -> ReadS DescribeAlgorithm
$creadsPrec :: Int -> ReadS DescribeAlgorithm
Prelude.Read, Int -> DescribeAlgorithm -> ShowS
[DescribeAlgorithm] -> ShowS
DescribeAlgorithm -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeAlgorithm] -> ShowS
$cshowList :: [DescribeAlgorithm] -> ShowS
show :: DescribeAlgorithm -> String
$cshow :: DescribeAlgorithm -> String
showsPrec :: Int -> DescribeAlgorithm -> ShowS
$cshowsPrec :: Int -> DescribeAlgorithm -> ShowS
Prelude.Show, forall x. Rep DescribeAlgorithm x -> DescribeAlgorithm
forall x. DescribeAlgorithm -> Rep DescribeAlgorithm x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeAlgorithm x -> DescribeAlgorithm
$cfrom :: forall x. DescribeAlgorithm -> Rep DescribeAlgorithm x
Prelude.Generic)

-- |
-- Create a value of 'DescribeAlgorithm' 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:
--
-- 'algorithmArn', 'describeAlgorithm_algorithmArn' - The Amazon Resource Name (ARN) of the algorithm to describe.
newDescribeAlgorithm ::
  -- | 'algorithmArn'
  Prelude.Text ->
  DescribeAlgorithm
newDescribeAlgorithm :: Text -> DescribeAlgorithm
newDescribeAlgorithm Text
pAlgorithmArn_ =
  DescribeAlgorithm' {$sel:algorithmArn:DescribeAlgorithm' :: Text
algorithmArn = Text
pAlgorithmArn_}

-- | The Amazon Resource Name (ARN) of the algorithm to describe.
describeAlgorithm_algorithmArn :: Lens.Lens' DescribeAlgorithm Prelude.Text
describeAlgorithm_algorithmArn :: Lens' DescribeAlgorithm Text
describeAlgorithm_algorithmArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAlgorithm' {Text
algorithmArn :: Text
$sel:algorithmArn:DescribeAlgorithm' :: DescribeAlgorithm -> Text
algorithmArn} -> Text
algorithmArn) (\s :: DescribeAlgorithm
s@DescribeAlgorithm' {} Text
a -> DescribeAlgorithm
s {$sel:algorithmArn:DescribeAlgorithm' :: Text
algorithmArn = Text
a} :: DescribeAlgorithm)

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

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

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

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

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

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

-- |
-- Create a value of 'DescribeAlgorithmResponse' 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:
--
-- 'algorithm', 'describeAlgorithmResponse_algorithm' - A listing of the properties of the algorithm.
--
-- 'httpStatus', 'describeAlgorithmResponse_httpStatus' - The response's http status code.
newDescribeAlgorithmResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeAlgorithmResponse
newDescribeAlgorithmResponse :: Int -> DescribeAlgorithmResponse
newDescribeAlgorithmResponse Int
pHttpStatus_ =
  DescribeAlgorithmResponse'
    { $sel:algorithm:DescribeAlgorithmResponse' :: Maybe Algorithm
algorithm =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeAlgorithmResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A listing of the properties of the algorithm.
describeAlgorithmResponse_algorithm :: Lens.Lens' DescribeAlgorithmResponse (Prelude.Maybe Algorithm)
describeAlgorithmResponse_algorithm :: Lens' DescribeAlgorithmResponse (Maybe Algorithm)
describeAlgorithmResponse_algorithm = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAlgorithmResponse' {Maybe Algorithm
algorithm :: Maybe Algorithm
$sel:algorithm:DescribeAlgorithmResponse' :: DescribeAlgorithmResponse -> Maybe Algorithm
algorithm} -> Maybe Algorithm
algorithm) (\s :: DescribeAlgorithmResponse
s@DescribeAlgorithmResponse' {} Maybe Algorithm
a -> DescribeAlgorithmResponse
s {$sel:algorithm:DescribeAlgorithmResponse' :: Maybe Algorithm
algorithm = Maybe Algorithm
a} :: DescribeAlgorithmResponse)

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

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