{-# 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.CloudTrail.StopImport
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Stops a specified import.
module Amazonka.CloudTrail.StopImport
  ( -- * Creating a Request
    StopImport (..),
    newStopImport,

    -- * Request Lenses
    stopImport_importId,

    -- * Destructuring the Response
    StopImportResponse (..),
    newStopImportResponse,

    -- * Response Lenses
    stopImportResponse_createdTimestamp,
    stopImportResponse_destinations,
    stopImportResponse_endEventTime,
    stopImportResponse_importId,
    stopImportResponse_importSource,
    stopImportResponse_importStatistics,
    stopImportResponse_importStatus,
    stopImportResponse_startEventTime,
    stopImportResponse_updatedTimestamp,
    stopImportResponse_httpStatus,
  )
where

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

-- | /See:/ 'newStopImport' smart constructor.
data StopImport = StopImport'
  { -- | The ID of the import.
    StopImport -> Text
importId :: Prelude.Text
  }
  deriving (StopImport -> StopImport -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StopImport -> StopImport -> Bool
$c/= :: StopImport -> StopImport -> Bool
== :: StopImport -> StopImport -> Bool
$c== :: StopImport -> StopImport -> Bool
Prelude.Eq, ReadPrec [StopImport]
ReadPrec StopImport
Int -> ReadS StopImport
ReadS [StopImport]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StopImport]
$creadListPrec :: ReadPrec [StopImport]
readPrec :: ReadPrec StopImport
$creadPrec :: ReadPrec StopImport
readList :: ReadS [StopImport]
$creadList :: ReadS [StopImport]
readsPrec :: Int -> ReadS StopImport
$creadsPrec :: Int -> ReadS StopImport
Prelude.Read, Int -> StopImport -> ShowS
[StopImport] -> ShowS
StopImport -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StopImport] -> ShowS
$cshowList :: [StopImport] -> ShowS
show :: StopImport -> String
$cshow :: StopImport -> String
showsPrec :: Int -> StopImport -> ShowS
$cshowsPrec :: Int -> StopImport -> ShowS
Prelude.Show, forall x. Rep StopImport x -> StopImport
forall x. StopImport -> Rep StopImport x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StopImport x -> StopImport
$cfrom :: forall x. StopImport -> Rep StopImport x
Prelude.Generic)

-- |
-- Create a value of 'StopImport' 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:
--
-- 'importId', 'stopImport_importId' - The ID of the import.
newStopImport ::
  -- | 'importId'
  Prelude.Text ->
  StopImport
newStopImport :: Text -> StopImport
newStopImport Text
pImportId_ =
  StopImport' {$sel:importId:StopImport' :: Text
importId = Text
pImportId_}

-- | The ID of the import.
stopImport_importId :: Lens.Lens' StopImport Prelude.Text
stopImport_importId :: Lens' StopImport Text
stopImport_importId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopImport' {Text
importId :: Text
$sel:importId:StopImport' :: StopImport -> Text
importId} -> Text
importId) (\s :: StopImport
s@StopImport' {} Text
a -> StopImport
s {$sel:importId:StopImport' :: Text
importId = Text
a} :: StopImport)

instance Core.AWSRequest StopImport where
  type AWSResponse StopImport = StopImportResponse
  request :: (Service -> Service) -> StopImport -> Request StopImport
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 StopImport
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse StopImport)))
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 (NonEmpty Text)
-> Maybe POSIX
-> Maybe Text
-> Maybe ImportSource
-> Maybe ImportStatistics
-> Maybe ImportStatus
-> Maybe POSIX
-> Maybe POSIX
-> Int
-> StopImportResponse
StopImportResponse'
            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
"CreatedTimestamp")
            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
"Destinations")
            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
"EndEventTime")
            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
"ImportSource")
            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
"ImportStatistics")
            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
"StartEventTime")
            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
"UpdatedTimestamp")
            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 StopImport where
  hashWithSalt :: Int -> StopImport -> Int
hashWithSalt Int
_salt StopImport' {Text
importId :: Text
$sel:importId:StopImport' :: StopImport -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
importId

instance Prelude.NFData StopImport where
  rnf :: StopImport -> ()
rnf StopImport' {Text
importId :: Text
$sel:importId:StopImport' :: StopImport -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
importId

instance Data.ToHeaders StopImport where
  toHeaders :: StopImport -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"com.amazonaws.cloudtrail.v20131101.CloudTrail_20131101.StopImport" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON StopImport where
  toJSON :: StopImport -> Value
toJSON StopImport' {Text
importId :: Text
$sel:importId:StopImport' :: StopImport -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"ImportId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
importId)]
      )

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

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

-- | /See:/ 'newStopImportResponse' smart constructor.
data StopImportResponse = StopImportResponse'
  { -- | The timestamp of the import\'s creation.
    StopImportResponse -> Maybe POSIX
createdTimestamp :: Prelude.Maybe Data.POSIX,
    -- | The ARN of the destination event data store.
    StopImportResponse -> Maybe (NonEmpty Text)
destinations :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | Used with @StartEventTime@ to bound a @StartImport@ request, and limit
    -- imported trail events to only those events logged within a specified
    -- time period.
    StopImportResponse -> Maybe POSIX
endEventTime :: Prelude.Maybe Data.POSIX,
    -- | The ID for the import.
    StopImportResponse -> Maybe Text
importId :: Prelude.Maybe Prelude.Text,
    -- | The source S3 bucket for the import.
    StopImportResponse -> Maybe ImportSource
importSource :: Prelude.Maybe ImportSource,
    -- | Returns information on the stopped import.
    StopImportResponse -> Maybe ImportStatistics
importStatistics :: Prelude.Maybe ImportStatistics,
    -- | The status of the import.
    StopImportResponse -> Maybe ImportStatus
importStatus :: Prelude.Maybe ImportStatus,
    -- | Used with @EndEventTime@ to bound a @StartImport@ request, and limit
    -- imported trail events to only those events logged within a specified
    -- time period.
    StopImportResponse -> Maybe POSIX
startEventTime :: Prelude.Maybe Data.POSIX,
    -- | The timestamp of the import\'s last update.
    StopImportResponse -> Maybe POSIX
updatedTimestamp :: Prelude.Maybe Data.POSIX,
    -- | The response's http status code.
    StopImportResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (StopImportResponse -> StopImportResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StopImportResponse -> StopImportResponse -> Bool
$c/= :: StopImportResponse -> StopImportResponse -> Bool
== :: StopImportResponse -> StopImportResponse -> Bool
$c== :: StopImportResponse -> StopImportResponse -> Bool
Prelude.Eq, ReadPrec [StopImportResponse]
ReadPrec StopImportResponse
Int -> ReadS StopImportResponse
ReadS [StopImportResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StopImportResponse]
$creadListPrec :: ReadPrec [StopImportResponse]
readPrec :: ReadPrec StopImportResponse
$creadPrec :: ReadPrec StopImportResponse
readList :: ReadS [StopImportResponse]
$creadList :: ReadS [StopImportResponse]
readsPrec :: Int -> ReadS StopImportResponse
$creadsPrec :: Int -> ReadS StopImportResponse
Prelude.Read, Int -> StopImportResponse -> ShowS
[StopImportResponse] -> ShowS
StopImportResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StopImportResponse] -> ShowS
$cshowList :: [StopImportResponse] -> ShowS
show :: StopImportResponse -> String
$cshow :: StopImportResponse -> String
showsPrec :: Int -> StopImportResponse -> ShowS
$cshowsPrec :: Int -> StopImportResponse -> ShowS
Prelude.Show, forall x. Rep StopImportResponse x -> StopImportResponse
forall x. StopImportResponse -> Rep StopImportResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StopImportResponse x -> StopImportResponse
$cfrom :: forall x. StopImportResponse -> Rep StopImportResponse x
Prelude.Generic)

-- |
-- Create a value of 'StopImportResponse' 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:
--
-- 'createdTimestamp', 'stopImportResponse_createdTimestamp' - The timestamp of the import\'s creation.
--
-- 'destinations', 'stopImportResponse_destinations' - The ARN of the destination event data store.
--
-- 'endEventTime', 'stopImportResponse_endEventTime' - Used with @StartEventTime@ to bound a @StartImport@ request, and limit
-- imported trail events to only those events logged within a specified
-- time period.
--
-- 'importId', 'stopImportResponse_importId' - The ID for the import.
--
-- 'importSource', 'stopImportResponse_importSource' - The source S3 bucket for the import.
--
-- 'importStatistics', 'stopImportResponse_importStatistics' - Returns information on the stopped import.
--
-- 'importStatus', 'stopImportResponse_importStatus' - The status of the import.
--
-- 'startEventTime', 'stopImportResponse_startEventTime' - Used with @EndEventTime@ to bound a @StartImport@ request, and limit
-- imported trail events to only those events logged within a specified
-- time period.
--
-- 'updatedTimestamp', 'stopImportResponse_updatedTimestamp' - The timestamp of the import\'s last update.
--
-- 'httpStatus', 'stopImportResponse_httpStatus' - The response's http status code.
newStopImportResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StopImportResponse
newStopImportResponse :: Int -> StopImportResponse
newStopImportResponse Int
pHttpStatus_ =
  StopImportResponse'
    { $sel:createdTimestamp:StopImportResponse' :: Maybe POSIX
createdTimestamp =
        forall a. Maybe a
Prelude.Nothing,
      $sel:destinations:StopImportResponse' :: Maybe (NonEmpty Text)
destinations = forall a. Maybe a
Prelude.Nothing,
      $sel:endEventTime:StopImportResponse' :: Maybe POSIX
endEventTime = forall a. Maybe a
Prelude.Nothing,
      $sel:importId:StopImportResponse' :: Maybe Text
importId = forall a. Maybe a
Prelude.Nothing,
      $sel:importSource:StopImportResponse' :: Maybe ImportSource
importSource = forall a. Maybe a
Prelude.Nothing,
      $sel:importStatistics:StopImportResponse' :: Maybe ImportStatistics
importStatistics = forall a. Maybe a
Prelude.Nothing,
      $sel:importStatus:StopImportResponse' :: Maybe ImportStatus
importStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:startEventTime:StopImportResponse' :: Maybe POSIX
startEventTime = forall a. Maybe a
Prelude.Nothing,
      $sel:updatedTimestamp:StopImportResponse' :: Maybe POSIX
updatedTimestamp = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:StopImportResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The timestamp of the import\'s creation.
stopImportResponse_createdTimestamp :: Lens.Lens' StopImportResponse (Prelude.Maybe Prelude.UTCTime)
stopImportResponse_createdTimestamp :: Lens' StopImportResponse (Maybe UTCTime)
stopImportResponse_createdTimestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopImportResponse' {Maybe POSIX
createdTimestamp :: Maybe POSIX
$sel:createdTimestamp:StopImportResponse' :: StopImportResponse -> Maybe POSIX
createdTimestamp} -> Maybe POSIX
createdTimestamp) (\s :: StopImportResponse
s@StopImportResponse' {} Maybe POSIX
a -> StopImportResponse
s {$sel:createdTimestamp:StopImportResponse' :: Maybe POSIX
createdTimestamp = Maybe POSIX
a} :: StopImportResponse) 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 ARN of the destination event data store.
stopImportResponse_destinations :: Lens.Lens' StopImportResponse (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
stopImportResponse_destinations :: Lens' StopImportResponse (Maybe (NonEmpty Text))
stopImportResponse_destinations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopImportResponse' {Maybe (NonEmpty Text)
destinations :: Maybe (NonEmpty Text)
$sel:destinations:StopImportResponse' :: StopImportResponse -> Maybe (NonEmpty Text)
destinations} -> Maybe (NonEmpty Text)
destinations) (\s :: StopImportResponse
s@StopImportResponse' {} Maybe (NonEmpty Text)
a -> StopImportResponse
s {$sel:destinations:StopImportResponse' :: Maybe (NonEmpty Text)
destinations = Maybe (NonEmpty Text)
a} :: StopImportResponse) 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

-- | Used with @StartEventTime@ to bound a @StartImport@ request, and limit
-- imported trail events to only those events logged within a specified
-- time period.
stopImportResponse_endEventTime :: Lens.Lens' StopImportResponse (Prelude.Maybe Prelude.UTCTime)
stopImportResponse_endEventTime :: Lens' StopImportResponse (Maybe UTCTime)
stopImportResponse_endEventTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopImportResponse' {Maybe POSIX
endEventTime :: Maybe POSIX
$sel:endEventTime:StopImportResponse' :: StopImportResponse -> Maybe POSIX
endEventTime} -> Maybe POSIX
endEventTime) (\s :: StopImportResponse
s@StopImportResponse' {} Maybe POSIX
a -> StopImportResponse
s {$sel:endEventTime:StopImportResponse' :: Maybe POSIX
endEventTime = Maybe POSIX
a} :: StopImportResponse) 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 ID for the import.
stopImportResponse_importId :: Lens.Lens' StopImportResponse (Prelude.Maybe Prelude.Text)
stopImportResponse_importId :: Lens' StopImportResponse (Maybe Text)
stopImportResponse_importId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopImportResponse' {Maybe Text
importId :: Maybe Text
$sel:importId:StopImportResponse' :: StopImportResponse -> Maybe Text
importId} -> Maybe Text
importId) (\s :: StopImportResponse
s@StopImportResponse' {} Maybe Text
a -> StopImportResponse
s {$sel:importId:StopImportResponse' :: Maybe Text
importId = Maybe Text
a} :: StopImportResponse)

-- | The source S3 bucket for the import.
stopImportResponse_importSource :: Lens.Lens' StopImportResponse (Prelude.Maybe ImportSource)
stopImportResponse_importSource :: Lens' StopImportResponse (Maybe ImportSource)
stopImportResponse_importSource = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopImportResponse' {Maybe ImportSource
importSource :: Maybe ImportSource
$sel:importSource:StopImportResponse' :: StopImportResponse -> Maybe ImportSource
importSource} -> Maybe ImportSource
importSource) (\s :: StopImportResponse
s@StopImportResponse' {} Maybe ImportSource
a -> StopImportResponse
s {$sel:importSource:StopImportResponse' :: Maybe ImportSource
importSource = Maybe ImportSource
a} :: StopImportResponse)

-- | Returns information on the stopped import.
stopImportResponse_importStatistics :: Lens.Lens' StopImportResponse (Prelude.Maybe ImportStatistics)
stopImportResponse_importStatistics :: Lens' StopImportResponse (Maybe ImportStatistics)
stopImportResponse_importStatistics = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopImportResponse' {Maybe ImportStatistics
importStatistics :: Maybe ImportStatistics
$sel:importStatistics:StopImportResponse' :: StopImportResponse -> Maybe ImportStatistics
importStatistics} -> Maybe ImportStatistics
importStatistics) (\s :: StopImportResponse
s@StopImportResponse' {} Maybe ImportStatistics
a -> StopImportResponse
s {$sel:importStatistics:StopImportResponse' :: Maybe ImportStatistics
importStatistics = Maybe ImportStatistics
a} :: StopImportResponse)

-- | The status of the import.
stopImportResponse_importStatus :: Lens.Lens' StopImportResponse (Prelude.Maybe ImportStatus)
stopImportResponse_importStatus :: Lens' StopImportResponse (Maybe ImportStatus)
stopImportResponse_importStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopImportResponse' {Maybe ImportStatus
importStatus :: Maybe ImportStatus
$sel:importStatus:StopImportResponse' :: StopImportResponse -> Maybe ImportStatus
importStatus} -> Maybe ImportStatus
importStatus) (\s :: StopImportResponse
s@StopImportResponse' {} Maybe ImportStatus
a -> StopImportResponse
s {$sel:importStatus:StopImportResponse' :: Maybe ImportStatus
importStatus = Maybe ImportStatus
a} :: StopImportResponse)

-- | Used with @EndEventTime@ to bound a @StartImport@ request, and limit
-- imported trail events to only those events logged within a specified
-- time period.
stopImportResponse_startEventTime :: Lens.Lens' StopImportResponse (Prelude.Maybe Prelude.UTCTime)
stopImportResponse_startEventTime :: Lens' StopImportResponse (Maybe UTCTime)
stopImportResponse_startEventTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopImportResponse' {Maybe POSIX
startEventTime :: Maybe POSIX
$sel:startEventTime:StopImportResponse' :: StopImportResponse -> Maybe POSIX
startEventTime} -> Maybe POSIX
startEventTime) (\s :: StopImportResponse
s@StopImportResponse' {} Maybe POSIX
a -> StopImportResponse
s {$sel:startEventTime:StopImportResponse' :: Maybe POSIX
startEventTime = Maybe POSIX
a} :: StopImportResponse) 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 timestamp of the import\'s last update.
stopImportResponse_updatedTimestamp :: Lens.Lens' StopImportResponse (Prelude.Maybe Prelude.UTCTime)
stopImportResponse_updatedTimestamp :: Lens' StopImportResponse (Maybe UTCTime)
stopImportResponse_updatedTimestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopImportResponse' {Maybe POSIX
updatedTimestamp :: Maybe POSIX
$sel:updatedTimestamp:StopImportResponse' :: StopImportResponse -> Maybe POSIX
updatedTimestamp} -> Maybe POSIX
updatedTimestamp) (\s :: StopImportResponse
s@StopImportResponse' {} Maybe POSIX
a -> StopImportResponse
s {$sel:updatedTimestamp:StopImportResponse' :: Maybe POSIX
updatedTimestamp = Maybe POSIX
a} :: StopImportResponse) 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 response's http status code.
stopImportResponse_httpStatus :: Lens.Lens' StopImportResponse Prelude.Int
stopImportResponse_httpStatus :: Lens' StopImportResponse Int
stopImportResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopImportResponse' {Int
httpStatus :: Int
$sel:httpStatus:StopImportResponse' :: StopImportResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: StopImportResponse
s@StopImportResponse' {} Int
a -> StopImportResponse
s {$sel:httpStatus:StopImportResponse' :: Int
httpStatus = Int
a} :: StopImportResponse)

instance Prelude.NFData StopImportResponse where
  rnf :: StopImportResponse -> ()
rnf StopImportResponse' {Int
Maybe (NonEmpty Text)
Maybe Text
Maybe POSIX
Maybe ImportStatistics
Maybe ImportStatus
Maybe ImportSource
httpStatus :: Int
updatedTimestamp :: Maybe POSIX
startEventTime :: Maybe POSIX
importStatus :: Maybe ImportStatus
importStatistics :: Maybe ImportStatistics
importSource :: Maybe ImportSource
importId :: Maybe Text
endEventTime :: Maybe POSIX
destinations :: Maybe (NonEmpty Text)
createdTimestamp :: Maybe POSIX
$sel:httpStatus:StopImportResponse' :: StopImportResponse -> Int
$sel:updatedTimestamp:StopImportResponse' :: StopImportResponse -> Maybe POSIX
$sel:startEventTime:StopImportResponse' :: StopImportResponse -> Maybe POSIX
$sel:importStatus:StopImportResponse' :: StopImportResponse -> Maybe ImportStatus
$sel:importStatistics:StopImportResponse' :: StopImportResponse -> Maybe ImportStatistics
$sel:importSource:StopImportResponse' :: StopImportResponse -> Maybe ImportSource
$sel:importId:StopImportResponse' :: StopImportResponse -> Maybe Text
$sel:endEventTime:StopImportResponse' :: StopImportResponse -> Maybe POSIX
$sel:destinations:StopImportResponse' :: StopImportResponse -> Maybe (NonEmpty Text)
$sel:createdTimestamp:StopImportResponse' :: StopImportResponse -> Maybe POSIX
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
createdTimestamp
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Text)
destinations
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
endEventTime
      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 ImportSource
importSource
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ImportStatistics
importStatistics
      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 POSIX
startEventTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
updatedTimestamp
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus