{-# 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.IoTRoboRunner.CreateDestination
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Grants permission to create a destination
module Amazonka.IoTRoboRunner.CreateDestination
  ( -- * Creating a Request
    CreateDestination (..),
    newCreateDestination,

    -- * Request Lenses
    createDestination_additionalFixedProperties,
    createDestination_clientToken,
    createDestination_state,
    createDestination_name,
    createDestination_site,

    -- * Destructuring the Response
    CreateDestinationResponse (..),
    newCreateDestinationResponse,

    -- * Response Lenses
    createDestinationResponse_httpStatus,
    createDestinationResponse_arn,
    createDestinationResponse_id,
    createDestinationResponse_createdAt,
    createDestinationResponse_updatedAt,
    createDestinationResponse_state,
  )
where

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

-- | /See:/ 'newCreateDestination' smart constructor.
data CreateDestination = CreateDestination'
  { CreateDestination -> Maybe Text
additionalFixedProperties :: Prelude.Maybe Prelude.Text,
    CreateDestination -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The state of the destination. Default used if not specified.
    CreateDestination -> Maybe DestinationState
state :: Prelude.Maybe DestinationState,
    CreateDestination -> Text
name :: Prelude.Text,
    CreateDestination -> Text
site :: Prelude.Text
  }
  deriving (CreateDestination -> CreateDestination -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDestination -> CreateDestination -> Bool
$c/= :: CreateDestination -> CreateDestination -> Bool
== :: CreateDestination -> CreateDestination -> Bool
$c== :: CreateDestination -> CreateDestination -> Bool
Prelude.Eq, ReadPrec [CreateDestination]
ReadPrec CreateDestination
Int -> ReadS CreateDestination
ReadS [CreateDestination]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateDestination]
$creadListPrec :: ReadPrec [CreateDestination]
readPrec :: ReadPrec CreateDestination
$creadPrec :: ReadPrec CreateDestination
readList :: ReadS [CreateDestination]
$creadList :: ReadS [CreateDestination]
readsPrec :: Int -> ReadS CreateDestination
$creadsPrec :: Int -> ReadS CreateDestination
Prelude.Read, Int -> CreateDestination -> ShowS
[CreateDestination] -> ShowS
CreateDestination -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDestination] -> ShowS
$cshowList :: [CreateDestination] -> ShowS
show :: CreateDestination -> String
$cshow :: CreateDestination -> String
showsPrec :: Int -> CreateDestination -> ShowS
$cshowsPrec :: Int -> CreateDestination -> ShowS
Prelude.Show, forall x. Rep CreateDestination x -> CreateDestination
forall x. CreateDestination -> Rep CreateDestination x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateDestination x -> CreateDestination
$cfrom :: forall x. CreateDestination -> Rep CreateDestination x
Prelude.Generic)

-- |
-- Create a value of 'CreateDestination' 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:
--
-- 'additionalFixedProperties', 'createDestination_additionalFixedProperties' - Undocumented member.
--
-- 'clientToken', 'createDestination_clientToken' - Undocumented member.
--
-- 'state', 'createDestination_state' - The state of the destination. Default used if not specified.
--
-- 'name', 'createDestination_name' - Undocumented member.
--
-- 'site', 'createDestination_site' - Undocumented member.
newCreateDestination ::
  -- | 'name'
  Prelude.Text ->
  -- | 'site'
  Prelude.Text ->
  CreateDestination
newCreateDestination :: Text -> Text -> CreateDestination
newCreateDestination Text
pName_ Text
pSite_ =
  CreateDestination'
    { $sel:additionalFixedProperties:CreateDestination' :: Maybe Text
additionalFixedProperties =
        forall a. Maybe a
Prelude.Nothing,
      $sel:clientToken:CreateDestination' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
      $sel:state:CreateDestination' :: Maybe DestinationState
state = forall a. Maybe a
Prelude.Nothing,
      $sel:name:CreateDestination' :: Text
name = Text
pName_,
      $sel:site:CreateDestination' :: Text
site = Text
pSite_
    }

