{-# 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,
                                                      setRequestBodyJSON,
                                                      setRequestHeaders)

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 :: [[Char]]
-> VaultConnection -> Int -> Bool -> IO (Either [Char] Value)
configR [[Char]]
ss VaultConnection{[Char]
ByteString
Manager
vaultAddr :: [Char]
kvEnginePath :: [Char]
vaultToken :: ByteString
manager :: Manager
vaultAddr :: VaultConnection -> [Char]
kvEnginePath :: VaultConnection -> [Char]
vaultToken :: VaultConnection -> ByteString
manager :: VaultConnection -> Manager
..} Int
mvs Bool
casr =
  [Char] -> IO Request
forall (m :: * -> *). MonadThrow m => [Char] -> m Request
parseRequest ([[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Char]]
ss)
  IO Request
-> (Request -> IO (Either [Char] Value))
-> IO (Either [Char] Value)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Manager -> Request -> IO (Either [Char] Value)
runRequest Manager
manager
    (Request -> IO (Either [Char] Value))
-> (Request -> Request) -> Request -> IO (Either [Char] 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
          { 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 [Char] Value)
getSecretR vc :: VaultConnection
vc@VaultConnection{[Char]
ByteString
Manager
vaultAddr :: VaultConnection -> [Char]
kvEnginePath :: VaultConnection -> [Char]
vaultToken :: VaultConnection -> ByteString
manager :: VaultConnection -> Manager
vaultAddr :: [Char]
kvEnginePath :: [Char]
vaultToken :: ByteString
manager :: Manager
..} SecretPath{[Char]
path :: [Char]
path :: SecretPath -> [Char]
..} Maybe SecretVersion
msv =
  [Char] -> IO Request
forall (m :: * -> *). MonadThrow m => [Char] -> m Request
parseRequest
    ([[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [VaultConnection -> [Char]
forall a. Show a => a -> [Char]
show VaultConnection
vc, [Char]
"/data/", [Char]
path, Maybe SecretVersion -> [Char]
queryString Maybe SecretVersion
msv])
  IO Request
-> (Request -> IO (Either [Char] Value))
-> IO (Either [Char] Value)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Manager -> Request -> IO (Either [Char] Value)
runRequest Manager
manager (Request -> IO (Either [Char] Value))
-> (Request -> Request) -> Request -> IO (Either [Char] Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RequestHeaders -> Request -> Request
setRequestHeaders (ByteString -> RequestHeaders
vaultHeaders ByteString
vaultToken)
  where
  queryString :: Maybe SecretVersion -> [Char]
queryString = [Char]
-> (SecretVersion -> [Char]) -> Maybe SecretVersion -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" (\(SecretVersion Int
v) -> [Char]
"?version=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
v)

putSecretR
  :: VaultConnection
  -> CheckAndSet
  -> SecretPath
  -> SecretData
  -> IO (Either String A.Value)
putSecretR :: VaultConnection
-> CheckAndSet
-> SecretPath
-> SecretData
-> IO (Either [Char] Value)
putSecretR vc :: VaultConnection
vc@VaultConnection{[Char]
ByteString
Manager
vaultAddr :: VaultConnection -> [Char]
kvEnginePath :: VaultConnection -> [Char]
vaultToken :: VaultConnection -> ByteString
manager :: VaultConnection -> Manager
vaultAddr :: [Char]
kvEnginePath :: [Char]
vaultToken :: ByteString
manager :: Manager
..} CheckAndSet
cas SecretPath{[Char]
path :: SecretPath -> [Char]
path :: [Char]
..} SecretData
sd =
  [Char] -> IO Request
forall (m :: * -> *). MonadThrow m => [Char] -> m Request
parseRequest
    ([[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Char]
"POST ", VaultConnection -> [Char]
forall a. Show a => a -> [Char]
show VaultConnection
vc, [Char]
"/data/", [Char]
path])
  IO Request
-> (Request -> IO (Either [Char] Value))
-> IO (Either [Char] Value)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Manager -> Request -> IO (Either [Char] Value)
runRequest Manager
manager
    (Request -> IO (Either [Char] Value))
-> (Request -> Request) -> Request -> IO (Either [Char] 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
          { options :: PutSecretOptions
options  = 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 [Char] Value)
deleteSecretR vc :: VaultConnection
vc@VaultConnection{[Char]
ByteString
Manager
vaultAddr :: VaultConnection -> [Char]
kvEnginePath :: VaultConnection -> [Char]
vaultToken :: VaultConnection -> ByteString
manager :: VaultConnection -> Manager
vaultAddr :: [Char]
kvEnginePath :: [Char]
vaultToken :: ByteString
manager :: Manager
..} SecretPath{[Char]
path :: SecretPath -> [Char]
path :: [Char]
..} =
  [Char] -> IO Request
forall (m :: * -> *). MonadThrow m => [Char] -> m Request
parseRequest
    ([[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Char]
"DELETE ", VaultConnection -> [Char]
forall a. Show a => a -> [Char]
show VaultConnection
vc, [Char]
"/data/", [Char]
path])
  IO Request
-> (Request -> IO (Either [Char] Value))
-> IO (Either [Char] Value)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Manager -> Request -> IO (Either [Char] Value)
runRequest Manager
manager (Request -> IO (Either [Char] Value))
-> (Request -> Request) -> Request -> IO (Either [Char] 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 :: [[Char]]
-> VaultConnection -> SecretVersions -> IO (Either [Char] Value)
secretVersionsR [[Char]]
ss VaultConnection{[Char]
ByteString
Manager
vaultAddr :: VaultConnection -> [Char]
kvEnginePath :: VaultConnection -> [Char]
vaultToken :: VaultConnection -> ByteString
manager :: VaultConnection -> Manager
vaultAddr :: [Char]
kvEnginePath :: [Char]
vaultToken :: ByteString
manager :: Manager
..} SecretVersions
vs =
  [Char] -> IO Request
forall (m :: * -> *). MonadThrow m => [Char] -> m Request
parseRequest ([[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Char]]
ss) IO Request
-> (Request -> IO (Either [Char] Value))
-> IO (Either [Char] Value)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    Manager -> Request -> IO (Either [Char] Value)
runRequest Manager
manager
      (Request -> IO (Either [Char] Value))
-> (Request -> Request) -> Request -> IO (Either [Char] 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 [Char] Value)
destroySecretR vc :: VaultConnection
vc@VaultConnection{[Char]
ByteString
Manager
vaultAddr :: VaultConnection -> [Char]
kvEnginePath :: VaultConnection -> [Char]
vaultToken :: VaultConnection -> ByteString
manager :: VaultConnection -> Manager
vaultAddr :: [Char]
kvEnginePath :: [Char]
vaultToken :: ByteString
manager :: Manager
..} SecretPath{[Char]
path :: SecretPath -> [Char]
path :: [Char]
..} =
  [Char] -> IO Request
forall (m :: * -> *). MonadThrow m => [Char] -> m Request
parseRequest
    ([[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Char]
"DELETE ", VaultConnection -> [Char]
forall a. Show a => a -> [Char]
show VaultConnection
vc, [Char]
"/metadata/", [Char]
path])
  IO Request
-> (Request -> IO (Either [Char] Value))
-> IO (Either [Char] Value)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Manager -> Request -> IO (Either [Char] Value)
runRequest Manager
manager (Request -> IO (Either [Char] Value))
-> (Request -> Request) -> Request -> IO (Either [Char] 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 [Char] Value)
secretsListR vc :: VaultConnection
vc@VaultConnection{[Char]
ByteString
Manager
vaultAddr :: VaultConnection -> [Char]
kvEnginePath :: VaultConnection -> [Char]
vaultToken :: VaultConnection -> ByteString
manager :: VaultConnection -> Manager
vaultAddr :: [Char]
kvEnginePath :: [Char]
vaultToken :: ByteString
manager :: Manager
..} SecretPath{[Char]
path :: SecretPath -> [Char]
path :: [Char]
..} =
  if [Char] -> Bool
hasTrailingSlash [Char]
path
    then
      [Char] -> IO Request
forall (m :: * -> *). MonadThrow m => [Char] -> m Request
parseRequest
        ([[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Char]
"LIST ", VaultConnection -> [Char]
forall a. Show a => a -> [Char]
show VaultConnection
vc, [Char]
"/metadata/", [Char]
path])
      IO Request
-> (Request -> IO (Either [Char] Value))
-> IO (Either [Char] Value)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Manager -> Request -> IO (Either [Char] Value)
runRequest Manager
manager (Request -> IO (Either [Char] Value))
-> (Request -> Request) -> Request -> IO (Either [Char] Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RequestHeaders -> Request -> Request
setRequestHeaders (ByteString -> RequestHeaders
vaultHeaders ByteString
vaultToken)
    else Either [Char] Value -> IO (Either [Char] Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> Either [Char] Value
forall a b. a -> Either a b
Left [Char]
"SecretPath must be a folder/")

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