{-# 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.LexModels.StartImport
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Starts a job to import a resource to Amazon Lex.
module Amazonka.LexModels.StartImport
  ( -- * Creating a Request
    StartImport (..),
    newStartImport,

    -- * Request Lenses
    startImport_tags,
    startImport_payload,
    startImport_resourceType,
    startImport_mergeStrategy,

    -- * Destructuring the Response
    StartImportResponse (..),
    newStartImportResponse,

    -- * Response Lenses
    startImportResponse_createdDate,
    startImportResponse_importId,
    startImportResponse_importStatus,
    startImportResponse_mergeStrategy,
    startImportResponse_name,
    startImportResponse_resourceType,
    startImportResponse_tags,
    startImportResponse_httpStatus,
  )
where

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

-- | /See:/ 'newStartImport' smart constructor.
data StartImport = StartImport'
  { -- | A list of tags to add to the imported bot. You can only add tags when
    -- you import a bot, you can\'t add tags to an intent or slot type.
    StartImport -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | A zip archive in binary format. The archive should contain one file, a
    -- JSON file containing the resource to import. The resource should match
    -- the type specified in the @resourceType@ field.
    StartImport -> Base64
payload :: Data.Base64,
    -- | Specifies the type of resource to export. Each resource also exports any
    -- resources that it depends on.
    --
    -- -   A bot exports dependent intents.
    --
    -- -   An intent exports dependent slot types.
    StartImport -> ResourceType
resourceType :: ResourceType,
    -- | Specifies the action that the @StartImport@ operation should take when
    -- there is an existing resource with the same name.
    --
    -- -   FAIL_ON_CONFLICT - The import operation is stopped on the first
    --     conflict between a resource in the import file and an existing
    --     resource. The name of the resource causing the conflict is in the
    --     @failureReason@ field of the response to the @GetImport@ operation.
    --
    --     OVERWRITE_LATEST - The import operation proceeds even if there is a
    --     conflict with an existing resource. The $LASTEST version of the
    --     existing resource is overwritten with the data from the import file.
    StartImport -> MergeStrategy
mergeStrategy :: MergeStrategy
  }
  deriving (StartImport -> StartImport -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartImport -> StartImport -> Bool
$c/= :: StartImport -> StartImport -> Bool
== :: StartImport -> StartImport -> Bool
$c== :: StartImport -> StartImport -> Bool
Prelude.Eq, ReadPrec [StartImport]
ReadPrec StartImport
Int -> ReadS StartImport
ReadS [StartImport]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartImport]
$creadListPrec :: ReadPrec [StartImport]
readPrec :: ReadPrec StartImport
$creadPrec :: ReadPrec StartImport
readList :: ReadS [StartImport]
$creadList :: ReadS [StartImport]
readsPrec :: Int -> ReadS StartImport
$creadsPrec :: Int -> ReadS StartImport
Prelude.Read, Int -> StartImport -> ShowS
[StartImport] -> ShowS
StartImport -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartImport] -> ShowS
$cshowList :: [StartImport] -> ShowS
show :: StartImport -> String
$cshow :: StartImport -> String
showsPrec :: Int -> StartImport -> ShowS
$cshowsPrec :: Int -> StartImport -> ShowS
Prelude.Show, forall x. Rep StartImport x -> StartImport
forall x. StartImport -> Rep StartImport x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartImport x -> StartImport
$cfrom :: forall x. StartImport -> Rep StartImport x
Prelude.Generic)

