{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}

module Database.Vault.KVv2.Client.Requests (

    configR,
    getSecretR,
    putSecretR,
    deleteSecretR,
    destroySecretR,
    secretVersionsR,
    readSecretMetadataR,
    secretsListR

  ) where

import qualified Data.Aeson                          as A
import           Network.HTTP.Client
import           Network.HTTP.Simple                 ( setRequestBody
                                                     , setRequestHeaders
                                                     , setRequestBodyJSON
                                                     )

import           Database.Vault.KVv2.Client.Internal
import           Database.Vault.KVv2.Client.Types

configR
  :: [String]                   -- ^ Endpoint
  ->VaultConnection
  -> Int                        -- ^ Max versions
  -> Bool                       -- ^ CAS required
  -> IO (Either String A.Value)
configR :: [String]
-> VaultConnection -> Int -> Bool -> IO (Either String Value)
configR [String]
ss VaultConnection{String
ByteString
Manager
manager :: VaultConnection -> Manager
vaultToken :: VaultConnection -> ByteString
kvEnginePath :: VaultConnection -> String
vaultAddr :: VaultConnection -> String
manager :: Manager
vaultToken :: ByteString
kvEnginePath :: String
vaultAddr :: String
..} Int
mvs Bool
casr =
  String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
ss)
  IO Request
-> (Request -> IO (Either String Value))
-> IO (Either String Value)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Manager -> Request -> IO (Either String Value)
runRequest Manager
manager
    (Request -> IO (Either String Value))
-> (Request -> Request) -> Request -> IO (Either String Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RequestHeaders -> Request -> Request
setRequestHeaders (ByteString -> RequestHeaders
vaultHeaders ByteString
vaultToken)
    (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecretSettings -> Request -> Request
forall a. ToJSON a => a -> Request -> Request
setRequestBodyJSON
        SecretSettings :: Int -> Bool -> SecretSettings
SecretSettings
          { max_versions :: Int
max_versions = Int
mvs
          , cas_required :: Bool
cas_required = Bool
casr
          }

getSecretR
  :: VaultConnection
  -> SecretPath
  -> Maybe SecretVersion
  -> IO (Either String A.Value)
getSecretR :: VaultConnection
-> SecretPath -> Maybe SecretVersion -> IO (Either String Value)
getSecretR vc :: VaultConnection
vc@VaultConnection{String
ByteString
Manager
manager :: Manager
vaultToken :: ByteString
kvEnginePath :: String
vaultAddr :: String
manager :: VaultConnection -> Manager
vaultToken :: VaultConnection -> ByteString
kvEnginePath :: VaultConnection -> String
vaultAddr :: VaultConnection -> String
..} SecretPath{String
path :: SecretPath -> String
path :: String
..} Maybe SecretVersion
msv =
  String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest
    ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [VaultConnection -> String
forall a. Show a => a -> String
show VaultConnection
vc, String
"/data/", String
path, Maybe SecretVersion -> String
queryString Maybe SecretVersion
msv])
  IO Request
-> (Request -> IO (Either String Value))
-> IO (Either String Value)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Manager -> Request -> IO (Either String Value)
runRequest Manager
manager (Request -> IO (Either String Value))
-> (Request -> Request) -> Request -> IO (Either String Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RequestHeaders -> Request -> Request
setRequestHeaders (ByteString -> RequestHeaders
vaultHeaders ByteString
vaultToken)
  where
  queryString :: Maybe SecretVersion -> String
queryString = String
-> (SecretVersion -> String) -> Maybe SecretVersion -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\(SecretVersion Int
v) -> String
"?version=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
v) 
  
putSecretR
  :: VaultConnection
  -> CheckAndSet
  -> SecretPath
  -> SecretData
  -> IO (Either String A.Value)
putSecretR :: VaultConnection
-> CheckAndSet
-> SecretPath
-> SecretData
-> IO (Either String Value)
putSecretR vc :: VaultConnection
vc@VaultConnection{String
ByteString
Manager
manager :: Manager
vaultToken :: ByteString
kvEnginePath :: String
vaultAddr :: String
manager :: VaultConnection -> Manager
vaultToken :: VaultConnection -> ByteString
kvEnginePath :: VaultConnection -> String
vaultAddr :: VaultConnection -> String
..} CheckAndSet
cas SecretPath{String
path :: String
path :: SecretPath -> String
..} SecretData
sd =
  String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest
    ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"POST ", VaultConnection -> String
forall a. Show a => a -> String
show VaultConnection
vc, String
"/data/", String
path])
  IO Request
-> (Request -> IO (Either String Value))
-> IO (Either String Value)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Manager -> Request -> IO (Either String Value)
runRequest Manager
manager
    (Request -> IO (Either String Value))
-> (Request -> Request) -> Request -> IO (Either String Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RequestHeaders -> Request -> Request
setRequestHeaders (ByteString -> RequestHeaders
vaultHeaders ByteString
vaultToken)
    (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PutSecretRequestBody -> Request -> Request
forall a. ToJSON a => a -> Request -> Request
setRequestBodyJSON
        PutSecretRequestBody :: PutSecretOptions -> SecretData -> PutSecretRequestBody
PutSecretRequestBody
          { options :: PutSecretOptions
options  = PutSecretOptions :: CheckAndSet -> PutSecretOptions
PutSecretOptions { cas :: CheckAndSet
cas = CheckAndSet
cas }
          , put_data :: SecretData
put_data = SecretData
sd
          }

deleteSecretR
  :: VaultConnection
  -> SecretPath
  -> IO (Either String A.Value)
deleteSecretR :: VaultConnection -> SecretPath -> IO (Either String Value)
deleteSecretR vc :: VaultConnection
vc@VaultConnection{String
ByteString
Manager
manager :: Manager
vaultToken :: ByteString
kvEnginePath :: String
vaultAddr :: String
manager :: VaultConnection -> Manager
vaultToken :: VaultConnection -> ByteString
kvEnginePath :: VaultConnection -> String
vaultAddr :: VaultConnection -> String
..} SecretPath{String
path :: String
path :: SecretPath -> String
..} =
  String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest
    ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"DELETE ", VaultConnection -> String
forall a. Show a => a -> String
show VaultConnection
vc, String
"/data/", String
path])
  IO Request
-> (Request -> IO (Either String Value))
-> IO (Either String Value)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Manager -> Request -> IO (Either String Value)
runRequest Manager
manager (Request -> IO (Either String Value))
-> (Request -> Request) -> Request -> IO (Either String Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RequestHeaders -> Request -> Request
setRequestHeaders (ByteString -> RequestHeaders
vaultHeaders ByteString
vaultToken)

secretVersionsR
  :: [String]                    -- ^ Endpoint
  -> VaultConnection
  -> SecretVersions
  -> IO (Either String A.Value)
secretVersionsR :: [String]
-> VaultConnection -> SecretVersions -> IO (Either String Value)
secretVersionsR [String]
ss VaultConnection{String
ByteString
Manager
manager :: Manager
vaultToken :: ByteString
kvEnginePath :: String
vaultAddr :: String
manager :: VaultConnection -> Manager
vaultToken :: VaultConnection -> ByteString
kvEnginePath :: VaultConnection -> String
vaultAddr :: VaultConnection -> String
..} SecretVersions
vs =
  String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
ss) IO Request
-> (Request -> IO (Either String Value))
-> IO (Either String Value)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    Manager -> Request -> IO (Either String Value)
runRequest Manager
manager
      (Request -> IO (Either String Value))
-> (Request -> Request) -> Request -> IO (Either String Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RequestHeaders -> Request -> Request
setRequestHeaders (ByteString -> RequestHeaders
vaultHeaders ByteString
vaultToken)
      (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RequestBody -> Request -> Request
setRequestBody (ByteString -> RequestBody
RequestBodyLBS (ByteString -> RequestBody) -> ByteString -> RequestBody
forall a b. (a -> b) -> a -> b
$ SecretVersions -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode SecretVersions
vs)

destroySecretR
  :: VaultConnection
  -> SecretPath
  -> IO (Either String A.Value)
destroySecretR :: VaultConnection -> SecretPath -> IO (Either String Value)
destroySecretR vc :: VaultConnection
vc@VaultConnection{String
ByteString
Manager
manager :: Manager
vaultToken :: ByteString
kvEnginePath :: String
vaultAddr :: String
manager :: VaultConnection -> Manager
vaultToken :: VaultConnection -> ByteString
kvEnginePath :: VaultConnection -> String
vaultAddr :: VaultConnection -> String
..} SecretPath{String
path :: String
path :: SecretPath -> String
..} =
  String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest
    ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"DELETE ", VaultConnection -> String
forall a. Show a => a -> String
show VaultConnection
vc, String
"/metadata/", String
path])
  IO Request
-> (Request -> IO (Either String Value))
-> IO (Either String Value)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Manager -> Request -> IO (Either String Value)
runRequest Manager
manager (Request -> IO (Either String Value))
-> (Request -> Request) -> Request -> IO (Either String Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RequestHeaders -> Request -> Request
setRequestHeaders (ByteString -> RequestHeaders
vaultHeaders ByteString
vaultToken)

secretsListR
  :: VaultConnection
  -> SecretPath
  -> IO (Either String A.Value)
secretsListR :: VaultConnection -> SecretPath -> IO (Either String Value)
secretsListR vc :: VaultConnection
vc@VaultConnection{String
ByteString
Manager
manager :: Manager
vaultToken :: ByteString
kvEnginePath :: String
vaultAddr :: String
manager :: VaultConnection -> Manager
vaultToken :: VaultConnection -> ByteString
kvEnginePath :: VaultConnection -> String
vaultAddr :: VaultConnection -> String
..} SecretPath{String
path :: String
path :: SecretPath -> String
..} =
  if String -> Bool
hasTrailingSlash String
path
    then
      String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest
        ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"LIST ", VaultConnection -> String
forall a. Show a => a -> String
show VaultConnection
vc, String
"/metadata/", String
path])
      IO Request
-> (Request -> IO (Either String Value))
-> IO (Either String Value)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Manager -> Request -> IO (Either String Value)
runRequest Manager
manager (Request -> IO (Either String Value))
-> (Request -> Request) -> Request -> IO (Either String Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RequestHeaders -> Request -> Request
setRequestHeaders (ByteString -> RequestHeaders
vaultHeaders ByteString
vaultToken)
    else Either String Value -> IO (Either String Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Either String Value
forall a b. a -> Either a b
Left String
"SecretPath must be a folder/")

readSecretMetadataR
  :: VaultConnection
  -> SecretPath
  -> IO (Either String A.Value)
readSecretMetadataR :: VaultConnection -> SecretPath -> IO (Either String Value)
readSecretMetadataR vc :: VaultConnection
vc@VaultConnection{String
ByteString
Manager
manager :: Manager
vaultToken :: ByteString
kvEnginePath :: String
vaultAddr :: String
manager :: VaultConnection -> Manager
vaultToken :: VaultConnection -> ByteString
kvEnginePath :: VaultConnection -> String
vaultAddr :: VaultConnection -> String
..} SecretPath{String
path :: String
path :: SecretPath -> String
..} =
  String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest
    ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"GET ", VaultConnection -> String
forall a. Show a => a -> String
show VaultConnection
vc, String
"/metadata/", String
path])
  IO Request
-> (Request -> IO (Either String Value))
-> IO (Either String Value)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Manager -> Request -> IO (Either String Value)
runRequest Manager
manager (Request -> IO (Either String Value))
-> (Request -> Request) -> Request -> IO (Either String Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RequestHeaders -> Request -> Request
setRequestHeaders (ByteString -> RequestHeaders
vaultHeaders ByteString
vaultToken)