vault-trans (empty) → 0.1.0
raw patch · 6 files changed
+156/−0 lines, 6 filesdep +aesondep +basedep +containerssetup-changed
Dependencies added: aeson, base, containers, postgresql-simple, text, transformers, unordered-containers, vault-tool
Files
- LICENSE +29/−0
- Setup.hs +2/−0
- src/lib/Network/VaultTool/Trans.hs +29/−0
- src/lib/Network/VaultTool/Trans/Database.hs +37/−0
- src/lib/Network/VaultTool/Trans/Database/Postgresql.hs +19/−0
- vault-trans.cabal +40/−0
+ LICENSE view
@@ -0,0 +1,29 @@+BSD 3-Clause License++Copyright (c) 2018-present, Bitnomial, Inc.+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice, this+ list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.++* Neither the name of the copyright holder nor the names of its+ contributors may be used to endorse or promote products derived from+ this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/lib/Network/VaultTool/Trans.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}++module Network.VaultTool.Trans+ ( VaultT (..)+ , runVaultT++ , -- * Types+ VaultConnectionInfo (..)+ ) where++import Control.Monad.IO.Class (MonadIO)+import Control.Monad.Trans.Class (MonadTrans)+import Control.Monad.Trans.Reader (ReaderT (..))+import Network.VaultTool (VaultConnection, VaultSecretPath (..))+++newtype VaultT m a = VaultT { unVaultT :: ReaderT VaultConnectionInfo m a }+ deriving (Functor, Applicative, Monad, MonadTrans, MonadIO)+++data VaultConnectionInfo = VaultConnectionInfo+ { conn :: VaultConnection+ , secretPath :: VaultSecretPath+ }+++runVaultT :: MonadIO m => VaultConnection -> VaultSecretPath -> VaultT m a -> m a+runVaultT vc vsp = flip runReaderT (VaultConnectionInfo vc vsp) . unVaultT
+ src/lib/Network/VaultTool/Trans/Database.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.VaultTool.Trans.Database+ ( readCredentials+ ) where++import Control.Monad (liftM2)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Trans.Reader (ask)+import Data.Aeson (withText)+import Data.Aeson.Types (Object, Value, parseMaybe)+import qualified Data.HashMap.Strict as M+import Data.Maybe (maybe)+import Data.Monoid ((<>))+import Data.Text (Text, unpack)+import Network.VaultTool (VaultConnection, VaultSecretMetadata, VaultSecretPath (..), vaultRead)++import Network.VaultTool.Trans (VaultConnectionInfo (conn, secretPath), VaultT (..))++readCredentials :: MonadIO m => VaultT m (Text, Text)+readCredentials = do+ (_, secret) <- VaultT $ ask >>= liftIO . liftM2 vaultRead' conn secretPath+ case secret of+ Left (v,s) -> fail ("Unable to retrieve credentials - " <> show v <> s)+ Right s -> do+ username <- liftIO $ lookupField "username" s+ password <- liftIO $ lookupField "password" s+ return (username, password)+ where+ vaultRead' :: VaultConnection -> VaultSecretPath -> IO (VaultSecretMetadata, Either (Value, String) Object)+ vaultRead' = vaultRead++ lookupField :: Text -> Object -> IO Text+ lookupField f = maybe (fail $ "Unable to retrieve " <> unpack f) (parseField f) . M.lookup f++ parseField :: Text -> Value -> IO Text+ parseField f = maybe (fail $ "Unable to parse " <> unpack f) return . parseMaybe (withText (unpack f) return)
+ src/lib/Network/VaultTool/Trans/Database/Postgresql.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.VaultTool.Trans.Database.Postgresql+ ( connect+ ) where++import Control.Monad.IO.Class (MonadIO, liftIO)+import Data.Text (unpack)+import qualified Database.PostgreSQL.Simple as PSQL+import GHC.Word (Word16)++import Network.VaultTool.Trans (VaultT (..))+import Network.VaultTool.Trans.Database (readCredentials)+++connect :: MonadIO m => String -> Word16 -> String -> VaultT m PSQL.Connection+connect host port database = do+ (username, password) <- readCredentials+ liftIO . PSQL.connect $ PSQL.ConnectInfo host port (unpack username) (unpack password) database
+ vault-trans.cabal view
@@ -0,0 +1,40 @@+name: vault-trans+version: 0.1.0+synopsis: A monad transformer for vault-tool+description: Monad transformer for interfacing with vault.+License: BSD3+License-file: LICENSE+author: Michael Dunn+maintainer: michael@bitnomial.com, opensource@bitnomial.com+copyright: Bitnomial, Inc. (c) 2018+category: Network+build-type: Simple+cabal-version: >= 1.10+homepage: https://github.com/bitnomial/vault-trans+bug-reports: https://github.com/bitnomial/vault-trans/issues+++source-repository head+ type: git+ location: https://github.com/bitnomial/vault-trans.git+++library+ hs-source-dirs: src/lib+ default-language: Haskell2010+ ghc-options:+ -Wall -fwarn-tabs -fno-warn-unused-do-bind+ -funbox-strict-fields -O2++ exposed-modules: Network.VaultTool.Trans+ , Network.VaultTool.Trans.Database+ , Network.VaultTool.Trans.Database.Postgresql++ build-depends: base >= 4.8 && < 4.11+ , aeson >= 1.2 && < 1.3+ , containers >= 0.5 && < 0.6+ , postgresql-simple >= 0.5 && < 0.6+ , text >= 1.2 && < 1.3+ , transformers >= 0.4 && < 0.6+ , unordered-containers >= 0.2.6 && < 0.3+ , vault-tool >= 0.0.0.3 && < 0.0.0.4