{-# 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 [Char] Value
esv Either SomeException (Response ByteString)
t =
    case Either SomeException (Response ByteString)
t of
      Right Response ByteString
b ->
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a -> a
M.fromMaybe Value
A.Null forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => ByteString -> Maybe a
A.decode forall a b. (a -> b) -> a -> b
$ forall body. Response body -> body
responseBody Response ByteString
b)
      Left  SomeException
e -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ 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 forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Key -> Traversal' t Value
key Key
"data" forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
_              -> forall a b. a -> Either a b
Left [Char]
"Unexpected JSON type"
    Maybe Value
Nothing             -> 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 forall s a. s -> Getting (First a) s a -> Maybe a
^? 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 forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty
            then [Char]
"Undetermined error"
            else
              forall a. [a] -> [[a]] -> [a]
L.intercalate
                [Char]
", "
                (Value -> [Char]
toString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Vector a -> [a]
V.toList Array
a) 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
_            = forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Expected JSON String"

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

unexpectedJSONType :: Either String b
unexpectedJSONType :: forall b. Either [Char] b
unexpectedJSONType = forall a b. a -> Either a b
Left [Char]
"Unexpected JSON type"

toInt :: Scientific -> Int
toInt :: Scientific -> Int
toInt = forall a. HasCallStack => Maybe a -> a
M.fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i. (Integral i, Bounded i) => Scientific -> Maybe i
toBoundedInteger

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

removeTrailingSlash :: String -> String
removeTrailingSlash :: [Char] -> [Char]
removeTrailingSlash [Char]
s =
  if [Char] -> Bool
hasTrailingSlash [Char]
s
    then forall a. NonEmpty a -> [a]
N.init (forall a. [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 = forall a. NonEmpty a -> a
N.head (forall a. [a] -> NonEmpty a
N.fromList [Char]
s) forall a. Eq a => a -> a -> Bool
== Char
'/'

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