-- |
-- Create a value of 'StartImport' 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', 'startImport_tags' - A list of tags to add to the imported bot. You can only add tags when
-- you import a bot, you can\'t add tags to an intent or slot type.
--
-- 'payload', 'startImport_payload' - A zip archive in binary format. The archive should contain one file, a
-- JSON file containing the resource to import. The resource should match
-- the type specified in the @resourceType@ field.--
-- -- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.
-- -- The underlying isomorphism will encode to Base64 representation during
-- -- serialisation, and decode from Base64 representation during deserialisation.
-- -- This 'Lens' accepts and returns only raw unencoded data.
--
-- 'resourceType', 'startImport_resourceType' - Specifies the type of resource to export. Each resource also exports any
-- resources that it depends on.
--
-- -   A bot exports dependent intents.
--
-- -   An intent exports dependent slot types.
--
-- 'mergeStrategy', 'startImport_mergeStrategy' - Specifies the action that the @StartImport@ operation should take when
-- there is an existing resource with the same name.
--
-- -   FAIL_ON_CONFLICT - The import operation is stopped on the first
--     conflict between a resource in the import file and an existing
--     resource. The name of the resource causing the conflict is in the
--     @failureReason@ field of the response to the @GetImport@ operation.
--
--     OVERWRITE_LATEST - The import operation proceeds even if there is a
--     conflict with an existing resource. The $LASTEST version of the
--     existing resource is overwritten with the data from the import file.
newStartImport ::
  -- | 'payload'
  Prelude.ByteString ->
  -- | 'resourceType'
  ResourceType ->
  -- | 'mergeStrategy'
  MergeStrategy ->
  StartImport
newStartImport :: ByteString -> ResourceType -> MergeStrategy -> StartImport
newStartImport
  ByteString
pPayload_
  ResourceType
pResourceType_
  MergeStrategy
pMergeStrategy_ =
    StartImport'
      { $sel:tags:StartImport' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:payload:StartImport' :: Base64
payload = Iso' Base64 ByteString
Data._Base64 forall t b. AReview t b -> b -> t
Lens.# ByteString
pPayload_,
        $sel:resourceType:StartImport' :: ResourceType
resourceType = ResourceType
pResourceType_,
        $sel:mergeStrategy:StartImport' :: MergeStrategy
mergeStrategy = MergeStrategy
pMergeStrategy_
      }

-- | A list of tags to add to the imported bot. You can only add tags when
-- you import a bot, you can\'t add tags to an intent or slot type.
startImport_tags :: Lens.Lens' StartImport (Prelude.Maybe [Tag])
startImport_tags :: Lens' StartImport (Maybe [Tag])
startImport_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartImport' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:StartImport' :: StartImport -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: StartImport
s@StartImport' {} Maybe [Tag]
a -> StartImport
s {$sel:tags:StartImport' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: StartImport) 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

-- | A zip archive in binary format. The archive should contain one file, a
-- JSON file containing the resource to import. The resource should match
-- the type specified in the @resourceType@ field.--
-- -- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.
-- -- The underlying isomorphism will encode to Base64 representation during
-- -- serialisation, and decode from Base64 representation during deserialisation.
-- -- This 'Lens' accepts and returns only raw unencoded data.
startImport_payload :: Lens.Lens' StartImport Prelude.ByteString
startImport_payload :: Lens' StartImport ByteString
startImport_payload = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartImport' {Base64
payload :: Base64
$sel:payload:StartImport' :: StartImport -> Base64
payload} -> Base64
payload) (\s :: StartImport
s@StartImport' {} Base64
a -> StartImport
s {$sel:payload:StartImport' :: Base64
payload = Base64
a} :: StartImport) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Iso' Base64 ByteString
Data._Base64

-- | Specifies the type of resource to export. Each resource also exports any
-- resources that it depends on.
--
-- -   A bot exports dependent intents.
--
-- -   An intent exports dependent slot types.
startImport_resourceType :: Lens.Lens' StartImport ResourceType
startImport_resourceType :: Lens' StartImport ResourceType
startImport_resourceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartImport' {ResourceType
resourceType :: ResourceType
$sel:resourceType:StartImport' :: StartImport -> ResourceType
resourceType} -> ResourceType
resourceType) (\s :: StartImport
s@StartImport' {} ResourceType
a -> StartImport
s {$sel:resourceType:StartImport' :: ResourceType
resourceType = ResourceType
a} :: StartImport)

-- | Specifies the action that the @StartImport@ operation should take when
-- there is an existing resource with the same name.
--
-- -   FAIL_ON_CONFLICT - The import operation is stopped on the first
--     conflict between a resource in the import file and an existing
--     resource. The name of the resource causing the conflict is in the
--     @failureReason@ field of the response to the @GetImport@ operation.
--
--     OVERWRITE_LATEST - The import operation proceeds even if there is a
--     conflict with an existing resource. The $LASTEST version of the
--     existing resource is overwritten with the data from the import file.
startImport_mergeStrategy :: Lens.Lens' StartImport MergeStrategy
startImport_mergeStrategy :: Lens' StartImport MergeStrategy
startImport_mergeStrategy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartImport' {MergeStrategy
mergeStrategy :: MergeStrategy
$sel:mergeStrategy:StartImport' :: StartImport -> MergeStrategy
mergeStrategy} -> MergeStrategy
mergeStrategy) (\s :: StartImport
s@StartImport' {} MergeStrategy
a -> StartImport
s {$sel:mergeStrategy:StartImport' :: MergeStrategy
mergeStrategy = MergeStrategy
a} :: StartImport)

instance Core.AWSRequest StartImport where
  type AWSResponse StartImport = StartImportResponse
  request :: (Service -> Service) -> StartImport -> Request StartImport
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 StartImport
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse StartImport)))
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 ->
          Maybe POSIX
-> Maybe Text
-> Maybe ImportStatus
-> Maybe MergeStrategy
-> Maybe Text
-> Maybe ResourceType
-> Maybe [Tag]
-> Int
-> StartImportResponse
StartImportResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"createdDate")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"importId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"importStatus")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"mergeStrategy")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"name")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"resourceType")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"tags" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => 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))
      )

instance Prelude.Hashable StartImport where
  hashWithSalt :: Int -> StartImport -> Int
hashWithSalt Int
_salt StartImport' {Maybe [Tag]
Base64
MergeStrategy
ResourceType
mergeStrategy :: MergeStrategy
resourceType :: ResourceType
payload :: Base64
tags :: Maybe [Tag]
$sel:mergeStrategy:StartImport' :: StartImport -> MergeStrategy
$sel:resourceType:StartImport' :: StartImport -> ResourceType
$sel:payload:StartImport' :: StartImport -> Base64
$sel:tags:StartImport' :: StartImport -> Maybe [Tag]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Base64
payload
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ResourceType
resourceType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` MergeStrategy
mergeStrategy

instance Prelude.NFData StartImport where
  rnf :: StartImport -> ()
rnf StartImport' {Maybe [Tag]
Base64
MergeStrategy
ResourceType
mergeStrategy :: MergeStrategy
resourceType :: ResourceType
payload :: Base64
tags :: Maybe [Tag]
$sel:mergeStrategy:StartImport' :: StartImport -> MergeStrategy
$sel:resourceType:StartImport' :: StartImport -> ResourceType
$sel:payload:StartImport' :: StartImport -> Base64
$sel:tags:StartImport' :: StartImport -> Maybe [Tag]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Base64
payload
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ResourceType
resourceType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf MergeStrategy
mergeStrategy

instance Data.ToHeaders StartImport where
  toHeaders :: StartImport -> 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 StartImport where
  toJSON :: StartImport -> Value
toJSON StartImport' {Maybe [Tag]
Base64
MergeStrategy
ResourceType
mergeStrategy :: MergeStrategy
resourceType :: ResourceType
payload :: Base64
tags :: Maybe [Tag]
$sel:mergeStrategy:StartImport' :: StartImport -> MergeStrategy
$sel:resourceType:StartImport' :: StartImport -> ResourceType
$sel:payload:StartImport' :: StartImport -> Base64
$sel:tags:StartImport' :: StartImport -> Maybe [Tag]
..} =
    [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 [Tag]
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"payload" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Base64
payload),
            forall a. a -> Maybe a
Prelude.Just (Key
"resourceType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ResourceType
resourceType),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"mergeStrategy" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= MergeStrategy
mergeStrategy)
          ]
      )

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

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

-- | /See:/ 'newStartImportResponse' smart constructor.
data StartImportResponse = StartImportResponse'
  { -- | A timestamp for the date and time that the import job was requested.
    StartImportResponse -> Maybe POSIX
createdDate :: Prelude.Maybe Data.POSIX,
    -- | The identifier for the specific import job.
    StartImportResponse -> Maybe Text
importId :: Prelude.Maybe Prelude.Text,
    -- | The status of the import job. If the status is @FAILED@, you can get the
    -- reason for the failure using the @GetImport@ operation.
    StartImportResponse -> Maybe ImportStatus
importStatus :: Prelude.Maybe ImportStatus,
    -- | The action to take when there is a merge conflict.
    StartImportResponse -> Maybe MergeStrategy
mergeStrategy :: Prelude.Maybe MergeStrategy,
    -- | The name given to the import job.
    StartImportResponse -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The type of resource to import.
    StartImportResponse -> Maybe ResourceType
resourceType :: Prelude.Maybe ResourceType,
    -- | A list of tags added to the imported bot.
    StartImportResponse -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The response's http status code.
    StartImportResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (StartImportResponse -> StartImportResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartImportResponse -> StartImportResponse -> Bool
$c/= :: StartImportResponse -> StartImportResponse -> Bool
== :: StartImportResponse -> StartImportResponse -> Bool
$c== :: StartImportResponse -> StartImportResponse -> Bool
Prelude.Eq, ReadPrec [StartImportResponse]
ReadPrec StartImportResponse
Int -> ReadS StartImportResponse
ReadS [StartImportResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartImportResponse]
$creadListPrec :: ReadPrec [StartImportResponse]
readPrec :: ReadPrec StartImportResponse
$creadPrec :: ReadPrec StartImportResponse
readList :: ReadS [StartImportResponse]
$creadList :: ReadS [StartImportResponse]
readsPrec :: Int -> ReadS StartImportResponse
$creadsPrec :: Int -> ReadS StartImportResponse
Prelude.Read, Int -> StartImportResponse -> ShowS
[StartImportResponse] -> ShowS
StartImportResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartImportResponse] -> ShowS
$cshowList :: [StartImportResponse] -> ShowS
show :: StartImportResponse -> String
$cshow :: StartImportResponse -> String
showsPrec :: Int -> StartImportResponse -> ShowS
$cshowsPrec :: Int -> StartImportResponse -> ShowS
Prelude.Show, forall x. Rep StartImportResponse x -> StartImportResponse
forall x. StartImportResponse -> Rep StartImportResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartImportResponse x -> StartImportResponse
$cfrom :: forall x. StartImportResponse -> Rep StartImportResponse x
Prelude.Generic)

-- |
-- Create a value of 'StartImportResponse' 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:
--
-- 'createdDate', 'startImportResponse_createdDate' - A timestamp for the date and time that the import job was requested.
--
-- 'importId', 'startImportResponse_importId' - The identifier for the specific import job.
--
-- 'importStatus', 'startImportResponse_importStatus' - The status of the import job. If the status is @FAILED@, you can get the
-- reason for the failure using the @GetImport@ operation.
--
-- 'mergeStrategy', 'startImportResponse_mergeStrategy' - The action to take when there is a merge conflict.
--
-- 'name', 'startImportResponse_name' - The name given to the import job.
--
-- 'resourceType', 'startImportResponse_resourceType' - The type of resource to import.
--
-- 'tags', 'startImportResponse_tags' - A list of tags added to the imported bot.
--
-- 'httpStatus', 'startImportResponse_httpStatus' - The response's http status code.
newStartImportResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StartImportResponse
newStartImportResponse :: Int -> StartImportResponse
newStartImportResponse Int
pHttpStatus_ =
  StartImportResponse'
    { $sel:createdDate:StartImportResponse' :: Maybe POSIX
createdDate = forall a. Maybe a
Prelude.Nothing,
      $sel:importId:StartImportResponse' :: Maybe Text
importId = forall a. Maybe a
Prelude.Nothing,
      $sel:importStatus:StartImportResponse' :: Maybe ImportStatus
importStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:mergeStrategy:StartImportResponse' :: Maybe MergeStrategy
mergeStrategy = forall a. Maybe a
Prelude.Nothing,
      $sel:name:StartImportResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:resourceType:StartImportResponse' :: Maybe ResourceType
resourceType = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:StartImportResponse' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:StartImportResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A timestamp for the date and time that the import job was requested.
startImportResponse_createdDate :: Lens.Lens' StartImportResponse (Prelude.Maybe Prelude.UTCTime)
startImportResponse_createdDate :: Lens' StartImportResponse (Maybe UTCTime)
startImportResponse_createdDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartImportResponse' {Maybe POSIX
createdDate :: Maybe POSIX
$sel:createdDate:StartImportResponse' :: StartImportResponse -> Maybe POSIX
createdDate} -> Maybe POSIX
createdDate) (\s :: StartImportResponse
s@StartImportResponse' {} Maybe POSIX
a -> StartImportResponse
s {$sel:createdDate:StartImportResponse' :: Maybe POSIX
createdDate = Maybe POSIX
a} :: StartImportResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The identifier for the specific import job.
startImportResponse_importId :: Lens.Lens' StartImportResponse (Prelude.Maybe Prelude.Text)
startImportResponse_importId :: Lens' StartImportResponse (Maybe Text)
startImportResponse_importId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartImportResponse' {Maybe Text
importId :: Maybe Text
$sel:importId:StartImportResponse' :: StartImportResponse -> Maybe Text
importId} -> Maybe Text
importId) (\s :: StartImportResponse
s@StartImportResponse' {} Maybe Text
a -> StartImportResponse
s {$sel:importId:StartImportResponse' :: Maybe Text
importId = Maybe Text
a} :: StartImportResponse)

-- | The status of the import job. If the status is @FAILED@, you can get the
-- reason for the failure using the @GetImport@ operation.
startImportResponse_importStatus :: Lens.Lens' StartImportResponse (Prelude.Maybe ImportStatus)
startImportResponse_importStatus :: Lens' StartImportResponse (Maybe ImportStatus)
startImportResponse_importStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartImportResponse' {Maybe ImportStatus
importStatus :: Maybe ImportStatus
$sel:importStatus:StartImportResponse' :: StartImportResponse -> Maybe ImportStatus
importStatus} -> Maybe ImportStatus
importStatus) (\s :: StartImportResponse
s@StartImportResponse' {} Maybe ImportStatus
a -> StartImportResponse
s {$sel:importStatus:StartImportResponse' :: Maybe ImportStatus
importStatus = Maybe ImportStatus
a} :: StartImportResponse)

-- | The action to take when there is a merge conflict.
startImportResponse_mergeStrategy :: Lens.Lens' StartImportResponse (Prelude.Maybe MergeStrategy)
startImportResponse_mergeStrategy :: Lens' StartImportResponse (Maybe MergeStrategy)
startImportResponse_mergeStrategy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartImportResponse' {Maybe MergeStrategy
mergeStrategy :: Maybe MergeStrategy
$sel:mergeStrategy:StartImportResponse' :: StartImportResponse -> Maybe MergeStrategy
mergeStrategy} -> Maybe MergeStrategy
mergeStrategy) (\s :: StartImportResponse
s@StartImportResponse' {} Maybe MergeStrategy
a -> StartImportResponse
s {$sel:mergeStrategy:StartImportResponse' :: Maybe MergeStrategy
mergeStrategy = Maybe MergeStrategy
a} :: StartImportResponse)

-- | The name given to the import job.
startImportResponse_name :: Lens.Lens' StartImportResponse (Prelude.Maybe Prelude.Text)
startImportResponse_name :: Lens' StartImportResponse (Maybe Text)
startImportResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartImportResponse' {Maybe Text
name :: Maybe Text
$sel:name:StartImportResponse' :: StartImportResponse -> Maybe Text
name} -> Maybe Text
name) (\s :: StartImportResponse
s@StartImportResponse' {} Maybe Text
a -> StartImportResponse
s {$sel:name:StartImportResponse' :: Maybe Text
name = Maybe Text
a} :: StartImportResponse)

-- | The type of resource to import.
startImportResponse_resourceType :: Lens.Lens' StartImportResponse (Prelude.Maybe ResourceType)
startImportResponse_resourceType :: Lens' StartImportResponse (Maybe ResourceType)
startImportResponse_resourceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartImportResponse' {Maybe ResourceType
resourceType :: Maybe ResourceType
$sel:resourceType:StartImportResponse' :: StartImportResponse -> Maybe ResourceType
resourceType} -> Maybe ResourceType
resourceType) (\s :: StartImportResponse
s@StartImportResponse' {} Maybe ResourceType
a -> StartImportResponse
s {$sel:resourceType:StartImportResponse' :: Maybe ResourceType
resourceType = Maybe ResourceType
a} :: StartImportResponse)

-- | A list of tags added to the imported bot.
startImportResponse_tags :: Lens.Lens' StartImportResponse (Prelude.Maybe [Tag])
startImportResponse_tags :: Lens' StartImportResponse (Maybe [Tag])
startImportResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartImportResponse' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:StartImportResponse' :: StartImportResponse -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: StartImportResponse
s@StartImportResponse' {} Maybe [Tag]
a -> StartImportResponse
s {$sel:tags:StartImportResponse' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: StartImportResponse) 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 response's http status code.
startImportResponse_httpStatus :: Lens.Lens' StartImportResponse Prelude.Int
startImportResponse_httpStatus :: Lens' StartImportResponse Int
startImportResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartImportResponse' {Int
httpStatus :: Int
$sel:httpStatus:StartImportResponse' :: StartImportResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: StartImportResponse
s@StartImportResponse' {} Int
a -> StartImportResponse
s {$sel:httpStatus:StartImportResponse' :: Int
httpStatus = Int
a} :: StartImportResponse)

instance Prelude.NFData StartImportResponse where
  rnf :: StartImportResponse -> ()
rnf StartImportResponse' {Int
Maybe [Tag]
Maybe Text
Maybe POSIX
Maybe ImportStatus
Maybe MergeStrategy
Maybe ResourceType
httpStatus :: Int
tags :: Maybe [Tag]
resourceType :: Maybe ResourceType
name :: Maybe Text
mergeStrategy :: Maybe MergeStrategy
importStatus :: Maybe ImportStatus
importId :: Maybe Text
createdDate :: Maybe POSIX
$sel:httpStatus:StartImportResponse' :: StartImportResponse -> Int
$sel:tags:StartImportResponse' :: StartImportResponse -> Maybe [Tag]
$sel:resourceType:StartImportResponse' :: StartImportResponse -> Maybe ResourceType
$sel:name:StartImportResponse' :: StartImportResponse -> Maybe Text
$sel:mergeStrategy:StartImportResponse' :: StartImportResponse -> Maybe MergeStrategy
$sel:importStatus:StartImportResponse' :: StartImportResponse -> Maybe ImportStatus
$sel:importId:StartImportResponse' :: StartImportResponse -> Maybe Text
$sel:createdDate:StartImportResponse' :: StartImportResponse -> Maybe POSIX
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
createdDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
importId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ImportStatus
importStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe MergeStrategy
mergeStrategy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ResourceType
resourceType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus