{-# LANGUAGE TemplateHaskell #-}

-- |
-- Module      : Amazonka.S3.Encryption.Types
-- 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.Types where

import Amazonka.Core
import Amazonka.Prelude
import qualified Amazonka.S3 as S3
import qualified Control.Exception.Lens as Exception.Lens
import qualified Control.Lens as Lens
import qualified Crypto.Cipher.AES as AES
import qualified Crypto.Error
import qualified Crypto.PubKey.RSA.Types as RSA
import qualified Data.Aeson as Aeson
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text

-- | An error thrown when performing encryption or decryption.
data EncryptionError
  = -- | Error initialising an AES cipher from a secret key.
    CipherFailure Crypto.Error.CryptoError
  | -- | Failure performing asymmetric encryption/decryption.
    PubKeyFailure RSA.Error
  | -- | Failure creating an IV from some bytes.
    IVInvalid ByteString
  | -- | Required envelope field missing.
    EnvelopeMissing (CI Text)
  | -- | Error parsing envelope.
    EnvelopeInvalid (CI Text) String
  | -- | KMS error when retrieving decrypted plaintext.
    PlaintextUnavailable
  deriving stock (EncryptionError -> EncryptionError -> Bool
(EncryptionError -> EncryptionError -> Bool)
-> (EncryptionError -> EncryptionError -> Bool)
-> Eq EncryptionError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EncryptionError -> EncryptionError -> Bool
$c/= :: EncryptionError -> EncryptionError -> Bool
== :: EncryptionError -> EncryptionError -> Bool
$c== :: EncryptionError -> EncryptionError -> Bool
Eq, Int -> EncryptionError -> ShowS
[EncryptionError] -> ShowS
EncryptionError -> String
(Int -> EncryptionError -> ShowS)
-> (EncryptionError -> String)
-> ([EncryptionError] -> ShowS)
-> Show EncryptionError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EncryptionError] -> ShowS
$cshowList :: [EncryptionError] -> ShowS
show :: EncryptionError -> String
$cshow :: EncryptionError -> String
showsPrec :: Int -> EncryptionError -> ShowS
$cshowsPrec :: Int -> EncryptionError -> ShowS
Show)

instance Exception EncryptionError

$(Lens.makeClassyPrisms ''EncryptionError)

instance AsEncryptionError SomeException where
  _EncryptionError :: p EncryptionError (f EncryptionError)
-> p SomeException (f SomeException)
_EncryptionError = p EncryptionError (f EncryptionError)
-> p SomeException (f SomeException)
forall a. Exception a => Prism' SomeException a
Exception.Lens.exception

data ContentAlgorithm
  = -- | AES/CBC/PKCS5Padding
    AES_CBC_PKCS5Padding

instance FromText ContentAlgorithm where
  fromText :: Text -> Either String ContentAlgorithm
fromText = \case
    Text
"AES/CBC/PKCS5Padding" -> ContentAlgorithm -> Either String ContentAlgorithm
forall (f :: * -> *) a. Applicative f => a -> f a
pure ContentAlgorithm
AES_CBC_PKCS5Padding
    Text
other -> String -> Either String ContentAlgorithm
forall a b. a -> Either a b
Left (String
"Unrecognised content encryption algorithm: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
other)

instance ToByteString ContentAlgorithm where
  toBS :: ContentAlgorithm -> ByteString
toBS ContentAlgorithm
AES_CBC_PKCS5Padding = ByteString
"AES/CBC/PKCS5Padding"

data WrappingAlgorithm
  = -- | Key Management Service.
    KMSWrap

instance FromText WrappingAlgorithm where
  fromText :: Text -> Either String WrappingAlgorithm
fromText = \case
    Text
"kms" -> WrappingAlgorithm -> Either String WrappingAlgorithm
forall (f :: * -> *) a. Applicative f => a -> f a
pure WrappingAlgorithm
KMSWrap
    Text
other -> String -> Either String WrappingAlgorithm
forall a b. a -> Either a b
Left (String
"Unrecognised key wrapping algorithm: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
other)

instance ToByteString WrappingAlgorithm where
  toBS :: WrappingAlgorithm -> ByteString
toBS WrappingAlgorithm
KMSWrap = ByteString
"kms"

data Location = Metadata | Discard
  deriving stock (Location -> Location -> Bool
(Location -> Location -> Bool)
-> (Location -> Location -> Bool) -> Eq Location
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Location -> Location -> Bool
$c/= :: Location -> Location -> Bool
== :: Location -> Location -> Bool
$c== :: Location -> Location -> Bool
Eq)

-- | An instructions file extension.
newtype Ext = Ext Text
  deriving stock (Ext -> Ext -> Bool
(Ext -> Ext -> Bool) -> (Ext -> Ext -> Bool) -> Eq Ext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ext -> Ext -> Bool
$c/= :: Ext -> Ext -> Bool
== :: Ext -> Ext -> Bool
$c== :: Ext -> Ext -> Bool
Eq, Int -> Ext -> ShowS
[Ext] -> ShowS
Ext -> String
(Int -> Ext -> ShowS)
-> (Ext -> String) -> ([Ext] -> ShowS) -> Show Ext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ext] -> ShowS
$cshowList :: [Ext] -> ShowS
show :: Ext -> String
$cshow :: Ext -> String
showsPrec :: Int -> Ext -> ShowS
$cshowsPrec :: Int -> Ext -> ShowS
Show)
  deriving newtype (String -> Ext
(String -> Ext) -> IsString Ext
forall a. (String -> a) -> IsString a
fromString :: String -> Ext
$cfromString :: String -> Ext
IsString)

-- | Defaults to @.instruction@
defaultExtension :: Ext
defaultExtension :: Ext
defaultExtension = Ext
".instruction"

appendExtension :: Ext -> S3.ObjectKey -> S3.ObjectKey
appendExtension :: Ext -> ObjectKey -> ObjectKey
appendExtension (Ext Text
s) o :: ObjectKey
o@(S3.ObjectKey Text
k)
  | Text
s Text -> Text -> Bool
`Text.isSuffixOf` Text
k = ObjectKey
o
  | Bool
otherwise = Text -> ObjectKey
S3.ObjectKey (Text
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s)

-- | A key material description. This is attached in plaintext to the metadata,
-- and will be logged using CloudTrail. For KMS decryption any supplemental
-- material description is merged with the description stored on the object during
-- decryption.
newtype Description = Description {Description -> HashMap Text Text
fromDescription :: HashMap Text Text}
  deriving stock (Description -> Description -> Bool
(Description -> Description -> Bool)
-> (Description -> Description -> Bool) -> Eq Description
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Description -> Description -> Bool
$c/= :: Description -> Description -> Bool
== :: Description -> Description -> Bool
$c== :: Description -> Description -> Bool
Eq, Int -> Description -> ShowS
[Description] -> ShowS
Description -> String
(Int -> Description -> ShowS)
-> (Description -> String)
-> ([Description] -> ShowS)
-> Show Description
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Description] -> ShowS
$cshowList :: [Description] -> ShowS
show :: Description -> String
$cshow :: Description -> String
showsPrec :: Int -> Description -> ShowS
$cshowsPrec :: Int -> Description -> ShowS
Show)
  deriving newtype (b -> Description -> Description
NonEmpty Description -> Description
Description -> Description -> Description
(Description -> Description -> Description)
-> (NonEmpty Description -> Description)
-> (forall b. Integral b => b -> Description -> Description)
-> Semigroup Description
forall b. Integral b => b -> Description -> Description
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Description -> Description
$cstimes :: forall b. Integral b => b -> Description -> Description
sconcat :: NonEmpty Description -> Description
$csconcat :: NonEmpty Description -> Description
<> :: Description -> Description -> Description
$c<> :: Description -> Description -> Description
Semigroup, Semigroup Description
Description
Semigroup Description
-> Description
-> (Description -> Description -> Description)
-> ([Description] -> Description)
-> Monoid Description
[Description] -> Description
Description -> Description -> Description
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Description] -> Description
$cmconcat :: [Description] -> Description
mappend :: Description -> Description -> Description
$cmappend :: Description -> Description -> Description
mempty :: Description
$cmempty :: Description
$cp1Monoid :: Semigroup Description
Monoid, Value -> Parser [Description]
Value -> Parser Description
(Value -> Parser Description)
-> (Value -> Parser [Description]) -> FromJSON Description
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Description]
$cparseJSONList :: Value -> Parser [Description]
parseJSON :: Value -> Parser Description
$cparseJSON :: Value -> Parser Description
FromJSON, [Description] -> Encoding
[Description] -> Value
Description -> Encoding
Description -> Value
(Description -> Value)
-> (Description -> Encoding)
-> ([Description] -> Value)
-> ([Description] -> Encoding)
-> ToJSON Description
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Description] -> Encoding
$ctoEncodingList :: [Description] -> Encoding
toJSONList :: [Description] -> Value
$ctoJSONList :: [Description] -> Value
toEncoding :: Description -> Encoding
$ctoEncoding :: Description -> Encoding
toJSON :: Description -> Value
$ctoJSON :: Description -> Value
ToJSON)

instance ToByteString Description where
  toBS :: Description -> ByteString
toBS = ByteString -> ByteString
forall a. ToByteString a => a -> ByteString
toBS (ByteString -> ByteString)
-> (Description -> ByteString) -> Description -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Description -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode

instance FromText Description where
  fromText :: Text -> Either String Description
fromText = ByteString -> Either String Description
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecodeStrict' (ByteString -> Either String Description)
-> (Text -> ByteString) -> Text -> Either String Description
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8

-- | The key used for encryption and decryption.
data Key
  = Symmetric AES.AES256 Description
  | Asymmetric RSA.KeyPair Description
  | KMS Text Description

-- | Modify the material description of a key.
--
-- /See:/ 'Description'.
description :: Lens' Key Description
description :: (Description -> f Description) -> Key -> f Key
description = (Key -> Description)
-> (Key -> Description -> Key)
-> Lens Key Key Description Description
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens Key -> Description
f ((Description -> Key -> Key) -> Key -> Description -> Key
forall a b c. (a -> b -> c) -> b -> a -> c
flip Description -> Key -> Key
g)
  where
    f :: Key -> Description
f = \case
      Symmetric AES256
_ Description
a -> Description
a
      Asymmetric KeyPair
_ Description
a -> Description
a
      KMS Text
_ Description
a -> Description
a

    g :: Description -> Key -> Key
g Description
a = \case
      Symmetric AES256
c Description
_ -> AES256 -> Description -> Key
Symmetric AES256
c Description
a
      Asymmetric KeyPair
k Description
_ -> KeyPair -> Description -> Key
Asymmetric KeyPair
k Description
a
      KMS Text
k Description
_ -> Text -> Description -> Key
KMS Text
k Description
a