{-# 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.DeleteJourney
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deletes a journey from an application.
module Amazonka.Pinpoint.DeleteJourney
  ( -- * Creating a Request
    DeleteJourney (..),
    newDeleteJourney,

    -- * Request Lenses
    deleteJourney_journeyId,
    deleteJourney_applicationId,

    -- * Destructuring the Response
    DeleteJourneyResponse (..),
    newDeleteJourneyResponse,

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

-- |
-- Create a value of 'DeleteJourney' 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', 'deleteJourney_journeyId' - The unique identifier for the journey.
--
-- 'applicationId', 'deleteJourney_applicationId' - The unique identifier for the application. This identifier is displayed
-- as the __Project ID__ on the Amazon Pinpoint console.
newDeleteJourney ::
  -- | 'journeyId'
  Prelude.Text ->
  -- | 'applicationId'
  Prelude.Text ->
  DeleteJourney
newDeleteJourney :: Text -> Text -> DeleteJourney
newDeleteJourney Text
pJourneyId_ Text
pApplicationId_ =
  DeleteJourney'
    { $sel:journeyId:DeleteJourney' :: Text
journeyId = Text
pJourneyId_,
      $sel:applicationId:DeleteJourney' :: Text
applicationId = Text
pApplicationId_
    }

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

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

instance Core.AWSRequest DeleteJourney where
  type
    AWSResponse DeleteJourney =
      DeleteJourneyResponse
  request :: (Service -> Service) -> DeleteJourney -> Request DeleteJourney
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.delete (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DeleteJourney
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DeleteJourney)))
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 -> DeleteJourneyResponse
DeleteJourneyResponse'
            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 DeleteJourney where
  hashWithSalt :: Int -> DeleteJourney -> Int
hashWithSalt Int
_salt DeleteJourney' {Text
applicationId :: Text
journeyId :: Text
$sel:applicationId:DeleteJourney' :: DeleteJourney -> Text
$sel:journeyId:DeleteJourney' :: DeleteJourney -> 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

instance Prelude.NFData DeleteJourney where
  rnf :: DeleteJourney -> ()
rnf DeleteJourney' {Text
applicationId :: Text
journeyId :: Text
$sel:applicationId:DeleteJourney' :: DeleteJourney -> Text
$sel:journeyId:DeleteJourney' :: DeleteJourney -> 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

instance Data.ToHeaders DeleteJourney where
  toHeaders :: DeleteJourney -> 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.ToPath DeleteJourney where
  toPath :: DeleteJourney -> ByteString
toPath DeleteJourney' {Text
applicationId :: Text
journeyId :: Text
$sel:applicationId:DeleteJourney' :: DeleteJourney -> Text
$sel:journeyId:DeleteJourney' :: DeleteJourney -> 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 DeleteJourney where
  toQuery :: DeleteJourney -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

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

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

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

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