-
Notifications
You must be signed in to change notification settings - Fork 2
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
Michel Boucey
committed
Apr 7, 2019
0 parents
commit daf1925
Showing
8 changed files
with
321 additions
and
0 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,5 @@ | ||
.ghci | ||
.cabal-sandbox | ||
dist | ||
cabal.sandbox.config | ||
.stack-work |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,21 @@ | ||
module Database.Vault.Connection where | ||
|
||
import Database.Vault.KV.V2.Types | ||
import System.Environment (lookupEnv) | ||
-- import Data.Text as T | ||
import Network.HTTP.Client | ||
import qualified Data.ByteString.Char8 as C | ||
|
||
-- getVaultConfig :: IO (Either String VaultConfig) | ||
getVaultConfig :: IO VaultConfig | ||
getVaultConfig = do | ||
Just va <- lookupEnv "VAULT_ADDR" | ||
Just hm <- lookupEnv "HOME" | ||
vt <- readFile (hm ++ "/.vault-token") | ||
return VaultConfig { vaultAddr = va, vaultToken = C.pack vt, secretsEnginePath = "secret/" } | ||
|
||
getVaultConnection :: VaultConfig -> IO VaultConnection | ||
getVaultConnection c = | ||
newManager defaultManagerSettings >>= \m -> return VaultConnection { config = c, manager = m } | ||
|
||
-- getSecretsList |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,77 @@ | ||
{-# LANGUAGE OverloadedStrings #-} | ||
{-# LANGUAGE RecordWildCards #-} | ||
|
||
module Database.Vault.KV.V2 ( | ||
|
||
kvReadSecretVersion | ||
|
||
) where | ||
|
||
import Network.HTTP.Client | ||
import Network.HTTP.Types.Header | ||
import qualified Data.ByteString as B | ||
|
||
import Database.Vault.KV.V2.Types | ||
|
||
-- https://haskell-lang.org/library/http-client | ||
{- | ||
{ | ||
"data": { | ||
"data": { | ||
"foo": "bar" | ||
}, | ||
"metadata": { | ||
"created_time": "2018-03-22T02:24:06.945319214Z", | ||
"deletion_time": "", | ||
"destroyed": false, | ||
"version": 1 | ||
} | ||
}, | ||
} | ||
-} | ||
|
||
kvReadSecretVersion VaultConnection{config = VaultConfig{..},..} (SecretPath p) LatestVersion = do | ||
req <- parseRequest (vaultAddr ++ "/v1/" ++ secretsEnginePath ++ "data/" ++ p) | ||
>>= \r -> return r { requestHeaders = vaultRequestHeaders vaultToken } | ||
httpLbs req manager | ||
kvReadSecretVersion VaultConnection{config = VaultConfig{..},..} (SecretPath p) (Version v) = do | ||
req <- parseRequest (vaultAddr ++ "/v1/" ++ secretsEnginePath ++ "data/" ++ p ++ "?version=" ++ (show v)) | ||
>>= \r -> return r { requestHeaders = vaultRequestHeaders vaultToken } | ||
httpLbs req manager | ||
|
||
{- | ||
vaultAPIRequest :: Method | ||
kvPut = undefined | ||
-- https://www.vaultproject.io/api/secret/kv/kv-v2.html#create-update-secret | ||
kvSecretNewVersion = undefined | ||
kvSecretDelete = undefined | ||
-- https://www.vaultproject.io/api/secret/kv/kv-v2.html#delete-secret-versions | ||
kvDeleteSecretVersions = undefined | ||
-- https://www.vaultproject.io/api/secret/kv/kv-v2.html#undelete-secret-versions | ||
kvUndeleteSecretVersions = undefined | ||
-- https://www.vaultproject.io/api/secret/kv/kv-v2.html#destroy-secret-versions | ||
kvDestroySecretVersions =undefined | ||
-- https://www.vaultproject.io/api/secret/kv/kv-v2.html#list-secrets | ||
kvListSecrets = undefined | ||
--https://www.vaultproject.io/api/secret/kv/kv-v2.html#read-secret-metadata | ||
kvReadSecretMetadata = undefined | ||
kvUpdateSecretMetadata = undefined | ||
-} | ||
|
||
vaultRequestHeaders :: B.ByteString -> [Header] | ||
vaultRequestHeaders vt = | ||
[ ("Content-Type", "application/json; charset=utf-8") | ||
, ("X-Vault-Token", vt) | ||
] | ||
|
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,86 @@ | ||
{-# LANGUAGE OverloadedStrings #-} | ||
|
||
module Database.Vault.KV.V2.Types where | ||
|
||
import qualified Data.Aeson as A | ||
-- import qualified Data.Aeson.Lens as L | ||
import qualified Data.ByteString as B | ||
import Data.HashMap.Strict as HM | ||
import qualified Data.Vector as V | ||
import Data.HashSet | ||
import Network.HTTP.Client (Manager) | ||
import qualified Data.Text as T | ||
import Control.Monad | ||
|
||
data VaultAPIVersion = V1 | ||
|
||
instance Show VaultAPIVersion where | ||
show V1 = "v1" | ||
|
||
data VaultConfig = | ||
VaultConfig | ||
{ vaultToken :: B.ByteString | ||
, vaultAddr :: String | ||
, secretsEnginePath :: String | ||
} deriving (Show) | ||
|
||
data VaultConnection = | ||
VaultConnection | ||
{ config :: VaultConfig | ||
, manager :: Manager | ||
} | ||
|
||
newtype Versions = Versions (HashSet Int) deriving (Show) | ||
|
||
data SecretVersion = LatestVersion | ||
| Version !Int | ||
deriving (Show) | ||
|
||
newtype SecretData = SecretData (HashMap T.Text T.Text) | ||
|
||
-- TODO instance A.ToJSON SecretData where | ||
|
||
data SecretMetadata = | ||
SecretMetadata | ||
{ createdTime :: String | ||
, version :: Int | ||
, deletionTime :: String | ||
, destroyed :: Bool | ||
} deriving (Show) | ||
|
||
instance A.ToJSON SecretMetadata where | ||
toJSON (SecretMetadata c v l s) = | ||
A.object [ "created_time" A..= c | ||
, "version" A..= v | ||
, "deletion_time" A..= l | ||
, "destroyed" A..= s | ||
] | ||
|
||
instance A.FromJSON SecretMetadata where | ||
parseJSON (A.Object v) = | ||
SecretMetadata <$> | ||
v A..: "created_time" <*> | ||
v A..: "version" <*> | ||
v A..: "deletion_time" <*> | ||
v A..: "destroyed" | ||
parseJSON _ = mzero | ||
|
||
newtype SecretPath = SecretPath { unSecretPath :: String } deriving (Show) | ||
|
||
{- | ||
(Response {responseStatus = Status {statusCode = 200, statusMessage = "OK"}, responseVersion = HTTP/1.1, responseHeaders = [("Cache-Control","no-store"),("Content-Type","application/json"),("Date","Sat, 01 Dec 2018 10:10:25 GMT"),("Content-Length","294")], responseBody = Object (fromList [("lease_duration",Number 0.0),("wrap_info",Null),("auth",Null),("data",Object (fromList [("data",Object (fromList [("michel",String "True")])),("metadata",Object (fromList [("destroyed",Bool False),("deletion_time",String ""),("version",Number 1.0),("created_time",String "2018-12-01T07:12:25.806880744Z")]))])),("request_id",String "3667a85c-ff92-48fb-c265-1b38a3dc2b32"),("warnings",Null),("lease_id",String ""),("renewable",Bool False)]) | ||
https://github.com/hashicorp/vault/blob/5269abb64c878aabbf91d0e54befb314630fae12/api/secret.go | ||
-} | ||
|
||
data VaultKVResponse = | ||
VaultSecret | ||
{ leaseDuration :: Int | ||
, wrapInfo :: Maybe (HashMap T.Text T.Text) | ||
, auth :: Maybe String -- TODO | ||
, secretData :: SecretData | ||
, requestId :: String | ||
, warnings :: Maybe (V.Vector String) | ||
, leaseId :: String | ||
, renewable :: Bool | ||
} |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,28 @@ | ||
Vault-KV-Client - Copyright (c) 2019, Michel Boucey | ||
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 Vault-KV-CLient 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. | ||
|
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,2 @@ | ||
import Distribution.Simple | ||
main = defaultMain |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,38 @@ | ||
name: Vault-KV-Client | ||
version: 0.1.0 | ||
synopsis: A Haskell client library for the Hashicorp Vault | ||
description: A Haskell client library for the Hashicorp Vault | ||
homepage: https://github.com/MichelBoucey/Vault-KV-Client | ||
license: BSD3 | ||
license-file: LICENSE | ||
author: Michel Boucey | ||
maintainer: [email protected] | ||
copyright: (c) 2019 - Michel Boucey | ||
category: Database, Security | ||
build-type: Simple | ||
cabal-version: >=1.10 | ||
extra-source-files: README.md | ||
|
||
Source-Repository head | ||
Type: git | ||
Location: https://github.com/MichelBoucey/vaultdoor.git | ||
|
||
library | ||
exposed-modules: Database.Vault.Connection | ||
, Database.Vault.KV.V2 | ||
other-modules: Database.Vault.KV.V2.Types | ||
other-extensions: OverloadedStrings | ||
build-depends: aeson >= 0.8.0.2 && < 1.5 | ||
, base >= 4.8.1.0 && < 5 | ||
, http-client | ||
, http-types | ||
, bytestring | ||
, http-conduit | ||
, text | ||
, unordered-containers | ||
, lens | ||
, lens-aeson | ||
, vector | ||
|
||
default-language: Haskell2010 | ||
GHC-Options: -Wall |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,64 @@ | ||
# This file was automatically generated by 'stack init' | ||
# | ||
# Some commonly used options have been documented as comments in this file. | ||
# For advanced use and comprehensive documentation of the format, please see: | ||
# https://docs.haskellstack.org/en/stable/yaml_configuration/ | ||
|
||
# Resolver to choose a 'specific' stackage snapshot or a compiler version. | ||
# A snapshot resolver dictates the compiler version and the set of packages | ||
# to be used for project dependencies. For example: | ||
# | ||
# resolver: lts-3.5 | ||
# resolver: nightly-2015-09-21 | ||
# resolver: ghc-7.10.2 | ||
# | ||
# The location of a snapshot can be provided as a file or url. Stack assumes | ||
# a snapshot provided as a file might change, whereas a url resource does not. | ||
# | ||
# resolver: ./custom-snapshot.yaml | ||
# resolver: https://example.com/snapshots/2018-01-01.yaml | ||
resolver: lts-12.19 | ||
|
||
# User packages to be built. | ||
# Various formats can be used as shown in the example below. | ||
# | ||
# packages: | ||
# - some-directory | ||
# - https://example.com/foo/bar/baz-0.0.2.tar.gz | ||
# - location: | ||
# git: https://github.com/commercialhaskell/stack.git | ||
# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a | ||
# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a | ||
# subdirs: | ||
# - auto-update | ||
# - wai | ||
packages: | ||
- . | ||
# Dependency packages to be pulled from upstream that are not in the resolver | ||
# using the same syntax as the packages field. | ||
# (e.g., acme-missiles-0.3) | ||
# extra-deps: [] | ||
|
||
# Override default flag values for local packages and extra-deps | ||
# flags: {} | ||
|
||
# Extra package databases containing global packages | ||
# extra-package-dbs: [] | ||
|
||
# Control whether we use the GHC we find on the path | ||
# system-ghc: true | ||
# | ||
# Require a specific version of stack, using version ranges | ||
# require-stack-version: -any # Default | ||
# require-stack-version: ">=1.9" | ||
# | ||
# Override the architecture used by stack, especially useful on Windows | ||
# arch: i386 | ||
# arch: x86_64 | ||
# | ||
# Extra directories used by stack for building | ||
# extra-include-dirs: [/path/to/dir] | ||
# extra-lib-dirs: [/path/to/dir] | ||
# | ||
# Allow a newer minor version of GHC than the snapshot specifies | ||
# compiler-check: newer-minor |