{-# 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.Chime.CreateSipMediaApplication
-- 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 SIP media application.
module Amazonka.Chime.CreateSipMediaApplication
  ( -- * Creating a Request
    CreateSipMediaApplication (..),
    newCreateSipMediaApplication,

    -- * Request Lenses
    createSipMediaApplication_awsRegion,
    createSipMediaApplication_name,
    createSipMediaApplication_endpoints,

    -- * Destructuring the Response
    CreateSipMediaApplicationResponse (..),
    newCreateSipMediaApplicationResponse,

    -- * Response Lenses
    createSipMediaApplicationResponse_sipMediaApplication,
    createSipMediaApplicationResponse_httpStatus,
  )
where

import Amazonka.Chime.Types
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

-- | /See:/ 'newCreateSipMediaApplication' smart constructor.
data CreateSipMediaApplication = CreateSipMediaApplication'
  { -- | The AWS Region assigned to the SIP media application.
    CreateSipMediaApplication -> Text
awsRegion :: Prelude.Text,
    -- | The SIP media application name.
    CreateSipMediaApplication -> Text
name :: Prelude.Text,
    -- | List of endpoints (Lambda Amazon Resource Names) specified for the SIP
    -- media application. Currently, only one endpoint is supported.
    CreateSipMediaApplication -> NonEmpty SipMediaApplicationEndpoint
endpoints :: Prelude.NonEmpty SipMediaApplicationEndpoint
  }
  deriving (CreateSipMediaApplication -> CreateSipMediaApplication -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateSipMediaApplication -> CreateSipMediaApplication -> Bool
$c/= :: CreateSipMediaApplication -> CreateSipMediaApplication -> Bool
== :: CreateSipMediaApplication -> CreateSipMediaApplication -> Bool
$c== :: CreateSipMediaApplication -> CreateSipMediaApplication -> Bool
Prelude.Eq, Int -> CreateSipMediaApplication -> ShowS
[CreateSipMediaApplication] -> ShowS
CreateSipMediaApplication -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateSipMediaApplication] -> ShowS
$cshowList :: [CreateSipMediaApplication] -> ShowS
show :: CreateSipMediaApplication -> String
$cshow :: CreateSipMediaApplication -> String
showsPrec :: Int -> CreateSipMediaApplication -> ShowS
$cshowsPrec :: Int -> CreateSipMediaApplication -> ShowS
Prelude.Show, forall x.
Rep CreateSipMediaApplication x -> CreateSipMediaApplication
forall x.
CreateSipMediaApplication -> Rep CreateSipMediaApplication x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateSipMediaApplication x -> CreateSipMediaApplication
$cfrom :: forall x.
CreateSipMediaApplication -> Rep CreateSipMediaApplication x
Prelude.Generic)

-- |
-- Create a value of 'CreateSipMediaApplication' 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:
--
-- 'awsRegion', 'createSipMediaApplication_awsRegion' - The AWS Region assigned to the SIP media application.
--
-- 'name', 'createSipMediaApplication_name' - The SIP media application name.
--
-- 'endpoints', 'createSipMediaApplication_endpoints' - List of endpoints (Lambda Amazon Resource Names) specified for the SIP
-- media application. Currently, only one endpoint is supported.
newCreateSipMediaApplication ::
  -- | 'awsRegion'
  Prelude.Text ->
  -- | 'name'
  Prelude.Text ->
  -- | 'endpoints'
  Prelude.NonEmpty SipMediaApplicationEndpoint ->
  CreateSipMediaApplication
newCreateSipMediaApplication :: Text
-> Text
-> NonEmpty SipMediaApplicationEndpoint
-> CreateSipMediaApplication
newCreateSipMediaApplication
  Text
pAwsRegion_
  Text
pName_
  NonEmpty SipMediaApplicationEndpoint
pEndpoints_ =
    CreateSipMediaApplication'
      { $sel:awsRegion:CreateSipMediaApplication' :: Text
awsRegion = Text
pAwsRegion_,
        $sel:name:CreateSipMediaApplication' :: Text
name = Text
pName_,
        $sel:endpoints:CreateSipMediaApplication' :: NonEmpty SipMediaApplicationEndpoint
endpoints = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty SipMediaApplicationEndpoint
pEndpoints_
      }

-- | The AWS Region assigned to the SIP media application.
createSipMediaApplication_awsRegion :: Lens.Lens' CreateSipMediaApplication Prelude.Text
createSipMediaApplication_awsRegion :: Lens' CreateSipMediaApplication Text
createSipMediaApplication_awsRegion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSipMediaApplication' {Text
awsRegion :: Text
$sel:awsRegion:CreateSipMediaApplication' :: CreateSipMediaApplication -> Text
awsRegion} -> Text
awsRegion) (\s :: CreateSipMediaApplication
s@CreateSipMediaApplication' {} Text
a -> CreateSipMediaApplication
s {$sel:awsRegion:CreateSipMediaApplication' :: Text
awsRegion = Text
a} :: CreateSipMediaApplication)

-- | The SIP media application name.
createSipMediaApplication_name :: Lens.Lens' CreateSipMediaApplication Prelude.Text
createSipMediaApplication_name :: Lens' CreateSipMediaApplication Text
createSipMediaApplication_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSipMediaApplication' {Text
name :: Text
$sel:name:CreateSipMediaApplication' :: CreateSipMediaApplication -> Text
name} -> Text
name) (\s :: CreateSipMediaApplication
s@CreateSipMediaApplication' {} Text
a -> CreateSipMediaApplication
s {$sel:name:CreateSipMediaApplication' :: Text
name = Text
a} :: CreateSipMediaApplication)

-- | List of endpoints (Lambda Amazon Resource Names) specified for the SIP
-- media application. Currently, only one endpoint is supported.
createSipMediaApplication_endpoints :: Lens.Lens' CreateSipMediaApplication (Prelude.NonEmpty SipMediaApplicationEndpoint)
createSipMediaApplication_endpoints :: Lens'
  CreateSipMediaApplication (NonEmpty SipMediaApplicationEndpoint)
createSipMediaApplication_endpoints = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSipMediaApplication' {NonEmpty SipMediaApplicationEndpoint
endpoints :: NonEmpty SipMediaApplicationEndpoint
$sel:endpoints:CreateSipMediaApplication' :: CreateSipMediaApplication -> NonEmpty SipMediaApplicationEndpoint
endpoints} -> NonEmpty SipMediaApplicationEndpoint
endpoints) (\s :: CreateSipMediaApplication
s@CreateSipMediaApplication' {} NonEmpty SipMediaApplicationEndpoint
a -> CreateSipMediaApplication
s {$sel:endpoints:CreateSipMediaApplication' :: NonEmpty SipMediaApplicationEndpoint
endpoints = NonEmpty SipMediaApplicationEndpoint
a} :: CreateSipMediaApplication) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest CreateSipMediaApplication where
  type
    AWSResponse CreateSipMediaApplication =
      CreateSipMediaApplicationResponse
  request :: (Service -> Service)
-> CreateSipMediaApplication -> Request CreateSipMediaApplication
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 CreateSipMediaApplication
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateSipMediaApplication)))
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 SipMediaApplication
-> Int -> CreateSipMediaApplicationResponse
CreateSipMediaApplicationResponse'
            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
"SipMediaApplication")
            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 CreateSipMediaApplication where
  hashWithSalt :: Int -> CreateSipMediaApplication -> Int
hashWithSalt Int
_salt CreateSipMediaApplication' {NonEmpty SipMediaApplicationEndpoint
Text
endpoints :: NonEmpty SipMediaApplicationEndpoint
name :: Text
awsRegion :: Text
$sel:endpoints:CreateSipMediaApplication' :: CreateSipMediaApplication -> NonEmpty SipMediaApplicationEndpoint
$sel:name:CreateSipMediaApplication' :: CreateSipMediaApplication -> Text
$sel:awsRegion:CreateSipMediaApplication' :: CreateSipMediaApplication -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
awsRegion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty SipMediaApplicationEndpoint
endpoints

instance Prelude.NFData CreateSipMediaApplication where
  rnf :: CreateSipMediaApplication -> ()
rnf CreateSipMediaApplication' {NonEmpty SipMediaApplicationEndpoint
Text
endpoints :: NonEmpty SipMediaApplicationEndpoint
name :: Text
awsRegion :: Text
$sel:endpoints:CreateSipMediaApplication' :: CreateSipMediaApplication -> NonEmpty SipMediaApplicationEndpoint
$sel:name:CreateSipMediaApplication' :: CreateSipMediaApplication -> Text
$sel:awsRegion:CreateSipMediaApplication' :: CreateSipMediaApplication -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
awsRegion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty SipMediaApplicationEndpoint
endpoints

instance Data.ToHeaders CreateSipMediaApplication where
  toHeaders :: CreateSipMediaApplication -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToJSON CreateSipMediaApplication where
  toJSON :: CreateSipMediaApplication -> Value
toJSON CreateSipMediaApplication' {NonEmpty SipMediaApplicationEndpoint
Text
endpoints :: NonEmpty SipMediaApplicationEndpoint
name :: Text
awsRegion :: Text
$sel:endpoints:CreateSipMediaApplication' :: CreateSipMediaApplication -> NonEmpty SipMediaApplicationEndpoint
$sel:name:CreateSipMediaApplication' :: CreateSipMediaApplication -> Text
$sel:awsRegion:CreateSipMediaApplication' :: CreateSipMediaApplication -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"AwsRegion" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
awsRegion),
            forall a. a -> Maybe a
Prelude.Just (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            forall a. a -> Maybe a
Prelude.Just (Key
"Endpoints" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty SipMediaApplicationEndpoint
endpoints)
          ]
      )

instance Data.ToPath CreateSipMediaApplication where
  toPath :: CreateSipMediaApplication -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/sip-media-applications"

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

-- | /See:/ 'newCreateSipMediaApplicationResponse' smart constructor.
data CreateSipMediaApplicationResponse = CreateSipMediaApplicationResponse'
  { -- | The SIP media application details.
    CreateSipMediaApplicationResponse -> Maybe SipMediaApplication
sipMediaApplication :: Prelude.Maybe SipMediaApplication,
    -- | The response's http status code.
    CreateSipMediaApplicationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateSipMediaApplicationResponse
-> CreateSipMediaApplicationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateSipMediaApplicationResponse
-> CreateSipMediaApplicationResponse -> Bool
$c/= :: CreateSipMediaApplicationResponse
-> CreateSipMediaApplicationResponse -> Bool
== :: CreateSipMediaApplicationResponse
-> CreateSipMediaApplicationResponse -> Bool
$c== :: CreateSipMediaApplicationResponse
-> CreateSipMediaApplicationResponse -> Bool
Prelude.Eq, Int -> CreateSipMediaApplicationResponse -> ShowS
[CreateSipMediaApplicationResponse] -> ShowS
CreateSipMediaApplicationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateSipMediaApplicationResponse] -> ShowS
$cshowList :: [CreateSipMediaApplicationResponse] -> ShowS
show :: CreateSipMediaApplicationResponse -> String
$cshow :: CreateSipMediaApplicationResponse -> String
showsPrec :: Int -> CreateSipMediaApplicationResponse -> ShowS
$cshowsPrec :: Int -> CreateSipMediaApplicationResponse -> ShowS
Prelude.Show, forall x.
Rep CreateSipMediaApplicationResponse x
-> CreateSipMediaApplicationResponse
forall x.
CreateSipMediaApplicationResponse
-> Rep CreateSipMediaApplicationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateSipMediaApplicationResponse x
-> CreateSipMediaApplicationResponse
$cfrom :: forall x.
CreateSipMediaApplicationResponse
-> Rep CreateSipMediaApplicationResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateSipMediaApplicationResponse' 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:
--
-- 'sipMediaApplication', 'createSipMediaApplicationResponse_sipMediaApplication' - The SIP media application details.
--
-- 'httpStatus', 'createSipMediaApplicationResponse_httpStatus' - The response's http status code.
newCreateSipMediaApplicationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateSipMediaApplicationResponse
newCreateSipMediaApplicationResponse :: Int -> CreateSipMediaApplicationResponse
newCreateSipMediaApplicationResponse Int
pHttpStatus_ =
  CreateSipMediaApplicationResponse'
    { $sel:sipMediaApplication:CreateSipMediaApplicationResponse' :: Maybe SipMediaApplication
sipMediaApplication =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateSipMediaApplicationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The SIP media application details.
createSipMediaApplicationResponse_sipMediaApplication :: Lens.Lens' CreateSipMediaApplicationResponse (Prelude.Maybe SipMediaApplication)
createSipMediaApplicationResponse_sipMediaApplication :: Lens' CreateSipMediaApplicationResponse (Maybe SipMediaApplication)
createSipMediaApplicationResponse_sipMediaApplication = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSipMediaApplicationResponse' {Maybe SipMediaApplication
sipMediaApplication :: Maybe SipMediaApplication
$sel:sipMediaApplication:CreateSipMediaApplicationResponse' :: CreateSipMediaApplicationResponse -> Maybe SipMediaApplication
sipMediaApplication} -> Maybe SipMediaApplication
sipMediaApplication) (\s :: CreateSipMediaApplicationResponse
s@CreateSipMediaApplicationResponse' {} Maybe SipMediaApplication
a -> CreateSipMediaApplicationResponse
s {$sel:sipMediaApplication:CreateSipMediaApplicationResponse' :: Maybe SipMediaApplication
sipMediaApplication = Maybe SipMediaApplication
a} :: CreateSipMediaApplicationResponse)

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

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