{-# 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.IotTwinMaker.CreateSyncJob
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- This action creates a SyncJob.
module Amazonka.IotTwinMaker.CreateSyncJob
  ( -- * Creating a Request
    CreateSyncJob (..),
    newCreateSyncJob,

    -- * Request Lenses
    createSyncJob_tags,
    createSyncJob_workspaceId,
    createSyncJob_syncSource,
    createSyncJob_syncRole,

    -- * Destructuring the Response
    CreateSyncJobResponse (..),
    newCreateSyncJobResponse,

    -- * Response Lenses
    createSyncJobResponse_httpStatus,
    createSyncJobResponse_arn,
    createSyncJobResponse_creationDateTime,
    createSyncJobResponse_state,
  )
where

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

-- | /See:/ 'newCreateSyncJob' smart constructor.
data CreateSyncJob = CreateSyncJob'
  { -- | The SyncJob tags.
    CreateSyncJob -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The workspace Id.
    CreateSyncJob -> Text
workspaceId :: Prelude.Text,
    -- | The sync source.
    --
    -- Currently the only supported syncSoucre is @SITEWISE @.
    CreateSyncJob -> Text
syncSource :: Prelude.Text,
    -- | The SyncJob IAM role. This IAM role is used by the sync job to read from
    -- the syncSource, and create, update or delete the corresponding
    -- resources.
    CreateSyncJob -> Text
syncRole :: Prelude.Text
  }
  deriving (CreateSyncJob -> CreateSyncJob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateSyncJob -> CreateSyncJob -> Bool
$c/= :: CreateSyncJob -> CreateSyncJob -> Bool
== :: CreateSyncJob -> CreateSyncJob -> Bool
$c== :: CreateSyncJob -> CreateSyncJob -> Bool
Prelude.Eq, ReadPrec [CreateSyncJob]
ReadPrec CreateSyncJob
Int -> ReadS CreateSyncJob
ReadS [CreateSyncJob]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateSyncJob]
$creadListPrec :: ReadPrec [CreateSyncJob]
readPrec :: ReadPrec CreateSyncJob
$creadPrec :: ReadPrec CreateSyncJob
readList :: ReadS [CreateSyncJob]
$creadList :: ReadS [CreateSyncJob]
readsPrec :: Int -> ReadS CreateSyncJob
$creadsPrec :: Int -> ReadS CreateSyncJob
Prelude.Read, Int -> CreateSyncJob -> ShowS
[CreateSyncJob] -> ShowS
CreateSyncJob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateSyncJob] -> ShowS
$cshowList :: [CreateSyncJob] -> ShowS
show :: CreateSyncJob -> String
$cshow :: CreateSyncJob -> String
showsPrec :: Int -> CreateSyncJob -> ShowS
$cshowsPrec :: Int -> CreateSyncJob -> ShowS
Prelude.Show, forall x. Rep CreateSyncJob x -> CreateSyncJob
forall x. CreateSyncJob -> Rep CreateSyncJob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateSyncJob x -> CreateSyncJob
$cfrom :: forall x. CreateSyncJob -> Rep CreateSyncJob x
Prelude.Generic)

-- |
-- Create a value of 'CreateSyncJob' 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:
--
-- 'tags', 'createSyncJob_tags' - The SyncJob tags.
--
-- 'workspaceId', 'createSyncJob_workspaceId' - The workspace Id.
--
-- 'syncSource', 'createSyncJob_syncSource' - The sync source.
--
-- Currently the only supported syncSoucre is @SITEWISE @.
--
-- 'syncRole', 'createSyncJob_syncRole' - The SyncJob IAM role. This IAM role is used by the sync job to read from
-- the syncSource, and create, update or delete the corresponding
-- resources.
newCreateSyncJob ::
  -- | 'workspaceId'
  Prelude.Text ->
  -- | 'syncSource'
  Prelude.Text ->
  -- | 'syncRole'
  Prelude.Text ->
  CreateSyncJob
newCreateSyncJob :: Text -> Text -> Text -> CreateSyncJob
newCreateSyncJob
  Text
pWorkspaceId_
  Text
pSyncSource_
  Text
pSyncRole_ =
    CreateSyncJob'
      { $sel:tags:CreateSyncJob' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:workspaceId:CreateSyncJob' :: Text
workspaceId = Text
pWorkspaceId_,
        $sel:syncSource:CreateSyncJob' :: Text
syncSource = Text
pSyncSource_,
        $sel:syncRole:CreateSyncJob' :: Text
syncRole = Text
pSyncRole_
      }

-- | The SyncJob tags.
createSyncJob_tags :: Lens.Lens' CreateSyncJob (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createSyncJob_tags :: Lens' CreateSyncJob (Maybe (HashMap Text Text))
createSyncJob_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSyncJob' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateSyncJob' :: CreateSyncJob -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateSyncJob
s@CreateSyncJob' {} Maybe (HashMap Text Text)
a -> CreateSyncJob
s {$sel:tags:CreateSyncJob' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateSyncJob) 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 workspace Id.
createSyncJob_workspaceId :: Lens.Lens' CreateSyncJob Prelude.Text
createSyncJob_workspaceId :: Lens' CreateSyncJob Text
createSyncJob_workspaceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSyncJob' {Text
workspaceId :: Text
$sel:workspaceId:CreateSyncJob' :: CreateSyncJob -> Text
workspaceId} -> Text
workspaceId) (\s :: CreateSyncJob
s@CreateSyncJob' {} Text
a -> CreateSyncJob
s {$sel:workspaceId:CreateSyncJob' :: Text
workspaceId = Text
a} :: CreateSyncJob)

-- | The sync source.
--
-- Currently the only supported syncSoucre is @SITEWISE @.
createSyncJob_syncSource :: Lens.Lens' CreateSyncJob Prelude.Text
createSyncJob_syncSource :: Lens' CreateSyncJob Text
createSyncJob_syncSource = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSyncJob' {Text
syncSource :: Text
$sel:syncSource:CreateSyncJob' :: CreateSyncJob -> Text
syncSource} -> Text
syncSource) (\s :: CreateSyncJob
s@CreateSyncJob' {} Text
a -> CreateSyncJob
s {$sel:syncSource:CreateSyncJob' :: Text
syncSource = Text
a} :: CreateSyncJob)

-- | The SyncJob IAM role. This IAM role is used by the sync job to read from
-- the syncSource, and create, update or delete the corresponding
-- resources.
createSyncJob_syncRole :: Lens.Lens' CreateSyncJob Prelude.Text
createSyncJob_syncRole :: Lens' CreateSyncJob Text
createSyncJob_syncRole = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSyncJob' {Text
syncRole :: Text
$sel:syncRole:CreateSyncJob' :: CreateSyncJob -> Text
syncRole} -> Text
syncRole) (\s :: CreateSyncJob
s@CreateSyncJob' {} Text
a -> CreateSyncJob
s {$sel:syncRole:CreateSyncJob' :: Text
syncRole = Text
a} :: CreateSyncJob)

instance Core.AWSRequest CreateSyncJob where
  type
    AWSResponse CreateSyncJob =
      CreateSyncJobResponse
  request :: (Service -> Service) -> CreateSyncJob -> Request CreateSyncJob
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 CreateSyncJob
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateSyncJob)))
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 -> POSIX -> SyncJobState -> CreateSyncJobResponse
CreateSyncJobResponse'
            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
"creationDateTime")
            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 CreateSyncJob where
  hashWithSalt :: Int -> CreateSyncJob -> Int
hashWithSalt Int
_salt CreateSyncJob' {Maybe (HashMap Text Text)
Text
syncRole :: Text
syncSource :: Text
workspaceId :: Text
tags :: Maybe (HashMap Text Text)
$sel:syncRole:CreateSyncJob' :: CreateSyncJob -> Text
$sel:syncSource:CreateSyncJob' :: CreateSyncJob -> Text
$sel:workspaceId:CreateSyncJob' :: CreateSyncJob -> Text
$sel:tags:CreateSyncJob' :: CreateSyncJob -> Maybe (HashMap Text Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
workspaceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
syncSource
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
syncRole

instance Prelude.NFData CreateSyncJob where
  rnf :: CreateSyncJob -> ()
rnf CreateSyncJob' {Maybe (HashMap Text Text)
Text
syncRole :: Text
syncSource :: Text
workspaceId :: Text
tags :: Maybe (HashMap Text Text)
$sel:syncRole:CreateSyncJob' :: CreateSyncJob -> Text
$sel:syncSource:CreateSyncJob' :: CreateSyncJob -> Text
$sel:workspaceId:CreateSyncJob' :: CreateSyncJob -> Text
$sel:tags:CreateSyncJob' :: CreateSyncJob -> Maybe (HashMap Text Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
workspaceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
syncSource
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
syncRole

instance Data.ToHeaders CreateSyncJob where
  toHeaders :: CreateSyncJob -> 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 CreateSyncJob where
  toJSON :: CreateSyncJob -> Value
toJSON CreateSyncJob' {Maybe (HashMap Text Text)
Text
syncRole :: Text
syncSource :: Text
workspaceId :: Text
tags :: Maybe (HashMap Text Text)
$sel:syncRole:CreateSyncJob' :: CreateSyncJob -> Text
$sel:syncSource:CreateSyncJob' :: CreateSyncJob -> Text
$sel:workspaceId:CreateSyncJob' :: CreateSyncJob -> Text
$sel:tags:CreateSyncJob' :: CreateSyncJob -> Maybe (HashMap Text Text)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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 (HashMap Text Text)
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"syncRole" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
syncRole)
          ]
      )

instance Data.ToPath CreateSyncJob where
  toPath :: CreateSyncJob -> ByteString
toPath CreateSyncJob' {Maybe (HashMap Text Text)
Text
syncRole :: Text
syncSource :: Text
workspaceId :: Text
tags :: Maybe (HashMap Text Text)
$sel:syncRole:CreateSyncJob' :: CreateSyncJob -> Text
$sel:syncSource:CreateSyncJob' :: CreateSyncJob -> Text
$sel:workspaceId:CreateSyncJob' :: CreateSyncJob -> Text
$sel:tags:CreateSyncJob' :: CreateSyncJob -> Maybe (HashMap Text Text)
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/workspaces/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
workspaceId,
        ByteString
"/sync-jobs/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
syncSource
      ]

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

-- | /See:/ 'newCreateSyncJobResponse' smart constructor.
data CreateSyncJobResponse = CreateSyncJobResponse'
  { -- | The response's http status code.
    CreateSyncJobResponse -> Int
httpStatus :: Prelude.Int,
    -- | The SyncJob ARN.
    CreateSyncJobResponse -> Text
arn :: Prelude.Text,
    -- | The date and time for the SyncJob creation.
    CreateSyncJobResponse -> POSIX
creationDateTime :: Data.POSIX,
    -- | The SyncJob response state.
    CreateSyncJobResponse -> SyncJobState
state :: SyncJobState
  }
  deriving (CreateSyncJobResponse -> CreateSyncJobResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateSyncJobResponse -> CreateSyncJobResponse -> Bool
$c/= :: CreateSyncJobResponse -> CreateSyncJobResponse -> Bool
== :: CreateSyncJobResponse -> CreateSyncJobResponse -> Bool
$c== :: CreateSyncJobResponse -> CreateSyncJobResponse -> Bool
Prelude.Eq, ReadPrec [CreateSyncJobResponse]
ReadPrec CreateSyncJobResponse
Int -> ReadS CreateSyncJobResponse
ReadS [CreateSyncJobResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateSyncJobResponse]
$creadListPrec :: ReadPrec [CreateSyncJobResponse]
readPrec :: ReadPrec CreateSyncJobResponse
$creadPrec :: ReadPrec CreateSyncJobResponse
readList :: ReadS [CreateSyncJobResponse]
$creadList :: ReadS [CreateSyncJobResponse]
readsPrec :: Int -> ReadS CreateSyncJobResponse
$creadsPrec :: Int -> ReadS CreateSyncJobResponse
Prelude.Read, Int -> CreateSyncJobResponse -> ShowS
[CreateSyncJobResponse] -> ShowS
CreateSyncJobResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateSyncJobResponse] -> ShowS
$cshowList :: [CreateSyncJobResponse] -> ShowS
show :: CreateSyncJobResponse -> String
$cshow :: CreateSyncJobResponse -> String
showsPrec :: Int -> CreateSyncJobResponse -> ShowS
$cshowsPrec :: Int -> CreateSyncJobResponse -> ShowS
Prelude.Show, forall x. Rep CreateSyncJobResponse x -> CreateSyncJobResponse
forall x. CreateSyncJobResponse -> Rep CreateSyncJobResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateSyncJobResponse x -> CreateSyncJobResponse
$cfrom :: forall x. CreateSyncJobResponse -> Rep CreateSyncJobResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateSyncJobResponse' 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', 'createSyncJobResponse_httpStatus' - The response's http status code.
--
-- 'arn', 'createSyncJobResponse_arn' - The SyncJob ARN.
--
-- 'creationDateTime', 'createSyncJobResponse_creationDateTime' - The date and time for the SyncJob creation.
--
-- 'state', 'createSyncJobResponse_state' - The SyncJob response state.
newCreateSyncJobResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'arn'
  Prelude.Text ->
  -- | 'creationDateTime'
  Prelude.UTCTime ->
  -- | 'state'
  SyncJobState ->
  CreateSyncJobResponse
newCreateSyncJobResponse :: Int -> Text -> UTCTime -> SyncJobState -> CreateSyncJobResponse
newCreateSyncJobResponse
  Int
pHttpStatus_
  Text
pArn_
  UTCTime
pCreationDateTime_
  SyncJobState
pState_ =
    CreateSyncJobResponse'
      { $sel:httpStatus:CreateSyncJobResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:arn:CreateSyncJobResponse' :: Text
arn = Text
pArn_,
        $sel:creationDateTime:CreateSyncJobResponse' :: POSIX
creationDateTime =
          forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pCreationDateTime_,
        $sel:state:CreateSyncJobResponse' :: SyncJobState
state = SyncJobState
pState_
      }

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

-- | The SyncJob ARN.
createSyncJobResponse_arn :: Lens.Lens' CreateSyncJobResponse Prelude.Text
createSyncJobResponse_arn :: Lens' CreateSyncJobResponse Text
createSyncJobResponse_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSyncJobResponse' {Text
arn :: Text
$sel:arn:CreateSyncJobResponse' :: CreateSyncJobResponse -> Text
arn} -> Text
arn) (\s :: CreateSyncJobResponse
s@CreateSyncJobResponse' {} Text
a -> CreateSyncJobResponse
s {$sel:arn:CreateSyncJobResponse' :: Text
arn = Text
a} :: CreateSyncJobResponse)

-- | The date and time for the SyncJob creation.
createSyncJobResponse_creationDateTime :: Lens.Lens' CreateSyncJobResponse Prelude.UTCTime
createSyncJobResponse_creationDateTime :: Lens' CreateSyncJobResponse UTCTime
createSyncJobResponse_creationDateTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSyncJobResponse' {POSIX
creationDateTime :: POSIX
$sel:creationDateTime:CreateSyncJobResponse' :: CreateSyncJobResponse -> POSIX
creationDateTime} -> POSIX
creationDateTime) (\s :: CreateSyncJobResponse
s@CreateSyncJobResponse' {} POSIX
a -> CreateSyncJobResponse
s {$sel:creationDateTime:CreateSyncJobResponse' :: POSIX
creationDateTime = POSIX
a} :: CreateSyncJobResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The SyncJob response state.
createSyncJobResponse_state :: Lens.Lens' CreateSyncJobResponse SyncJobState
createSyncJobResponse_state :: Lens' CreateSyncJobResponse SyncJobState
createSyncJobResponse_state = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSyncJobResponse' {SyncJobState
state :: SyncJobState
$sel:state:CreateSyncJobResponse' :: CreateSyncJobResponse -> SyncJobState
state} -> SyncJobState
state) (\s :: CreateSyncJobResponse
s@CreateSyncJobResponse' {} SyncJobState
a -> CreateSyncJobResponse
s {$sel:state:CreateSyncJobResponse' :: SyncJobState
state = SyncJobState
a} :: CreateSyncJobResponse)

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