amazonka-s3-encryption (empty) → 2.0
raw patch · 12 files changed
+1784/−0 lines, 12 filesdep +QuickCheckdep +aesondep +amazonka
Dependencies added: QuickCheck, aeson, amazonka, amazonka-core, amazonka-kms, amazonka-s3, amazonka-s3-encryption, amazonka-test, base, bytestring, case-insensitive, conduit, crypton, http-client, lens, memory, mtl, quickcheck-instances, resourcet, tasty, tasty-hunit, tasty-quickcheck, text, time, unordered-containers
Files
- LICENSE +367/−0
- README.md +25/−0
- amazonka-s3-encryption.cabal +140/−0
- src/Amazonka/S3/Encryption.hs +330/−0
- src/Amazonka/S3/Encryption/Body.hs +41/−0
- src/Amazonka/S3/Encryption/Decrypt.hs +53/−0
- src/Amazonka/S3/Encryption/Encrypt.hs +110/−0
- src/Amazonka/S3/Encryption/Envelope.hs +350/−0
- src/Amazonka/S3/Encryption/Instructions.hs +136/−0
- src/Amazonka/S3/Encryption/Types.hs +122/−0
- test/Main.hs +14/−0
- test/Test/Amazonka/S3/Encryption/Envelope.hs +96/−0
+ LICENSE view
@@ -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.
+ README.md view
@@ -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/).
+ amazonka-s3-encryption.cabal view
@@ -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 <brendan.g.hay@gmail.com>, Jack Kelly <jack@jackkelly.name>++copyright: Copyright (c) 2016 Brendan Hay+category: AWS+build-type: Simple+extra-source-files: README.md+description:+ Addons for <http://hackage.haskell.org/package/amazonka-s3 amazonka-s3> 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 <http://hackage.haskell.org/package/amazonka-s3-encryption/docs/Network-AWS-S3-Encryption.html Amazonka.S3.Encryption>+ 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
+ src/Amazonka/S3/Encryption.hs view
@@ -0,0 +1,330 @@+-- |+-- Module : Amazonka.S3.Encryption+-- 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)+--+-- Addons for <http://hackage.haskell.org/package/amazonka-s3 amazonka-s3> 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.+-- @
+ src/Amazonka/S3/Encryption/Body.hs view
@@ -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 <brendan.g.hay+amazonka.com>+-- 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)
+ src/Amazonka/S3/Encryption/Decrypt.hs view
@@ -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 <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 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
+ src/Amazonka/S3/Encryption/Encrypt.hs view
@@ -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 <brendan.g.hay+amazonka.com>+-- 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
+ src/Amazonka/S3/Encryption/Envelope.hs view
@@ -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 <brendan.g.hay+amazonka.com>+-- 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
+ src/Amazonka/S3/Encryption/Instructions.hs view
@@ -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 <brendan.g.hay+amazonka.com>+-- 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)
+ src/Amazonka/S3/Encryption/Types.hs view
@@ -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 <brendan.g.hay+amazonka.com>+-- 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
+ test/Main.hs view
@@ -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+ ]
+ test/Test/Amazonka/S3/Encryption/Envelope.hs view
@@ -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