{-# 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.Transfer.CreateProfile
-- 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 the local or partner profile to use for AS2 transfers.
module Amazonka.Transfer.CreateProfile
  ( -- * Creating a Request
    CreateProfile (..),
    newCreateProfile,

    -- * Request Lenses
    createProfile_certificateIds,
    createProfile_tags,
    createProfile_as2Id,
    createProfile_profileType,

    -- * Destructuring the Response
    CreateProfileResponse (..),
    newCreateProfileResponse,

    -- * Response Lenses
    createProfileResponse_httpStatus,
    createProfileResponse_profileId,
  )
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.Transfer.Types

-- | /See:/ 'newCreateProfile' smart constructor.
data CreateProfile = CreateProfile'
  { -- | An array of identifiers for the imported certificates. You use this
    -- identifier for working with profiles and partner profiles.
    CreateProfile -> Maybe [Text]
certificateIds :: Prelude.Maybe [Prelude.Text],
    -- | Key-value pairs that can be used to group and search for AS2 profiles.
    CreateProfile -> Maybe (NonEmpty Tag)
tags :: Prelude.Maybe (Prelude.NonEmpty Tag),
    -- | The @As2Id@ is the /AS2-name/, as defined in the
    -- <https://datatracker.ietf.org/doc/html/rfc4130 RFC 4130>. For inbound
    -- transfers, this is the @AS2-From@ header for the AS2 messages sent from
    -- the partner. For outbound connectors, this is the @AS2-To@ header for
    -- the AS2 messages sent to the partner using the @StartFileTransfer@ API
    -- operation. This ID cannot include spaces.
    CreateProfile -> Text
as2Id :: Prelude.Text,
    -- | Determines the type of profile to create:
    --
    -- -   Specify @LOCAL@ to create a local profile. A local profile
    --     represents the AS2-enabled Transfer Family server organization or
    --     party.
    --
    -- -   Specify @PARTNER@ to create a partner profile. A partner profile
    --     represents a remote organization, external to Transfer Family.
    CreateProfile -> ProfileType
profileType :: ProfileType
  }
  deriving (CreateProfile -> CreateProfile -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateProfile -> CreateProfile -> Bool
$c/= :: CreateProfile -> CreateProfile -> Bool
== :: CreateProfile -> CreateProfile -> Bool
$c== :: CreateProfile -> CreateProfile -> Bool
Prelude.Eq, ReadPrec [CreateProfile]
ReadPrec CreateProfile
Int -> ReadS CreateProfile
ReadS [CreateProfile]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateProfile]
$creadListPrec :: ReadPrec [CreateProfile]
readPrec :: ReadPrec CreateProfile
$creadPrec :: ReadPrec CreateProfile
readList :: ReadS [CreateProfile]
$creadList :: ReadS [CreateProfile]
readsPrec :: Int -> ReadS CreateProfile
$creadsPrec :: Int -> ReadS CreateProfile
Prelude.Read, Int -> CreateProfile -> ShowS
[CreateProfile] -> ShowS
CreateProfile -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateProfile] -> ShowS
$cshowList :: [CreateProfile] -> ShowS
show :: CreateProfile -> String
$cshow :: CreateProfile -> String
showsPrec :: Int -> CreateProfile -> ShowS
$cshowsPrec :: Int -> CreateProfile -> ShowS
Prelude.Show, forall x. Rep CreateProfile x -> CreateProfile
forall x. CreateProfile -> Rep CreateProfile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateProfile x -> CreateProfile
$cfrom :: forall x. CreateProfile -> Rep CreateProfile x
Prelude.Generic)

-- |
-- Create a value of 'CreateProfile' 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:
--
-- 'certificateIds', 'createProfile_certificateIds' - An array of identifiers for the imported certificates. You use this
-- identifier for working with profiles and partner profiles.
--
-- 'tags', 'createProfile_tags' - Key-value pairs that can be used to group and search for AS2 profiles.
--
-- 'as2Id', 'createProfile_as2Id' - The @As2Id@ is the /AS2-name/, as defined in the
-- <https://datatracker.ietf.org/doc/html/rfc4130 RFC 4130>. For inbound
-- transfers, this is the @AS2-From@ header for the AS2 messages sent from
-- the partner. For outbound connectors, this is the @AS2-To@ header for
-- the AS2 messages sent to the partner using the @StartFileTransfer@ API
-- operation. This ID cannot include spaces.
--
-- 'profileType', 'createProfile_profileType' - Determines the type of profile to create:
--
-- -   Specify @LOCAL@ to create a local profile. A local profile
--     represents the AS2-enabled Transfer Family server organization or
--     party.
--
-- -   Specify @PARTNER@ to create a partner profile. A partner profile
--     represents a remote organization, external to Transfer Family.
newCreateProfile ::
  -- | 'as2Id'
  Prelude.Text ->
  -- | 'profileType'
  ProfileType ->
  CreateProfile
newCreateProfile :: Text -> ProfileType -> CreateProfile
newCreateProfile Text
pAs2Id_ ProfileType
pProfileType_ =
  CreateProfile'
    { $sel:certificateIds:CreateProfile' :: Maybe [Text]
certificateIds = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateProfile' :: Maybe (NonEmpty Tag)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:as2Id:CreateProfile' :: Text
as2Id = Text
pAs2Id_,
      $sel:profileType:CreateProfile' :: ProfileType
profileType = ProfileType
pProfileType_
    }

-- | An array of identifiers for the imported certificates. You use this
-- identifier for working with profiles and partner profiles.
createProfile_certificateIds :: Lens.Lens' CreateProfile (Prelude.Maybe [Prelude.Text])
createProfile_certificateIds :: Lens' CreateProfile (Maybe [Text])
createProfile_certificateIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProfile' {Maybe [Text]
certificateIds :: Maybe [Text]
$sel:certificateIds:CreateProfile' :: CreateProfile -> Maybe [Text]
certificateIds} -> Maybe [Text]
certificateIds) (\s :: CreateProfile
s@CreateProfile' {} Maybe [Text]
a -> CreateProfile
s {$sel:certificateIds:CreateProfile' :: Maybe [Text]
certificateIds = Maybe [Text]
a} :: CreateProfile) 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

-- | Key-value pairs that can be used to group and search for AS2 profiles.
createProfile_tags :: Lens.Lens' CreateProfile (Prelude.Maybe (Prelude.NonEmpty Tag))
createProfile_tags :: Lens' CreateProfile (Maybe (NonEmpty Tag))
createProfile_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProfile' {Maybe (NonEmpty Tag)
tags :: Maybe (NonEmpty Tag)
$sel:tags:CreateProfile' :: CreateProfile -> Maybe (NonEmpty Tag)
tags} -> Maybe (NonEmpty Tag)
tags) (\s :: CreateProfile
s@CreateProfile' {} Maybe (NonEmpty Tag)
a -> CreateProfile
s {$sel:tags:CreateProfile' :: Maybe (NonEmpty Tag)
tags = Maybe (NonEmpty Tag)
a} :: CreateProfile) 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 @As2Id@ is the /AS2-name/, as defined in the
-- <https://datatracker.ietf.org/doc/html/rfc4130 RFC 4130>. For inbound
-- transfers, this is the @AS2-From@ header for the AS2 messages sent from
-- the partner. For outbound connectors, this is the @AS2-To@ header for
-- the AS2 messages sent to the partner using the @StartFileTransfer@ API
-- operation. This ID cannot include spaces.
createProfile_as2Id :: Lens.Lens' CreateProfile Prelude.Text
createProfile_as2Id :: Lens' CreateProfile Text
createProfile_as2Id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProfile' {Text
as2Id :: Text
$sel:as2Id:CreateProfile' :: CreateProfile -> Text
as2Id} -> Text
as2Id) (\s :: CreateProfile
s@CreateProfile' {} Text
a -> CreateProfile
s {$sel:as2Id:CreateProfile' :: Text
as2Id = Text
a} :: CreateProfile)

-- | Determines the type of profile to create:
--
-- -   Specify @LOCAL@ to create a local profile. A local profile
--     represents the AS2-enabled Transfer Family server organization or
--     party.
--
-- -   Specify @PARTNER@ to create a partner profile. A partner profile
--     represents a remote organization, external to Transfer Family.
createProfile_profileType :: Lens.Lens' CreateProfile ProfileType
createProfile_profileType :: Lens' CreateProfile ProfileType
createProfile_profileType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProfile' {ProfileType
profileType :: ProfileType
$sel:profileType:CreateProfile' :: CreateProfile -> ProfileType
profileType} -> ProfileType
profileType) (\s :: CreateProfile
s@CreateProfile' {} ProfileType
a -> CreateProfile
s {$sel:profileType:CreateProfile' :: ProfileType
profileType = ProfileType
a} :: CreateProfile)

instance Core.AWSRequest CreateProfile where
  type
    AWSResponse CreateProfile =
      CreateProfileResponse
  request :: (Service -> Service) -> CreateProfile -> Request CreateProfile
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 CreateProfile
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateProfile)))
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 ->
          Int -> Text -> CreateProfileResponse
CreateProfileResponse'
            forall (f :: * -> *) a b. Functor 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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"ProfileId")
      )

instance Prelude.Hashable CreateProfile where
  hashWithSalt :: Int -> CreateProfile -> Int
hashWithSalt Int
_salt CreateProfile' {Maybe [Text]
Maybe (NonEmpty Tag)
Text
ProfileType
profileType :: ProfileType
as2Id :: Text
tags :: Maybe (NonEmpty Tag)
certificateIds :: Maybe [Text]
$sel:profileType:CreateProfile' :: CreateProfile -> ProfileType
$sel:as2Id:CreateProfile' :: CreateProfile -> Text
$sel:tags:CreateProfile' :: CreateProfile -> Maybe (NonEmpty Tag)
$sel:certificateIds:CreateProfile' :: CreateProfile -> Maybe [Text]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
certificateIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Tag)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
as2Id
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ProfileType
profileType

instance Prelude.NFData CreateProfile where
  rnf :: CreateProfile -> ()
