credentials (empty) → 0.0.1
raw patch · 9 files changed
+1140/−0 lines, 9 filesdep +aesondep +amazonkadep +amazonka-coresetup-changed
Dependencies added: aeson, amazonka, amazonka-core, amazonka-dynamodb, amazonka-kms, base, bytestring, conduit, credentials, cryptonite, exceptions, lens, memory, retry, semigroups, text, time, transformers, unordered-containers
Files
- LICENSE +202/−0
- Setup.hs +2/−0
- credentials.cabal +82/−0
- src/Credentials.hs +106/−0
- src/Credentials/DynamoDB.hs +315/−0
- src/Credentials/DynamoDB/Item.hs +159/−0
- src/Credentials/KMS.hs +144/−0
- src/Credentials/Types.hs +118/−0
- test/Main.hs +12/−0
+ LICENSE view
@@ -0,0 +1,202 @@++ Apache License+ Version 2.0, January 2004+ http://www.apache.org/licenses/++ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++ 1. Definitions.++ "License" shall mean the terms and conditions for use, reproduction,+ and distribution as defined by Sections 1 through 9 of this document.++ "Licensor" shall mean the copyright owner or entity authorized by+ the copyright owner that is granting the License.++ "Legal Entity" shall mean the union of the acting entity and all+ other entities that control, are controlled by, or are under common+ control with that entity. For the purposes of this definition,+ "control" means (i) the power, direct or indirect, to cause the+ direction or management of such entity, whether by contract or+ otherwise, or (ii) ownership of fifty percent (50%) or more of the+ outstanding shares, or (iii) beneficial ownership of such entity.++ "You" (or "Your") shall mean an individual or Legal Entity+ exercising permissions granted by this License.++ "Source" form shall mean the preferred form for making modifications,+ including but not limited to software source code, documentation+ source, and configuration files.++ "Object" form shall mean any form resulting from mechanical+ transformation or translation of a Source form, including but+ not limited to compiled object code, generated documentation,+ and conversions to other media types.++ "Work" shall mean the work of authorship, whether in Source or+ Object form, made available under the License, as indicated by a+ copyright notice that is included in or attached to the work+ (an example is provided in the Appendix below).++ "Derivative Works" shall mean any work, whether in Source or Object+ form, that is based on (or derived from) the Work and for which the+ editorial revisions, annotations, elaborations, or other modifications+ represent, as a whole, an original work of authorship. For the purposes+ of this License, Derivative Works shall not include works that remain+ separable from, or merely link (or bind by name) to the interfaces of,+ the Work and Derivative Works thereof.++ "Contribution" shall mean any work of authorship, including+ the original version of the Work and any modifications or additions+ to that Work or Derivative Works thereof, that is intentionally+ submitted to Licensor for inclusion in the Work by the copyright owner+ or by an individual or Legal Entity authorized to submit on behalf of+ the copyright owner. For the purposes of this definition, "submitted"+ means any form of electronic, verbal, or written communication sent+ to the Licensor or its representatives, including but not limited to+ communication on electronic mailing lists, source code control systems,+ and issue tracking systems that are managed by, or on behalf of, the+ Licensor for the purpose of discussing and improving the Work, but+ excluding communication that is conspicuously marked or otherwise+ designated in writing by the copyright owner as "Not a Contribution."++ "Contributor" shall mean Licensor and any individual or Legal Entity+ on behalf of whom a Contribution has been received by Licensor and+ subsequently incorporated within the Work.++ 2. Grant of Copyright License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ copyright license to reproduce, prepare Derivative Works of,+ publicly display, publicly perform, sublicense, and distribute the+ Work and such Derivative Works in Source or Object form.++ 3. Grant of Patent License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ (except as stated in this section) patent license to make, have made,+ use, offer to sell, sell, import, and otherwise transfer the Work,+ where such license applies only to those patent claims licensable+ by such Contributor that are necessarily infringed by their+ Contribution(s) alone or by combination of their Contribution(s)+ with the Work to which such Contribution(s) was submitted. If You+ institute patent litigation against any entity (including a+ cross-claim or counterclaim in a lawsuit) alleging that the Work+ or a Contribution incorporated within the Work constitutes direct+ or contributory patent infringement, then any patent licenses+ granted to You under this License for that Work shall terminate+ as of the date such litigation is filed.++ 4. Redistribution. You may reproduce and distribute copies of the+ Work or Derivative Works thereof in any medium, with or without+ modifications, and in Source or Object form, provided that You+ meet the following conditions:++ (a) You must give any other recipients of the Work or+ Derivative Works a copy of this License; and++ (b) You must cause any modified files to carry prominent notices+ stating that You changed the files; and++ (c) You must retain, in the Source form of any Derivative Works+ that You distribute, all copyright, patent, trademark, and+ attribution notices from the Source form of the Work,+ excluding those notices that do not pertain to any part of+ the Derivative Works; and++ (d) If the Work includes a "NOTICE" text file as part of its+ distribution, then any Derivative Works that You distribute must+ include a readable copy of the attribution notices contained+ within such NOTICE file, excluding those notices that do not+ pertain to any part of the Derivative Works, in at least one+ of the following places: within a NOTICE text file distributed+ as part of the Derivative Works; within the Source form or+ documentation, if provided along with the Derivative Works; or,+ within a display generated by the Derivative Works, if and+ wherever such third-party notices normally appear. The contents+ of the NOTICE file are for informational purposes only and+ do not modify the License. You may add Your own attribution+ notices within Derivative Works that You distribute, alongside+ or as an addendum to the NOTICE text from the Work, provided+ that such additional attribution notices cannot be construed+ as modifying the License.++ You may add Your own copyright statement to Your modifications and+ may provide additional or different license terms and conditions+ for use, reproduction, or distribution of Your modifications, or+ for any such Derivative Works as a whole, provided Your use,+ reproduction, and distribution of the Work otherwise complies with+ the conditions stated in this License.++ 5. Submission of Contributions. Unless You explicitly state otherwise,+ any Contribution intentionally submitted for inclusion in the Work+ by You to the Licensor shall be under the terms and conditions of+ this License, without any additional terms or conditions.+ Notwithstanding the above, nothing herein shall supersede or modify+ the terms of any separate license agreement you may have executed+ with Licensor regarding such Contributions.++ 6. Trademarks. This License does not grant permission to use the trade+ names, trademarks, service marks, or product names of the Licensor,+ except as required for reasonable and customary use in describing the+ origin of the Work and reproducing the content of the NOTICE file.++ 7. Disclaimer of Warranty. Unless required by applicable law or+ agreed to in writing, Licensor provides the Work (and each+ Contributor provides its Contributions) on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+ implied, including, without limitation, any warranties or conditions+ of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+ PARTICULAR PURPOSE. You are solely responsible for determining the+ appropriateness of using or redistributing the Work and assume any+ risks associated with Your exercise of permissions under this License.++ 8. Limitation of Liability. In no event and under no legal theory,+ whether in tort (including negligence), contract, or otherwise,+ unless required by applicable law (such as deliberate and grossly+ negligent acts) or agreed to in writing, shall any Contributor be+ liable to You for damages, including any direct, indirect, special,+ incidental, or consequential damages of any character arising as a+ result of this License or out of the use or inability to use the+ Work (including but not limited to damages for loss of goodwill,+ work stoppage, computer failure or malfunction, or any and all+ other commercial damages or losses), even if such Contributor+ has been advised of the possibility of such damages.++ 9. Accepting Warranty or Additional Liability. While redistributing+ the Work or Derivative Works thereof, You may choose to offer,+ and charge a fee for, acceptance of support, warranty, indemnity,+ or other liability obligations and/or rights consistent with this+ License. However, in accepting such obligations, You may act only+ on Your own behalf and on Your sole responsibility, not on behalf+ of any other Contributor, and only if You agree to indemnify,+ defend, and hold each Contributor harmless for any liability+ incurred by, or claims asserted against, such Contributor by reason+ of your accepting any such warranty or additional liability.++ END OF TERMS AND CONDITIONS++ APPENDIX: How to apply the Apache License to your work.++ To apply the Apache License to your work, attach the following+ boilerplate notice, with the fields enclosed by brackets "[]"+ replaced with your own identifying information. (Don't include+ the brackets!) The text should be enclosed in the appropriate+ comment syntax for the file format. We also recommend that a+ file or class name and description of purpose be included on the+ same "printed page" as the copyright notice for easier+ identification within third-party archives.++ Copyright [yyyy] [name of copyright owner]++ Licensed under the Apache License, Version 2.0 (the "License");+ you may not use this file except in compliance with the License.+ You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++ Unless required by applicable law or agreed to in writing, software+ distributed under the License is distributed on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+ See the License for the specific language governing permissions and+ limitations under the License.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ credentials.cabal view
@@ -0,0 +1,82 @@+name: credentials+version: 0.0.1+synopsis: Secure Credentials Storage and Distribution+homepage: https://github.com/brendanhay/credentials+license: OtherLicense+license-file: LICENSE+author: Brendan Hay+maintainer: Brendan Hay <brendan.g.hay@gmail.com>+copyright: Copyright (c) 2015-2016 Brendan Hay+category: Network, AWS, Security+build-type: Simple+cabal-version: >= 1.10++description:+ This library provides a unified interface for managing secure, shared credentials.+ It uses Amazon Key Management Service (KMS) for master key management, locally+ encrypts and decrypts secrets, which are then stored in any of the supported+ storage backends. (Currently DynamoDB.)+ .+ The use-case is to avoid storing sensitive information such as passwords and+ connection strings in plaintext in places such as source control or on+ developers' machines. Instead you can securely administer and distribute+ secrets, leveraging Amazon's IAM policies for access control and permissions to+ ensure limited read-only permissions from production/deployed hosts.+ You can embed this library into projects such as web applications to securely+ retrieve sensitive information such as database passwords or private keys on startup.+ .+ A complementary CLI for management of credentials can be installed via+ <https://hackage.haskell.org/package/credentials-cli credentials-cli>.+ .+ You can read more about other use-cases and prerequisites <https://github.com/brendanhay/credentials here>.++source-repository head+ type: git+ location: git://github.com/brendanhay/credentials.git++library+ default-language: Haskell2010+ hs-source-dirs: src++ ghc-options: -Wall++ exposed-modules:+ Credentials+ , Credentials.KMS+ , Credentials.DynamoDB+ , Credentials.DynamoDB.Item+ , Credentials.Types++ build-depends:+ aeson >= 0.8+ , amazonka >= 1.3.7+ , amazonka-core >= 1.3.7+ , amazonka-dynamodb >= 1.3.7+ , amazonka-kms >= 1.3.7+ , base >= 4.7 && < 5+ , bytestring >= 0.10+ , conduit >= 1.2+ , cryptonite >= 0.10+ , exceptions >= 0.6+ , lens >= 4.4+ , memory >= 0.11+ , retry >= 0.7.0.1+ , semigroups >= 0.6+ , text >= 0.11+ , time >= 1.4+ , transformers >= 0.3+ , unordered-containers >= 0.2.5++test-suite tests+ type: exitcode-stdio-1.0+ default-language: Haskell2010+ hs-source-dirs: test+ main-is: Main.hs++ ghc-options: -Wall -threaded++ other-modules:++ build-depends:+ base+ , credentials
+ src/Credentials.hs view
@@ -0,0 +1,106 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}++-- |+-- Module : Credentials+-- Copyright : (c) 2015-2016 Brendan Hay+-- License : Mozilla Public License, v. 2.0.+-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Stability : provisional+-- Portability : non-portable (GHC extensions)+--+-- This module provides a common interface for operating on your shared+-- credentials.+module Credentials+ (+ -- * Usage+ -- $usage++ -- * Operations+ insert+ , select+ , delete+ , truncate+ , revisions+ , setup+ , teardown++ -- * KMS+ , KeyId (..)+ , defaultKeyId++ -- * DynamoDB+ , DynamoTable (..)+ , defaultTable++ -- * Errors+ , CredentialError (..)+ , AsCredentialError (..)++ -- * Types+ , Name (..)+ , Revision (..)+ , Context (..)+ , Setup (..)+ ) where++import Credentials.DynamoDB+import Credentials.Types++-- $usage+-- To use the library, make sure you have met the following prerequisites:+--+-- * You have a master key in KMS. You can create this under Identity and Access+-- Management > Encryption Keys, in the AWS developer console.+--+-- * Your AWS access credentials are available where+-- <https://hackage.haskell.org/package/amazonka amazonka> can find them. This+-- will be automatic if you are running on an EC2 host, otherwise+-- the <https://blogs.aws.amazon.com/security/post/Tx3D6U6WSFGOK2H/A-New-and-Standardized-Way-to-Manage-Credentials-in-the-AWS-SDKs ~\/.aws\/credentials> file, as @AWS_ACCESS_KEY_ID@ and+-- @AWS_SECRET_ACCESS_KEY@ environment variables need to be configured.+--+-- Since all of the credentials operations are constrained by a 'MonadAWS' context,+-- running them is identical to that of [amazonka](https://hackage.haskell.org/package/amazonka),+-- which you will also need to add to your @build-depends@ section of your project's cabal file.+--+-- > {-# LANGUAGE OverloadedStrings #-}+-- >+-- > import Credentials+-- > import Control.Lens+-- > import Data.ByteString (ByteString)+-- > import Network.AWS+-- > import System.IO+-- >+-- > example :: IO (ByteString, Revision)+-- > example = do+-- > -- A new 'Logger' to replace the default noop logger is created,+-- > -- which will print AWS debug information and errors to stdout.+-- > lgr <- newLogger Debug stdout+-- >+-- > -- A new amazonka 'Env' is created, which auto-discovers the+-- > -- underlying host credentials.+-- > env <- newEnv Frankfurt Discover+-- >+-- > let table = "dynamo-table-name"+-- > key = "kms-key-alias"+-- > name = "credential-name"+-- >+-- > -- We now run the 'AWS' computation with the overriden logger,+-- > -- performing the sequence of credentials operations.+-- > runResourceT . runAWS (env & envLogger .~ lgr) $ do+-- > -- Firstly, we create the DynamoDB table.+-- > -- This is an idempotent operation but since it makes remote API calls,+-- > -- it's recommended you only run this once via the CLI.+-- > Credentials.setup table+-- >+-- > -- Then we insert a credential\'s value, for a given name.+-- > -- Encryption is handled transparently and the resulting revision+-- > -- is returned.+-- > _ <- Credentials.insert key mempty name "a-super-secret-value" table+-- >+-- > -- Selecting the credential by name, and specifying 'Nothing' for the+-- > -- revision results in the latest credential revision being returned.+-- > Credentials.select mempty name Nothing table
+ src/Credentials/DynamoDB.hs view
@@ -0,0 +1,315 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeFamilies #-}++-- |+-- Module : Credentials.DynamoDB+-- Copyright : (c) 2015-2016 Brendan Hay+-- License : Mozilla Public License, v. 2.0.+-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Stability : provisional+-- Portability : non-portable (GHC extensions)+--+-- Provides the implementation for storage and retrieval of encrypted credentials+-- in DynamoDB. The encryption and decryption is handled by "Credentials.KMS".+--+-- See the "Credentials" module for usage information.+module Credentials.DynamoDB+ (+ -- * Table+ DynamoTable (..)+ , defaultTable++ -- * Operations+ , insert+ , select+ , delete+ , truncate+ , revisions+ , setup+ , teardown+ ) where++import Prelude hiding (truncate)++import Control.Exception.Lens+import Control.Lens hiding (Context)+import Control.Monad+import Control.Monad.Catch+import Control.Monad.IO.Class+import Control.Retry++import Credentials.DynamoDB.Item+import Credentials.KMS as KMS+import Credentials.Types++import Crypto.Hash (Digest, SHA1)++import Data.ByteArray.Encoding+import Data.ByteString (ByteString)+import Data.Conduit hiding (await)+import Data.List.NonEmpty (NonEmpty (..))+import Data.Maybe+import Data.Monoid ((<>))+import Data.Ord+import Data.Text (Text)+import Data.Time.Clock.POSIX+import Data.Typeable++import Network.AWS+import Network.AWS.Data+import Network.AWS.DynamoDB++import qualified Crypto.Hash as Crypto+import qualified Data.ByteString as BS+import qualified Data.Conduit as C+import qualified Data.Conduit.List as CL+import qualified Data.HashMap.Strict as Map+import qualified Data.List.NonEmpty as NE++-- | A DynamoDB table reference.+newtype DynamoTable = DynamoTable { tableName :: Text }+ deriving (Eq, Ord, Show, FromText, ToText, ToByteString, ToLog)++-- | The default DynamoDB table used to store credentials.+--+-- /Value:/ @credentials@+defaultTable :: DynamoTable+defaultTable = DynamoTable "credentials"++-- | Encrypt and insert a new credential revision with the specified name.+--+-- The newly inserted revision is returned.+insert :: (MonadMask m, MonadAWS m, Typeable m)+ => KeyId -- ^ The KMS master key ARN or alias.+ -> Context -- ^ The KMS encryption context.+ -> Name -- ^ The credential name.+ -> ByteString -- ^ The unencrypted plaintext.+ -> DynamoTable -- ^ The DynamoDB table.+ -> m Revision+insert key ctx name plaintext table = do+ ciphertext <- encrypt key ctx name plaintext+ catchResourceNotFound table (insertEncrypted name ciphertext table)++-- | Select an existing credential, optionally specifying the revision.+--+-- The decrypted plaintext and selected revision are returned.+select :: MonadAWS m+ => Context -- ^ The KMS encryption context that was used during insertion.+ -> Name -- ^ The credential name.+ -> Maybe Revision -- ^ A revision. If 'Nothing', the latest will be selected.+ -> DynamoTable -- ^ The DynamoDB table.+ -> m (ByteString, Revision)+select ctx name rev table = do+ (_, (ciphertext, rev')) <-+ catchResourceNotFound table (selectEncrypted name rev table)+ (,rev') <$> decrypt ctx name ciphertext++-- | Delete the specific credential revision.+delete :: MonadAWS m+ => Name -- ^ The credential name.+ -> Revision -- ^ The revision to delete.+ -> DynamoTable -- ^ The DynamoDB table.+ -> m ()+delete name rev table@DynamoTable{..} =+ catchResourceNotFound table $ do+ (ver, _) <- selectEncrypted name (Just rev) table+ void . send $+ deleteItem tableName+ & diKey .~ toItem name <> toItem ver++-- | Truncate all of a credential's revisions, so that only+-- the latest revision remains.+truncate :: MonadAWS m+ => Name -- ^ The credential name.+ -> DynamoTable -- ^ The DynamoDB table.+ -> m ()+truncate name table@DynamoTable{..} = catchResourceNotFound table $+ queryAll $$ CL.mapM_ (deleteMany . view qrsItems)+ where+ queryAll =+ paginate $+ queryByName name table+ & qAttributesToGet ?~ nameField :| [versionField]+ & qScanIndexForward ?~ True+ & qLimit ?~ batchSize++ deleteMany [] = pure ()+ deleteMany (x:xs) = void . send $+ batchWriteItem+ & bwiRequestItems .~+ [ (tableName, deleteItem x :| map deleteItem (batchInit xs))+ ]++ deleteItem k =+ writeRequest+ & wrDeleteRequest ?~ (deleteRequest & drKey .~ k)++ batchInit xs+ | i < n = take (i - 1) xs+ | otherwise = xs+ where+ n = fromIntegral (batchSize - 1)+ i = length xs++ batchSize = 50++-- | Scan the entire credential database, grouping pages of results into+-- unique credential names and their corresponding revisions.+revisions :: MonadAWS m+ => DynamoTable -- ^ The DynamoDB table.+ -> Source m (Name, NonEmpty Revision)+revisions table = catchResourceNotFound table $+ paginate (scanTable table)+ =$= CL.concatMapM (traverse fromItem . view srsItems)+ =$= CL.groupOn1 fst+ =$= CL.map group+ where+ group ((name, rev), revs) = (name, desc (rev :| map snd revs))++ desc :: NonEmpty (Version, Revision) -> NonEmpty Revision+ desc = NE.map snd . NE.sortWith (Down . fst)++-- | Create the credentials database table.+--+-- The returned idempotency flag can be used to notify configuration+-- management tools such as ansible whether about system state.+setup :: MonadAWS m+ => DynamoTable -- ^ The DynamoDB table.+ -> m Setup+setup table@DynamoTable{..} = do+ p <- exists table+ unless p $ do+ let iops = provisionedThroughput 1 1+ keys = keySchemaElement nameField Hash+ :| [keySchemaElement versionField Range]+ attr = ctAttributeDefinitions .~+ [ attributeDefinition nameField S+ , attributeDefinition versionField S+ , attributeDefinition revisionField B+ ]+ secn = ctLocalSecondaryIndexes .~+ [ localSecondaryIndex revisionField+ (keySchemaElement nameField Hash+ :| [keySchemaElement revisionField Range])+ (projection & pProjectionType ?~ All)+ ]+ void $ send (createTable tableName keys iops & attr & secn)+ void $ await tableExists (describeTable tableName)+ pure $+ if p+ then Exists+ else Created++-- | Delete the credentials database table and all data.+--+-- /Note:/ Unless you have DynamoDB backups running, this is a completely+-- irrevocable action.+teardown :: MonadAWS m => DynamoTable -> m ()+teardown table@DynamoTable{..} = do+ p <- exists table+ when p $ do+ void $ send (deleteTable tableName)+ void $ await tableNotExists (describeTable tableName)++insertEncrypted :: (MonadMask m, MonadAWS m, Typeable m)+ => Name+ -> Encrypted+ -> DynamoTable+ -> m Revision+insertEncrypted name encrypted table@DynamoTable{..} =+ recovering policy [const cond] write+ where+ write = const $ do+ ver <- maybe 1 (+1) <$> latest name table+ rev <- genRevision ver+ void . send $ putItem tableName+ & piExpected .~ Map.map (const expect) (toItem ver <> toItem rev)+ & piItem .~+ toItem name+ <> toItem ver+ <> toItem rev+ <> toItem encrypted+ pure rev++ cond = handler_ _ConditionalCheckFailedException (pure True)++ expect = expectedAttributeValue & eavExists ?~ False++ policy = constantDelay 1000 <> limitRetries 5++selectEncrypted :: (MonadThrow m, MonadAWS m)+ => Name+ -> Maybe Revision+ -> DynamoTable+ -> m (Version, (Encrypted, Revision))+selectEncrypted name rev table@DynamoTable{..} =+ send (queryByName name table & revision rev) >>= result+ where+ result = maybe missing fromItem . listToMaybe . view qrsItems++ missing = throwM $ SecretMissing name rev tableName++ -- If revision is specified, the revision index is used and+ -- a consistent read is done.+ revision Nothing = id+ revision (Just r) =+ (qIndexName ?~ revisionField)+ . (qKeyConditions <>~ equals r)+ . (qConsistentRead ?~ True)++latest :: (MonadThrow m, MonadAWS m)+ => Name+ -> DynamoTable+ -> m (Maybe Version)+latest name table = do+ rs <- send (queryByName name table & qConsistentRead ?~ True)+ case listToMaybe (rs ^. qrsItems) of+ Nothing -> pure Nothing+ Just m -> Just <$> fromItem m++exists :: MonadAWS m => DynamoTable -> m Bool+exists DynamoTable{..} = paginate listTables+ =$= CL.concatMap (view ltrsTableNames)+ $$ (isJust <$> findC (== tableName))++scanTable :: DynamoTable -> Scan+scanTable DynamoTable{..} =+ scan tableName+ & sAttributesToGet ?~ nameField :| [versionField, revisionField]++queryByName :: Name -> DynamoTable -> Query+queryByName name DynamoTable{..} =+ query tableName+ & qLimit ?~ 1+ & qScanIndexForward ?~ False+ & qConsistentRead ?~ False+ & qKeyConditions .~ equals name++genRevision :: MonadIO m => Version -> m Revision+genRevision (Version ver) = do+ ts <- liftIO getPOSIXTime+ let d = Crypto.hash (toBS (show ts) <> toBS ver) :: Digest SHA1+ r = BS.take 7 (convertToBase Base16 d)+ pure $! Revision r++findC :: Monad m => (a -> Bool) -> Consumer a m (Maybe a)+findC f = loop+ where+ loop = C.await >>= maybe (pure Nothing) go++ go x | f x = pure (Just x)+ | otherwise = loop++-- FIXME: Over specified due to the coarseness of _ResourceNotFound.+catchResourceNotFound :: MonadCatch m => DynamoTable -> m b -> m b+catchResourceNotFound DynamoTable{..} =+ handling_ _ResourceNotFoundException $+ throwM $ StorageMissing ("Table " <> tableName <> " doesn't exist.")
+ src/Credentials/DynamoDB/Item.hs view
@@ -0,0 +1,159 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- |+-- Module : Credentials.DynamoDB.Item+-- Copyright : (c) 2013-2015-2016 Brendan Hay+-- License : Mozilla Public License, v. 2.0.+-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Stability : provisional+-- Portability : non-portable (GHC extensions)+--+-- This module contains the schema that is used by "Credentials.DynamoDB" to+-- serialise encryption parameters to DynamoDB items.+module Credentials.DynamoDB.Item where++import Control.Lens (set, view, (&), (.~))+import Control.Monad ((>=>))+import Control.Monad.Catch (MonadThrow (..))++import Credentials.Types++import Crypto.Hash (SHA256, digestFromByteString)+import Crypto.MAC.HMAC (HMAC (..))++import Data.Bifunctor (bimap)+import Data.ByteArray (convert)+import Data.ByteArray.Encoding (Base (Base16), convertFromBase, convertToBase)+import Data.ByteString (ByteString)+import Data.HashMap.Strict (HashMap)+import Data.Monoid ((<>))+import Data.Text (Text)++import Network.AWS.Data+import Network.AWS.DynamoDB++import qualified Data.HashMap.Strict as Map+import qualified Data.Text as Text+import qualified Data.Text.Encoding as Text++padding :: Text+padding = Text.replicate 19 "0"++-- | The DynamoDB field used for optimistic locking.+--+-- Serialisation of 'Version' handles left-padding to support+-- consistent lexicographic ordering when used as a range in DynamoDB.+newtype Version = Version Integer+ deriving (Eq, Ord, Num, FromText, ToText)++equals :: Item a => a -> HashMap Text Condition+equals = Map.map (\x -> condition EQ' & cAttributeValueList .~ [x]) . toItem++nameField, revisionField, versionField, wrappedKeyField,+ ciphertextField, digestField :: Text+nameField = "name"+revisionField = "revision"+versionField = "version"+wrappedKeyField = "key"+ciphertextField = "contents"+digestField = "hmac"++class Item a where+ -- | Encode an item as a set of attributes including their schema.+ toItem :: a -> HashMap Text AttributeValue++ -- | Decode an item from a set of attributes.+ parseItem :: HashMap Text AttributeValue -> Either CredentialError a++-- | Decode an item by throwing a 'CredentialError' exception when an+-- error is encountered.+fromItem :: (MonadThrow m, Item a) => HashMap Text AttributeValue -> m a+fromItem = either throwM pure . parseItem++instance (Item a, Item b) => Item (a, b) where+ toItem (x, y) = toItem x <> toItem y+ parseItem m = (,) <$> parseItem m <*> parseItem m++instance Item Name where+ toItem = Map.singleton nameField . toAttr+ parseItem = parse nameField++instance Item Revision where+ toItem = Map.singleton revisionField . toAttr+ parseItem = parse revisionField++instance Item Version where+ toItem = Map.singleton versionField . toAttr+ parseItem = parse versionField++instance Item Encrypted where+ toItem Encrypted{..} =+ Map.fromList+ [ (wrappedKeyField, toAttr wrappedKey)+ , (ciphertextField, toAttr ciphertext)+ , (digestField, toAttr digest)+ ]++ parseItem m =+ Encrypted+ <$> parse wrappedKeyField m+ <*> parse ciphertextField m+ <*> parse digestField m++parse :: Attribute a+ => Text+ -> HashMap Text AttributeValue+ -> Either CredentialError a+parse k m =+ case Map.lookup k m of+ Nothing -> Left $ FieldMissing k (Map.keys m)+ Just v ->+ case parseAttr v of+ Nothing -> Left $ FieldInvalid k (show v)+ Just x -> Right x++class Attribute a where+ -- | Encode an attribute value.+ toAttr :: a -> AttributeValue++ -- | Decode an attribute value.+ parseAttr :: AttributeValue -> Maybe a++instance Attribute Text where+ toAttr t = set avS (Just t) attributeValue+ parseAttr = view avS++instance Attribute ByteString where+ toAttr bs = set avB (Just bs) attributeValue+ parseAttr = view avB++instance Attribute Name where+ toAttr = toAttr . toText+ parseAttr = fmap Name . parseAttr++instance Attribute Revision where+ toAttr = toAttr . toBS+ parseAttr = fmap Revision . parseAttr++instance Attribute Integer where+ toAttr = toAttr . toText+ parseAttr = parseAttr >=> either (const Nothing) Just . fromText++instance Attribute Version where+ toAttr (Version n) =+ let x = toText n+ y = Text.drop (Text.length x) padding <> x+ in toAttr y+ parseAttr = fmap Version . parseAttr++instance Attribute (HMAC SHA256) where+ toAttr = toAttr . Text.decodeUtf8 . convertToBase Base16 . hmacGetDigest+ parseAttr v = do+ t :: Text <- parseAttr v+ case convertFromBase Base16 (Text.encodeUtf8 t) of+ Left _ -> Nothing+ Right bs -> HMAC <$> digestFromByteString (bs :: ByteString)
+ src/Credentials/KMS.hs view
@@ -0,0 +1,144 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- |+-- Module : Credentials.KMS+-- Copyright : (c) 2015-2016 Brendan Hay+-- License : Mozilla Public License, v. 2.0.+-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Stability : provisional+-- Portability : non-portable (GHC extensions)+--+-- Encryption and decryption of local data, by using a wrapped key mechanism+-- and master keys stored in KMS.+--+-- See the "Credentials" module for usage information.+module Credentials.KMS+ ( encrypt+ , decrypt+ ) where++import Control.Exception.Lens (catching_, handler)+import Control.Lens hiding (Context)+import Control.Monad+import Control.Monad.Catch (Exception, MonadThrow (..), catches)++import Credentials.Types++import Crypto.Cipher.AES (AES256)+import Crypto.Cipher.Types (nullIV)+import Crypto.Error+import Crypto.MAC.HMAC (HMAC (..), hmac)++import Data.ByteArray.Encoding (Base (Base16), convertToBase)+import Data.ByteString (ByteString)+import Data.Text (Text)+import Data.Typeable (Typeable)++import Network.AWS+import Network.AWS.Data+import Network.AWS.Error (hasCode, hasStatus)+import Network.AWS.KMS hiding (decrypt, encrypt)++import Numeric.Natural (Natural)++import qualified Crypto.Cipher.Types as Cipher+import qualified Data.ByteString as BS+import qualified Data.HashMap.Strict as Map+import qualified Data.Text as Text+import qualified Network.AWS.KMS as KMS++-- | Encrypt a plaintext 'ByteString' with the given master key and+-- encryption context. The 'Name' is used to annotate error messages.+--+-- The wrapped data encryption key, ciphertext, and HMAC SHA256 are returned+-- if no error occurs.+encrypt :: (MonadAWS m, Typeable m)+ => KeyId+ -> Context+ -> Name+ -> ByteString+ -> m Encrypted+encrypt key ctx name plaintext = do+ let rq = generateDataKey (toText key)+ & gdkNumberOfBytes ?~ keyLength+ & gdkEncryptionContext .~ fromContext ctx++ rs <- catches (send rq)+ [ handler (_ServiceError . hasStatus 400 . hasCode "NotFound") $+ throwM . MasterKeyMissing key . fmap toText . _serviceMessage+ , handler _NotFoundException $+ throwM . MasterKeyMissing key . fmap toText . _serviceMessage+ ]++ let (dataKey, hmacKey) = splitKey (rs ^. gdkrsPlaintext)+ failure = EncryptFailure ctx name++ aes :: AES256 <- cryptoError failure (Cipher.cipherInit dataKey)++ let !wrappedKey = rs ^. gdkrsCiphertextBlob+ !ciphertext = Cipher.ctrCombine aes nullIV plaintext+ !digest = hmac hmacKey ciphertext++ pure $! Encrypted{..}++-- | Decrypt ciphertext using the given encryption context, and wrapped+-- data encryption key. The HMAC SHA256 is recalculated and compared for+-- message integrity. The 'Name' is used to annotate error messages.+--+-- The resulting unencrypted plaintext 'ByteString' is returned if no error occurs.+decrypt :: MonadAWS m+ => Context+ -> Name+ -> Encrypted+ -> m ByteString+decrypt ctx name Encrypted{..} = do+ let rq = KMS.decrypt wrappedKey+ & decEncryptionContext .~ fromContext ctx++ rs <- catching_ _InvalidCiphertextException (send rq) $+ throwM . DecryptFailure ctx name $+ if Map.null (fromContext ctx)+ then "Could not decrypt stored key using KMS. \+ \The credential may require an ecryption context."+ else "Could not decrypt stored key using KMS. \+ \The provided encryption context may not match the one \+ \used when the credential was stored."++ -- Decrypted plaintext data. This value may not be returned if the customer+ -- master key is not available or if you didn't have permission to use it.+ plaintextKey <-+ case rs ^. drsPlaintext of+ Nothing -> throwM $+ DecryptFailure ctx name+ "Decrypted plaintext data not available from KMS."+ Just t -> pure t++ let (dataKey, hmacKey) = splitKey plaintextKey+ expect = hmac hmacKey (toBS ciphertext)+ failure = DecryptFailure ctx name++ unless (expect == digest) $+ throwM (IntegrityFailure name (encodeHex expect) (encodeHex digest))++ aes :: AES256 <- cryptoError failure (Cipher.cipherInit dataKey)++ pure $! Cipher.ctrCombine aes nullIV (toBS ciphertext)++splitKey :: ByteString -> (ByteString, ByteString)+splitKey = BS.splitAt 32++keyLength :: Natural+keyLength = 64++cryptoError :: (MonadThrow m, Exception e)+ => (Text -> e)+ -> CryptoFailable a+ -> m a+cryptoError f = onCryptoFailure (throwM . f . Text.pack . show) pure++encodeHex :: HMAC a -> ByteString+encodeHex = convertToBase Base16
+ src/Credentials/Types.hs view
@@ -0,0 +1,118 @@+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}++-- |+-- Module : Credentials.Types+-- Copyright : (c) 2015-2016 Brendan Hay+-- License : Mozilla Public License, v. 2.0.+-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Stability : provisional+-- Portability : non-portable (GHC extensions)+--+module Credentials.Types where++import Control.Exception.Lens (exception)+import Control.Lens hiding (Context)+import Control.Monad.Catch (Exception, SomeException)++import Crypto.Hash (SHA256)+import Crypto.MAC.HMAC (HMAC)++import Data.ByteString (ByteString)+import Data.HashMap.Strict (HashMap)+import Data.Text (Text)+import Data.Typeable (Typeable)++import Network.AWS.Data++-- | The KMS master key identifier.+newtype KeyId = KeyId Text+ deriving (Eq, Ord, Show, FromText, ToText, ToByteString, ToLog)++-- | The default KMS master key alias.+--+-- /Value:/ @alias\/credentials@+defaultKeyId :: KeyId+defaultKeyId = KeyId "alias/credentials"++-- | A shared/readable name for a secret.+newtype Name = Name Text+ deriving (Eq, Ord, Show, FromText, ToText, ToByteString, ToLog)++-- | An opaque, non-monotonic revision number.+newtype Revision = Revision ByteString+ deriving (Eq, Ord, Show, FromText, ToText, ToByteString, ToLog)++-- | A KMS encryption context.+--+-- /See:/ KMS <http://docs.aws.amazon.com/kms/latest/developerguide/encrypt-context.html Encryption Context>+-- documentation for more information.+newtype Context = Context { fromContext :: HashMap Text Text }+ deriving (Eq, Show, Monoid)++-- | The encryption parameters required to perform decryption.+data Encrypted = Encrypted+ { wrappedKey :: !ByteString -- ^ The wrapped (encrypted) data encryption key.+ , ciphertext :: !ByteString -- ^ The encrypted ciphertext.+ , digest :: !(HMAC SHA256) -- ^ HMAC SHA256 digest of the ciphertext.+ }++-- | Denotes idempotency of an action. That is, whether an action resulted+-- in any setup being performed.+data Setup+ = Created+ | Exists+ deriving (Eq, Show)++instance ToText Setup where+ toText = \case+ Created -> "created"+ Exists -> "exists"++instance ToLog Setup where+ build = build . toText++data CredentialError+ = MasterKeyMissing KeyId (Maybe Text)+ -- ^ The specified master key id doesn't exist.++ | IntegrityFailure Name ByteString ByteString+ -- ^ The computed HMAC doesn't matched the stored HMAC.++ | EncryptFailure Context Name Text+ -- ^ Failure occured during local encryption.++ | DecryptFailure Context Name Text+ -- ^ Failure occured during local decryption.++ | StorageMissing Text+ -- ^ Storage doesn't exist, or has gone on holiday.++ | StorageFailure Text+ -- ^ Some storage pre-condition wasn't met.+ -- For example: DynamoDB column size exceeded.++ | FieldMissing Text [Text]+ -- ^ Missing field from the storage engine.++ | FieldInvalid Text String+ -- ^ Unable to parse field from the storage engine.++ | SecretMissing Name (Maybe Revision) Text+ -- ^ Secret with the specified name cannot found.++ | OptimisticLockFailure Name Revision Text+ -- ^ Attempting to insert a revision that already exists.++ deriving (Eq, Show, Typeable)++instance Exception CredentialError++makeClassyPrisms ''CredentialError++instance AsCredentialError SomeException where+ _CredentialError = exception
+ test/Main.hs view
@@ -0,0 +1,12 @@+-- |+-- Module : Main+-- Copyright : (c) 2015-2016 Brendan Hay+-- License : Mozilla Public License, v. 2.0.+-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Stability : provisional+-- Portability : non-portable (GHC extensions)+--+module Main (main) where++main :: IO ()+main = putStrLn "Test suite not yet implemented"