{-# LANGUAGE OverloadedStrings #-}

module Database.Vault.KVv2.Client.Internal where

import           Control.Lens
import           Control.Monad.Catch
import qualified Data.Aeson                as A
import           Data.Aeson.Key            (fromText)
import           Data.Aeson.Lens
import qualified Data.ByteString           as B
import           Data.List                 as L
import           Data.List.NonEmpty        as N
import qualified Data.Maybe                as M
import           Data.Scientific
import           Data.Text                 as T
import qualified Data.Vector               as V
import           Network.HTTP.Client
import           Network.HTTP.Types.Header

runRequest
  :: Manager
  -> Request
  -> IO (Either String A.Value)
runRequest :: Manager -> Request -> IO (Either [Char] Value)
runRequest Manager
m Request
r =
  Either SomeException (Response ByteString) -> Either [Char] Value
esv (Either SomeException (Response ByteString) -> Either [Char] Value)
-> IO (Either SomeException (Response ByteString))
-> IO (Either [Char] 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.
(HasCallStack, 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 [Char] Value
esv Either SomeException (Response ByteString)
t =
    case Either SomeException (Response ByteString)
t of
      Right Response ByteString
b ->
        Value -> Either [Char] Value
forall a. a -> Either [Char] a
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 -> [Char] -> Either [Char] Value
forall a b. a -> Either a b
Left ([Char] -> Either [Char] Value) -> [Char] -> Either [Char] Value
forall a b. (a -> b) -> a -> b
$ SomeException -> [Char]
forall a. Show a => a -> [Char]
show (SomeException
e::SomeException)

fromVaultResponse
  :: T.Text
  -> (A.Value -> Either String a)
  -> A.Value
  -> Either String a
fromVaultResponse :: forall a.
Text -> (Value -> Either [Char] a) -> Value -> Either [Char] a
fromVaultResponse Text
k Value -> Either [Char] 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
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"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
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key (Text -> Key
fromText Text
k) of
    Just o :: Value
o@(A.Object Object
_) -> Value -> Either [Char] a
f Value
o
    Just n :: Value
n@(A.Number Scientific
_) -> Value -> Either [Char] a
f Value
n
    Just a :: Value
a@(A.Array  Array
_) -> Value -> Either [Char] a
f Value
a
    Just Value
_              -> [Char] -> Either [Char] a
forall a b. a -> Either a b
Left [Char]
"Unexpected JSON type"
    Maybe Value
Nothing             -> [Char] -> Either [Char] a
forall a b. a -> Either a b
Left (Value -> [Char]
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 :: [Char] -> [Char]
toJSONName [Char]
"secret_data"     = [Char]
"data"
toJSONName [Char]
"secret_metadata" = [Char]
"metadata"
toJSONName [Char]
"response_data"   = [Char]
"data"
toJSONName [Char]
s                 = [Char]
s

jsonErrors :: A.Value -> String
jsonErrors :: Value -> [Char]
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
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"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 [Char]
"Undetermined error"
            else
              [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
L.intercalate
                [Char]
", "
                (Value -> [Char]
toString (Value -> [Char]) -> [Value] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
a) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"."
        Value
_anyOther -> [Char]
"Expected JSON array"
    Maybe Value
Nothing -> [Char] -> [Char]
expectedJSONField [Char]
"errors"

toString :: A.Value -> String
toString :: Value -> [Char]
toString (A.String Text
s) = Text -> [Char]
T.unpack Text
s
toString Value
_            = [Char] -> [Char]
forall a. [Char] -> [a]
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Expected JSON String"

expectedJSONField :: String -> String
expectedJSONField :: [Char] -> [Char]
expectedJSONField = [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
(++) [Char]
"Expected JSON field not found: "

unexpectedJSONType :: Either String b
unexpectedJSONType :: forall b. Either [Char] b
unexpectedJSONType = [Char] -> Either [Char] b
forall a b. a -> Either a b
Left [Char]
"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 :: [Char] -> Bool
hasTrailingSlash [Char]
s = NonEmpty Char -> Char
forall a. NonEmpty a -> a
N.last ([Char] -> NonEmpty Char
forall a. HasCallStack => [a] -> NonEmpty a
N.fromList [Char]
s) Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/'

removeTrailingSlash :: String -> String
removeTrailingSlash :: [Char] -> [Char]
removeTrailingSlash [Char]
s =
  if [Char] -> Bool
hasTrailingSlash [Char]
s
    then NonEmpty Char -> [Char]
forall a. NonEmpty a -> [a]
N.init ([Char] -> NonEmpty Char
forall a. HasCallStack => [a] -> NonEmpty a
N.fromList [Char]
s)
    else [Char]
s

hasLeadingSlash :: String -> Bool
-- hasLeadingSlash s = N.head (N.fromList s) == '/'
hasLeadingSlash :: [Char] -> Bool
hasLeadingSlash [Char]
s = NonEmpty Char -> Char
forall a. NonEmpty a -> a
N.head ([Char] -> NonEmpty Char
forall a. HasCallStack => [a] -> NonEmpty a
N.fromList [Char]
s) Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/'

removeLeadingSlash :: String -> String
removeLeadingSlash :: [Char] -> [Char]
removeLeadingSlash [Char]
s =
  if [Char] -> Bool
hasLeadingSlash [Char]
s
    then NonEmpty Char -> [Char]
forall a. NonEmpty a -> [a]
N.tail ([Char] -> NonEmpty Char
forall a. HasCallStack => [a] -> NonEmpty a
N.fromList [Char]
s)
    else [Char]
s