rnf CreateProfile' {Maybe [Text]
Maybe (NonEmpty Tag)
Text
ProfileType
profileType :: ProfileType
as2Id :: Text
tags :: Maybe (NonEmpty Tag)
certificateIds :: Maybe [Text]
$sel:profileType:CreateProfile' :: CreateProfile -> ProfileType
$sel:as2Id:CreateProfile' :: CreateProfile -> Text
$sel:tags:CreateProfile' :: CreateProfile -> Maybe (NonEmpty Tag)
$sel:certificateIds:CreateProfile' :: CreateProfile -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
certificateIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Tag)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
as2Id
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ProfileType
profileType

instance Data.ToHeaders CreateProfile where
  toHeaders :: CreateProfile -> 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
"TransferService.CreateProfile" ::
                          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 CreateProfile where
  toJSON :: CreateProfile -> Value
toJSON CreateProfile' {Maybe [Text]
Maybe (NonEmpty Tag)
Text
ProfileType
profileType :: ProfileType
as2Id :: Text
tags :: Maybe (NonEmpty Tag)
certificateIds :: Maybe [Text]
$sel:profileType:CreateProfile' :: CreateProfile -> ProfileType
$sel:as2Id:CreateProfile' :: CreateProfile -> Text
$sel:tags:CreateProfile' :: CreateProfile -> Maybe (NonEmpty Tag)
$sel:certificateIds:CreateProfile' :: CreateProfile -> Maybe [Text]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"CertificateIds" 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]
certificateIds,
            (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 (NonEmpty Tag)
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"As2Id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
as2Id),
            forall a. a -> Maybe a
Prelude.Just (Key
"ProfileType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ProfileType
profileType)
          ]
      )

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

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

-- | /See:/ 'newCreateProfileResponse' smart constructor.
data CreateProfileResponse = CreateProfileResponse'
  { -- | The response's http status code.
    CreateProfileResponse -> Int
httpStatus :: Prelude.Int,
    -- | The unique identifier for the AS2 profile, returned after the API call
    -- succeeds.
    CreateProfileResponse -> Text
profileId :: Prelude.Text
  }
  deriving (CreateProfileResponse -> CreateProfileResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateProfileResponse -> CreateProfileResponse -> Bool
$c/= :: CreateProfileResponse -> CreateProfileResponse -> Bool
== :: CreateProfileResponse -> CreateProfileResponse -> Bool
$c== :: CreateProfileResponse -> CreateProfileResponse -> Bool
Prelude.Eq, ReadPrec [CreateProfileResponse]
ReadPrec CreateProfileResponse
Int -> ReadS CreateProfileResponse
ReadS [CreateProfileResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateProfileResponse]
$creadListPrec :: ReadPrec [CreateProfileResponse]
readPrec :: ReadPrec CreateProfileResponse
$creadPrec :: ReadPrec CreateProfileResponse
readList :: ReadS [CreateProfileResponse]
$creadList :: ReadS [CreateProfileResponse]
readsPrec :: Int -> ReadS CreateProfileResponse
$creadsPrec :: Int -> ReadS CreateProfileResponse
Prelude.Read, Int -> CreateProfileResponse -> ShowS
[CreateProfileResponse] -> ShowS
CreateProfileResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateProfileResponse] -> ShowS
$cshowList :: [CreateProfileResponse] -> ShowS
show :: CreateProfileResponse -> String
$cshow :: CreateProfileResponse -> String
showsPrec :: Int -> CreateProfileResponse -> ShowS
$cshowsPrec :: Int -> CreateProfileResponse -> ShowS
Prelude.Show, forall x. Rep CreateProfileResponse x -> CreateProfileResponse
forall x. CreateProfileResponse -> Rep CreateProfileResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateProfileResponse x -> CreateProfileResponse
$cfrom :: forall x. CreateProfileResponse -> Rep CreateProfileResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateProfileResponse' 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:
--
-- 'httpStatus', 'createProfileResponse_httpStatus' - The response's http status code.
--
-- 'profileId', 'createProfileResponse_profileId' - The unique identifier for the AS2 profile, returned after the API call
-- succeeds.
newCreateProfileResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'profileId'
  Prelude.Text ->
  CreateProfileResponse
newCreateProfileResponse :: Int -> Text -> CreateProfileResponse
newCreateProfileResponse Int
pHttpStatus_ Text
pProfileId_ =
  CreateProfileResponse'
    { $sel:httpStatus:CreateProfileResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:profileId:CreateProfileResponse' :: Text
profileId = Text
pProfileId_
    }

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

-- | The unique identifier for the AS2 profile, returned after the API call
-- succeeds.
createProfileResponse_profileId :: Lens.Lens' CreateProfileResponse Prelude.Text
createProfileResponse_profileId :: Lens' CreateProfileResponse Text
createProfileResponse_profileId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProfileResponse' {Text
profileId :: Text
$sel:profileId:CreateProfileResponse' :: CreateProfileResponse -> Text
profileId} -> Text
profileId) (\s :: CreateProfileResponse
s@CreateProfileResponse' {} Text
a -> CreateProfileResponse
s {$sel:profileId:CreateProfileResponse' :: Text
profileId = Text
a} :: CreateProfileResponse)

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