-- | Undocumented member.
createDestination_additionalFixedProperties :: Lens.Lens' CreateDestination (Prelude.Maybe Prelude.Text)
createDestination_additionalFixedProperties :: Lens' CreateDestination (Maybe Text)
createDestination_additionalFixedProperties = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDestination' {Maybe Text
additionalFixedProperties :: Maybe Text
$sel:additionalFixedProperties:CreateDestination' :: CreateDestination -> Maybe Text
additionalFixedProperties} -> Maybe Text
additionalFixedProperties) (\s :: CreateDestination
s@CreateDestination' {} Maybe Text
a -> CreateDestination
s {$sel:additionalFixedProperties:CreateDestination' :: Maybe Text
additionalFixedProperties = Maybe Text
a} :: CreateDestination)

-- | Undocumented member.
createDestination_clientToken :: Lens.Lens' CreateDestination (Prelude.Maybe Prelude.Text)
createDestination_clientToken :: Lens' CreateDestination (Maybe Text)
createDestination_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDestination' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateDestination' :: CreateDestination -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateDestination
s@CreateDestination' {} Maybe Text
a -> CreateDestination
s {$sel:clientToken:CreateDestination' :: Maybe Text
clientToken = Maybe Text
a} :: CreateDestination)

-- | The state of the destination. Default used if not specified.
createDestination_state :: Lens.Lens' CreateDestination (Prelude.Maybe DestinationState)
createDestination_state :: Lens' CreateDestination (Maybe DestinationState)
createDestination_state = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDestination' {Maybe DestinationState
state :: Maybe DestinationState
$sel:state:CreateDestination' :: CreateDestination -> Maybe DestinationState
state} -> Maybe DestinationState
state) (\s :: CreateDestination
s@CreateDestination' {} Maybe DestinationState
a -> CreateDestination
s {$sel:state:CreateDestination' :: Maybe DestinationState
state = Maybe DestinationState
a} :: CreateDestination)

-- | Undocumented member.
createDestination_name :: Lens.Lens' CreateDestination Prelude.Text
createDestination_name :: Lens' CreateDestination Text
createDestination_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDestination' {Text
name :: Text
$sel:name:CreateDestination' :: CreateDestination -> Text
name} -> Text
name) (\s :: CreateDestination
s@CreateDestination' {} Text
a -> CreateDestination
s {$sel:name:CreateDestination' :: Text
name = Text
a} :: CreateDestination)

-- | Undocumented member.
createDestination_site :: Lens.Lens' CreateDestination Prelude.Text
createDestination_site :: Lens' CreateDestination Text
createDestination_site = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDestination' {Text
site :: Text
$sel:site:CreateDestination' :: CreateDestination -> Text
site} -> Text
site) (\s :: CreateDestination
s@CreateDestination' {} Text
a -> CreateDestination
s {$sel:site:CreateDestination' :: Text
site = Text
a} :: CreateDestination)

instance Core.AWSRequest CreateDestination where
  type
    AWSResponse CreateDestination =
      CreateDestinationResponse
  request :: (Service -> Service)
-> CreateDestination -> Request CreateDestination
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 CreateDestination
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateDestination)))
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
-> Text
-> POSIX
-> POSIX
-> DestinationState
-> CreateDestinationResponse
CreateDestinationResponse'
            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
"arn")
            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
"id")
            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
"createdAt")
            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
"updatedAt")
            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
"state")
      )

instance Prelude.Hashable CreateDestination where
  hashWithSalt :: Int -> CreateDestination -> Int
hashWithSalt Int
_salt CreateDestination' {Maybe Text
Maybe DestinationState
Text
site :: Text
name :: Text
state :: Maybe DestinationState
clientToken :: Maybe Text
additionalFixedProperties :: Maybe Text
$sel:site:CreateDestination' :: CreateDestination -> Text
$sel:name:CreateDestination' :: CreateDestination -> Text
$sel:state:CreateDestination' :: CreateDestination -> Maybe DestinationState
$sel:clientToken:CreateDestination' :: CreateDestination -> Maybe Text
$sel:additionalFixedProperties:CreateDestination' :: CreateDestination -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
additionalFixedProperties
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DestinationState
state
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
site

