{-# 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.GetSolutionMetrics
-- 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 the metrics for the specified solution version.
module Amazonka.Personalize.GetSolutionMetrics
  ( -- * Creating a Request
    GetSolutionMetrics (..),
    newGetSolutionMetrics,

    -- * Request Lenses
    getSolutionMetrics_solutionVersionArn,

    -- * Destructuring the Response
    GetSolutionMetricsResponse (..),
    newGetSolutionMetricsResponse,

    -- * Response Lenses
    getSolutionMetricsResponse_metrics,
    getSolutionMetricsResponse_solutionVersionArn,
    getSolutionMetricsResponse_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:/ 'newGetSolutionMetrics' smart constructor.
data GetSolutionMetrics = GetSolutionMetrics'
  { -- | The Amazon Resource Name (ARN) of the solution version for which to get
    -- metrics.
    GetSolutionMetrics -> Text
solutionVersionArn :: Prelude.Text
  }
  deriving (GetSolutionMetrics -> GetSolutionMetrics -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetSolutionMetrics -> GetSolutionMetrics -> Bool
$c/= :: GetSolutionMetrics -> GetSolutionMetrics -> Bool
== :: GetSolutionMetrics -> GetSolutionMetrics -> Bool
$c== :: GetSolutionMetrics -> GetSolutionMetrics -> Bool
Prelude.Eq, ReadPrec [GetSolutionMetrics]
ReadPrec GetSolutionMetrics
Int -> ReadS GetSolutionMetrics
ReadS [GetSolutionMetrics]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetSolutionMetrics]
$creadListPrec :: ReadPrec [GetSolutionMetrics]
readPrec :: ReadPrec GetSolutionMetrics
$creadPrec :: ReadPrec GetSolutionMetrics
readList :: ReadS [GetSolutionMetrics]
$creadList :: ReadS [GetSolutionMetrics]
readsPrec :: Int -> ReadS GetSolutionMetrics
$creadsPrec :: Int -> ReadS GetSolutionMetrics
Prelude.Read, Int -> GetSolutionMetrics -> ShowS
[GetSolutionMetrics] -> ShowS
GetSolutionMetrics -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetSolutionMetrics] -> ShowS
$cshowList :: [GetSolutionMetrics] -> ShowS
show :: GetSolutionMetrics -> String
$cshow :: GetSolutionMetrics -> String
showsPrec :: Int -> GetSolutionMetrics -> ShowS
$cshowsPrec :: Int -> GetSolutionMetrics -> ShowS
Prelude.Show, forall x. Rep GetSolutionMetrics x -> GetSolutionMetrics
forall x. GetSolutionMetrics -> Rep GetSolutionMetrics x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetSolutionMetrics x -> GetSolutionMetrics
$cfrom :: forall x. GetSolutionMetrics -> Rep GetSolutionMetrics x
Prelude.Generic)

-- |
-- Create a value of 'GetSolutionMetrics' 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:
--
-- 'solutionVersionArn', 'getSolutionMetrics_solutionVersionArn' - The Amazon Resource Name (ARN) of the solution version for which to get
-- metrics.
newGetSolutionMetrics ::
  -- | 'solutionVersionArn'
  Prelude.Text ->
  GetSolutionMetrics
newGetSolutionMetrics :: Text -> GetSolutionMetrics
newGetSolutionMetrics Text
pSolutionVersionArn_ =
  GetSolutionMetrics'
    { $sel:solutionVersionArn:GetSolutionMetrics' :: Text
solutionVersionArn =
        Text
pSolutionVersionArn_
    }

-- | The Amazon Resource Name (ARN) of the solution version for which to get
-- metrics.
getSolutionMetrics_solutionVersionArn :: Lens.Lens' GetSolutionMetrics Prelude.Text
getSolutionMetrics_solutionVersionArn :: Lens' GetSolutionMetrics Text
getSolutionMetrics_solutionVersionArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSolutionMetrics' {Text
solutionVersionArn :: Text
$sel:solutionVersionArn:GetSolutionMetrics' :: GetSolutionMetrics -> Text
solutionVersionArn} -> Text
solutionVersionArn) (\s :: GetSolutionMetrics
s@GetSolutionMetrics' {} Text
a -> GetSolutionMetrics
s {$sel:solutionVersionArn:GetSolutionMetrics' :: Text
solutionVersionArn = Text
a} :: GetSolutionMetrics)

