{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

module Ecluse.Config.Parser (
    rejectSecretKeys,
    parseRegistryUrl,
    parseEnum,
    valueKind,
    rejectUnknownKeys,
    parseUrl,
) where

import Data.Aeson (Value (..))
import Data.Aeson.Key qualified as Key
import Data.Aeson.KeyMap qualified as KeyMap
import Data.Aeson.Types (Parser, withText)
import Data.Text qualified as T

import Ecluse.Config.Types (Url, mkUrl)
import Ecluse.Core.Security.Egress (RegistryUrl, mkRegistryUrl)

rejectSecretKeys :: KeyMap.KeyMap Value -> Parser ()
rejectSecretKeys :: KeyMap Value -> Parser ()
rejectSecretKeys KeyMap Value
o =
    case (Key -> Bool) -> [Key] -> [Key]
forall a. (a -> Bool) -> [a] -> [a]
filter (Key -> KeyMap Value -> Bool
forall a. Key -> KeyMap a -> Bool
`KeyMap.member` KeyMap Value
o) [Key]
secretKeys of
        [] -> () -> Parser ()
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        [Key]
present ->
            String -> Parser ()
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
                ( String
"secret key(s) are not allowed in the config document (use environment variables): "
                    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((Key -> String) -> [Key] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> String
forall b a. (Show a, IsString b) => a -> b
show (Text -> String) -> (Key -> Text) -> Key -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Text
Key.toText) [Key]
present)
                )
  where
    secretKeys :: [Key.Key]
    secretKeys :: [Key]
secretKeys = [Key
"token", Key
"authToken", Key
"password", Key
"secret", Key
"credentialToken"]

parseRegistryUrl :: Value -> Parser RegistryUrl
parseRegistryUrl :: Value -> Parser RegistryUrl
parseRegistryUrl = \case
    String Text
t -> (Text -> Parser RegistryUrl)
-> (RegistryUrl -> Parser RegistryUrl)
-> Either Text RegistryUrl
-> Parser RegistryUrl
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Parser RegistryUrl
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser RegistryUrl)
-> (Text -> String) -> Text -> Parser RegistryUrl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) RegistryUrl -> Parser RegistryUrl
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Either Text RegistryUrl
mkRegistryUrl Text
t)
    Value
other -> String -> Parser RegistryUrl
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"parseRegistryUrl expected a string, but encountered a " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Value -> String
valueKind Value
other)

parseEnum :: (Text -> Either Text a) -> String -> Value -> Parser a
parseEnum :: forall a. (Text -> Either Text a) -> String -> Value -> Parser a
parseEnum Text -> Either Text a
parser String
field = \case
    String Text
t -> (Text -> Parser a) -> (a -> Parser a) -> Either Text a -> Parser a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\Text
e -> String -> Parser a
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
field String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
e)) a -> Parser a
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Either Text a
parser Text
t)
    Value
other -> String -> Parser a
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
field String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" expected a string, but encountered a " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Value -> String
valueKind Value
other)

valueKind :: Value -> String
valueKind :: Value -> String
valueKind = \case
    Object{} -> String
"an object"
    Array{} -> String
"an array"
    Number{} -> String
"a number"
    Bool{} -> String
"a boolean"
    Value
Null -> String
"null"
    String{} -> String
"a string"

rejectUnknownKeys :: String -> [Key.Key] -> KeyMap.KeyMap Value -> Parser ()
rejectUnknownKeys :: String -> [Key] -> KeyMap Value -> Parser ()
rejectUnknownKeys String
context [Key]
accepted KeyMap Value
o =
    let isUnknown :: Key -> Bool
isUnknown Key
k = Key
k Key -> [Key] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`notElem` [Key]
accepted Bool -> Bool -> Bool
&& Bool -> Bool
not (Text
"aws" Text -> Text -> Bool
`T.isPrefixOf` Key -> Text
Key.toText Key
k)
     in case (Key -> Bool) -> [Key] -> [Key]
forall a. (a -> Bool) -> [a] -> [a]
filter Key -> Bool
isUnknown (KeyMap Value -> [Key]
forall v. KeyMap v -> [Key]
KeyMap.keys KeyMap Value
o) of
            [] -> () -> Parser ()
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            [Key]
unknown ->
                String -> Parser ()
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
                    ( String
"unexpected "
                        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
context
                        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" key(s): "
                        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((Key -> String) -> [Key] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> String
forall b a. (Show a, IsString b) => a -> b
show (Text -> String) -> (Key -> Text) -> Key -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Text
Key.toText) [Key]
unknown)
                    )

parseUrl :: Value -> Parser Url
parseUrl :: Value -> Parser Url
parseUrl = String -> (Text -> Parser Url) -> Value -> Parser Url
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Url" ((Text -> Parser Url) -> Value -> Parser Url)
-> (Text -> Parser Url) -> Value -> Parser Url
forall a b. (a -> b) -> a -> b
$ \Text
t ->
    case Text -> Either Text Url
mkUrl Text
t of
        Right Url
u -> Url -> Parser Url
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Url
u
        Left Text
e -> String -> Parser Url
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (Text -> String
T.unpack Text
e)