{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Funflow.Config where

import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.ByteString.UTF8 as BSU
import Data.HashSet (HashSet)
import qualified Data.HashSet as HashSet
import Data.Text (Text, unpack)
import Data.Yaml (FromJSON, Object, ParseException, decodeEither', decodeFileThrow, encode, prettyPrintParseException)
import System.Environment (lookupEnv)
import qualified Data.Aeson.KeyMap as Ae
import qualified Data.Aeson.Key as Ae

-- Re-using Data.Yaml types here since we are parsing config from
-- text anyways.
type ConfigKey = Text

-- Note: EnvConfigMap and ConfigMap have different types since
-- environment variables are expected to only contain a single
-- config value, while file config maps are expected to contain a tree
-- of values (since they are coming from a YAML file). Config coming from
-- a config file needs to get parsed using the default FromJSON parser when
-- initially being read in order to identify which config keys are defined in
-- the file and therefore is of type Object.

-- this has changed to be a KeyMap Value in the latest version of yaml
type ConfigMap = Object

type EnvConfigMap = Ae.KeyMap String

data ExternalConfig = ExternalConfig
  { ExternalConfig -> ConfigMap
fileConfig :: ConfigMap,
    ExternalConfig -> EnvConfigMap
envConfig :: EnvConfigMap
    -- Dorran: Disabling this for now until we implement CLI support
    -- cliConfig :: ConfigMap
  }
  deriving (Int -> ExternalConfig -> ShowS
[ExternalConfig] -> ShowS
ExternalConfig -> String
(Int -> ExternalConfig -> ShowS)
-> (ExternalConfig -> String)
-> ([ExternalConfig] -> ShowS)
-> Show ExternalConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExternalConfig] -> ShowS
$cshowList :: [ExternalConfig] -> ShowS
show :: ExternalConfig -> String
$cshow :: ExternalConfig -> String
showsPrec :: Int -> ExternalConfig -> ShowS
$cshowsPrec :: Int -> ExternalConfig -> ShowS
Show)

-- | A value which is intended to be populated using an external source (e.g. a config file)
data Configurable a where
  -- | Define a configurable which will be loaded from a config file using the given key
  ConfigFromFile :: FromJSON a => ConfigKey -> Configurable a
  -- | Define a configurable which will be loaded from the specified environment variable
  ConfigFromEnv :: FromJSON a => ConfigKey -> Configurable a
  -- Dorran: Disabling this for now until we implement CLI support
  -- -- | Define a configurable which will be loaded from the specified command line option
  -- ConfigFromCLI :: FromJSON a => ConfigKey -> Configurable a

  -- | A literal value which does not need to be loaded from an external config source
  Literal :: a -> Configurable a

-- Note: Errors should be raised in the interpreter, so all of this stuff just returns
-- the messages.

-- | Render a Configurable into a Literal value using a set of external configurations, returning
-- an error message if rendering failed.
render :: forall a. Configurable a -> ExternalConfig -> Either String (Configurable a)
render :: Configurable a -> ExternalConfig -> Either String (Configurable a)
render Configurable a
configVal ExternalConfig
extConfig = case Configurable a
configVal of
  ConfigFromFile ConfigKey
key -> ConfigKey
-> String -> Either String a -> Either String (Configurable a)
appendErrorContext ConfigKey
key String
"config file" (Either String a -> Either String (Configurable a))
-> Either String a -> Either String (Configurable a)
forall a b. (a -> b) -> a -> b
$ ConfigKey -> ConfigMap -> Either String a
FromJSON a => ConfigKey -> ConfigMap -> Either String a
valueFromObject ConfigKey
key (ConfigMap -> Either String a) -> ConfigMap -> Either String a
forall a b. (a -> b) -> a -> b
$ ExternalConfig -> ConfigMap
fileConfig ExternalConfig
extConfig
  ConfigFromEnv ConfigKey
key -> ConfigKey
-> String -> Either String a -> Either String (Configurable a)
appendErrorContext ConfigKey
key String
"environment variable" (Either String a -> Either String (Configurable a))
-> Either String a -> Either String (Configurable a)
forall a b. (a -> b) -> a -> b
$ ConfigKey -> EnvConfigMap -> Either String a
FromJSON a => ConfigKey -> EnvConfigMap -> Either String a
valueFromStrings ConfigKey
key (EnvConfigMap -> Either String a)
-> EnvConfigMap -> Either String a
forall a b. (a -> b) -> a -> b
$ ExternalConfig -> EnvConfigMap
envConfig ExternalConfig
extConfig
  -- ConfigFromCLI key -> appendErrorContext key "CLI args" $ valueFromObject key $ cliConfig extConfig
  Literal a
_ -> Configurable a -> Either String (Configurable a)
forall a b. b -> Either a b
Right Configurable a
configVal
  where
    valueFromStrings :: FromJSON a => Text -> EnvConfigMap -> Either String a
    valueFromStrings :: ConfigKey -> EnvConfigMap -> Either String a
valueFromStrings ConfigKey
k EnvConfigMap
env = case Key -> EnvConfigMap -> Maybe String
forall v. Key -> KeyMap v -> Maybe v
Ae.lookup (ConfigKey -> Key
Ae.fromText ConfigKey
k) EnvConfigMap
env of
      Maybe String
Nothing -> String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ String
"Failed to find key '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ConfigKey -> String
unpack ConfigKey
k String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' in provided config."
      Just String
v -> case (ByteString -> Either ParseException a
forall a. FromJSON a => ByteString -> Either ParseException a
decodeEither' (ByteString -> Either ParseException a)
-> ByteString -> Either ParseException a
forall a b. (a -> b) -> a -> b
$ String -> ByteString
BSU.fromString String
v) :: Either ParseException a of
        Left ParseException
parseException -> String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ ParseException -> String
prettyPrintParseException ParseException
parseException
        Right a
parseResult -> a -> Either String a
forall a b. b -> Either a b
Right a
parseResult

    valueFromObject :: FromJSON a => Text -> Object -> Either String a
    valueFromObject :: ConfigKey -> ConfigMap -> Either String a
valueFromObject ConfigKey
k ConfigMap
obj = case Key -> ConfigMap -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
Ae.lookup (ConfigKey -> Key
Ae.fromText ConfigKey
k) ConfigMap
obj of
      Maybe Value
Nothing -> String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ String
"Failed to find key '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ConfigKey -> String
unpack ConfigKey
k String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' in provided config."
      Just Value
v -> case (ByteString -> Either ParseException a
forall a. FromJSON a => ByteString -> Either ParseException a
decodeEither' (ByteString -> Either ParseException a)
-> ByteString -> Either ParseException a
forall a b. (a -> b) -> a -> b
$ Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
v) :: Either ParseException a of
        Left ParseException
parseException -> String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ ParseException -> String
prettyPrintParseException ParseException
parseException
        Right a
parseResult -> a -> Either String a
forall a b. b -> Either a b
Right a
parseResult

    appendErrorContext :: Text -> String -> Either String a -> Either String (Configurable a)
    appendErrorContext :: ConfigKey
-> String -> Either String a -> Either String (Configurable a)
appendErrorContext ConfigKey
configKey String
fromConfigName Either String a
parseResult = case Either String a
parseResult of
      Left String
err -> String -> Either String (Configurable a)
forall a b. a -> Either a b
Left (String -> Either String (Configurable a))
-> String -> Either String (Configurable a)
forall a b. (a -> b) -> a -> b
$ String
"Failed to extract configurable " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ConfigKey -> String
unpack ConfigKey
configKey String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" from " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fromConfigName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" with error: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err
      Right a
result -> Configurable a -> Either String (Configurable a)
forall a b. b -> Either a b
Right (Configurable a -> Either String (Configurable a))
-> Configurable a -> Either String (Configurable a)
forall a b. (a -> b) -> a -> b
$ a -> Configurable a
forall a. a -> Configurable a
Literal a
result

---------------------------------------------------------------------
-- Functions for gathering and filtering config keys
---------------------------------------------------------------------

-- | Gets the config key for a configurable value, if it exists.
getConfigKey :: Configurable a -> Maybe ConfigKey
getConfigKey :: Configurable a -> Maybe ConfigKey
getConfigKey Configurable a
conf = case Configurable a
conf of
  ConfigFromFile ConfigKey
k -> ConfigKey -> Maybe ConfigKey
forall a. a -> Maybe a
Just ConfigKey
k
  ConfigFromEnv ConfigKey
k -> ConfigKey -> Maybe ConfigKey
forall a. a -> Maybe a
Just ConfigKey
k
  -- ConfigFromCLI k -> Just k
  Literal a
_ -> Maybe ConfigKey
forall a. Maybe a
Nothing

-- | Stores ConfigKey values by their declared sources.
data ConfigKeysBySource = ConfigKeysBySource
  { ConfigKeysBySource -> HashSet ConfigKey
fileConfigKeys :: !(HashSet Text),
    ConfigKeysBySource -> HashSet ConfigKey
envConfigKeys :: !(HashSet Text)
    -- cliConfigKeys :: HashSet Text
  }
  deriving (Int -> ConfigKeysBySource -> ShowS
[ConfigKeysBySource] -> ShowS
ConfigKeysBySource -> String
(Int -> ConfigKeysBySource -> ShowS)
-> (ConfigKeysBySource -> String)
-> ([ConfigKeysBySource] -> ShowS)
-> Show ConfigKeysBySource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConfigKeysBySource] -> ShowS
$cshowList :: [ConfigKeysBySource] -> ShowS
show :: ConfigKeysBySource -> String
$cshow :: ConfigKeysBySource -> String
showsPrec :: Int -> ConfigKeysBySource -> ShowS
$cshowsPrec :: Int -> ConfigKeysBySource -> ShowS
Show)

-- Note: Making ConfigKeysBySource a Monoid to make them easier to combine
-- in Funflow.Run.

instance Semigroup ConfigKeysBySource where
  <> :: ConfigKeysBySource -> ConfigKeysBySource -> ConfigKeysBySource
(<>) ConfigKeysBySource
m1 ConfigKeysBySource
m2 =
    ConfigKeysBySource :: HashSet ConfigKey -> HashSet ConfigKey -> ConfigKeysBySource
ConfigKeysBySource
      { fileConfigKeys :: HashSet ConfigKey
fileConfigKeys = ConfigKeysBySource -> HashSet ConfigKey
fileConfigKeys ConfigKeysBySource
m1 HashSet ConfigKey -> HashSet ConfigKey -> HashSet ConfigKey
forall a. Semigroup a => a -> a -> a
<> ConfigKeysBySource -> HashSet ConfigKey
fileConfigKeys ConfigKeysBySource
m2,
        envConfigKeys :: HashSet ConfigKey
envConfigKeys = ConfigKeysBySource -> HashSet ConfigKey
envConfigKeys ConfigKeysBySource
m1 HashSet ConfigKey -> HashSet ConfigKey -> HashSet ConfigKey
forall a. Semigroup a => a -> a -> a
<> ConfigKeysBySource -> HashSet ConfigKey
envConfigKeys ConfigKeysBySource
m2
        -- cliConfigKeys = cliConfigKeys m1 <> cliConfigKeys m2
      }

instance Monoid ConfigKeysBySource where
  mempty :: ConfigKeysBySource
mempty =
    ConfigKeysBySource :: HashSet ConfigKey -> HashSet ConfigKey -> ConfigKeysBySource
ConfigKeysBySource
      { fileConfigKeys :: HashSet ConfigKey
fileConfigKeys = HashSet ConfigKey
forall a. HashSet a
HashSet.empty,
        envConfigKeys :: HashSet ConfigKey
envConfigKeys = HashSet ConfigKey
forall a. HashSet a
HashSet.empty
        -- cliConfigKeys = HashSet.empty
      }

-- | Get the key of a `Configurable` as a `ConfigKeysBySource`.
configKeyBySource :: Configurable a -> ConfigKeysBySource
configKeyBySource :: Configurable a -> ConfigKeysBySource
configKeyBySource Configurable a
conf = case Configurable a
conf of
  ConfigFromFile ConfigKey
k ->
    ConfigKeysBySource :: HashSet ConfigKey -> HashSet ConfigKey -> ConfigKeysBySource
ConfigKeysBySource
      { fileConfigKeys :: HashSet ConfigKey
fileConfigKeys = [ConfigKey] -> HashSet ConfigKey
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList [ConfigKey
k],
        envConfigKeys :: HashSet ConfigKey
envConfigKeys = HashSet ConfigKey
forall a. HashSet a
HashSet.empty
        -- cliConfigKeys = HashSet.empty
      }
  ConfigFromEnv ConfigKey
k ->
    ConfigKeysBySource :: HashSet ConfigKey -> HashSet ConfigKey -> ConfigKeysBySource
ConfigKeysBySource
      { fileConfigKeys :: HashSet ConfigKey
fileConfigKeys = HashSet ConfigKey
forall a. HashSet a
HashSet.empty,
        envConfigKeys :: HashSet ConfigKey
envConfigKeys = [ConfigKey] -> HashSet ConfigKey
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList [ConfigKey
k]
        -- cliConfigKeys = HashSet.empty
      }
  -- ConfigFromCLI k ->
  --   ConfigKeysBySource
  --     { fileConfigKeys = HashSet.empty,
  --       envConfigKeys = HashSet.empty,
  --       cliConfigKeys = HashSet.fromList [k]
  --     }
  Literal a
_ -> ConfigKeysBySource
forall a. Monoid a => a
mempty

-- | Get a list of any ConfigKeys which don't exist in their corresponding
-- field in the providedExternalConfig
missing :: ExternalConfig -> ConfigKeysBySource -> [ConfigKey]
missing :: ExternalConfig -> ConfigKeysBySource -> [ConfigKey]
missing ExternalConfig
conf ConfigKeysBySource
ids =
  let missingFileConfs :: [Key]
missingFileConfs = (Key -> Bool) -> [Key] -> [Key]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Key -> Bool) -> Key -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key -> ConfigMap -> Bool) -> ConfigMap -> Key -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Key -> ConfigMap -> Bool
forall a. Key -> KeyMap a -> Bool
Ae.member (ExternalConfig -> ConfigMap
fileConfig ExternalConfig
conf)) ([Key] -> [Key]) -> [Key] -> [Key]
forall a b. (a -> b) -> a -> b
$ ConfigKey -> Key
Ae.fromText (ConfigKey -> Key) -> [ConfigKey] -> [Key]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashSet ConfigKey -> [ConfigKey]
forall a. HashSet a -> [a]
HashSet.toList (ConfigKeysBySource -> HashSet ConfigKey
fileConfigKeys ConfigKeysBySource
ids)
      missingEnvConfs :: [Key]
missingEnvConfs = (Key -> Bool) -> [Key] -> [Key]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Key -> Bool) -> Key -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key -> EnvConfigMap -> Bool) -> EnvConfigMap -> Key -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Key -> EnvConfigMap -> Bool
forall a. Key -> KeyMap a -> Bool
Ae.member (ExternalConfig -> EnvConfigMap
envConfig ExternalConfig
conf)) ([Key] -> [Key]) -> [Key] -> [Key]
forall a b. (a -> b) -> a -> b
$ ConfigKey -> Key
Ae.fromText (ConfigKey -> Key) -> [ConfigKey] -> [Key]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashSet ConfigKey -> [ConfigKey]
forall a. HashSet a -> [a]
HashSet.toList (ConfigKeysBySource -> HashSet ConfigKey
envConfigKeys ConfigKeysBySource
ids)
   in -- missingCLIConfs = filter (not . (flip HashMap.member $ cliConfig conf)) $ HashSet.toList $ cliConfigKeys ids
      Key -> ConfigKey
Ae.toText (Key -> ConfigKey) -> [Key] -> [ConfigKey]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Key]
missingFileConfs [Key] -> [Key] -> [Key]
forall a. Semigroup a => a -> a -> a
<> [Key]
missingEnvConfs -- ++ missingCLIConfs

---------------------------------------------------------------------
-- IO actions which return configs
---------------------------------------------------------------------

-- | Construct an HashMap containing specified environment variable values.
readEnv :: MonadIO m => ConfigKey -> m (Ae.KeyMap String)
readEnv :: ConfigKey -> m EnvConfigMap
readEnv ConfigKey
key = do
  Maybe String
val <- IO (Maybe String) -> m (Maybe String)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String) -> m (Maybe String))
-> IO (Maybe String) -> m (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
lookupEnv (String -> IO (Maybe String)) -> String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ ConfigKey -> String
unpack ConfigKey
key
  case Maybe String
val of
    Maybe String
Nothing -> EnvConfigMap -> m EnvConfigMap
forall (f :: * -> *) a. Applicative f => a -> f a
pure EnvConfigMap
forall a. Monoid a => a
mempty
    Just String
v -> EnvConfigMap -> m EnvConfigMap
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EnvConfigMap -> m EnvConfigMap) -> EnvConfigMap -> m EnvConfigMap
forall a b. (a -> b) -> a -> b
$ Key -> String -> EnvConfigMap
forall v. Key -> v -> KeyMap v
Ae.singleton (ConfigKey -> Key
Ae.fromText ConfigKey
key) String
v

-- | Convenience function for calling readEnv on a list of ConfigKeys
readEnvs :: MonadIO m => [ConfigKey] -> m (Ae.KeyMap String)
readEnvs :: [ConfigKey] -> m EnvConfigMap
readEnvs [ConfigKey]
keys = do
  [EnvConfigMap]
envVars <- (ConfigKey -> m EnvConfigMap) -> [ConfigKey] -> m [EnvConfigMap]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ConfigKey -> m EnvConfigMap
forall (m :: * -> *). MonadIO m => ConfigKey -> m EnvConfigMap
readEnv [ConfigKey]
keys
  EnvConfigMap -> m EnvConfigMap
forall (m :: * -> *) a. Monad m => a -> m a
return (EnvConfigMap -> m EnvConfigMap) -> EnvConfigMap -> m EnvConfigMap
forall a b. (a -> b) -> a -> b
$ [EnvConfigMap] -> EnvConfigMap
forall a. Monoid a => [a] -> a
mconcat [EnvConfigMap]
envVars

-- | Construct a HashMap containing the content of a yaml file. Is just an Alias for `decodeFileThrow`.
readYamlFileConfig :: (MonadIO m, FromJSON a) => FilePath -> m a
readYamlFileConfig :: String -> m a
readYamlFileConfig = String -> m a
forall (m :: * -> *) a. (MonadIO m, FromJSON a) => String -> m a
decodeFileThrow