{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Database.Vault.KVv2.Client (
VaultConnection,
vaultConnect,
kvEngineConfig,
secretConfig,
putSecret,
getSecret,
deleteSecret,
deleteSecretVersions,
unDeleteSecretVersions,
destroySecret,
destroySecretVersions,
currentSecretVersion,
readSecretMetadata,
secretsList,
toSecretData,
fromSecretData,
toSecretVersions,
) where
import qualified Data.Aeson as A
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.HashMap.Strict
import qualified Data.Maybe as M
import Data.Text hiding (concat)
import Network.Connection
import Network.HTTP.Client.TLS
import System.Environment (lookupEnv)
import System.Posix.Files (fileExist)
import Database.Vault.KVv2.Client.Types
import Database.Vault.KVv2.Client.Lens
import Database.Vault.KVv2.Client.Requests
vaultConnect
:: Maybe String
-> String
-> Maybe VaultToken
-> Bool
-> IO (Either String VaultConnection)
vaultConnect mva kvep mvt dcv = do
nm <- newTlsManagerWith $
mkManagerSettings
TLSSettingsSimple
{ settingDisableCertificateValidation = dcv
, settingDisableSession = False
, settingUseServerName = True
}
Nothing
va <- case mva of
Just va -> return (Just va)
Nothing -> lookupEnv "VAULT_ADDR"
evt <- case mvt of
Just t -> return (Right $ C.pack t)
Nothing -> do
hm <- lookupEnv "HOME"
if M.isJust hm
then do
let fp = M.fromJust hm ++ "/.vault-token"
if M.isJust va
then do
fe <- fileExist fp
if fe
then Right <$> B.readFile fp
else return (Left $ "No Vault token file found at " ++ fp)
else return (Left "Variable environment VAULT_ADDR not set")
else return (Left "Variable environment HOME not set")
pure $
(\vt ->
VaultConnection
{ vaultAddr = M.fromJust va
, vaultToken = vt
, kvEnginePath = kvep
, manager = nm
}
) <$> evt
kvEngineConfig
:: VaultConnection
-> Int
-> Bool
-> IO (Either String A.Value)
kvEngineConfig vc@VaultConnection{..} =
configR ["POST ", show vc, "/config"] vc
secretConfig
:: VaultConnection
-> SecretPath
-> Int
-> Bool
-> IO (Either String A.Value)
secretConfig vc@VaultConnection{..} SecretPath{..} =
configR ["POST ", show vc, "/metadata/", path] vc
getSecret
:: VaultConnection
-> SecretPath
-> Maybe SecretVersion
-> IO (Either String SecretData)
getSecret vc sp msv =
(>>= secret) <$> getSecretR vc sp msv
putSecret
:: VaultConnection
-> CheckAndSet
-> SecretPath
-> SecretData
-> IO (Either String SecretVersion)
putSecret vc cas sp sd =
(>>= version) <$> putSecretR vc cas sp sd
deleteSecret
:: VaultConnection
-> SecretPath
-> IO (Maybe Error)
deleteSecret vc sp =
maybeError <$> deleteSecretR vc sp
deleteSecretVersions
:: VaultConnection
-> SecretPath
-> SecretVersions
-> IO (Maybe Error)
deleteSecretVersions vc@VaultConnection{..} SecretPath{..} svs =
maybeError <$> secretVersionsR ["POST ", show vc, "/delete/", path] vc svs
unDeleteSecretVersions
:: VaultConnection
-> SecretPath
-> SecretVersions
-> IO (Maybe Error)
unDeleteSecretVersions vc@VaultConnection{..} SecretPath{..} svs =
maybeError <$> secretVersionsR ["POST ", show vc, "/undelete/", path] vc svs
destroySecret
:: VaultConnection
-> SecretPath
-> IO (Maybe Error)
destroySecret vc sp =
maybeError <$> destroySecretR vc sp
destroySecretVersions
:: VaultConnection
-> SecretPath
-> SecretVersions
-> IO (Either String A.Value)
destroySecretVersions vc@VaultConnection{..} SecretPath{..} =
secretVersionsR ["POST ", show vc, "/destroy/", path] vc
secretsList
:: VaultConnection
-> SecretPath
-> IO (Either String [VaultKey])
secretsList vc sp =
(>>= list) <$> secretsListR vc sp
readSecretMetadata
:: VaultConnection
-> SecretPath
-> IO (Either String SecretMetadata)
readSecretMetadata vc sp =
(>>= metadata) <$> readSecretMetadataR vc sp
currentSecretVersion
:: VaultConnection
-> SecretPath
-> IO (Either String SecretVersion)
currentSecretVersion vc sp =
(>>= current) <$> readSecretMetadataR vc sp
toSecretData
:: [(Text,Text)]
-> SecretData
toSecretData = SecretData . fromList
fromSecretData
:: SecretData
-> [(Text,Text)]
fromSecretData (SecretData sd) = toList sd
toSecretVersions
:: [Int]
-> SecretVersions
toSecretVersions is =
SecretVersions (SecretVersion <$> is)