{-# 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 -- ^ Vault token
  -> [(HeaderName, B.ByteString)]
vaultHeaders :: ByteString -> [(HeaderName, ByteString)]
vaultHeaders 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