{-# 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.UpdateJourney
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the configuration and other settings for a journey.
module Amazonka.Pinpoint.UpdateJourney
  ( -- * Creating a Request
    UpdateJourney (..),
    newUpdateJourney,

    -- * Request Lenses
    updateJourney_journeyId,
    updateJourney_applicationId,
    updateJourney_writeJourneyRequest,

    -- * Destructuring the Response
    UpdateJourneyResponse (..),
    newUpdateJourneyResponse,

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

-- |
-- Create a value of 'UpdateJourney' 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:
--
-- 'journeyId', 'updateJourney_journeyId' - The unique identifier for the journey.
--
-- 'applicationId', 'updateJourney_applicationId' - The unique identifier for the application. This identifier is displayed
-- as the __Project ID__ on the Amazon Pinpoint console.
--
-- 'writeJourneyRequest', 'updateJourney_writeJourneyRequest' - Undocumented member.
newUpdateJourney ::
  -- | 'journeyId'
  Prelude.Text ->
  -- | 'applicationId'
  Prelude.Text ->
  -- | 'writeJourneyRequest'
  WriteJourneyRequest ->
  UpdateJourney
newUpdateJourney :: Text -> Text -> WriteJourneyRequest -> UpdateJourney
newUpdateJourney
  Text
pJourneyId_
  Text
pApplicationId_
  WriteJourneyRequest
pWriteJourneyRequest_ =
    UpdateJourney'
      { $sel:journeyId:UpdateJourney' :: Text
journeyId = Text
pJourneyId_,
        $sel:applicationId:UpdateJourney' :: Text
applicationId = Text
pApplicationId_,
        $sel:writeJourneyRequest:UpdateJourney' :: WriteJourneyRequest
writeJourneyRequest = WriteJourneyRequest
pWriteJourneyRequest_
      }

-- | The unique identifier for the journey.
updateJourney_journeyId :: Lens.Lens' UpdateJourney Prelude.Text
updateJourney_journeyId :: Lens' UpdateJourney Text
updateJourney_journeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateJourney' {Text
journeyId :: Text
$sel:journeyId:UpdateJourney' :: UpdateJourney -> Text
journeyId} -> Text
journeyId) (\s :: UpdateJourney
s@UpdateJourney' {} Text
a -> UpdateJourney
s {$sel:journeyId:UpdateJourney' :: Text
journeyId = Text
a} :: UpdateJourney)

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

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

instance Core.AWSRequest UpdateJourney where
  type
    AWSResponse UpdateJourney =
      UpdateJourneyResponse
  request :: (Service -> Service) -> UpdateJourney -> Request UpdateJourney
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateJourney
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateJourney)))
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 -> UpdateJourneyResponse
UpdateJourneyResponse'
            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 UpdateJourney where
  hashWithSalt :: Int -> UpdateJourney -> Int
hashWithSalt Int
_salt UpdateJourney' {Text
WriteJourneyRequest
writeJourneyRequest :: WriteJourneyRequest
applicationId :: Text
journeyId :: Text
$sel:writeJourneyRequest:UpdateJourney' :: UpdateJourney -> WriteJourneyRequest
$sel:applicationId:UpdateJourney' :: UpdateJourney -> Text
$sel:journeyId:UpdateJourney' :: UpdateJourney -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
journeyId
      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 UpdateJourney where
  rnf :: UpdateJourney -> ()
rnf UpdateJourney' {Text
WriteJourneyRequest
writeJourneyRequest :: WriteJourneyRequest
applicationId :: Text
journeyId :: Text
$sel:writeJourneyRequest:UpdateJourney' :: UpdateJourney -> WriteJourneyRequest
$sel:applicationId:UpdateJourney' :: UpdateJourney -> Text
$sel:journeyId:UpdateJourney' :: UpdateJourney -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
journeyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 UpdateJourney where
  toHeaders :: UpdateJourney -> 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 UpdateJourney where
  toJSON :: UpdateJourney -> Value
toJSON UpdateJourney' {Text
WriteJourneyRequest
writeJourneyRequest :: WriteJourneyRequest
applicationId :: Text
journeyId :: Text
$sel:writeJourneyRequest:UpdateJourney' :: UpdateJourney -> WriteJourneyRequest
$sel:applicationId:UpdateJourney' :: UpdateJourney -> Text
$sel:journeyId:UpdateJourney' :: UpdateJourney -> Text
..} =
    forall a. ToJSON a => a -> Value
Data.toJSON WriteJourneyRequest
writeJourneyRequest

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

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

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

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

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

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

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