instance Prelude.NFData CreateDestination where
  rnf :: CreateDestination -> ()
rnf CreateDestination' {Maybe Text
Maybe DestinationState
Text
site :: Text
name :: Text
state :: Maybe DestinationState
clientToken :: Maybe Text
additionalFixedProperties :: Maybe Text
$sel:site:CreateDestination' :: CreateDestination -> Text
$sel:name:CreateDestination' :: CreateDestination -> Text
$sel:state:CreateDestination' :: CreateDestination -> Maybe DestinationState
$sel:clientToken:CreateDestination' :: CreateDestination -> Maybe Text
$sel:additionalFixedProperties:CreateDestination' :: CreateDestination -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
additionalFixedProperties
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DestinationState
state
      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 Text
site

instance Data.ToHeaders CreateDestination where
  toHeaders :: CreateDestination -> 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 CreateDestination where
  toJSON :: CreateDestination -> Value
toJSON CreateDestination' {Maybe Text
Maybe DestinationState
Text
site :: Text
name :: Text
state :: Maybe DestinationState
clientToken :: Maybe Text
additionalFixedProperties :: Maybe Text
$sel:site:CreateDestination' :: CreateDestination -> Text
$sel:name:CreateDestination' :: CreateDestination -> Text
$sel:state:CreateDestination' :: CreateDestination -> Maybe DestinationState
$sel:clientToken:CreateDestination' :: CreateDestination -> Maybe Text
$sel:additionalFixedProperties:CreateDestination' :: CreateDestination -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"additionalFixedProperties" 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
additionalFixedProperties,
            (Key
"clientToken" 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
clientToken,
            (Key
"state" 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 DestinationState
state,
            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
"site" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
site)
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateDestinationResponse' 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', 'createDestinationResponse_httpStatus' - The response's http status code.
--
-- 'arn', 'createDestinationResponse_arn' - Undocumented member.
--
-- 'id', 'createDestinationResponse_id' - Undocumented member.
--
-- 'createdAt', 'createDestinationResponse_createdAt' - Undocumented member.
--
-- 'updatedAt', 'createDestinationResponse_updatedAt' - Undocumented member.
--
-- 'state', 'createDestinationResponse_state' - Undocumented member.
newCreateDestinationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'arn'
  Prelude.Text ->
  -- | 'id'
  Prelude.Text ->
  -- | 'createdAt'
  Prelude.UTCTime ->
  -- | 'updatedAt'
  Prelude.UTCTime ->
  -- | 'state'
  DestinationState ->
  CreateDestinationResponse
newCreateDestinationResponse :: Int
-> Text
-> Text
-> UTCTime
-> UTCTime
-> DestinationState
-> CreateDestinationResponse
newCreateDestinationResponse
  Int
pHttpStatus_
  Text
pArn_
  Text
pId_
  UTCTime
pCreatedAt_
  UTCTime
pUpdatedAt_
  DestinationState
pState_ =
    CreateDestinationResponse'
      { $sel:httpStatus:CreateDestinationResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:arn:CreateDestinationResponse' :: Text
arn = Text
pArn_,
        $sel:id:CreateDestinationResponse' :: Text
id = Text
pId_,
        $sel:createdAt:CreateDestinationResponse' :: POSIX
createdAt = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pCreatedAt_,
        $sel:updatedAt:CreateDestinationResponse' :: POSIX
updatedAt = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pUpdatedAt_,
        $sel:state:CreateDestinationResponse' :: DestinationState
state = DestinationState
pState_
      }

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

-- | Undocumented member.
createDestinationResponse_arn :: Lens.Lens' CreateDestinationResponse Prelude.Text
createDestinationResponse_arn :: Lens' CreateDestinationResponse Text
createDestinationResponse_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDestinationResponse' {Text
arn :: Text
$sel:arn:CreateDestinationResponse' :: CreateDestinationResponse -> Text
arn} -> Text
arn) (\s :: CreateDestinationResponse
s@CreateDestinationResponse' {} Text
a -> CreateDestinationResponse
s {$sel:arn:CreateDestinationResponse' :: Text
arn = Text
a} :: CreateDestinationResponse)

-- | Undocumented member.
createDestinationResponse_id :: Lens.Lens' CreateDestinationResponse Prelude.Text
createDestinationResponse_id :: Lens' CreateDestinationResponse Text
createDestinationResponse_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDestinationResponse' {Text
id :: Text
$sel:id:CreateDestinationResponse' :: CreateDestinationResponse -> Text
id} -> Text
id) (\s :: CreateDestinationResponse
s@CreateDestinationResponse' {} Text
a -> CreateDestinationResponse
s {$sel:id:CreateDestinationResponse' :: Text
id = Text
a} :: CreateDestinationResponse)

-- | Undocumented member.
createDestinationResponse_createdAt :: Lens.Lens' CreateDestinationResponse Prelude.UTCTime
createDestinationResponse_createdAt :: Lens' CreateDestinationResponse UTCTime
createDestinationResponse_createdAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDestinationResponse' {POSIX
createdAt :: POSIX
$sel:createdAt:CreateDestinationResponse' :: CreateDestinationResponse -> POSIX
createdAt} -> POSIX
createdAt) (\s :: CreateDestinationResponse
s@CreateDestinationResponse' {} POSIX
a -> CreateDestinationResponse
s {$sel:createdAt:CreateDestinationResponse' :: POSIX
createdAt = POSIX
a} :: CreateDestinationResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | Undocumented member.
createDestinationResponse_updatedAt :: Lens.Lens' CreateDestinationResponse Prelude.UTCTime
createDestinationResponse_updatedAt :: Lens' CreateDestinationResponse UTCTime
createDestinationResponse_updatedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDestinationResponse' {POSIX
updatedAt :: POSIX
$sel:updatedAt:CreateDestinationResponse' :: CreateDestinationResponse -> POSIX
updatedAt} -> POSIX
updatedAt) (\s :: CreateDestinationResponse
s@CreateDestinationResponse' {} POSIX
a -> CreateDestinationResponse
s {$sel:updatedAt:CreateDestinationResponse' :: POSIX
updatedAt = POSIX
a} :: CreateDestinationResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | Undocumented member.
createDestinationResponse_state :: Lens.Lens' CreateDestinationResponse DestinationState
createDestinationResponse_state :: Lens' CreateDestinationResponse DestinationState
createDestinationResponse_state = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDestinationResponse' {DestinationState
state :: DestinationState
$sel:state:CreateDestinationResponse' :: CreateDestinationResponse -> DestinationState
state} -> DestinationState
state) (\s :: CreateDestinationResponse
s@CreateDestinationResponse' {} DestinationState
a -> CreateDestinationResponse
s {$sel:state:CreateDestinationResponse' :: DestinationState
state = DestinationState
a} :: CreateDestinationResponse)

instance Prelude.NFData CreateDestinationResponse where
  rnf :: CreateDestinationResponse -> ()
rnf CreateDestinationResponse' {Int
Text
POSIX
DestinationState
state :: DestinationState
updatedAt :: POSIX
createdAt :: POSIX
id :: Text
arn :: Text
httpStatus :: Int
$sel:state:CreateDestinationResponse' :: CreateDestinationResponse -> DestinationState
$sel:updatedAt:CreateDestinationResponse' :: CreateDestinationResponse -> POSIX
$sel:createdAt:CreateDestinationResponse' :: CreateDestinationResponse -> POSIX
$sel:id:CreateDestinationResponse' :: CreateDestinationResponse -> Text
$sel:arn:CreateDestinationResponse' :: CreateDestinationResponse -> Text
$sel:httpStatus:CreateDestinationResponse' :: CreateDestinationResponse -> 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
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
id
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
createdAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
updatedAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf DestinationState
state