{-# 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.Wisdom.CreateSession
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a session. A session is a contextual container used for
-- generating recommendations. Amazon Connect creates a new Wisdom session
-- for each contact on which Wisdom is enabled.
module Amazonka.Wisdom.CreateSession
  ( -- * Creating a Request
    CreateSession (..),
    newCreateSession,

    -- * Request Lenses
    createSession_clientToken,
    createSession_description,
    createSession_tags,
    createSession_assistantId,
    createSession_name,

    -- * Destructuring the Response
    CreateSessionResponse (..),
    newCreateSessionResponse,

    -- * Response Lenses
    createSessionResponse_session,
    createSessionResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateSession' smart constructor.
data CreateSession = CreateSession'
  { -- | A unique, case-sensitive identifier that you provide to ensure the
    -- idempotency of the request.
    CreateSession -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The description.
    CreateSession -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The tags used to organize, track, or control access for this resource.
    CreateSession -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The identifier of the Wisdom assistant. Can be either the ID or the ARN.
    -- URLs cannot contain the ARN.
    CreateSession -> Text
assistantId :: Prelude.Text,
    -- | The name of the session.
    CreateSession -> Text
name :: Prelude.Text
  }
  deriving (CreateSession -> CreateSession -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateSession -> CreateSession -> Bool
$c/= :: CreateSession -> CreateSession -> Bool
== :: CreateSession -> CreateSession -> Bool
$c== :: CreateSession -> CreateSession -> Bool
Prelude.Eq, ReadPrec [CreateSession]
ReadPrec CreateSession
Int -> ReadS CreateSession
ReadS [CreateSession]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateSession]
$creadListPrec :: ReadPrec [CreateSession]
readPrec :: ReadPrec CreateSession
$creadPrec :: ReadPrec CreateSession
readList :: ReadS [CreateSession]
$creadList :: ReadS [CreateSession]
readsPrec :: Int -> ReadS CreateSession
$creadsPrec :: Int -> ReadS CreateSession
Prelude.Read, Int -> CreateSession -> ShowS
[CreateSession] -> ShowS
CreateSession -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateSession] -> ShowS
$cshowList :: [CreateSession] -> ShowS
show :: CreateSession -> String
$cshow :: CreateSession -> String
showsPrec :: Int -> CreateSession -> ShowS
$cshowsPrec :: Int -> CreateSession -> ShowS
Prelude.Show, forall x. Rep CreateSession x -> CreateSession
forall x. CreateSession -> Rep CreateSession x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateSession x -> CreateSession
$cfrom :: forall x. CreateSession -> Rep CreateSession x
Prelude.Generic)

-- |
-- Create a value of 'CreateSession' 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:
--
-- 'clientToken', 'createSession_clientToken' - A unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request.
--
-- 'description', 'createSession_description' - The description.
--
-- 'tags', 'createSession_tags' - The tags used to organize, track, or control access for this resource.
--
-- 'assistantId', 'createSession_assistantId' - The identifier of the Wisdom assistant. Can be either the ID or the ARN.
-- URLs cannot contain the ARN.
--
-- 'name', 'createSession_name' - The name of the session.
newCreateSession ::
  -- | 'assistantId'
  Prelude.Text ->
  -- | 'name'
  Prelude.Text ->
  CreateSession
newCreateSession :: Text -> Text -> CreateSession
newCreateSession Text
pAssistantId_ Text
pName_ =
  CreateSession'
    { $sel:clientToken:CreateSession' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
      $sel:description:CreateSession' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateSession' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:assistantId:CreateSession' :: Text
assistantId = Text
pAssistantId_,
      $sel:name:CreateSession' :: Text
name = Text
pName_
    }

-- | A unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request.
createSession_clientToken :: Lens.Lens' CreateSession (Prelude.Maybe Prelude.Text)
createSession_clientToken :: Lens' CreateSession (Maybe Text)
createSession_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSession' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateSession' :: CreateSession -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateSession
s@CreateSession' {} Maybe Text
a -> CreateSession
s {$sel:clientToken:CreateSession' :: Maybe Text
clientToken = Maybe Text
a} :: CreateSession)

-- | The description.
createSession_description :: Lens.Lens' CreateSession (Prelude.Maybe Prelude.Text)
createSession_description :: Lens' CreateSession (Maybe Text)
createSession_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSession' {Maybe Text
description :: Maybe Text
$sel:description:CreateSession' :: CreateSession -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateSession
s@CreateSession' {} Maybe Text
a -> CreateSession
s {$sel:description:CreateSession' :: Maybe Text
description = Maybe Text
a} :: CreateSession)

-- | The tags used to organize, track, or control access for this resource.
createSession_tags :: Lens.Lens' CreateSession (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createSession_tags :: Lens' CreateSession (Maybe (HashMap Text Text))
createSession_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSession' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateSession' :: CreateSession -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateSession
s@CreateSession' {} Maybe (HashMap Text Text)
a -> CreateSession
s {$sel:tags:CreateSession' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateSession) 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 identifier of the Wisdom assistant. Can be either the ID or the ARN.
-- URLs cannot contain the ARN.
createSession_assistantId :: Lens.Lens' CreateSession Prelude.Text
createSession_assistantId :: Lens' CreateSession Text
createSession_assistantId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSession' {Text
assistantId :: Text
$sel:assistantId:CreateSession' :: CreateSession -> Text
assistantId} -> Text
assistantId) (\s :: CreateSession
s@CreateSession' {} Text
a -> CreateSession
s {$sel:assistantId:CreateSession' :: Text
assistantId = Text
a} :: CreateSession)

-- | The name of the session.
createSession_name :: Lens.Lens' CreateSession Prelude.Text
createSession_name :: Lens' CreateSession Text
createSession_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSession' {Text
name :: Text
$sel:name:CreateSession' :: CreateSession -> Text
name} -> Text
name) (\s :: CreateSession
s@CreateSession' {} Text
a -> CreateSession
s {$sel:name:CreateSession' :: Text
name = Text
a} :: CreateSession)

instance Core.AWSRequest CreateSession where
  type
    AWSResponse CreateSession =
      CreateSessionResponse
  request :: (Service -> Service) -> CreateSession -> Request CreateSession
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 CreateSession
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateSession)))
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 SessionData -> Int -> CreateSessionResponse
CreateSessionResponse'
            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
"session")
            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 CreateSession where
  hashWithSalt :: Int -> CreateSession -> Int
hashWithSalt Int
_salt CreateSession' {Maybe Text
Maybe (HashMap Text Text)
Text
name :: Text
assistantId :: Text
tags :: Maybe (HashMap Text Text)
description :: Maybe Text
clientToken :: Maybe Text
$sel:name:CreateSession' :: CreateSession -> Text
$sel:assistantId:CreateSession' :: CreateSession -> Text
$sel:tags:CreateSession' :: CreateSession -> Maybe (HashMap Text Text)
$sel:description:CreateSession' :: CreateSession -> Maybe Text
$sel:clientToken:CreateSession' :: CreateSession -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
assistantId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData CreateSession where
  rnf :: CreateSession -> ()
rnf CreateSession' {Maybe Text
Maybe (HashMap Text Text)
Text
name :: Text
assistantId :: Text
tags :: Maybe (HashMap Text Text)
description :: Maybe Text
clientToken :: Maybe Text
$sel:name:CreateSession' :: CreateSession -> Text
$sel:assistantId:CreateSession' :: CreateSession -> Text
$sel:tags:CreateSession' :: CreateSession -> Maybe (HashMap Text Text)
$sel:description:CreateSession' :: CreateSession -> Maybe Text
$sel:clientToken:CreateSession' :: CreateSession -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
assistantId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name

instance Data.ToHeaders CreateSession where
  toHeaders :: CreateSession -> 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.ToJSON CreateSession where
  toJSON :: CreateSession -> Value
toJSON CreateSession' {Maybe Text
Maybe (HashMap Text Text)
Text
name :: Text
assistantId :: Text
tags :: Maybe (HashMap Text Text)
description :: Maybe Text
clientToken :: Maybe Text
$sel:name:CreateSession' :: CreateSession -> Text
$sel:assistantId:CreateSession' :: CreateSession -> Text
$sel:tags:CreateSession' :: CreateSession -> Maybe (HashMap Text Text)
$sel:description:CreateSession' :: CreateSession -> Maybe Text
$sel:clientToken:CreateSession' :: CreateSession -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"clientToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
clientToken,
            (Key
"description" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
description,
            (Key
"tags" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (HashMap Text Text)
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name)
          ]
      )

instance Data.ToPath CreateSession where
  toPath :: CreateSession -> ByteString
toPath CreateSession' {Maybe Text
Maybe (HashMap Text Text)
Text
name :: Text
assistantId :: Text
tags :: Maybe (HashMap Text Text)
description :: Maybe Text
clientToken :: Maybe Text
$sel:name:CreateSession' :: CreateSession -> Text
$sel:assistantId:CreateSession' :: CreateSession -> Text
$sel:tags:CreateSession' :: CreateSession -> Maybe (HashMap Text Text)
$sel:description:CreateSession' :: CreateSession -> Maybe Text
$sel:clientToken:CreateSession' :: CreateSession -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/assistants/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
assistantId, ByteString
"/sessions"]

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

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

-- |
-- Create a value of 'CreateSessionResponse' 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:
--
-- 'session', 'createSessionResponse_session' - The session.
--
-- 'httpStatus', 'createSessionResponse_httpStatus' - The response's http status code.
newCreateSessionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateSessionResponse
newCreateSessionResponse :: Int -> CreateSessionResponse
newCreateSessionResponse Int
pHttpStatus_ =
  CreateSessionResponse'
    { $sel:session:CreateSessionResponse' :: Maybe SessionData
session = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateSessionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The session.
createSessionResponse_session :: Lens.Lens' CreateSessionResponse (Prelude.Maybe SessionData)
createSessionResponse_session :: Lens' CreateSessionResponse (Maybe SessionData)
createSessionResponse_session = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSessionResponse' {Maybe SessionData
session :: Maybe SessionData
$sel:session:CreateSessionResponse' :: CreateSessionResponse -> Maybe SessionData
session} -> Maybe SessionData
session) (\s :: CreateSessionResponse
s@CreateSessionResponse' {} Maybe SessionData
a -> CreateSessionResponse
s {$sel:session:CreateSessionResponse' :: Maybe SessionData
session = Maybe SessionData
a} :: CreateSessionResponse)

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

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