-- |
-- Module      : Amazonka.S3.Encryption.Decrypt
-- Copyright   : (c) 2013-2021 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay <brendan.g.hay@gmail.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 = (GetObject -> Decrypt GetObject
forall a. a -> Decrypt a
Decrypt GetObject
x, GetObject -> GetInstructions
forall a. AddInstructions a => a -> GetInstructions
getInstructions GetObject
x)

newtype Decrypt a = Decrypt a

newtype Decrypted a = Decrypted
  { 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 :: Decrypt GetObject -> Request (Decrypt GetObject)
request (Decrypt GetObject
x) = Request GetObject -> Request (Decrypt GetObject)
coerce (GetObject -> Request GetObject
forall a. AWSRequest a => a -> Request a
request GetObject
x)

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

      let body :: GetObjectResponse
body = Response GetObjectResponse -> GetObjectResponse
forall body. Response body -> body
Client.responseBody Response GetObjectResponse
rs
          decrypt :: Decrypted GetObjectResponse
decrypt =
            (forall (m :: * -> *).
 MonadResource m =>
 Key -> Env -> Maybe Envelope -> m GetObjectResponse)
-> Decrypted GetObjectResponse
forall a.
(forall (m :: * -> *).
 MonadResource m =>
 Key -> Env -> Maybe Envelope -> m a)
-> Decrypted a
Decrypted ((forall (m :: * -> *).
  MonadResource m =>
  Key -> Env -> Maybe Envelope -> m GetObjectResponse)
 -> Decrypted GetObjectResponse)
-> (forall (m :: * -> *).
    MonadResource m =>
    Key -> Env -> Maybe Envelope -> m GetObjectResponse)
-> Decrypted GetObjectResponse
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 -> Key -> Env -> HashMap Text Text -> m Envelope
forall (m :: * -> *).
MonadResource m =>
Key -> Env -> HashMap Text Text -> m Envelope
fromMetadata Key
key Env
env (GetObjectResponse
body GetObjectResponse
-> Getting
     (HashMap Text Text) GetObjectResponse (HashMap Text Text)
-> HashMap Text Text
forall s a. s -> Getting a s a -> a
^. Getting (HashMap Text Text) GetObjectResponse (HashMap Text Text)
Lens' GetObjectResponse (HashMap Text Text)
S3.getObjectResponse_metadata)
                  Just Envelope
e -> Envelope -> m Envelope
forall (f :: * -> *) a. Applicative f => a -> f a
pure Envelope
e

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

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

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