{-# 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.Pinpoint.CreateJourney
-- 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 journey for an application.
module Amazonka.Pinpoint.CreateJourney
  ( -- * Creating a Request
    CreateJourney (..),
    newCreateJourney,

    -- * Request Lenses
    createJourney_applicationId,
    createJourney_writeJourneyRequest,

    -- * Destructuring the Response
    CreateJourneyResponse (..),
    newCreateJourneyResponse,

    -- * Response Lenses
    createJourneyResponse_httpStatus,
    createJourneyResponse_journeyResponse,
  )
where

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

-- | /See:/ 'newCreateJourney' smart constructor.
data CreateJourney = CreateJourney'
  { -- | The unique identifier for the application. This identifier is displayed
    -- as the __Project ID__ on the Amazon Pinpoint console.
    CreateJourney -> Text
applicationId :: Prelude.Text,
    CreateJourney -> WriteJourneyRequest
writeJourneyRequest :: WriteJourneyRequest
  }
  deriving (CreateJourney -> CreateJourney -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateJourney -> CreateJourney -> Bool
$c/= :: CreateJourney -> CreateJourney -> Bool
== :: CreateJourney -> CreateJourney -> Bool
$c== :: CreateJourney -> CreateJourney -> Bool
Prelude.Eq, ReadPrec [CreateJourney]
ReadPrec CreateJourney
Int -> ReadS CreateJourney
ReadS [CreateJourney]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateJourney]
$creadListPrec :: ReadPrec [CreateJourney]
readPrec :: ReadPrec CreateJourney
$creadPrec :: ReadPrec CreateJourney
readList :: ReadS [CreateJourney]
$creadList :: ReadS [CreateJourney]
readsPrec :: Int -> ReadS CreateJourney
$creadsPrec :: Int -> ReadS CreateJourney
Prelude.Read, Int -> CreateJourney -> ShowS
[CreateJourney] -> ShowS
CreateJourney -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateJourney] -> ShowS
$cshowList :: [CreateJourney] -> ShowS
show :: CreateJourney -> String
$cshow :: CreateJourney -> String
showsPrec :: Int -> CreateJourney -> ShowS
$cshowsPrec :: Int -> CreateJourney -> ShowS
Prelude.Show, forall x. Rep CreateJourney x -> CreateJourney
forall x. CreateJourney -> Rep CreateJourney x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateJourney x -> CreateJourney
$cfrom :: forall x. CreateJourney -> Rep CreateJourney x
Prelude.Generic)

-- |
-- Create a value of 'CreateJourney' 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:
--
-- 'applicationId', 'createJourney_applicationId' - The unique identifier for the application. This identifier is displayed
-- as the __Project ID__ on the Amazon Pinpoint console.
--
-- 'writeJourneyRequest', 'createJourney_writeJourneyRequest' - Undocumented member.
newCreateJourney ::
  -- | 'applicationId'
  Prelude.Text ->
  -- | 'writeJourneyRequest'
  WriteJourneyRequest ->
  CreateJourney
newCreateJourney :: Text -> WriteJourneyRequest -> CreateJourney
newCreateJourney
  Text
pApplicationId_
  WriteJourneyRequest
pWriteJourneyRequest_ =
    CreateJourney'
      { $sel:applicationId:CreateJourney' :: Text
applicationId = Text
pApplicationId_,
        $sel:writeJourneyRequest:CreateJourney' :: WriteJourneyRequest
writeJourneyRequest = WriteJourneyRequest
pWriteJourneyRequest_
      }

-- | The unique identifier for the application. This identifier is displayed
-- as the __Project ID__ on the Amazon Pinpoint console.
createJourney_applicationId :: Lens.Lens' CreateJourney Prelude.Text
createJourney_applicationId :: Lens' CreateJourney Text
createJourney_applicationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJourney' {Text
applicationId :: Text
$sel:applicationId:CreateJourney' :: CreateJourney -> Text
applicationId} -> Text
applicationId) (\s :: CreateJourney
s@CreateJourney' {} Text
a -> CreateJourney
s {$sel:applicationId:CreateJourney' :: Text
applicationId = Text
a} :: CreateJourney)

-- | Undocumented member.
createJourney_writeJourneyRequest :: Lens.Lens' CreateJourney WriteJourneyRequest
createJourney_writeJourneyRequest :: Lens' CreateJourney WriteJourneyRequest
createJourney_writeJourneyRequest = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJourney' {WriteJourneyRequest
writeJourneyRequest :: WriteJourneyRequest
$sel:writeJourneyRequest:CreateJourney' :: CreateJourney -> WriteJourneyRequest
writeJourneyRequest} -> WriteJourneyRequest
writeJourneyRequest) (\s :: CreateJourney
s@CreateJourney' {} WriteJourneyRequest
a -> CreateJourney
s {$sel:writeJourneyRequest:CreateJourney' :: WriteJourneyRequest
writeJourneyRequest = WriteJourneyRequest
a} :: CreateJourney)

