{-# 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.LexV2Models.UpdateExport
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the password used to protect an export zip archive.
--
-- The password is not required. If you don\'t supply a password, Amazon
-- Lex generates a zip file that is not protected by a password. This is
-- the archive that is available at the pre-signed S3 URL provided by the
-- <https://docs.aws.amazon.com/lexv2/latest/dg/API_DescribeExport.html DescribeExport>
-- operation.
module Amazonka.LexV2Models.UpdateExport
  ( -- * Creating a Request
    UpdateExport (..),
    newUpdateExport,

    -- * Request Lenses
    updateExport_filePassword,
    updateExport_exportId,

    -- * Destructuring the Response
    UpdateExportResponse (..),
    newUpdateExportResponse,

    -- * Response Lenses
    updateExportResponse_creationDateTime,
    updateExportResponse_exportId,
    updateExportResponse_exportStatus,
    updateExportResponse_fileFormat,
    updateExportResponse_lastUpdatedDateTime,
    updateExportResponse_resourceSpecification,
    updateExportResponse_httpStatus,
  )
where

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

-- | /See:/ 'newUpdateExport' smart constructor.
data UpdateExport = UpdateExport'
  { -- | The new password to use to encrypt the export zip archive.
    UpdateExport -> Maybe (Sensitive Text)
filePassword :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The unique identifier Amazon Lex assigned to the export.
    UpdateExport -> Text
exportId :: Prelude.Text
  }
  deriving (UpdateExport -> UpdateExport -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateExport -> UpdateExport -> Bool
$c/= :: UpdateExport -> UpdateExport -> Bool
== :: UpdateExport -> UpdateExport -> Bool
$c== :: UpdateExport -> UpdateExport -> Bool
Prelude.Eq, Int -> UpdateExport -> ShowS
[UpdateExport] -> ShowS
UpdateExport -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateExport] -> ShowS
$cshowList :: [UpdateExport] -> ShowS
show :: UpdateExport -> String
$cshow :: UpdateExport -> String
showsPrec :: Int -> UpdateExport -> ShowS
$cshowsPrec :: Int -> UpdateExport -> ShowS
Prelude.Show, forall x. Rep UpdateExport x -> UpdateExport
forall x. UpdateExport -> Rep UpdateExport x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateExport x -> UpdateExport
$cfrom :: forall x. UpdateExport -> Rep UpdateExport x
Prelude.Generic)

-- |
-- Create a value of 'UpdateExport' 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:
--
-- 'filePassword', 'updateExport_filePassword' - The new password to use to encrypt the export zip archive.
--
-- 'exportId', 'updateExport_exportId' - The unique identifier Amazon Lex assigned to the export.
newUpdateExport ::
  -- | 'exportId'
  Prelude.Text ->
  UpdateExport
newUpdateExport :: Text -> UpdateExport
newUpdateExport Text
pExportId_ =
  UpdateExport'
    { $sel:filePassword:UpdateExport' :: Maybe (Sensitive Text)
filePassword = forall a. Maybe a
Prelude.Nothing,
      $sel:exportId:UpdateExport' :: Text
exportId = Text
pExportId_
    }

-- | The new password to use to encrypt the export zip archive.
updateExport_filePassword :: Lens.Lens' UpdateExport (Prelude.Maybe Prelude.Text)
updateExport_filePassword :: Lens' UpdateExport (Maybe Text)
updateExport_filePassword = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateExport' {Maybe (Sensitive Text)
filePassword :: Maybe (Sensitive Text)
$sel:filePassword:UpdateExport' :: UpdateExport -> Maybe (Sensitive Text)
filePassword} -> Maybe (Sensitive Text)
filePassword) (\s :: UpdateExport
s@UpdateExport' {} Maybe (Sensitive Text)
a -> UpdateExport
s {$sel:filePassword:UpdateExport' :: Maybe (Sensitive Text)
filePassword = Maybe (Sensitive Text)
a} :: UpdateExport) 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. Iso' (Sensitive a) a
Data._Sensitive

-- | The unique identifier Amazon Lex assigned to the export.
updateExport_exportId :: Lens.Lens' UpdateExport Prelude.Text
updateExport_exportId :: Lens' UpdateExport Text
updateExport_exportId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateExport' {Text
exportId :: Text
$sel:exportId:UpdateExport' :: UpdateExport -> Text
exportId} -> Text
exportId) (\s :: UpdateExport
s@UpdateExport' {} Text
a -> UpdateExport
s {$sel:exportId:UpdateExport' :: Text
exportId = Text
a} :: UpdateExport)

instance Core.AWSRequest UpdateExport where
  type AWSResponse UpdateExport = UpdateExportResponse
  request :: (Service -> Service) -> UpdateExport -> Request UpdateExport
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateExport
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateExport)))
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 ExportStatus
-> Maybe ImportExportFileFormat
-> Maybe POSIX
-> Maybe ExportResourceSpecification
-> Int
-> UpdateExportResponse
UpdateExportResponse'
            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
"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 (Maybe a)
Data..?> Key
"exportId")
            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
"exportStatus")
            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
"fileFormat")
            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
"lastUpdatedDateTime")
            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
"resourceSpecification")
            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 UpdateExport where
  hashWithSalt :: Int -> UpdateExport -> Int
hashWithSalt Int
_salt UpdateExport' {Maybe (Sensitive Text)
Text
exportId :: Text
filePassword :: Maybe (Sensitive Text)
$sel:exportId:UpdateExport' :: UpdateExport -> Text
$sel:filePassword:UpdateExport' :: UpdateExport -> Maybe (Sensitive Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
filePassword
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
exportId

instance Prelude.NFData UpdateExport where
  rnf :: UpdateExport -> ()
rnf UpdateExport' {Maybe (Sensitive Text)
Text
exportId :: Text
filePassword :: Maybe (Sensitive Text)
$sel:exportId:UpdateExport' :: UpdateExport -> Text
$sel:filePassword:UpdateExport' :: UpdateExport -> Maybe (Sensitive Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
filePassword
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
exportId

instance Data.ToHeaders UpdateExport where
  toHeaders :: UpdateExport -> 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 UpdateExport where
  toJSON :: UpdateExport -> Value
toJSON UpdateExport' {Maybe (Sensitive Text)
Text
exportId :: Text
filePassword :: Maybe (Sensitive Text)
$sel:exportId:UpdateExport' :: UpdateExport -> Text
$sel:filePassword:UpdateExport' :: UpdateExport -> Maybe (Sensitive Text)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [(Key
"filePassword" 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 (Sensitive Text)
filePassword]
      )

instance Data.ToPath UpdateExport where
  toPath :: UpdateExport -> ByteString
toPath UpdateExport' {Maybe (Sensitive Text)
Text
exportId :: Text
filePassword :: Maybe (Sensitive Text)
$sel:exportId:UpdateExport' :: UpdateExport -> Text
$sel:filePassword:UpdateExport' :: UpdateExport -> Maybe (Sensitive Text)
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/exports/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
exportId, ByteString
"/"]

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

-- | /See:/ 'newUpdateExportResponse' smart constructor.
data UpdateExportResponse = UpdateExportResponse'
  { -- | The date and time that the export was created.
    UpdateExportResponse -> Maybe POSIX
creationDateTime :: Prelude.Maybe Data.POSIX,
    -- | The unique identifier Amazon Lex assigned to the export.
    UpdateExportResponse -> Maybe Text
exportId :: Prelude.Maybe Prelude.Text,
    -- | The status of the export. When the status is @Completed@ the export
    -- archive is available for download.
    UpdateExportResponse -> Maybe ExportStatus
exportStatus :: Prelude.Maybe ExportStatus,
    -- | The file format used for the files that define the resource. The @TSV@
    -- format is required to export a custom vocabulary only; otherwise use
    -- @LexJson@ format.
    UpdateExportResponse -> Maybe ImportExportFileFormat
fileFormat :: Prelude.Maybe ImportExportFileFormat,
    -- | The date and time that the export was last updated.
    UpdateExportResponse -> Maybe POSIX
lastUpdatedDateTime :: Prelude.Maybe Data.POSIX,
    -- | A description of the type of resource that was exported, either a bot or
    -- a bot locale.
    UpdateExportResponse -> Maybe ExportResourceSpecification
resourceSpecification :: Prelude.Maybe ExportResourceSpecification,
    -- | The response's http status code.
    UpdateExportResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateExportResponse -> UpdateExportResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateExportResponse -> UpdateExportResponse -> Bool
$c/= :: UpdateExportResponse -> UpdateExportResponse -> Bool
== :: UpdateExportResponse -> UpdateExportResponse -> Bool
$c== :: UpdateExportResponse -> UpdateExportResponse -> Bool
Prelude.Eq, ReadPrec [UpdateExportResponse]
ReadPrec UpdateExportResponse
Int -> ReadS UpdateExportResponse
ReadS [UpdateExportResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateExportResponse]
$creadListPrec :: ReadPrec [UpdateExportResponse]
readPrec :: ReadPrec UpdateExportResponse
$creadPrec :: ReadPrec UpdateExportResponse
readList :: ReadS [UpdateExportResponse]
$creadList :: ReadS [UpdateExportResponse]
readsPrec :: Int -> ReadS UpdateExportResponse
$creadsPrec :: Int -> ReadS UpdateExportResponse
Prelude.Read, Int -> UpdateExportResponse -> ShowS
[UpdateExportResponse] -> ShowS
UpdateExportResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateExportResponse] -> ShowS
$cshowList :: [UpdateExportResponse] -> ShowS
show :: UpdateExportResponse -> String
$cshow :: UpdateExportResponse -> String
showsPrec :: Int -> UpdateExportResponse -> ShowS
$cshowsPrec :: Int -> UpdateExportResponse -> ShowS
Prelude.Show, forall x. Rep UpdateExportResponse x -> UpdateExportResponse
forall x. UpdateExportResponse -> Rep UpdateExportResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateExportResponse x -> UpdateExportResponse
$cfrom :: forall x. UpdateExportResponse -> Rep UpdateExportResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateExportResponse' 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:
--
-- 'creationDateTime', 'updateExportResponse_creationDateTime' - The date and time that the export was created.
--
-- 'exportId', 'updateExportResponse_exportId' - The unique identifier Amazon Lex assigned to the export.
--
-- 'exportStatus', 'updateExportResponse_exportStatus' - The status of the export. When the status is @Completed@ the export
-- archive is available for download.
--
-- 'fileFormat', 'updateExportResponse_fileFormat' - The file format used for the files that define the resource. The @TSV@
-- format is required to export a custom vocabulary only; otherwise use
-- @LexJson@ format.
--
-- 'lastUpdatedDateTime', 'updateExportResponse_lastUpdatedDateTime' - The date and time that the export was last updated.
--
-- 'resourceSpecification', 'updateExportResponse_resourceSpecification' - A description of the type of resource that was exported, either a bot or
-- a bot locale.
--
-- 'httpStatus', 'updateExportResponse_httpStatus' - The response's http status code.
newUpdateExportResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateExportResponse
newUpdateExportResponse :: Int -> UpdateExportResponse
newUpdateExportResponse Int
pHttpStatus_ =
  UpdateExportResponse'
    { $sel:creationDateTime:UpdateExportResponse' :: Maybe POSIX
creationDateTime =
        forall a. Maybe a
Prelude.Nothing,
      $sel:exportId:UpdateExportResponse' :: Maybe Text
exportId = forall a. Maybe a
Prelude.Nothing,
      $sel:exportStatus:UpdateExportResponse' :: Maybe ExportStatus
exportStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:fileFormat:UpdateExportResponse' :: Maybe ImportExportFileFormat
fileFormat = forall a. Maybe a
Prelude.Nothing,
      $sel:lastUpdatedDateTime:UpdateExportResponse' :: Maybe POSIX
lastUpdatedDateTime = forall a. Maybe a
Prelude.Nothing,
      $sel:resourceSpecification:UpdateExportResponse' :: Maybe ExportResourceSpecification
resourceSpecification = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateExportResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The date and time that the export was created.
updateExportResponse_creationDateTime :: Lens.Lens' UpdateExportResponse (Prelude.Maybe Prelude.UTCTime)
updateExportResponse_creationDateTime :: Lens' UpdateExportResponse (Maybe UTCTime)
updateExportResponse_creationDateTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateExportResponse' {Maybe POSIX
creationDateTime :: Maybe POSIX
$sel:creationDateTime:UpdateExportResponse' :: UpdateExportResponse -> Maybe POSIX
creationDateTime} -> Maybe POSIX
creationDateTime) (\s :: UpdateExportResponse
s@UpdateExportResponse' {} Maybe POSIX
a -> UpdateExportResponse
s {$sel:creationDateTime:UpdateExportResponse' :: Maybe POSIX
creationDateTime = Maybe POSIX
a} :: UpdateExportResponse) 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 unique identifier Amazon Lex assigned to the export.
updateExportResponse_exportId :: Lens.Lens' UpdateExportResponse (Prelude.Maybe Prelude.Text)
updateExportResponse_exportId :: Lens' UpdateExportResponse (Maybe Text)
updateExportResponse_exportId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateExportResponse' {Maybe Text
exportId :: Maybe Text
$sel:exportId:UpdateExportResponse' :: UpdateExportResponse -> Maybe Text
exportId} -> Maybe Text
exportId) (\s :: UpdateExportResponse
s@UpdateExportResponse' {} Maybe Text
a -> UpdateExportResponse
s {$sel:exportId:UpdateExportResponse' :: Maybe Text
exportId = Maybe Text
a} :: UpdateExportResponse)

-- | The status of the export. When the status is @Completed@ the export
-- archive is available for download.
updateExportResponse_exportStatus :: Lens.Lens' UpdateExportResponse (Prelude.Maybe ExportStatus)
updateExportResponse_exportStatus :: Lens' UpdateExportResponse (Maybe ExportStatus)
updateExportResponse_exportStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateExportResponse' {Maybe ExportStatus
exportStatus :: Maybe ExportStatus
$sel:exportStatus:UpdateExportResponse' :: UpdateExportResponse -> Maybe ExportStatus
exportStatus} -> Maybe ExportStatus
exportStatus) (\s :: UpdateExportResponse
s@UpdateExportResponse' {} Maybe ExportStatus
a -> UpdateExportResponse
s {$sel:exportStatus:UpdateExportResponse' :: Maybe ExportStatus
exportStatus = Maybe ExportStatus
a} :: UpdateExportResponse)

-- | The file format used for the files that define the resource. The @TSV@
-- format is required to export a custom vocabulary only; otherwise use
-- @LexJson@ format.
updateExportResponse_fileFormat :: Lens.Lens' UpdateExportResponse (Prelude.Maybe ImportExportFileFormat)
updateExportResponse_fileFormat :: Lens' UpdateExportResponse (Maybe ImportExportFileFormat)
updateExportResponse_fileFormat = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateExportResponse' {Maybe ImportExportFileFormat
fileFormat :: Maybe ImportExportFileFormat
$sel:fileFormat:UpdateExportResponse' :: UpdateExportResponse -> Maybe ImportExportFileFormat
fileFormat} -> Maybe ImportExportFileFormat
fileFormat) (\s :: UpdateExportResponse
s@UpdateExportResponse' {} Maybe ImportExportFileFormat
a -> UpdateExportResponse
s {$sel:fileFormat:UpdateExportResponse' :: Maybe ImportExportFileFormat
fileFormat = Maybe ImportExportFileFormat
a} :: UpdateExportResponse)

-- | The date and time that the export was last updated.
updateExportResponse_lastUpdatedDateTime :: Lens.Lens' UpdateExportResponse (Prelude.Maybe Prelude.UTCTime)
updateExportResponse_lastUpdatedDateTime :: Lens' UpdateExportResponse (Maybe UTCTime)
updateExportResponse_lastUpdatedDateTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateExportResponse' {Maybe POSIX
lastUpdatedDateTime :: Maybe POSIX
$sel:lastUpdatedDateTime:UpdateExportResponse' :: UpdateExportResponse -> Maybe POSIX
lastUpdatedDateTime} -> Maybe POSIX
lastUpdatedDateTime) (\s :: UpdateExportResponse
s@UpdateExportResponse' {} Maybe POSIX
a -> UpdateExportResponse
s {$sel:lastUpdatedDateTime:UpdateExportResponse' :: Maybe POSIX
lastUpdatedDateTime = Maybe POSIX
a} :: UpdateExportResponse) 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

-- | A description of the type of resource that was exported, either a bot or
-- a bot locale.
updateExportResponse_resourceSpecification :: Lens.Lens' UpdateExportResponse (Prelude.Maybe ExportResourceSpecification)
updateExportResponse_resourceSpecification :: Lens' UpdateExportResponse (Maybe ExportResourceSpecification)
updateExportResponse_resourceSpecification = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateExportResponse' {Maybe ExportResourceSpecification
resourceSpecification :: Maybe ExportResourceSpecification
$sel:resourceSpecification:UpdateExportResponse' :: UpdateExportResponse -> Maybe ExportResourceSpecification
resourceSpecification} -> Maybe ExportResourceSpecification
resourceSpecification) (\s :: UpdateExportResponse
s@UpdateExportResponse' {} Maybe ExportResourceSpecification
a -> UpdateExportResponse
s {$sel:resourceSpecification:UpdateExportResponse' :: Maybe ExportResourceSpecification
resourceSpecification = Maybe ExportResourceSpecification
a} :: UpdateExportResponse)

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

instance Prelude.NFData UpdateExportResponse where
  rnf :: UpdateExportResponse -> ()
rnf UpdateExportResponse' {Int
Maybe Text
Maybe POSIX
Maybe ExportResourceSpecification
Maybe ExportStatus
Maybe ImportExportFileFormat
httpStatus :: Int
resourceSpecification :: Maybe ExportResourceSpecification
lastUpdatedDateTime :: Maybe POSIX
fileFormat :: Maybe ImportExportFileFormat
exportStatus :: Maybe ExportStatus
exportId :: Maybe Text
creationDateTime :: Maybe POSIX
$sel:httpStatus:UpdateExportResponse' :: UpdateExportResponse -> Int
$sel:resourceSpecification:UpdateExportResponse' :: UpdateExportResponse -> Maybe ExportResourceSpecification
$sel:lastUpdatedDateTime:UpdateExportResponse' :: UpdateExportResponse -> Maybe POSIX
$sel:fileFormat:UpdateExportResponse' :: UpdateExportResponse -> Maybe ImportExportFileFormat
$sel:exportStatus:UpdateExportResponse' :: UpdateExportResponse -> Maybe ExportStatus
$sel:exportId:UpdateExportResponse' :: UpdateExportResponse -> Maybe Text
$sel:creationDateTime:UpdateExportResponse' :: UpdateExportResponse -> Maybe POSIX
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
creationDateTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
exportId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ExportStatus
exportStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ImportExportFileFormat
fileFormat
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastUpdatedDateTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ExportResourceSpecification
resourceSpecification
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus