{-# LANGUAGE OverloadedStrings #-}
-- {-# LANGUAGE ExplicitForAll    #-}
-- {-# LANGUAGE RankNTypes #-}

module Database.Vault.KVv2.Client.Lens (

    current,
    list,
    metadata,
    maybeError,
    secret,
    version

  ) where

import           Control.Lens
import qualified Data.Aeson                          as A
import           Data.Aeson.Lens
import qualified Data.Text                           as T
import qualified Data.Vector                         as V

import           Database.Vault.KVv2.Client.Internal
import           Database.Vault.KVv2.Client.Types

secret
  :: A.Value
  -> Either String SecretData
secret :: Value -> Either Error SecretData
secret =
  Text
-> (Value -> Either Error SecretData)
-> Value
-> Either Error SecretData
forall a.
Text -> (Value -> Either Error a) -> Value -> Either Error a
fromVaultResponse Text
"data" Value -> Either Error SecretData
forall {b}. FromJSON b => Value -> Either Error b
toSecretData
  where
  toSecretData :: Value -> Either Error b
toSecretData o :: Value
o@(A.Object Object
_) =
    case Value -> Result b
forall a. FromJSON a => Value -> Result a
A.fromJSON Value
o of
      A.Success b
sd -> b -> Either Error b
forall a b. b -> Either a b
Right b
sd
      A.Error Error
e    -> Error -> Either Error b
forall a b. a -> Either a b
Left Error
e
  toSecretData Value
A.Null         = Error -> Either Error b
forall a b. a -> Either a b
Left Error
"No current secret version"
  toSecretData Value
_              = Error -> Either Error b
forall a b. a -> Either a b
Left Error
"Expected JSON object"

version
  :: A.Value
  -> Either String SecretVersion
version :: Value -> Either Error SecretVersion
version =
  Text
-> (Value -> Either Error SecretVersion)
-> Value
-> Either Error SecretVersion
forall a.
Text -> (Value -> Either Error a) -> Value -> Either Error a
fromVaultResponse Text
"version" Value -> Either Error SecretVersion
forall {a}. IsString a => Value -> Either a SecretVersion
toSecretVersion
  where
  toSecretVersion :: Value -> Either a SecretVersion
toSecretVersion (A.Number Scientific
n) = SecretVersion -> Either a SecretVersion
forall a b. b -> Either a b
Right (Int -> SecretVersion
SecretVersion (Int -> SecretVersion) -> Int -> SecretVersion
forall a b. (a -> b) -> a -> b
$ Scientific -> Int
toInt Scientific
n)
  toSecretVersion Value
_            = a -> Either a SecretVersion
forall a b. a -> Either a b
Left a
"Expected JSON number"

current
  :: A.Value
  -> Either String SecretVersion
current :: Value -> Either Error SecretVersion
current =
  Text
-> (Value -> Either Error SecretVersion)
-> Value
-> Either Error SecretVersion
forall a.
Text -> (Value -> Either Error a) -> Value -> Either Error a
fromVaultResponse Text
"current_version" Value -> Either Error SecretVersion
forall {a}. IsString a => Value -> Either a SecretVersion
toSecretVersion
  where
  toSecretVersion :: Value -> Either a SecretVersion
toSecretVersion (A.Number Scientific
n) = SecretVersion -> Either a SecretVersion
forall a b. b -> Either a b
Right (Int -> SecretVersion
SecretVersion (Int -> SecretVersion) -> Int -> SecretVersion
forall a b. (a -> b) -> a -> b
$ Scientific -> Int
toInt Scientific
n)
  toSecretVersion Value
_            = a -> Either a SecretVersion
forall a b. a -> Either a b
Left a
"Expected JSON number"

metadata
  :: A.Value
  -> Either String SecretMetadata
metadata :: Value -> Either Error SecretMetadata
metadata =
  Text
-> (Value -> Either Error SecretMetadata)
-> Value
-> Either Error SecretMetadata
forall a.
Text -> (Value -> Either Error a) -> Value -> Either Error a
fromVaultResponse Text
"versions" Value -> Either Error SecretMetadata
forall {b}. FromJSON b => Value -> Either Error b
toSecretMetadata
  where
  toSecretMetadata :: Value -> Either Error b
toSecretMetadata o :: Value
o@(A.Object Object
_) =
    case Value -> Result b
forall a. FromJSON a => Value -> Result a
A.fromJSON Value
o of
      A.Success b
vs -> b -> Either Error b
forall a b. b -> Either a b
Right b
vs
      A.Error Error
e    -> Error -> Either Error b
forall a b. a -> Either a b
Left Error
e
  toSecretMetadata Value
_              = Error -> Either Error b
forall a. HasCallStack => Error -> a
error Error
"Expected JSON object"

list
  :: A.Value
  -> Either String [VaultKey]
list :: Value -> Either Error [VaultKey]
list =
  Text
-> (Value -> Either Error [VaultKey])
-> Value
-> Either Error [VaultKey]
forall a.
Text -> (Value -> Either Error a) -> Value -> Either Error a
fromVaultResponse Text
"keys" Value -> Either Error [VaultKey]
forall {a}. Value -> Either a [VaultKey]
toListKeys
  where
    toListKeys :: Value -> Either a [VaultKey]
toListKeys (A.Array Array
a) =
      [VaultKey] -> Either a [VaultKey]
forall a b. b -> Either a b
Right (([VaultKey] -> Value -> [VaultKey])
-> [VaultKey] -> Array -> [VaultKey]
forall a b. (a -> b -> a) -> a -> Vector b -> a
V.foldl [VaultKey] -> Value -> [VaultKey]
lks [VaultKey]
forall a. Monoid a => a
mempty Array
a)
      where
        lks :: [VaultKey] -> Value -> [VaultKey]
lks [VaultKey]
ks (A.String Text
t) =
          let s :: Error
s = Text -> Error
T.unpack Text
t in
          (if Error -> Bool
hasTrailingSlash Error
s
             then Error -> VaultKey
VaultFolder Error
s
             else Error -> VaultKey
VaultKey Error
s) VaultKey -> [VaultKey] -> [VaultKey]
forall a. a -> [a] -> [a]
: [VaultKey]
ks
        lks [VaultKey]
p       Value
_       = [VaultKey]
p
    toListKeys Value
_            = Error -> Either a [VaultKey]
forall a. HasCallStack => Error -> a
error Error
"Expected JSON array"

maybeError
  :: Either String A.Value
  -> Maybe Error
maybeError :: Either Error Value -> Maybe Error
maybeError (Left Error
s)  = Error -> Maybe Error
forall a. a -> Maybe a
Just Error
s
maybeError (Right 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 Key
"version" of
    Just Value
A.Null -> Maybe Error
forall a. Maybe a
Nothing
    Just Value
_      -> Error -> Maybe Error
forall a. a -> Maybe a
Just Error
"Unexpected JSON type"
    Maybe Value
Nothing     -> Error -> Maybe Error
forall a. a -> Maybe a
Just (Value -> Error
jsonErrors Value
v)