instance Core.AWSRequest CreateJourney where
  type
    AWSResponse CreateJourney =
      CreateJourneyResponse
  request :: (Service -> Service) -> CreateJourney -> Request CreateJourney
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 CreateJourney
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateJourney)))
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 -> JourneyResponse -> CreateJourneyResponse
CreateJourneyResponse'
            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.<*> (forall a. FromJSON a => Object -> Either String a
Data.eitherParseJSON Object
x)
      )

instance Prelude.Hashable CreateJourney where
  hashWithSalt :: Int -> CreateJourney -> Int
hashWithSalt Int
_salt CreateJourney' {Text
WriteJourneyRequest
writeJourneyRequest :: WriteJourneyRequest
applicationId :: Text
$sel:writeJourneyRequest:CreateJourney' :: CreateJourney -> WriteJourneyRequest
$sel:applicationId:CreateJourney' :: CreateJourney -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
applicationId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` WriteJourneyRequest
writeJourneyRequest

instance Prelude.NFData CreateJourney where
  rnf :: CreateJourney -> ()
rnf CreateJourney' {Text
WriteJourneyRequest
writeJourneyRequest :: WriteJourneyRequest
applicationId :: Text
$sel:writeJourneyRequest:CreateJourney' :: CreateJourney -> WriteJourneyRequest
$sel:applicationId:CreateJourney' :: CreateJourney -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
applicationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf WriteJourneyRequest
writeJourneyRequest

instance Data.ToHeaders CreateJourney where
  toHeaders :: CreateJourney -> 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 CreateJourney where
  toJSON :: CreateJourney -> Value
toJSON CreateJourney' {Text
WriteJourneyRequest
writeJourneyRequest :: WriteJourneyRequest
applicationId :: Text
$sel:writeJourneyRequest:CreateJourney' :: CreateJourney -> WriteJourneyRequest
$sel:applicationId:CreateJourney' :: CreateJourney -> Text
..} =
    forall a. ToJSON a => a -> Value
Data.toJSON WriteJourneyRequest
writeJourneyRequest

instance Data.ToPath CreateJourney where
  toPath :: CreateJourney -> ByteString
toPath CreateJourney' {Text
WriteJourneyRequest
writeJourneyRequest :: WriteJourneyRequest
applicationId :: Text
$sel:writeJourneyRequest:CreateJourney' :: CreateJourney -> WriteJourneyRequest
$sel:applicationId:CreateJourney' :: CreateJourney -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/v1/apps/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
applicationId, ByteString
"/journeys"]

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

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

-- |
-- Create a value of 'CreateJourneyResponse' 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', 'createJourneyResponse_httpStatus' - The response's http status code.
--
-- 'journeyResponse', 'createJourneyResponse_journeyResponse' - Undocumented member.
newCreateJourneyResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'journeyResponse'
  JourneyResponse ->
  CreateJourneyResponse
newCreateJourneyResponse :: Int -> JourneyResponse -> CreateJourneyResponse
newCreateJourneyResponse
  Int
pHttpStatus_
  JourneyResponse
pJourneyResponse_ =
    CreateJourneyResponse'
      { $sel:httpStatus:CreateJourneyResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:journeyResponse:CreateJourneyResponse' :: JourneyResponse
journeyResponse = JourneyResponse
pJourneyResponse_
      }

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

-- | Undocumented member.
createJourneyResponse_journeyResponse :: Lens.Lens' CreateJourneyResponse JourneyResponse
createJourneyResponse_journeyResponse :: Lens' CreateJourneyResponse JourneyResponse
createJourneyResponse_journeyResponse = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJourneyResponse' {JourneyResponse
journeyResponse :: JourneyResponse
$sel:journeyResponse:CreateJourneyResponse' :: CreateJourneyResponse -> JourneyResponse
journeyResponse} -> JourneyResponse
journeyResponse) (\s :: CreateJourneyResponse
s@CreateJourneyResponse' {} JourneyResponse
a -> CreateJourneyResponse
s {$sel:journeyResponse:CreateJourneyResponse' :: JourneyResponse
journeyResponse = JourneyResponse
a} :: CreateJourneyResponse)

instance Prelude.NFData CreateJourneyResponse where
  rnf :: CreateJourneyResponse -> ()
rnf CreateJourneyResponse' {Int
JourneyResponse
journeyResponse :: JourneyResponse
httpStatus :: Int
$sel:journeyResponse:CreateJourneyResponse' :: CreateJourneyResponse -> JourneyResponse
$sel:httpStatus:CreateJourneyResponse' :: CreateJourneyResponse -> 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 JourneyResponse
journeyResponse