{-# LANGUAGE OverloadedStrings #-}
module Database.Vault.KVv2.Client.Internal where
import Control.Lens
import Control.Monad.Catch
import qualified Data.ByteString as B
import qualified Data.Aeson as A
import Data.Aeson.Lens
import qualified Data.Maybe as M
import Data.Scientific
import Data.List as L
import Data.Text as T
import Network.HTTP.Client
import Network.HTTP.Types.Header
import qualified Data.Vector as V
runRequest
:: Manager
-> Request
-> IO (Either String A.Value)
runRequest :: Manager -> Request -> IO (Either String Value)
runRequest Manager
m Request
r =
Either SomeException (Response ByteString) -> Either String Value
esv (Either SomeException (Response ByteString) -> Either String Value)
-> IO (Either SomeException (Response ByteString))
-> IO (Either String Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Response ByteString)
-> IO (Either SomeException (Response ByteString))
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (Request -> Manager -> IO (Response ByteString)
httpLbs Request
r Manager
m)
where
esv :: Either SomeException (Response ByteString) -> Either String Value
esv Either SomeException (Response ByteString)
t =
case Either SomeException (Response ByteString)
t of
Right Response ByteString
b ->
Value -> Either String Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
M.fromMaybe Value
A.Null (Maybe Value -> Value) -> Maybe Value -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe Value
forall a. FromJSON a => ByteString -> Maybe a
A.decode (ByteString -> Maybe Value) -> ByteString -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
b)
Left SomeException
e -> String -> Either String Value
forall a b. a -> Either a b
Left (String -> Either String Value) -> String -> Either String Value
forall a b. (a -> b) -> a -> b
$ SomeException -> String
forall a. Show a => a -> String
show (SomeException
e::SomeException)
fromVaultResponse
:: T.Text
-> (A.Value -> Either String a)
-> A.Value
-> Either String a
fromVaultResponse :: Text -> (Value -> Either String a) -> Value -> Either String a
fromVaultResponse Text
k Value -> Either String a
f Value
v =
case Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"data" Getting (First Value) Value Value
-> Getting (First Value) Value Value
-> Getting (First Value) Value Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
k of
Just o :: Value
o@(A.Object Object
_) -> Value -> Either String a
f Value
o
Just n :: Value
n@(A.Number Scientific
_) -> Value -> Either String a
f Value
n
Just a :: Value
a@(A.Array Array
_) -> Value -> Either String a
f Value
a
Just Value
_ -> String -> Either String a
forall a b. a -> Either a b
Left String
"Unexpected JSON type"
Maybe Value
Nothing -> String -> Either String a
forall a b. a -> Either a b
Left (Value -> String
jsonErrors Value
v)
vaultHeaders
:: B.ByteString
-> [(HeaderName, B.ByteString)]
ByteString
vt =
[ (HeaderName
"Content-Type", ByteString
"application/json; charset=utf-8")
, (HeaderName
"X-Vault-Token", ByteString
vt)
]
toJSONName :: String -> String
toJSONName :: String -> String
toJSONName String
"secret_data" = String
"data"
toJSONName String
"secret_metadata" = String
"metadata"
toJSONName String
"response_data" = String
"data"
toJSONName String
s = String
s
jsonErrors :: A.Value -> String
jsonErrors :: Value -> String
jsonErrors Value
v =
case Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"errors" of
Just Value
ja ->
case Value
ja of
A.Array Array
a ->
if Array
a Array -> Array -> Bool
forall a. Eq a => a -> a -> Bool
== Array
forall a. Monoid a => a
mempty
then String
"Undetermined error"
else
String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate
String
", "
(Value -> String
toString (Value -> String) -> [Value] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
a) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
Value
_ -> String
"Unexpected JSON type"
Maybe Value
Nothing -> String -> String
expectedJSONField String
"errors"
toString :: A.Value -> String
toString :: Value -> String
toString (A.String Text
s) = Text -> String
T.unpack Text
s
toString Value
_ = String -> String
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expecting JSON type String only"
expectedJSONField :: String -> String
expectedJSONField :: String -> String
expectedJSONField String
f = String
"Expected JSON field not found: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
f
unexpectedJSONType :: Either String b
unexpectedJSONType :: Either String b
unexpectedJSONType = String -> Either String b
forall a b. a -> Either a b
Left String
"Unexpected JSON type"
toInt :: Scientific -> Int
toInt :: Scientific -> Int
toInt = Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
M.fromJust (Maybe Int -> Int)
-> (Scientific -> Maybe Int) -> Scientific -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Maybe Int
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
toBoundedInteger
hasTrailingSlash :: String -> Bool
hasTrailingSlash :: String -> Bool
hasTrailingSlash String
s = String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
forall a. Monoid a => a
mempty Bool -> Bool -> Bool
&& String -> Char
forall a. [a] -> a
L.last String
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/'
removeTrailingSlash :: String -> String
removeTrailingSlash :: String -> String
removeTrailingSlash String
s =
if String -> Bool
hasTrailingSlash String
s
then String -> String
forall a. [a] -> [a]
L.init String
s
else String
s
hasLeadingSlash :: String -> Bool
hasLeadingSlash :: String -> Bool
hasLeadingSlash String
s = String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
forall a. Monoid a => a
mempty Bool -> Bool -> Bool
&& String -> Char
forall a. [a] -> a
L.head String
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/'
removeLeadingSlash :: String -> String
removeLeadingSlash :: String -> String
removeLeadingSlash String
s =
if String -> Bool
hasLeadingSlash String
s
then String -> String
forall a. [a] -> [a]
L.tail String
s
else String
s