diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,367 @@ +Mozilla Public License Version 2.0 +================================== + +1. Definitions +-------------- + +1.1. "Contributor" + means each individual or legal entity that creates, contributes to + the creation of, or owns Covered Software. + +1.2. "Contributor Version" + means the combination of the Contributions of others (if any) used + by a Contributor and that particular Contributor's Contribution. + +1.3. "Contribution" + means Covered Software of a particular Contributor. + +1.4. "Covered Software" + means Source Code Form to which the initial Contributor has attached + the notice in Exhibit A, the Executable Form of such Source Code + Form, and Modifications of such Source Code Form, in each case + including portions thereof. + +1.5. "Incompatible With Secondary Licenses" + means + + (a) that the initial Contributor has attached the notice described + in Exhibit B to the Covered Software; or + + (b) that the Covered Software was made available under the terms of + version 1.1 or earlier of the License, but not also under the + terms of a Secondary License. + +1.6. "Executable Form" + means any form of the work other than Source Code Form. + +1.7. "Larger Work" + means a work that combines Covered Software with other material, in + a separate file or files, that is not Covered Software. + +1.8. "License" + means this document. + +1.9. "Licensable" + means having the right to grant, to the maximum extent possible, + whether at the time of the initial grant or subsequently, any and + all of the rights conveyed by this License. + +1.10. "Modifications" + means any of the following: + + (a) any file in Source Code Form that results from an addition to, + deletion from, or modification of the contents of Covered + Software; or + + (b) any new file in Source Code Form that contains any Covered + Software. + +1.11. "Patent Claims" of a Contributor + means any patent claim(s), including without limitation, method, + process, and apparatus claims, in any patent Licensable by such + Contributor that would be infringed, but for the grant of the + License, by the making, using, selling, offering for sale, having + made, import, or transfer of either its Contributions or its + Contributor Version. + +1.12. "Secondary License" + means either the GNU General Public License, Version 2.0, the GNU + Lesser General Public License, Version 2.1, the GNU Affero General + Public License, Version 3.0, or any later versions of those + licenses. + +1.13. "Source Code Form" + means the form of the work preferred for making modifications. + +1.14. "You" (or "Your") + means an individual or a legal entity exercising rights under this + License. For legal entities, "You" includes any entity that + controls, is controlled by, or is under common control with You. For + purposes of this definition, "control" means (a) the power, direct + or indirect, to cause the direction or management of such entity, + whether by contract or otherwise, or (b) ownership of more than + fifty percent (50%) of the outstanding shares or beneficial + ownership of such entity. + +2. License Grants and Conditions +-------------------------------- + +2.1. Grants + +Each Contributor hereby grants You a world-wide, royalty-free, +non-exclusive license: + +(a) under intellectual property rights (other than patent or trademark) + Licensable by such Contributor to use, reproduce, make available, + modify, display, perform, distribute, and otherwise exploit its + Contributions, either on an unmodified basis, with Modifications, or + as part of a Larger Work; and + +(b) under Patent Claims of such Contributor to make, use, sell, offer + for sale, have made, import, and otherwise transfer either its + Contributions or its Contributor Version. + +2.2. Effective Date + +The licenses granted in Section 2.1 with respect to any Contribution +become effective for each Contribution on the date the Contributor first +distributes such Contribution. + +2.3. Limitations on Grant Scope + +The licenses granted in this Section 2 are the only rights granted under +this License. No additional rights or licenses will be implied from the +distribution or licensing of Covered Software under this License. +Notwithstanding Section 2.1(b) above, no patent license is granted by a +Contributor: + +(a) for any code that a Contributor has removed from Covered Software; + or + +(b) for infringements caused by: (i) Your and any other third party's + modifications of Covered Software, or (ii) the combination of its + Contributions with other software (except as part of its Contributor + Version); or + +(c) under Patent Claims infringed by Covered Software in the absence of + its Contributions. + +This License does not grant any rights in the trademarks, service marks, +or logos of any Contributor (except as may be necessary to comply with +the notice requirements in Section 3.4). + +2.4. Subsequent Licenses + +No Contributor makes additional grants as a result of Your choice to +distribute the Covered Software under a subsequent version of this +License (see Section 10.2) or under the terms of a Secondary License (if +permitted under the terms of Section 3.3). + +2.5. Representation + +Each Contributor represents that the Contributor believes its +Contributions are its original creation(s) or it has sufficient rights +to grant the rights to its Contributions conveyed by this License. + +2.6. Fair Use + +This License is not intended to limit any rights You have under +applicable copyright doctrines of fair use, fair dealing, or other +equivalents. + +2.7. Conditions + +Sections 3.1, 3.2, 3.3, and 3.4 are conditions of the licenses granted +in Section 2.1. + +3. Responsibilities +------------------- + +3.1. Distribution of Source Form + +All distribution of Covered Software in Source Code Form, including any +Modifications that You create or to which You contribute, must be under +the terms of this License. You must inform recipients that the Source +Code Form of the Covered Software is governed by the terms of this +License, and how they can obtain a copy of this License. You may not +attempt to alter or restrict the recipients' rights in the Source Code +Form. + +3.2. Distribution of Executable Form + +If You distribute Covered Software in Executable Form then: + +(a) such Covered Software must also be made available in Source Code + Form, as described in Section 3.1, and You must inform recipients of + the Executable Form how they can obtain a copy of such Source Code + Form by reasonable means in a timely manner, at a charge no more + than the cost of distribution to the recipient; and + +(b) You may distribute such Executable Form under the terms of this + License, or sublicense it under different terms, provided that the + license for the Executable Form does not attempt to limit or alter + the recipients' rights in the Source Code Form under this License. + +3.3. Distribution of a Larger Work + +You may create and distribute a Larger Work under terms of Your choice, +provided that You also comply with the requirements of this License for +the Covered Software. If the Larger Work is a combination of Covered +Software with a work governed by one or more Secondary Licenses, and the +Covered Software is not Incompatible With Secondary Licenses, this +License permits You to additionally distribute such Covered Software +under the terms of such Secondary License(s), so that the recipient of +the Larger Work may, at their option, further distribute the Covered +Software under the terms of either this License or such Secondary +License(s). + +3.4. Notices + +You may not remove or alter the substance of any license notices +(including copyright notices, patent notices, disclaimers of warranty, +or limitations of liability) contained within the Source Code Form of +the Covered Software, except that You may alter any license notices to +the extent required to remedy known factual inaccuracies. + +3.5. Application of Additional Terms + +You may choose to offer, and to charge a fee for, warranty, support, +indemnity or liability obligations to one or more recipients of Covered +Software. However, You may do so only on Your own behalf, and not on +behalf of any Contributor. You must make it absolutely clear that any +such warranty, support, indemnity, or liability obligation is offered by +You alone, and You hereby agree to indemnify every Contributor for any +liability incurred by such Contributor as a result of warranty, support, +indemnity or liability terms You offer. You may include additional +disclaimers of warranty and limitations of liability specific to any +jurisdiction. + +4. Inability to Comply Due to Statute or Regulation +--------------------------------------------------- + +If it is impossible for You to comply with any of the terms of this +License with respect to some or all of the Covered Software due to +statute, judicial order, or regulation then You must: (a) comply with +the terms of this License to the maximum extent possible; and (b) +describe the limitations and the code they affect. Such description must +be placed in a text file included with all distributions of the Covered +Software under this License. Except to the extent prohibited by statute +or regulation, such description must be sufficiently detailed for a +recipient of ordinary skill to be able to understand it. + +5. Termination +-------------- + +5.1. The rights granted under this License will terminate automatically +if You fail to comply with any of its terms. However, if You become +compliant, then the rights granted under this License from a particular +Contributor are reinstated (a) provisionally, unless and until such +Contributor explicitly and finally terminates Your grants, and (b) on an +ongoing basis, if such Contributor fails to notify You of the +non-compliance by some reasonable means prior to 60 days after You have +come back into compliance. Moreover, Your grants from a particular +Contributor are reinstated on an ongoing basis if such Contributor +notifies You of the non-compliance by some reasonable means, this is the +first time You have received notice of non-compliance with this License +from such Contributor, and You become compliant prior to 30 days after +Your receipt of the notice. + +5.2. If You initiate litigation against any entity by asserting a patent +infringement claim (excluding declaratory judgment actions, +counter-claims, and cross-claims) alleging that a Contributor Version +directly or indirectly infringes any patent, then the rights granted to +You by any and all Contributors for the Covered Software under Section +2.1 of this License shall terminate. + +5.3. In the event of termination under Sections 5.1 or 5.2 above, all +end user license agreements (excluding distributors and resellers) which +have been validly granted by You or Your distributors under this License +prior to termination shall survive termination. + +************************************************************************ +* * +* 6. Disclaimer of Warranty * +* ------------------------- * +* * +* Covered Software is provided under this License on an "as is" * +* basis, without warranty of any kind, either expressed, implied, or * +* statutory, including, without limitation, warranties that the * +* Covered Software is free of defects, merchantable, fit for a * +* particular purpose or non-infringing. The entire risk as to the * +* quality and performance of the Covered Software is with You. * +* Should any Covered Software prove defective in any respect, You * +* (not any Contributor) assume the cost of any necessary servicing, * +* repair, or correction. This disclaimer of warranty constitutes an * +* essential part of this License. No use of any Covered Software is * +* authorized under this License except under this disclaimer. * +* * +************************************************************************ + +************************************************************************ +* * +* 7. Limitation of Liability * +* -------------------------- * +* * +* Under no circumstances and under no legal theory, whether tort * +* (including negligence), contract, or otherwise, shall any * +* Contributor, or anyone who distributes Covered Software as * +* permitted above, be liable to You for any direct, indirect, * +* special, incidental, or consequential damages of any character * +* including, without limitation, damages for lost profits, loss of * +* goodwill, work stoppage, computer failure or malfunction, or any * +* and all other commercial damages or losses, even if such party * +* shall have been informed of the possibility of such damages. This * +* limitation of liability shall not apply to liability for death or * +* personal injury resulting from such party's negligence to the * +* extent applicable law prohibits such limitation. Some * +* jurisdictions do not allow the exclusion or limitation of * +* incidental or consequential damages, so this exclusion and * +* limitation may not apply to You. * +* * +************************************************************************ + +8. Litigation +------------- + +Any litigation relating to this License may be brought only in the +courts of a jurisdiction where the defendant maintains its principal +place of business and such litigation shall be governed by laws of that +jurisdiction, without reference to its conflict-of-law provisions. +Nothing in this Section shall prevent a party's ability to bring +cross-claims or counter-claims. + +9. Miscellaneous +---------------- + +This License represents the complete agreement concerning the subject +matter hereof. If any provision of this License is held to be +unenforceable, such provision shall be reformed only to the extent +necessary to make it enforceable. Any law or regulation which provides +that the language of a contract shall be construed against the drafter +shall not be used to construe this License against a Contributor. + +10. Versions of the License +--------------------------- + +10.1. New Versions + +Mozilla Foundation is the license steward. Except as provided in Section +10.3, no one other than the license steward has the right to modify or +publish new versions of this License. Each version will be given a +distinguishing version number. + +10.2. Effect of New Versions + +You may distribute the Covered Software under the terms of the version +of the License under which You originally received the Covered Software, +or under the terms of any subsequent version published by the license +steward. + +10.3. Modified Versions + +If you create software not governed by this License, and you want to +create a new license for such software, you may create and use a +modified version of this License if you rename the license and remove +any references to the name of the license steward (except to note that +such modified license differs from this License). + +10.4. Distributing Source Code Form that is Incompatible With Secondary +Licenses + +If You choose to distribute Source Code Form that is Incompatible With +Secondary Licenses under the terms of this version of the License, the +notice described in Exhibit B of this License must be attached. + +Exhibit A - Source Code Form License Notice +------------------------------------------- + + This Source Code Form is subject to the terms of the Mozilla Public + License, v. 2.0. If a copy of the MPL was not distributed with this + file, You can obtain one at http://mozilla.org/MPL/2.0/. + +If it is not possible or desirable to put the notice in a particular +file, then You may include the notice in a location (such as a LICENSE +file in a relevant directory) where a recipient would be likely to look +for such a notice. + +You may add additional accurate notices of copyright ownership. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,25 @@ +# Amazon Simple Storage Service SDK - Encryption Addons + +* [Version](#version) +* [Description](#description) +* [Contribute](#contribute) +* [Licence](#licence) + + +## Version + +`1.2.0.2` + + +## Description + +> TODO + +## Contribute + +For any problems, comments, or feedback please create an issue [here on GitHub](https://github.com/brendanhay/amazonka/issues). + + +## Licence + +`amazonka-s3-encryption` is released under the [Mozilla Public License Version 2.0](http://www.mozilla.org/MPL/). diff --git a/amazonka-s3-encryption.cabal b/amazonka-s3-encryption.cabal new file mode 100644 --- /dev/null +++ b/amazonka-s3-encryption.cabal @@ -0,0 +1,140 @@ +cabal-version: 2.2 +name: amazonka-s3-encryption +version: 2.0 +synopsis: Amazon Simple Storage Service SDK - Client-Side Encryption. +homepage: https://github.com/brendanhay/amazonka +bug-reports: https://github.com/brendanhay/amazonka/issues +license: MPL-2.0 +license-file: LICENSE +author: Brendan Hay +maintainer: + Brendan Hay , Jack Kelly + +copyright: Copyright (c) 2016 Brendan Hay +category: AWS +build-type: Simple +extra-source-files: README.md +description: + Addons for to + support client-side encryption. This allows the use of a client-side master key + to encrypt/decrypt data locally and store encrypted data in S3 to be later + decrypt by any other client with access to the same master key. Unencrypted + object data or keys are not sent to Amazon S3 using this method, but object + metadata is transmitted in plaintext. + . + Encryption and decryption are done in a streaming fashion, with + encrypted requests being incrementally signed using the version 4 signature + algorithm and sent via chunked-encoding. + . + The client-side master key you provide can be a symmetric key, an + asymmetric public/private key pair, or a KMS master key. + . + This library is designed to be compatible with the official Java + AWS SDK (both V1 and V2 envelopes), but only a limited set of the possible + encryption options are supported. Therefore assuming defaults, objects stored + with this library should be retrievable by any of the other official SDKs, and + vice versa. The metadata can be attached as header metadata + on the stored object or as a separate JSON instructions file. + @PutObject@, @GetObject@, and the various multipart upload operations are supported. + . + See + to get started. + +source-repository head + type: git + location: git://github.com/brendanhay/amazonka.git + subdir: lib/amazonka-s3-encryption + +common base + default-language: Haskell2010 + ghc-options: + -Wall -funbox-strict-fields -fwarn-incomplete-uni-patterns + -fwarn-incomplete-record-updates -fwarn-missing-deriving-strategies + -fwarn-unused-packages + + default-extensions: + NoImplicitPrelude + DataKinds + DeriveAnyClass + DeriveFoldable + DeriveFunctor + DeriveGeneric + DeriveTraversable + DerivingStrategies + DerivingVia + FlexibleContexts + FlexibleInstances + GeneralizedNewtypeDeriving + LambdaCase + NamedFieldPuns + OverloadedStrings + PatternSynonyms + RankNTypes + RecordWildCards + ScopedTypeVariables + StrictData + TupleSections + TypeApplications + TypeFamilies + ViewPatterns + + build-depends: base >=4.12 && <5 + +library + import: base + hs-source-dirs: src + exposed-modules: + Amazonka.S3.Encryption + Amazonka.S3.Encryption.Body + Amazonka.S3.Encryption.Decrypt + Amazonka.S3.Encryption.Encrypt + Amazonka.S3.Encryption.Envelope + Amazonka.S3.Encryption.Instructions + Amazonka.S3.Encryption.Types + + build-depends: + , aeson ^>=1.5.0.0 || >=2.0 && <2.2 || ^>=2.2 + , amazonka ^>=2.0 + , amazonka-core ^>=2.0 + , amazonka-kms ^>=2.0 + , amazonka-s3 ^>=2.0 + , bytestring >=0.10.8 + , case-insensitive >=1.2 + , conduit >=1.3 + , crypton >=0.32 && <0.34 + , http-client >=0.5 && <0.8 + , lens >=4.14 + , memory >=0.6 + , mtl >=2.1.3.1 + , text >=1.1 + , unordered-containers >=0.2.5 + +test-suite amazonka-s3-encryption-test + type: exitcode-stdio-1.0 + default-language: Haskell2010 + hs-source-dirs: test + main-is: Main.hs + ghc-options: -Wall -threaded + + -- This section is encoded by the template and any modules added by + -- hand outside these namespaces will not correctly be added to the + -- distribution package. + other-modules: Test.Amazonka.S3.Encryption.Envelope + build-depends: + , amazonka-core + , amazonka-s3-encryption + , amazonka-test ^>=2.0 + , base + , bytestring + , conduit + , crypton + , mtl + , QuickCheck + , quickcheck-instances >=0.3.25.2 + , resourcet + , tasty + , tasty-hunit + , tasty-quickcheck + , text + , time + , unordered-containers diff --git a/src/Amazonka/S3/Encryption.hs b/src/Amazonka/S3/Encryption.hs new file mode 100644 --- /dev/null +++ b/src/Amazonka/S3/Encryption.hs @@ -0,0 +1,330 @@ +-- | +-- Module : Amazonka.S3.Encryption +-- Copyright : (c) 2013-2023 Brendan Hay +-- License : Mozilla Public License, v. 2.0. +-- Maintainer : Brendan Hay +-- Stability : provisional +-- Portability : non-portable (GHC extensions) +-- +-- Addons for to +-- support client-side encryption. +-- +-- Your client-side master keys and your unencrypted data are never sent to AWS; +-- therefore, it is important that you safely manage your encryption keys. If +-- you lose them, you won't be able to decrypt your data. +-- When generating a symmetric key, you should ensure +-- that the key length is compatible with the underlying 'AES256' cipher. +-- +-- The encryption procedure is: +-- +-- * A one-time-use symmetric key a.k.a. a data encryption key (or data key) and +-- initialisation vector (IV) are generated locally. This data key and IV are used +-- to encrypt the data of a single S3 object using an AES256 cipher in CBC mode, +-- with PKCS5 padding. (For each object sent, a completely separate data key and IV are generated.) +-- +-- * The generated data encryption key used above is encrypted using a symmetric +-- AES256 cipher in ECB mode, asymmetric RSA, or KMS facilities, depending on the +-- client-side master key you provide. +-- +-- * The encrypted data is uploaded and the encrypted data key and material description +-- are attached as object metadata (either headers or a separate instruction file). +-- If KMS is used, the material description helps determine which client-side master +-- key to later use for decryption, otherwise the configured client-side key at +-- time of decryption is used. +-- +-- For decryption: +-- +-- The encrypted object is downloaded from Amazon S3 along with any metadata. +-- If KMS was used to encrypt the data then the master key id is taken from the +-- metadata material description, otherwise the client-side master key in the +-- current environment is used to decrypt the data key, which in turn is used +-- to decrypt the object data. +-- +-- The client-side master key you provide can be either a symmetric key, an +-- asymmetric public/private key pair, or a KMS master key. +-- +-- The stored metadata format is designed to be compatible with the official Java +-- AWS SDK (both V1 and V2 envelopes), but only a limited set of the possible +-- encryption options are supported. Therefore assuming defaults, objects stored +-- with this library should be retrievable by any of the other official SDKs, and +-- vice versa. +module Amazonka.S3.Encryption + ( -- * Usage + -- $usage + + -- * Specifying Master Keys + -- $master-key + Key (..), + kmsKey, + asymmetricKey, + symmetricKey, + newSecret, + + -- * Request Encryption/Decryption + -- $requests + encrypt, + decrypt, + initiate, + + -- ** Instruction Files + -- $instructions + encryptInstructions, + decryptInstructions, + initiateInstructions, + cleanupInstructions, + + -- *** Default Instruction Extension + Ext (..), + defaultExtension, + + -- * Handling Errors + -- $errors + EncryptionError (..), + AsEncryptionError (..), + ) +where + +import Amazonka as AWS +import Amazonka.Prelude +import Amazonka.S3 +import Amazonka.S3.Encryption.Decrypt +import Amazonka.S3.Encryption.Encrypt +import Amazonka.S3.Encryption.Envelope +import Amazonka.S3.Encryption.Instructions +import Amazonka.S3.Encryption.Types +import Control.Lens +import Crypto.PubKey.RSA.Types as RSA +import Crypto.Random +import Data.Typeable (Typeable) + +-- | Specify a KMS master key to use, with an initially empty material description. +-- +-- /See:/ 'description', 'material'. +kmsKey :: Text -> Key +kmsKey k = KMS k mempty + +-- | Specify the asymmetric key used for RSA encryption. +-- +-- /See:/ 'description', 'material'. +asymmetricKey :: PrivateKey -> Key +asymmetricKey k = Asymmetric (KeyPair k) mempty + +-- | Specify the shared secret to use for symmetric key encryption. +-- This must be compatible with the AES256 key size, 32 bytes. +-- +-- Throws 'EncryptionError', specifically 'CipherFailure'. +-- +-- /See:/ 'newSecret', 'description', 'material'. +symmetricKey :: MonadIO m => ByteString -> m Key +symmetricKey = fmap (`Symmetric` mempty) . createCipher + +-- | Generate a random shared secret that is of the correct length to use with +-- 'symmetricKey'. This will need to be stored securely to enable decryption +-- of any requests that are encrypted using this secret. +newSecret :: MonadRandom m => m ByteString +newSecret = getRandomBytes aesKeySize + +-- | Encrypt an object, storing the encryption envelope in @x-amz-meta-*@ +-- headers. +-- +-- Throws 'EncryptionError', 'AWS.Error'. +encrypt :: + MonadResource m => + Key -> + Env -> + PutObject -> + m PutObjectResponse +encrypt key env x = do + (a, _) <- encrypted key env x + send env (set location Metadata a) + +-- | Encrypt an object, storing the encryption envelope in an adjacent instruction +-- file with the same 'ObjectKey' and 'defaultExtension'. +-- This makes two HTTP requests, storing the instruction file first and upon success, +-- storing the actual object. +-- +-- Throws 'EncryptionError', 'AWS.Error'. +encryptInstructions :: + MonadResource m => + Key -> + Env -> + PutObject -> + m PutObjectResponse +encryptInstructions key env x = do + (a, b) <- encrypted key env x + _ <- send env b + send env a + +-- | Initiate an encrypted multipart upload, storing the encryption envelope +-- in the @x-amz-meta-*@ headers. +-- +-- The returned 'UploadPart' @->@ 'Encrypted' 'UploadPart' function is used to encrypt +-- each part of the object. The same caveats for multipart upload apply, it is +-- assumed that each part is uploaded in order and each part needs to be +-- individually encrypted. +-- +-- For example: +-- +-- @ +-- (a', f) <- initiate (a :: CreateMultipartUpload) +-- b' <- send (f b :: Encrypted UploadPart) +-- @ +-- +-- Throws 'EncryptionError', 'AWS.Error'. +initiate :: + MonadResource m => + Key -> + Env -> + CreateMultipartUpload -> + m + ( CreateMultipartUploadResponse, + UploadPart -> Encrypted UploadPart + ) +initiate key env x = do + (a, _) <- encrypted key env x + rs <- send env (set location Metadata a) + return (rs, encryptPart a) + +-- | Initiate an encrypted multipart upload, storing the encryption envelope +-- in an adjacent instruction file with the same 'ObjectKey' and 'defaultExtension'. +-- +-- The returned 'UploadPart' @->@ 'Encrypted' 'UploadPart' function is used to encrypt +-- each part of the object. The same caveats for multipart upload apply, it is +-- assumed that each part is uploaded in order and each part needs to be +-- individually encrypted. +-- +-- Throws 'EncryptionError', 'AWS.Error'. +initiateInstructions :: + MonadResource m => + Key -> + Env -> + CreateMultipartUpload -> + m + ( CreateMultipartUploadResponse, + UploadPart -> Encrypted UploadPart + ) +initiateInstructions key env x = do + (a, b) <- encrypted key env x + rs <- send env a + _ <- send env b + return (rs, encryptPart a) + +-- | Retrieve an object, parsing the envelope from any @x-amz-meta-*@ headers +-- and decrypting the response body. +-- +-- Throws 'EncryptionError', 'AWS.Error'. +decrypt :: + MonadResource m => + Key -> + Env -> + GetObject -> + m GetObjectResponse +decrypt key env x = do + let (a, _) = decrypted x + Decrypted f <- send env a + f key env Nothing + +-- | Retrieve an object and its adjacent instruction file. The instruction +-- are retrieved and parsed first. +-- Performs two HTTP requests. +-- +-- Throws 'EncryptionError', 'AWS.Error'. +decryptInstructions :: + MonadResource m => + Key -> + Env -> + GetObject -> + m GetObjectResponse +decryptInstructions key env x = do + let (a, b) = decrypted x + Instructions g <- send env b + Decrypted f <- send env a + g key env >>= f key env . Just + +-- | Given a request to execute, such as 'AbortMultipartUpload' or 'DeleteObject', +-- remove the adjacent instruction file, if it exists with the 'defaultExtension'. +-- Performs two HTTP requests. +-- +-- Throws 'EncryptionError', 'AWS.Error'. +cleanupInstructions :: + ( MonadResource m, + RemoveInstructions a, + Typeable (AWSResponse a), + Typeable a + ) => + Env -> + a -> + m (AWSResponse a) +cleanupInstructions env x = do + rs <- send env x + _ <- send env (deleteInstructions x) + return rs + +-- $usage +-- When sending requests that make use of a master key, an extension to the underlying +-- 'AWS' environment is required. You can specify this environment as follows: +-- +-- @ +-- import Amazonka +-- import Amazonka.S3 +-- import Amazonka.S3.Encryption +-- import System.IO +-- +-- example :: Key -> IO GetObjectResponse +-- example k = do +-- -- A standard AWS environment with credentials is created using 'newEnv': +-- e <- newEnv Frankfurt Discover +-- +-- runResourceT $ do +-- -- To store an encrypted object, 'encrypt' is used inplace of where you would +-- -- typically use 'AWS.send': +-- _ <- encrypt (kmsKey "alias/master-key") e (putObject "bucket-name" "object-key" body) +-- +-- -- To retrieve a previously encrypted object, 'decrypt' is used, again similarly to +-- -- how you'd use 'AWS.send': +-- rs <- decrypt (kmsKey "alias/master-key") e (getObject "bucket-name" "object-key") +-- +-- -- The 'GetObjectResponse' here contains a 'body' that is decrypted during read: +-- return rs +-- @ + +-- $master-key +-- You master key should be stored and secured by you alone (or KMS). The specific +-- key that is used to encrypt an object is required to decrypt the same object. +-- If you lose this key, you will not be able to decrypt the related objects. + +-- $errors +-- Errors are thrown by the library using 'MonadThrow' and will consist of one of +-- the branches from 'EncryptionError' for anything crypto related, or a disparate +-- 'AWS.Error' anything related to the underlying 'AWS' service calls. +-- +-- You can catch errors and sub-errors via 'trying' etc. from "Control.Exception.Lens", +-- and the appropriate 'AsEncryptionError' 'Prism': +-- +-- @ +-- trying '_EncryptionError' (encrypt (putObject "bkt" "key")) :: Either 'EncryptionError' PutObjectResponse +-- @ + +-- $requests +-- Only a small number of S3 operations actually utilise encryption/decryption +-- behaviour, namely 'PutObject', 'GetObject', and the related multipart upload +-- operations. The following functions store the encryption envelope in object +-- metadata (headers). + +-- $instructions +-- An alternative method of storing the encryption envelope in an adjacent S3 +-- object is provided for the case when metadata headers are reserved for other +-- data. This method removes the metadata overhead at the expense of an additional +-- HTTP request to perform encryption/decryption. +-- The provided @*Instruction@ functions make the convenient assumption that +-- the 'defaultExtension' is desired. If you wish to override the suffix\/extension, +-- you can simply call the underlying plumbing to modify the +-- 'PutInstructions' or 'GetInstructions' suffix before sending. +-- +-- An example of encryption with a non-default instruction extension: +-- +-- @ +-- (a, b) <- 'encrypted' (x :: 'PutObject') +-- _ <- 'AWS.send' (b & 'piExtension' .~ ".envelope") -- Store the custom instruction file. +-- 'AWS.send' a -- Store the actual encrypted object. +-- @ diff --git a/src/Amazonka/S3/Encryption/Body.hs b/src/Amazonka/S3/Encryption/Body.hs new file mode 100644 --- /dev/null +++ b/src/Amazonka/S3/Encryption/Body.hs @@ -0,0 +1,41 @@ +-- | +-- Module : Amazonka.S3.Encryption.Body +-- Copyright : (c) 2013-2023 Brendan Hay +-- License : Mozilla Public License, v. 2.0. +-- Maintainer : Brendan Hay +-- Stability : provisional +-- Portability : non-portable (GHC extensions) +module Amazonka.S3.Encryption.Body where + +import Amazonka.Core +import Amazonka.Prelude +import Conduit ((.|)) +import qualified Conduit +import qualified Data.ByteString as BS + +-- Resides here since it's unsafe without the use of enforceChunks, +-- which incurs extra dependencies not desired in core. +class ToChunkedBody a where + toChunked :: a -> ChunkedBody + +instance ToChunkedBody ChunkedBody where + toChunked = id + +instance ToChunkedBody HashedBody where + toChunked = \case + HashedStream _ n s -> enforceChunks n s + HashedBytes _ b -> enforceChunks (BS.length b) (mapM_ Conduit.yield [b]) + +instance ToChunkedBody RequestBody where + toChunked = \case + Chunked c -> c + Hashed h -> toChunked h + +enforceChunks :: + Integral a => + a -> + Conduit.ConduitT () ByteString (Conduit.ResourceT IO) () -> + ChunkedBody +enforceChunks size c = + ChunkedBody defaultChunkSize (fromIntegral size) $ + c .| Conduit.chunksOfCE (fromIntegral defaultChunkSize) diff --git a/src/Amazonka/S3/Encryption/Decrypt.hs b/src/Amazonka/S3/Encryption/Decrypt.hs new file mode 100644 --- /dev/null +++ b/src/Amazonka/S3/Encryption/Decrypt.hs @@ -0,0 +1,53 @@ +-- | +-- Module : Amazonka.S3.Encryption.Decrypt +-- Copyright : (c) 2013-2023 Brendan Hay +-- License : Mozilla Public License, v. 2.0. +-- Maintainer : Brendan Hay +-- 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 x = (Decrypt x, getInstructions x) + +newtype Decrypt a = Decrypt a + +newtype Decrypted a = Decrypted + { 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 overrides (Decrypt x) = coerce (request overrides x) + + response l s p r = + Except.runExceptT $ do + rs <- Except.ExceptT (response l s (proxy p) r) + + let body = Client.responseBody rs + decrypt = + Decrypted $ \key env m -> do + encrypted <- + case m of + Nothing -> fromMetadata key env (body ^. S3.getObjectResponse_metadata) + Just e -> pure e + + pure (body & S3.getObjectResponse_body %~ bodyDecrypt encrypted) + + pure (decrypt <$ rs) + +proxy :: forall a. Proxy (Decrypt a) -> Proxy a +proxy = const Proxy diff --git a/src/Amazonka/S3/Encryption/Encrypt.hs b/src/Amazonka/S3/Encryption/Encrypt.hs new file mode 100644 --- /dev/null +++ b/src/Amazonka/S3/Encryption/Encrypt.hs @@ -0,0 +1,110 @@ +{-# LANGUAGE DuplicateRecordFields #-} + +-- | +-- Module : Amazonka.S3.Encryption.Encrypt +-- Copyright : (c) 2013-2023 Brendan Hay +-- License : Mozilla Public License, v. 2.0. +-- Maintainer : Brendan Hay +-- Stability : provisional +-- Portability : non-portable (GHC extensions) +module Amazonka.S3.Encryption.Encrypt where + +import qualified Amazonka as AWS +import Amazonka.Core +import Amazonka.Data +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.Lens as Lens + +-- FIXME: Material + +-- | Note about how it doesn't attach metadata by default. +-- You can re-set the location and then discard the PutInstructions request. +encrypted :: + (MonadResource m, ToEncrypted a) => + Key -> + AWS.Env -> + a -> + m (Encrypted a, PutInstructions) +encrypted key env x = do + e <- newEnvelope key env + + pure + ( encryptWith x Discard e, + putInstructions x e + ) + +encryptPart :: + Encrypted S3.CreateMultipartUpload -> + S3.UploadPart -> + Encrypted S3.UploadPart +encryptPart e x = encryptWith x Discard (envelope e) + +data Encrypted a = Encrypted + { _encPayload :: a, + _encHeaders :: [Header], + _encLocation :: Location, + _encEnvelope :: Envelope + } + +location :: Setter' (Encrypted a) Location +location = Lens.lens _encLocation (\s a -> s {_encLocation = a}) + +envelope :: Encrypted a -> Envelope +envelope = _encEnvelope + +instance AWSRequest a => AWSRequest (Encrypted a) where + type AWSResponse (Encrypted a) = AWSResponse a + + request overrides (Encrypted x xs l e) = + coerce (request overrides x) & updateBodyAndHeaders + where + updateBodyAndHeaders :: Request x -> Request x + updateBodyAndHeaders rq@Request {body, headers} = + rq + { body = f body, + headers = headers <> hs + } + + f b + | contentLength b > 0 = bodyEncrypt e b + | otherwise = b + + hs + | l == Metadata = xs <> toHeaders e + | otherwise = xs + + response l s p = + response l s (proxy p) + +proxy :: forall a. Proxy (Encrypted a) -> Proxy a +proxy = const Proxy + +class AddInstructions a => ToEncrypted a where + -- | Create an encryption context. + encryptWith :: a -> Location -> Envelope -> Encrypted a + +instance ToEncrypted S3.CreateMultipartUpload where + encryptWith x = Encrypted x [] + +instance ToEncrypted S3.PutObject where + encryptWith x = Encrypted x (len : maybeToList md5) + where + len = ("X-Amz-Unencrypted-Content-Length", toBS (contentLength body)) + md5 = ("X-Amz-Unencrypted-Content-MD5",) <$> md5Base64 body + + body = x ^. S3.putObject_body + +-- FIXME: verify these additional headers. +instance ToEncrypted S3.UploadPart where + encryptWith x = Encrypted x (len : maybeToList md5) + where + len = ("X-Amz-Unencrypted-Content-Length", toBS (contentLength body)) + md5 = ("X-Amz-Unencrypted-Content-MD5",) <$> md5Base64 body + + body = x ^. S3.uploadPart_body diff --git a/src/Amazonka/S3/Encryption/Envelope.hs b/src/Amazonka/S3/Encryption/Envelope.hs new file mode 100644 --- /dev/null +++ b/src/Amazonka/S3/Encryption/Envelope.hs @@ -0,0 +1,350 @@ +{-# LANGUAGE CPP #-} + +-- | +-- Module : Amazonka.S3.Encryption.Envelope +-- Copyright : (c) 2013-2023 Brendan Hay +-- License : Mozilla Public License, v. 2.0. +-- Maintainer : Brendan Hay +-- Stability : provisional +-- Portability : non-portable (GHC extensions) +module Amazonka.S3.Encryption.Envelope where + +import qualified Amazonka as AWS +import Amazonka.Data +import qualified Amazonka.KMS as KMS +import qualified Amazonka.KMS.Lens as KMS +import Amazonka.Prelude hiding (length) +import Amazonka.S3.Encryption.Body +import Amazonka.S3.Encryption.Types +import Conduit ((.|)) +import qualified Conduit +import qualified Control.Exception as Exception +import Control.Lens ((?~), (^.)) +import Crypto.Cipher.AES (AES256) +import qualified Crypto.Cipher.AES as AES +import Crypto.Cipher.Types (BlockCipher, Cipher, IV) +import qualified Crypto.Cipher.Types as Cipher +import qualified Crypto.Data.Padding as Padding +import qualified Crypto.Error +import qualified Crypto.PubKey.RSA.PKCS15 as RSA +import Crypto.PubKey.RSA.Types (KeyPair, toPrivateKey, toPublicKey) +import Crypto.Random (getRandomBytes) +import qualified Data.Aeson as Aeson +import Data.ByteArray (ByteArray) +import qualified Data.ByteArray as ByteArray +import qualified Data.ByteString as BS +import qualified Data.CaseInsensitive as CI +import Data.Functor ((<&>)) +import qualified Data.HashMap.Strict as Map + +#if MIN_VERSION_aeson(2,0,0) +import qualified Data.Aeson.Key as Key +#endif + +data V1Envelope = V1Envelope + { -- | @x-amz-key@: Content encrypting key (cek) in encrypted form, base64 + -- encoded. The cek is randomly generated per S3 object, and is always + -- an AES 256-bit key. The corresponding cipher is always @AES/CBC/PKCS5Padding@. + _v1Key :: !ByteString, + -- | @x-amz-iv@: Randomly generated IV (per S3 object), base64 encoded. + _v1IV :: !(Cipher.IV AES.AES256), + -- | @x-amz-matdesc@: Customer provided material description in JSON (UTF8) + -- format. + _v1Description :: !Description + } + +newV1 :: MonadIO m => (ByteString -> IO ByteString) -> Description -> m Envelope +newV1 f d = + liftIO $ do + k <- getRandomBytes aesKeySize + c <- createCipher k + ek <- f k + iv <- createIV =<< getRandomBytes aesBlockSize + + pure . V1 c $ + V1Envelope + { _v1Key = ek, + _v1IV = iv, + _v1Description = d + } + +decodeV1 :: + MonadResource m => + (ByteString -> IO ByteString) -> + [(CI Text, Text)] -> + m Envelope +decodeV1 decryptKey meta = do + Base64 k <- meta .& "X-Amz-Key" + Base64 i <- meta .& "X-Amz-IV" + d <- meta .& "X-Amz-Matdesc" + + key <- liftIO (decryptKey k) + iv <- createIV i + cipher <- createCipher key + + pure . V1 cipher $ + V1Envelope + { _v1Key = key, + _v1IV = iv, + _v1Description = d + } + +data V2Envelope = V2Envelope + { -- | @x-amz-key-v2@: CEK in key wrapped form. This is necessary so that + -- the S3 encryption client that doesn't recognize the v2 format will not + -- mistakenly decrypt S3 object encrypted in v2 format. + _v2Key :: !ByteString, + -- | @x-amz-iv@: Randomly generated IV (per S3 object), base64 encoded. + _v2IV :: !(Cipher.IV AES.AES256), + -- | @x-amz-cek-alg@: Content encryption algorithm used. Supported values: + -- @AES/GCM/NoPadding@, @AES/CBC/PKCS5Padding@ Default to @AES/CBC/PKCS5Padding@ + -- if this key is absent. + -- + -- Supported values: @AESWrap@, @RSA/ECB/OAEPWithSHA-256AndMGF1Padding@, @kms@ No + -- standard key wrapping is used if this meta information is absent Always set to + -- @kms@ if KMS is used for client-side encryption + _v2CEKAlgorithm :: !ContentAlgorithm, + -- | @x-amz-wrap-alg@: Key wrapping algorithm used. + _v2WrapAlgorithm :: !WrappingAlgorithm, + -- | @x-amz-matdesc@: Customer provided material description in JSON format. + -- Used to identify the client-side master key. For KMS client side + -- encryption, the KMS Customer Master Key ID is stored as part of the material + -- description, @x-amz-matdesc, under the key-name @kms_cmk_id@. + _v2Description :: !Description + } + +newV2 :: + MonadResource m => + Text -> + AWS.Env -> + Description -> + m Envelope +newV2 kid env d = do + let context = Map.insert "kms_cmk_id" kid (fromDescription d) + + rs <- + AWS.send env $ + KMS.newGenerateDataKey kid + & KMS.generateDataKey_encryptionContext ?~ context + & KMS.generateDataKey_keySpec ?~ KMS.DataKeySpec_AES_256 + + ivBytes <- liftIO (getRandomBytes aesBlockSize) + iv <- createIV ivBytes + cipher <- createCipher (rs ^. KMS.generateDataKeyResponse_plaintext) + + pure . V2 cipher $ + V2Envelope + { _v2Key = rs ^. KMS.generateDataKeyResponse_ciphertextBlob, + _v2IV = iv, + _v2CEKAlgorithm = AES_CBC_PKCS5Padding, + _v2WrapAlgorithm = KMSWrap, + _v2Description = Description context + } + +decodeV2 :: + MonadResource m => + AWS.Env -> + [(CI Text, Text)] -> + Description -> + m Envelope +decodeV2 env xs m = do + a <- xs .& "X-Amz-CEK-Alg" + w <- xs .& "X-Amz-Wrap-Alg" + raw <- (xs .& "X-Amz-Key-V2") <&> unBase64 + iv <- xs .& "X-Amz-IV" >>= createIV . unBase64 + d <- xs .& "X-Amz-Matdesc" + + rs <- + AWS.send env $ + KMS.newDecrypt raw + & KMS.decrypt_encryptionContext ?~ fromDescription (m <> d) + -- Left-associative merge for material description, + -- keys in the supplied description override those + -- on the envelope. + + k <- plaintext rs + c <- createCipher k + + pure . V2 c $ V2Envelope k iv a w d + +data Envelope + = V1 AES.AES256 V1Envelope + | V2 AES.AES256 V2Envelope + +instance ToHeaders Envelope where + toHeaders = fmap (first (CI.map ("X-Amz-Meta-" <>))) . toMetadata + +#if MIN_VERSION_aeson(2,0,0) +instance ToJSON Envelope where + toJSON = object . map (bimap k v) . toMetadata + where + k = Key.fromText . toText . CI.foldedCase + v = Aeson.String . toText +#else +instance ToJSON Envelope where + toJSON = object . map (bimap k v) . toMetadata + where + k = toText . CI.foldedCase + v = Aeson.String . toText +#endif + +instance ToBody Envelope where + toBody = toBody . toJSON + +toMetadata :: Envelope -> [(CI ByteString, ByteString)] +toMetadata = \case + V1 _ x -> v1 x + V2 _ x -> v2 x + where + v1 V1Envelope {..} = + [ ("X-Amz-Key", b64 _v1Key), + ("X-Amz-IV", b64 (ByteArray.convert _v1IV)), + ("X-Amz-Matdesc", toBS _v1Description) + ] + + v2 V2Envelope {..} = + [ ("X-Amz-Key-V2", b64 _v2Key), + ("X-Amz-IV", b64 (ByteArray.convert _v2IV)), + ("X-Amz-CEK-Alg", toBS _v2CEKAlgorithm), + ("X-Amz-Wrap-Alg", toBS _v2WrapAlgorithm), + ("X-Amz-Matdesc", toBS _v2Description) + ] + + b64 :: ByteString -> ByteString + b64 = toBS . Base64 + +newEnvelope :: + MonadResource m => + Key -> + AWS.Env -> + m Envelope +newEnvelope key env = + case key of + Symmetric c d -> newV1 (pure . Cipher.ecbEncrypt c) d + Asymmetric p d -> newV1 (rsaEncrypt p) d + KMS kid d -> newV2 kid env d + +decodeEnvelope :: + MonadResource m => + Key -> + AWS.Env -> + [(CI Text, Text)] -> + m Envelope +decodeEnvelope key env xs = + case key of + Symmetric c _ -> decodeV1 (pure . Cipher.ecbDecrypt c) xs + Asymmetric p _ -> decodeV1 (rsaDecrypt p) xs + KMS _ d -> decodeV2 env xs d + +fromMetadata :: + MonadResource m => + Key -> + AWS.Env -> + HashMap Text Text -> + m Envelope +fromMetadata key env = + decodeEnvelope key env + . map (first CI.mk) + . Map.toList + +aesKeySize, aesBlockSize :: Int +aesKeySize = 32 +aesBlockSize = 16 + +bodyEncrypt :: Envelope -> RequestBody -> RequestBody +bodyEncrypt (getCipher -> (aes, iv0)) rqBody = + Chunked $ + toChunked rqBody + -- Realign body chunks for upload (AWS enforces chunk limits on all but last) + & (`fuseChunks` (encryptChunks .| Conduit.chunksOfCE (fromIntegral defaultChunkSize))) + & addPadding -- extend length for any required AES padding + where + encryptChunks = aesCbc iv0 nextChunk lastChunk + + nextChunk iv b = + let iv' = fromMaybe iv . Cipher.makeIV $ BS.drop (BS.length b - aesBlockSize) r + r = Cipher.cbcEncrypt aes iv b + in (iv', r) + + lastChunk iv = Cipher.cbcEncrypt aes iv . Padding.pad (Padding.PKCS7 aesBlockSize) + + addPadding c@ChunkedBody {length} = c {length = length + padding} + padding = n - (contentLength rqBody `mod` n) + n = fromIntegral aesBlockSize + +bodyDecrypt :: Envelope -> ResponseBody -> ResponseBody +bodyDecrypt (getCipher -> (aes, iv0)) rsBody = + rsBody `fuseStream` decryptChunks + where + decryptChunks = aesCbc iv0 nextChunk lastChunk + + nextChunk iv b = + let iv' = fromMaybe iv . Cipher.makeIV $ BS.drop (BS.length b - aesBlockSize) b + r = Cipher.cbcDecrypt aes iv b + in (iv', r) + + lastChunk iv b = + let r = Cipher.cbcDecrypt aes iv b + in fromMaybe r (Padding.unpad (Padding.PKCS7 aesBlockSize) r) + +aesCbc :: + Monad m => + IV AES256 -> + (IV AES256 -> ByteString -> (IV AES256, ByteString)) -> + (IV AES256 -> ByteString -> ByteString) -> + Conduit.ConduitT ByteString ByteString m () +aesCbc iv0 onNextChunk onLastChunk = + Conduit.chunksOfCE aesBlockSize .| goChunk iv0 Nothing + where + goChunk iv carry = + do + carry' <- Conduit.await + case carry' of + Nothing -> maybe (pure ()) (Conduit.yield . onLastChunk iv) carry + Just _ -> case carry of + Nothing -> goChunk iv carry' + Just chunk -> do + let (iv', encrypted) = onNextChunk iv chunk + Conduit.yield encrypted + goChunk iv' carry' + +rsaEncrypt :: KeyPair -> ByteString -> IO ByteString +rsaEncrypt k = + RSA.encrypt (toPublicKey k) + >=> hoistEither . first PubKeyFailure + +rsaDecrypt :: KeyPair -> ByteString -> IO ByteString +rsaDecrypt k = + RSA.decryptSafer (toPrivateKey k) + >=> hoistEither . first PubKeyFailure + +getCipher :: Envelope -> (AES.AES256, Cipher.IV AES.AES256) +getCipher = \case + V1 c v1 -> (c, _v1IV v1) + V2 c v2 -> (c, _v2IV v2) + +createCipher :: (MonadIO m, ByteArray a, Cipher b) => a -> m b +createCipher = + Crypto.Error.onCryptoFailure (throwIO . CipherFailure) pure + . Cipher.cipherInit + +createIV :: (MonadIO m, BlockCipher a) => ByteString -> m (Cipher.IV a) +createIV b = maybe (throwIO $ IVInvalid (ByteArray.convert b)) pure (Cipher.makeIV b) + +plaintext :: MonadIO m => KMS.DecryptResponse -> m ByteString +plaintext rs = + case rs ^. KMS.decryptResponse_plaintext of + Nothing -> throwIO PlaintextUnavailable + Just x -> pure x + +(.&) :: (MonadIO m, FromText a) => [(CI Text, Text)] -> CI Text -> m a +xs .& k = + case k `lookup` xs of + Nothing -> throwIO (EnvelopeMissing k) + Just x -> hoistEither (EnvelopeInvalid k `first` fromText x) + +hoistEither :: MonadIO m => Either EncryptionError a -> m a +hoistEither = either throwIO pure + +throwIO :: MonadIO m => EncryptionError -> m a +throwIO = liftIO . Exception.throwIO diff --git a/src/Amazonka/S3/Encryption/Instructions.hs b/src/Amazonka/S3/Encryption/Instructions.hs new file mode 100644 --- /dev/null +++ b/src/Amazonka/S3/Encryption/Instructions.hs @@ -0,0 +1,136 @@ +-- | +-- Module : Amazonka.S3.Encryption.Instructions +-- Copyright : (c) 2013-2023 Brendan Hay +-- License : Mozilla Public License, v. 2.0. +-- Maintainer : Brendan Hay +-- Stability : provisional +-- Portability : non-portable (GHC extensions) +module Amazonka.S3.Encryption.Instructions where + +import qualified Amazonka as AWS +import Amazonka.Core +import Amazonka.Prelude +import qualified Amazonka.Response as Response +import qualified Amazonka.S3 as S3 +import Amazonka.S3.Encryption.Envelope +import Amazonka.S3.Encryption.Types +import qualified Amazonka.S3.Lens as S3 +import Control.Arrow ((&&&)) +import Control.Lens ((%~)) +import qualified Control.Lens as Lens +import qualified Data.Aeson.Types as Aeson + +newtype Instructions = Instructions + { runInstructions :: forall m. MonadResource m => Key -> AWS.Env -> m Envelope + } + +class AWSRequest a => AddInstructions a where + -- | Determine the bucket and key an instructions file is adjacent to. + addInstructions :: a -> (S3.BucketName, S3.ObjectKey) + +instance AddInstructions S3.PutObject where + addInstructions = + Lens.view S3.putObject_bucket + &&& Lens.view S3.putObject_key + +instance AddInstructions S3.GetObject where + addInstructions = + Lens.view S3.getObject_bucket + &&& Lens.view S3.getObject_key + +instance AddInstructions S3.CreateMultipartUpload where + addInstructions = + Lens.view S3.createMultipartUpload_bucket + &&& Lens.view S3.createMultipartUpload_key + +instance AddInstructions S3.UploadPart where + addInstructions = + Lens.view S3.uploadPart_bucket + &&& Lens.view S3.uploadPart_key + +data PutInstructions = PutInstructions + { _piExt :: Ext, + _piPut :: S3.PutObject + } + deriving stock (Show) + +putInstructions :: AddInstructions a => a -> Envelope -> PutInstructions +putInstructions (addInstructions -> (b, k)) = + PutInstructions defaultExtension . S3.newPutObject b k . toBody + +piExtension :: Lens' PutInstructions Ext +piExtension = Lens.lens _piExt (\s a -> s {_piExt = a}) + +instance AWSRequest PutInstructions where + type AWSResponse PutInstructions = S3.PutObjectResponse + + request overrides x = + coerce . request overrides $ + _piPut x & S3.putObject_key %~ appendExtension (_piExt x) + + response s l _ = response s l (Proxy :: Proxy S3.PutObject) + +data GetInstructions = GetInstructions + { _giExt :: Ext, + _giGet :: S3.GetObject + } + deriving stock (Show) + +getInstructions :: AddInstructions a => a -> GetInstructions +getInstructions = + GetInstructions defaultExtension + . uncurry S3.newGetObject + . addInstructions + +giExtension :: Lens' GetInstructions Ext +giExtension = Lens.lens _giExt (\s a -> s {_giExt = a}) + +instance AWSRequest GetInstructions where + type AWSResponse GetInstructions = Instructions + + request overrides x = + coerce . request overrides $ + _giGet x & S3.getObject_key %~ appendExtension (_giExt x) + + response = + Response.receiveJSON $ \_ _ o -> do + e <- Aeson.parseEither Aeson.parseJSON (Aeson.Object o) + pure $ Instructions $ \key env -> fromMetadata key env e + +class AWSRequest a => RemoveInstructions a where + -- | Determine the bucket and key an instructions file is adjacent to. + removeInstructions :: a -> (S3.BucketName, S3.ObjectKey) + +instance RemoveInstructions S3.AbortMultipartUpload where + removeInstructions = + Lens.view S3.abortMultipartUpload_bucket + &&& Lens.view S3.abortMultipartUpload_key + +instance RemoveInstructions S3.DeleteObject where + removeInstructions = + Lens.view S3.deleteObject_bucket + &&& Lens.view S3.deleteObject_key + +data DeleteInstructions = DeleteInstructions + { _diExt :: Ext, + _diDelete :: S3.DeleteObject + } + deriving stock (Show) + +deleteInstructions :: RemoveInstructions a => a -> DeleteInstructions +deleteInstructions = + DeleteInstructions defaultExtension + . uncurry S3.newDeleteObject + . removeInstructions + +diExtension :: Lens' DeleteInstructions Ext +diExtension = Lens.lens _diExt (\s a -> s {_diExt = a}) + +instance AWSRequest DeleteInstructions where + type AWSResponse DeleteInstructions = S3.DeleteObjectResponse + + request overrides x = + coerce . request overrides $ + _diDelete x & S3.deleteObject_key %~ appendExtension (_diExt x) + + response s l _ = response s l (Proxy :: Proxy S3.DeleteObject) diff --git a/src/Amazonka/S3/Encryption/Types.hs b/src/Amazonka/S3/Encryption/Types.hs new file mode 100644 --- /dev/null +++ b/src/Amazonka/S3/Encryption/Types.hs @@ -0,0 +1,122 @@ +{-# LANGUAGE TemplateHaskell #-} + +-- | +-- Module : Amazonka.S3.Encryption.Types +-- Copyright : (c) 2013-2023 Brendan Hay +-- License : Mozilla Public License, v. 2.0. +-- Maintainer : Brendan Hay +-- Stability : provisional +-- Portability : non-portable (GHC extensions) +module Amazonka.S3.Encryption.Types where + +import Amazonka.Data +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 (Eq, Show) + +instance Exception EncryptionError + +$(Lens.makeClassyPrisms ''EncryptionError) + +instance AsEncryptionError SomeException where + _EncryptionError = Exception.Lens.exception + +data ContentAlgorithm + = -- | AES/CBC/PKCS5Padding + AES_CBC_PKCS5Padding + +instance FromText ContentAlgorithm where + fromText = \case + "AES/CBC/PKCS5Padding" -> pure AES_CBC_PKCS5Padding + other -> Left ("Unrecognised content encryption algorithm: " ++ show other) + +instance ToByteString ContentAlgorithm where + toBS AES_CBC_PKCS5Padding = "AES/CBC/PKCS5Padding" + +data WrappingAlgorithm + = -- | Key Management Service. + KMSWrap + +instance FromText WrappingAlgorithm where + fromText = \case + "kms" -> pure KMSWrap + other -> Left ("Unrecognised key wrapping algorithm: " ++ show other) + +instance ToByteString WrappingAlgorithm where + toBS KMSWrap = "kms" + +data Location = Metadata | Discard + deriving stock (Eq) + +-- | An instructions file extension. +newtype Ext = Ext Text + deriving stock (Eq, Show) + deriving newtype (IsString) + +-- | Defaults to @.instruction@ +defaultExtension :: Ext +defaultExtension = ".instruction" + +appendExtension :: Ext -> S3.ObjectKey -> S3.ObjectKey +appendExtension (Ext s) o@(S3.ObjectKey k) + | s `Text.isSuffixOf` k = o + | otherwise = S3.ObjectKey (k <> 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 {fromDescription :: HashMap Text Text} + deriving stock (Eq, Show) + deriving newtype (Semigroup, Monoid, FromJSON, ToJSON) + +instance ToByteString Description where + toBS = toBS . Aeson.encode + +instance FromText Description where + fromText = Aeson.eitherDecodeStrict' . 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 = Lens.lens f (flip g) + where + f = \case + Symmetric _ a -> a + Asymmetric _ a -> a + KMS _ a -> a + + g a = \case + Symmetric c _ -> Symmetric c a + Asymmetric k _ -> Asymmetric k a + KMS k _ -> KMS k a diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,14 @@ +{-# OPTIONS_GHC -fno-warn-unused-imports #-} + +module Main (main) where + +import Test.Amazonka.S3.Encryption.Envelope +import Test.Tasty + +main :: IO () +main = + defaultMain $ + testGroup + "S3-encryption" + [ testGroup "envelope" envelopeTests + ] diff --git a/test/Test/Amazonka/S3/Encryption/Envelope.hs b/test/Test/Amazonka/S3/Encryption/Envelope.hs new file mode 100644 --- /dev/null +++ b/test/Test/Amazonka/S3/Encryption/Envelope.hs @@ -0,0 +1,96 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} + +module Test.Amazonka.S3.Encryption.Envelope (envelopeTests) where + +import Amazonka.Core +import Amazonka.S3.Encryption.Envelope +import Amazonka.S3.Encryption.Types +import Control.Monad.Trans.Resource +import Crypto.Cipher.AES +import Crypto.Cipher.Types +import Crypto.Error +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import Data.Conduit +import qualified Data.Conduit.List as CL +import qualified Data.Foldable as Fold +import Test.Amazonka.Prelude +import Test.QuickCheck.Instances.ByteString () +import qualified Test.QuickCheck.Monadic as QC +import Test.Tasty.HUnit +import Test.Tasty.QuickCheck (Property, arbitrary, testProperty) +import Prelude hiding (length) + +envelopeTests :: [TestTree] +envelopeTests = + [ testGroup + "encrypt/decrypt" + [ testCase "empty input" testEncryptEmptyInput, + testCase "tiny input" testEncryptTinyInput, + testCase "multiple of block size" testEncryptMultipleOfBlockSize, + testCase "leftover" testEncryptLeftover, + testProperty "random" testEncryptRandom + ] + ] + +testEncryptEmptyInput :: Assertion +testEncryptEmptyInput = do + testEncryptDecrypt [""] + testEncryptDecrypt ["", ""] + +testEncryptTinyInput :: Assertion +testEncryptTinyInput = do + testEncryptDecrypt ["a"] + testEncryptDecrypt ["a", "b", "c"] + +testEncryptMultipleOfBlockSize :: Assertion +testEncryptMultipleOfBlockSize = do + let b = BS.pack $ replicate aesBlockSize 170 + testEncryptDecrypt [b] + testEncryptDecrypt [b, b, b] + testEncryptDecrypt [b, b <> b <> b, b <> b] + +testEncryptLeftover :: Assertion +testEncryptLeftover = do + let b = BS.pack $ replicate aesBlockSize 170 + testEncryptDecrypt [b, "a"] + testEncryptDecrypt [b, b, b, "a"] + testEncryptDecrypt [b, b <> b <> b, b <> b, "abc"] + +testEncryptRandom :: Property +testEncryptRandom = QC.monadicIO $ + QC.forAllM arbitrary $ \b -> + QC.run $ testEncryptDecrypt b + +testEncryptDecrypt :: [ByteString] -> Assertion +testEncryptDecrypt bs = do + let e = mkTestAESV2Envelope + rqb = ChunkedBody defaultChunkSize (Fold.sum (fromIntegral . BS.length <$> bs)) (CL.sourceList bs) + (Chunked ChunkedBody {body, length}) = bodyEncrypt e (Chunked rqb) + + length `mod` fromIntegral aesBlockSize @?= 0 + + encRes <- runResourceT . runConduit $ body .| CL.consume + + let ResponseBody {body = rsb} = + bodyDecrypt e $ ResponseBody $ CL.sourceList encRes + + decRes <- runResourceT . runConduit $ rsb .| CL.consume + + mconcat bs @?= mconcat decRes + +mkTestAESV2Envelope :: Envelope +mkTestAESV2Envelope = + let (CryptoPassed aes) = cipherInit ("0123456789abcdef0123456789abcdef" :: ByteString) :: CryptoFailable AES256 + + e = + V2Envelope + { _v2Key = "don't care", + _v2IV = nullIV, + _v2CEKAlgorithm = AES_CBC_PKCS5Padding, + _v2WrapAlgorithm = KMSWrap, + _v2Description = Description mempty + } + in V2 aes e