-- |
-- Module      : Amazonka.S3.Encryption.Decrypt
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka.com>
-- Stability   : provisional
-- Portability : non-portable (GHC extensions)
module Amazonka.S3.Encryption.Decrypt where

import qualified Amazonka as AWS
import Amazonka.Core
import Amazonka.Prelude
import qualified Amazonka.S3 as S3
import Amazonka.S3.Encryption.Envelope
import Amazonka.S3.Encryption.Instructions
import Amazonka.S3.Encryption.Types
import qualified Amazonka.S3.Lens as S3
import Control.Lens ((%~), (^.))
import qualified Control.Monad.Except as Except
import qualified Network.HTTP.Client as Client

decrypted :: S3.GetObject -> (Decrypt S3.GetObject, GetInstructions)
decrypted :: GetObject -> (Decrypt GetObject, GetInstructions)
decrypted GetObject
x = (forall a. a -> Decrypt a
Decrypt GetObject
x, forall a. AddInstructions a => a -> GetInstructions
getInstructions GetObject
x)

newtype Decrypt a = Decrypt a

newtype Decrypted a = Decrypted
  { forall a.
Decrypted a
-> forall (m :: * -> *).
   MonadResource m =>
   Key -> Env -> Maybe Envelope -> m a
runDecrypted :: forall m. MonadResource m => Key -> AWS.Env -> Maybe Envelope -> m a
  }

instance AWSRequest (Decrypt S3.GetObject) where
  type AWSResponse (Decrypt S3.GetObject) = Decrypted S3.GetObjectResponse

  request :: (Service -> Service)
-> Decrypt GetObject -> Request (Decrypt GetObject)
request Service -> Service
overrides (Decrypt GetObject
x) = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. AWSRequest a => (Service -> Service) -> a -> Request a
request Service -> Service
overrides GetObject
x)

  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy (Decrypt GetObject)
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse (Decrypt GetObject))))
response ByteStringLazy -> IO ByteStringLazy
l Service
s Proxy (Decrypt GetObject)
p ClientResponse ClientBody
r =
    forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
Except.runExceptT forall a b. (a -> b) -> a -> b
$ do
      Response GetObjectResponse
rs <- forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
Except.ExceptT (forall a (m :: * -> *).
(AWSRequest a, MonadResource m) =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
response ByteStringLazy -> IO ByteStringLazy
l Service
s (forall a. Proxy (Decrypt a) -> Proxy a
proxy Proxy (Decrypt GetObject)
p) ClientResponse ClientBody
r)

      let body :: GetObjectResponse
body = forall body. Response body -> body
Client.responseBody Response GetObjectResponse
rs
          decrypt :: Decrypted GetObjectResponse
decrypt =
            forall a.
(forall (m :: * -> *).
 MonadResource m =>
 Key -> Env -> Maybe Envelope -> m a)
-> Decrypted a
Decrypted forall a b. (a -> b) -> a -> b
$ \Key
key Env
env Maybe Envelope
m -> do
              Envelope
encrypted <-
                case Maybe Envelope
m of
                  Maybe Envelope
Nothing -> forall (m :: * -> *).
MonadResource m =>
Key -> Env -> HashMap Text Text -> m Envelope
fromMetadata Key
key Env
env (GetObjectResponse
body forall s a. s -> Getting a s a -> a
^. Lens' GetObjectResponse (HashMap Text Text)
S3.getObjectResponse_metadata)
                  Just Envelope
e -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Envelope
e

              forall (f :: * -> *) a. Applicative f => a -> f a
pure (GetObjectResponse
body forall a b. a -> (a -> b) -> b
& Lens' GetObjectResponse ResponseBody
S3.getObjectResponse_body forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Envelope -> ResponseBody -> ResponseBody
bodyDecrypt Envelope
encrypted)

      forall (f :: * -> *) a. Applicative f => a -> f a
pure (Decrypted GetObjectResponse
decrypt forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Response GetObjectResponse
rs)

proxy :: forall a. Proxy (Decrypt a) -> Proxy a
proxy :: forall a. Proxy (Decrypt a) -> Proxy a
proxy = forall a b. a -> b -> a
const forall {k} (t :: k). Proxy t
Proxy