instance Core.AWSRequest GetSolutionMetrics where
  type
    AWSResponse GetSolutionMetrics =
      GetSolutionMetricsResponse
  request :: (Service -> Service)
-> GetSolutionMetrics -> Request GetSolutionMetrics
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 GetSolutionMetrics
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetSolutionMetrics)))
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 (HashMap Text Double)
-> Maybe Text -> Int -> GetSolutionMetricsResponse
GetSolutionMetricsResponse'
            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
"metrics" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"solutionVersionArn")
            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 GetSolutionMetrics where
  hashWithSalt :: Int -> GetSolutionMetrics -> Int
hashWithSalt Int
_salt GetSolutionMetrics' {Text
solutionVersionArn :: Text
$sel:solutionVersionArn:GetSolutionMetrics' :: GetSolutionMetrics -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
solutionVersionArn

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

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

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

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

-- | /See:/ 'newGetSolutionMetricsResponse' smart constructor.
data GetSolutionMetricsResponse = GetSolutionMetricsResponse'
  { -- | The metrics for the solution version. For more information, see
    -- <https://docs.aws.amazon.com/personalize/latest/dg/working-with-training-metrics.html Evaluating a solution version with metrics>
    -- .
    GetSolutionMetricsResponse -> Maybe (HashMap Text Double)
metrics :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Double),
    -- | The same solution version ARN as specified in the request.
    GetSolutionMetricsResponse -> Maybe Text
solutionVersionArn :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetSolutionMetricsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetSolutionMetricsResponse -> GetSolutionMetricsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetSolutionMetricsResponse -> GetSolutionMetricsResponse -> Bool
$c/= :: GetSolutionMetricsResponse -> GetSolutionMetricsResponse -> Bool
== :: GetSolutionMetricsResponse -> GetSolutionMetricsResponse -> Bool
$c== :: GetSolutionMetricsResponse -> GetSolutionMetricsResponse -> Bool
Prelude.Eq, ReadPrec [GetSolutionMetricsResponse]
ReadPrec GetSolutionMetricsResponse
Int -> ReadS GetSolutionMetricsResponse
ReadS [GetSolutionMetricsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetSolutionMetricsResponse]
$creadListPrec :: ReadPrec [GetSolutionMetricsResponse]
readPrec :: ReadPrec GetSolutionMetricsResponse
$creadPrec :: ReadPrec GetSolutionMetricsResponse
readList :: ReadS [GetSolutionMetricsResponse]
$creadList :: ReadS [GetSolutionMetricsResponse]
readsPrec :: Int -> ReadS GetSolutionMetricsResponse
$creadsPrec :: Int -> ReadS GetSolutionMetricsResponse
Prelude.Read, Int -> GetSolutionMetricsResponse -> ShowS
[GetSolutionMetricsResponse] -> ShowS
GetSolutionMetricsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetSolutionMetricsResponse] -> ShowS
$cshowList :: [GetSolutionMetricsResponse] -> ShowS
show :: GetSolutionMetricsResponse -> String
$cshow :: GetSolutionMetricsResponse -> String
showsPrec :: Int -> GetSolutionMetricsResponse -> ShowS
$cshowsPrec :: Int -> GetSolutionMetricsResponse -> ShowS
Prelude.Show, forall x.
Rep GetSolutionMetricsResponse x -> GetSolutionMetricsResponse
forall x.
GetSolutionMetricsResponse -> Rep GetSolutionMetricsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetSolutionMetricsResponse x -> GetSolutionMetricsResponse
$cfrom :: forall x.
GetSolutionMetricsResponse -> Rep GetSolutionMetricsResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetSolutionMetricsResponse' 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:
--
-- 'metrics', 'getSolutionMetricsResponse_metrics' - The metrics for the solution version. For more information, see
-- <https://docs.aws.amazon.com/personalize/latest/dg/working-with-training-metrics.html Evaluating a solution version with metrics>
-- .
--
-- 'solutionVersionArn', 'getSolutionMetricsResponse_solutionVersionArn' - The same solution version ARN as specified in the request.
--
-- 'httpStatus', 'getSolutionMetricsResponse_httpStatus' - The response's http status code.
newGetSolutionMetricsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetSolutionMetricsResponse
newGetSolutionMetricsResponse :: Int -> GetSolutionMetricsResponse
newGetSolutionMetricsResponse Int
pHttpStatus_ =
  GetSolutionMetricsResponse'
    { $sel:metrics:GetSolutionMetricsResponse' :: Maybe (HashMap Text Double)
metrics =
        forall a. Maybe a
Prelude.Nothing,
      $sel:solutionVersionArn:GetSolutionMetricsResponse' :: Maybe Text
solutionVersionArn = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetSolutionMetricsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The metrics for the solution version. For more information, see
-- <https://docs.aws.amazon.com/personalize/latest/dg/working-with-training-metrics.html Evaluating a solution version with metrics>
-- .
getSolutionMetricsResponse_metrics :: Lens.Lens' GetSolutionMetricsResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Double))
getSolutionMetricsResponse_metrics :: Lens' GetSolutionMetricsResponse (Maybe (HashMap Text Double))
getSolutionMetricsResponse_metrics = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSolutionMetricsResponse' {Maybe (HashMap Text Double)
metrics :: Maybe (HashMap Text Double)
$sel:metrics:GetSolutionMetricsResponse' :: GetSolutionMetricsResponse -> Maybe (HashMap Text Double)
metrics} -> Maybe (HashMap Text Double)
metrics) (\s :: GetSolutionMetricsResponse
s@GetSolutionMetricsResponse' {} Maybe (HashMap Text Double)
a -> GetSolutionMetricsResponse
s {$sel:metrics:GetSolutionMetricsResponse' :: Maybe (HashMap Text Double)
metrics = Maybe (HashMap Text Double)
a} :: GetSolutionMetricsResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The same solution version ARN as specified in the request.
getSolutionMetricsResponse_solutionVersionArn :: Lens.Lens' GetSolutionMetricsResponse (Prelude.Maybe Prelude.Text)
getSolutionMetricsResponse_solutionVersionArn :: Lens' GetSolutionMetricsResponse (Maybe Text)
getSolutionMetricsResponse_solutionVersionArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSolutionMetricsResponse' {Maybe Text
solutionVersionArn :: Maybe Text
$sel:solutionVersionArn:GetSolutionMetricsResponse' :: GetSolutionMetricsResponse -> Maybe Text
solutionVersionArn} -> Maybe Text
solutionVersionArn) (\s :: GetSolutionMetricsResponse
s@GetSolutionMetricsResponse' {} Maybe Text
a -> GetSolutionMetricsResponse
s {$sel:solutionVersionArn:GetSolutionMetricsResponse' :: Maybe Text
solutionVersionArn = Maybe Text
a} :: GetSolutionMetricsResponse)

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

instance Prelude.NFData GetSolutionMetricsResponse where
  rnf :: GetSolutionMetricsResponse -> ()
rnf GetSolutionMetricsResponse' {Int
Maybe Text
Maybe (HashMap Text Double)
httpStatus :: Int
solutionVersionArn :: Maybe Text
metrics :: Maybe (HashMap Text Double)
$sel:httpStatus:GetSolutionMetricsResponse' :: GetSolutionMetricsResponse -> Int
$sel:solutionVersionArn:GetSolutionMetricsResponse' :: GetSolutionMetricsResponse -> Maybe Text
$sel:metrics:GetSolutionMetricsResponse' :: GetSolutionMetricsResponse -> Maybe (HashMap Text Double)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Double)
metrics
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
solutionVersionArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus