{-# 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.Evidently.UpdateProjectDataDelivery
-- 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 data storage options for this project. If you store
-- evaluation events, you an keep them and analyze them on your own. If you
-- choose not to store evaluation events, Evidently deletes them after
-- using them to produce metrics and other experiment results that you can
-- view.
--
-- You can\'t specify both @cloudWatchLogs@ and @s3Destination@ in the same
-- operation.
module Amazonka.Evidently.UpdateProjectDataDelivery
  ( -- * Creating a Request
    UpdateProjectDataDelivery (..),
    newUpdateProjectDataDelivery,

    -- * Request Lenses
    updateProjectDataDelivery_cloudWatchLogs,
    updateProjectDataDelivery_s3Destination,
    updateProjectDataDelivery_project,

    -- * Destructuring the Response
    UpdateProjectDataDeliveryResponse (..),
    newUpdateProjectDataDeliveryResponse,

    -- * Response Lenses
    updateProjectDataDeliveryResponse_httpStatus,
    updateProjectDataDeliveryResponse_project,
  )
where

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

-- | /See:/ 'newUpdateProjectDataDelivery' smart constructor.
data UpdateProjectDataDelivery = UpdateProjectDataDelivery'
  { -- | A structure containing the CloudWatch Logs log group where you want to
    -- store evaluation events.
    UpdateProjectDataDelivery -> Maybe CloudWatchLogsDestinationConfig
cloudWatchLogs :: Prelude.Maybe CloudWatchLogsDestinationConfig,
    -- | A structure containing the S3 bucket name and bucket prefix where you
    -- want to store evaluation events.
    UpdateProjectDataDelivery -> Maybe S3DestinationConfig
s3Destination :: Prelude.Maybe S3DestinationConfig,
    -- | The name or ARN of the project that you want to modify the data storage
    -- options for.
    UpdateProjectDataDelivery -> Text
project :: Prelude.Text
  }
  deriving (UpdateProjectDataDelivery -> UpdateProjectDataDelivery -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateProjectDataDelivery -> UpdateProjectDataDelivery -> Bool
$c/= :: UpdateProjectDataDelivery -> UpdateProjectDataDelivery -> Bool
== :: UpdateProjectDataDelivery -> UpdateProjectDataDelivery -> Bool
$c== :: UpdateProjectDataDelivery -> UpdateProjectDataDelivery -> Bool
Prelude.Eq, ReadPrec [UpdateProjectDataDelivery]
ReadPrec UpdateProjectDataDelivery
Int -> ReadS UpdateProjectDataDelivery
ReadS [UpdateProjectDataDelivery]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateProjectDataDelivery]
$creadListPrec :: ReadPrec [UpdateProjectDataDelivery]
readPrec :: ReadPrec UpdateProjectDataDelivery
$creadPrec :: ReadPrec UpdateProjectDataDelivery
readList :: ReadS [UpdateProjectDataDelivery]
$creadList :: ReadS [UpdateProjectDataDelivery]
readsPrec :: Int -> ReadS UpdateProjectDataDelivery
$creadsPrec :: Int -> ReadS UpdateProjectDataDelivery
Prelude.Read, Int -> UpdateProjectDataDelivery -> ShowS
[UpdateProjectDataDelivery] -> ShowS
UpdateProjectDataDelivery -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateProjectDataDelivery] -> ShowS
$cshowList :: [UpdateProjectDataDelivery] -> ShowS
show :: UpdateProjectDataDelivery -> String
$cshow :: UpdateProjectDataDelivery -> String
showsPrec :: Int -> UpdateProjectDataDelivery -> ShowS
$cshowsPrec :: Int -> UpdateProjectDataDelivery -> ShowS
Prelude.Show, forall x.
Rep UpdateProjectDataDelivery x -> UpdateProjectDataDelivery
forall x.
UpdateProjectDataDelivery -> Rep UpdateProjectDataDelivery x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateProjectDataDelivery x -> UpdateProjectDataDelivery
$cfrom :: forall x.
UpdateProjectDataDelivery -> Rep UpdateProjectDataDelivery x
Prelude.Generic)

-- |
-- Create a value of 'UpdateProjectDataDelivery' 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:
--
-- 'cloudWatchLogs', 'updateProjectDataDelivery_cloudWatchLogs' - A structure containing the CloudWatch Logs log group where you want to
-- store evaluation events.
--
-- 's3Destination', 'updateProjectDataDelivery_s3Destination' - A structure containing the S3 bucket name and bucket prefix where you
-- want to store evaluation events.
--
-- 'project', 'updateProjectDataDelivery_project' - The name or ARN of the project that you want to modify the data storage
-- options for.
newUpdateProjectDataDelivery ::
  -- | 'project'
  Prelude.Text ->
  UpdateProjectDataDelivery
newUpdateProjectDataDelivery :: Text -> UpdateProjectDataDelivery
newUpdateProjectDataDelivery Text
pProject_ =
  UpdateProjectDataDelivery'
    { $sel:cloudWatchLogs:UpdateProjectDataDelivery' :: Maybe CloudWatchLogsDestinationConfig
cloudWatchLogs =
        forall a. Maybe a
Prelude.Nothing,
      $sel:s3Destination:UpdateProjectDataDelivery' :: Maybe S3DestinationConfig
s3Destination = forall a. Maybe a
Prelude.Nothing,
      $sel:project:UpdateProjectDataDelivery' :: Text
project = Text
pProject_
    }

-- | A structure containing the CloudWatch Logs log group where you want to
-- store evaluation events.
updateProjectDataDelivery_cloudWatchLogs :: Lens.Lens' UpdateProjectDataDelivery (Prelude.Maybe CloudWatchLogsDestinationConfig)
updateProjectDataDelivery_cloudWatchLogs :: Lens'
  UpdateProjectDataDelivery (Maybe CloudWatchLogsDestinationConfig)
updateProjectDataDelivery_cloudWatchLogs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateProjectDataDelivery' {Maybe CloudWatchLogsDestinationConfig
cloudWatchLogs :: Maybe CloudWatchLogsDestinationConfig
$sel:cloudWatchLogs:UpdateProjectDataDelivery' :: UpdateProjectDataDelivery -> Maybe CloudWatchLogsDestinationConfig
cloudWatchLogs} -> Maybe CloudWatchLogsDestinationConfig
cloudWatchLogs) (\s :: UpdateProjectDataDelivery
s@UpdateProjectDataDelivery' {} Maybe CloudWatchLogsDestinationConfig
a -> UpdateProjectDataDelivery
s {$sel:cloudWatchLogs:UpdateProjectDataDelivery' :: Maybe CloudWatchLogsDestinationConfig
cloudWatchLogs = Maybe CloudWatchLogsDestinationConfig
a} :: UpdateProjectDataDelivery)

-- | A structure containing the S3 bucket name and bucket prefix where you
-- want to store evaluation events.
updateProjectDataDelivery_s3Destination :: Lens.Lens' UpdateProjectDataDelivery (Prelude.Maybe S3DestinationConfig)
updateProjectDataDelivery_s3Destination :: Lens' UpdateProjectDataDelivery (Maybe S3DestinationConfig)
updateProjectDataDelivery_s3Destination = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateProjectDataDelivery' {Maybe S3DestinationConfig
s3Destination :: Maybe S3DestinationConfig
$sel:s3Destination:UpdateProjectDataDelivery' :: UpdateProjectDataDelivery -> Maybe S3DestinationConfig
s3Destination} -> Maybe S3DestinationConfig
s3Destination) (\s :: UpdateProjectDataDelivery
s@UpdateProjectDataDelivery' {} Maybe S3DestinationConfig
a -> UpdateProjectDataDelivery
s {$sel:s3Destination:UpdateProjectDataDelivery' :: Maybe S3DestinationConfig
s3Destination = Maybe S3DestinationConfig
a} :: UpdateProjectDataDelivery)

-- | The name or ARN of the project that you want to modify the data storage
-- options for.
updateProjectDataDelivery_project :: Lens.Lens' UpdateProjectDataDelivery Prelude.Text
updateProjectDataDelivery_project :: Lens' UpdateProjectDataDelivery Text
updateProjectDataDelivery_project = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateProjectDataDelivery' {Text
project :: Text
$sel:project:UpdateProjectDataDelivery' :: UpdateProjectDataDelivery -> Text
project} -> Text
project) (\s :: UpdateProjectDataDelivery
s@UpdateProjectDataDelivery' {} Text
a -> UpdateProjectDataDelivery
s {$sel:project:UpdateProjectDataDelivery' :: Text
project = Text
a} :: UpdateProjectDataDelivery)

instance Core.AWSRequest UpdateProjectDataDelivery where
  type
    AWSResponse UpdateProjectDataDelivery =
      UpdateProjectDataDeliveryResponse
  request :: (Service -> Service)
-> UpdateProjectDataDelivery -> Request UpdateProjectDataDelivery
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.patchJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateProjectDataDelivery
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateProjectDataDelivery)))
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 -> Project -> UpdateProjectDataDeliveryResponse
UpdateProjectDataDeliveryResponse'
            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
"project")
      )

instance Prelude.Hashable UpdateProjectDataDelivery where
  hashWithSalt :: Int -> UpdateProjectDataDelivery -> Int
hashWithSalt Int
_salt UpdateProjectDataDelivery' {Maybe CloudWatchLogsDestinationConfig
Maybe S3DestinationConfig
Text
project :: Text
s3Destination :: Maybe S3DestinationConfig
cloudWatchLogs :: Maybe CloudWatchLogsDestinationConfig
$sel:project:UpdateProjectDataDelivery' :: UpdateProjectDataDelivery -> Text
$sel:s3Destination:UpdateProjectDataDelivery' :: UpdateProjectDataDelivery -> Maybe S3DestinationConfig
$sel:cloudWatchLogs:UpdateProjectDataDelivery' :: UpdateProjectDataDelivery -> Maybe CloudWatchLogsDestinationConfig
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CloudWatchLogsDestinationConfig
cloudWatchLogs
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe S3DestinationConfig
s3Destination
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
project

instance Prelude.NFData UpdateProjectDataDelivery where
  rnf :: UpdateProjectDataDelivery -> ()
rnf UpdateProjectDataDelivery' {Maybe CloudWatchLogsDestinationConfig
Maybe S3DestinationConfig
Text
project :: Text
s3Destination :: Maybe S3DestinationConfig
cloudWatchLogs :: Maybe CloudWatchLogsDestinationConfig
$sel:project:UpdateProjectDataDelivery' :: UpdateProjectDataDelivery -> Text
$sel:s3Destination:UpdateProjectDataDelivery' :: UpdateProjectDataDelivery -> Maybe S3DestinationConfig
$sel:cloudWatchLogs:UpdateProjectDataDelivery' :: UpdateProjectDataDelivery -> Maybe CloudWatchLogsDestinationConfig
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe CloudWatchLogsDestinationConfig
cloudWatchLogs
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe S3DestinationConfig
s3Destination
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
project

instance Data.ToHeaders UpdateProjectDataDelivery where
  toHeaders :: UpdateProjectDataDelivery -> 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 UpdateProjectDataDelivery where
  toJSON :: UpdateProjectDataDelivery -> Value
toJSON UpdateProjectDataDelivery' {Maybe CloudWatchLogsDestinationConfig
Maybe S3DestinationConfig
Text
project :: Text
s3Destination :: Maybe S3DestinationConfig
cloudWatchLogs :: Maybe CloudWatchLogsDestinationConfig
$sel:project:UpdateProjectDataDelivery' :: UpdateProjectDataDelivery -> Text
$sel:s3Destination:UpdateProjectDataDelivery' :: UpdateProjectDataDelivery -> Maybe S3DestinationConfig
$sel:cloudWatchLogs:UpdateProjectDataDelivery' :: UpdateProjectDataDelivery -> Maybe CloudWatchLogsDestinationConfig
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"cloudWatchLogs" 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 CloudWatchLogsDestinationConfig
cloudWatchLogs,
            (Key
"s3Destination" 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 S3DestinationConfig
s3Destination
          ]
      )

instance Data.ToPath UpdateProjectDataDelivery where
  toPath :: UpdateProjectDataDelivery -> ByteString
toPath UpdateProjectDataDelivery' {Maybe CloudWatchLogsDestinationConfig
Maybe S3DestinationConfig
Text
project :: Text
s3Destination :: Maybe S3DestinationConfig
cloudWatchLogs :: Maybe CloudWatchLogsDestinationConfig
$sel:project:UpdateProjectDataDelivery' :: UpdateProjectDataDelivery -> Text
$sel:s3Destination:UpdateProjectDataDelivery' :: UpdateProjectDataDelivery -> Maybe S3DestinationConfig
$sel:cloudWatchLogs:UpdateProjectDataDelivery' :: UpdateProjectDataDelivery -> Maybe CloudWatchLogsDestinationConfig
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/projects/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
project, ByteString
"/data-delivery"]

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

-- | /See:/ 'newUpdateProjectDataDeliveryResponse' smart constructor.
data UpdateProjectDataDeliveryResponse = UpdateProjectDataDeliveryResponse'
  { -- | The response's http status code.
    UpdateProjectDataDeliveryResponse -> Int
httpStatus :: Prelude.Int,
    -- | A structure containing details about the project that you updated.
    UpdateProjectDataDeliveryResponse -> Project
project :: Project
  }
  deriving (UpdateProjectDataDeliveryResponse
-> UpdateProjectDataDeliveryResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateProjectDataDeliveryResponse
-> UpdateProjectDataDeliveryResponse -> Bool
$c/= :: UpdateProjectDataDeliveryResponse
-> UpdateProjectDataDeliveryResponse -> Bool
== :: UpdateProjectDataDeliveryResponse
-> UpdateProjectDataDeliveryResponse -> Bool
$c== :: UpdateProjectDataDeliveryResponse
-> UpdateProjectDataDeliveryResponse -> Bool
Prelude.Eq, ReadPrec [UpdateProjectDataDeliveryResponse]
ReadPrec UpdateProjectDataDeliveryResponse
Int -> ReadS UpdateProjectDataDeliveryResponse
ReadS [UpdateProjectDataDeliveryResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateProjectDataDeliveryResponse]
$creadListPrec :: ReadPrec [UpdateProjectDataDeliveryResponse]
readPrec :: ReadPrec UpdateProjectDataDeliveryResponse
$creadPrec :: ReadPrec UpdateProjectDataDeliveryResponse
readList :: ReadS [UpdateProjectDataDeliveryResponse]
$creadList :: ReadS [UpdateProjectDataDeliveryResponse]
readsPrec :: Int -> ReadS UpdateProjectDataDeliveryResponse
$creadsPrec :: Int -> ReadS UpdateProjectDataDeliveryResponse
Prelude.Read, Int -> UpdateProjectDataDeliveryResponse -> ShowS
[UpdateProjectDataDeliveryResponse] -> ShowS
UpdateProjectDataDeliveryResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateProjectDataDeliveryResponse] -> ShowS
$cshowList :: [UpdateProjectDataDeliveryResponse] -> ShowS
show :: UpdateProjectDataDeliveryResponse -> String
$cshow :: UpdateProjectDataDeliveryResponse -> String
showsPrec :: Int -> UpdateProjectDataDeliveryResponse -> ShowS
$cshowsPrec :: Int -> UpdateProjectDataDeliveryResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateProjectDataDeliveryResponse x
-> UpdateProjectDataDeliveryResponse
forall x.
UpdateProjectDataDeliveryResponse
-> Rep UpdateProjectDataDeliveryResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateProjectDataDeliveryResponse x
-> UpdateProjectDataDeliveryResponse
$cfrom :: forall x.
UpdateProjectDataDeliveryResponse
-> Rep UpdateProjectDataDeliveryResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateProjectDataDeliveryResponse' 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', 'updateProjectDataDeliveryResponse_httpStatus' - The response's http status code.
--
-- 'project', 'updateProjectDataDeliveryResponse_project' - A structure containing details about the project that you updated.
newUpdateProjectDataDeliveryResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'project'
  Project ->
  UpdateProjectDataDeliveryResponse
newUpdateProjectDataDeliveryResponse :: Int -> Project -> UpdateProjectDataDeliveryResponse
newUpdateProjectDataDeliveryResponse
  Int
pHttpStatus_
  Project
pProject_ =
    UpdateProjectDataDeliveryResponse'
      { $sel:httpStatus:UpdateProjectDataDeliveryResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:project:UpdateProjectDataDeliveryResponse' :: Project
project = Project
pProject_
      }

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

-- | A structure containing details about the project that you updated.
updateProjectDataDeliveryResponse_project :: Lens.Lens' UpdateProjectDataDeliveryResponse Project
updateProjectDataDeliveryResponse_project :: Lens' UpdateProjectDataDeliveryResponse Project
updateProjectDataDeliveryResponse_project = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateProjectDataDeliveryResponse' {Project
project :: Project
$sel:project:UpdateProjectDataDeliveryResponse' :: UpdateProjectDataDeliveryResponse -> Project
project} -> Project
project) (\s :: UpdateProjectDataDeliveryResponse
s@UpdateProjectDataDeliveryResponse' {} Project
a -> UpdateProjectDataDeliveryResponse
s {$sel:project:UpdateProjectDataDeliveryResponse' :: Project
project = Project
a} :: UpdateProjectDataDeliveryResponse)

instance
  Prelude.NFData
    UpdateProjectDataDeliveryResponse
  where
  rnf :: UpdateProjectDataDeliveryResponse -> ()
rnf UpdateProjectDataDeliveryResponse' {Int
Project
project :: Project
httpStatus :: Int
$sel:project:UpdateProjectDataDeliveryResponse' :: UpdateProjectDataDeliveryResponse -> Project
$sel:httpStatus:UpdateProjectDataDeliveryResponse' :: UpdateProjectDataDeliveryResponse -> 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 Project
project