conftrack-0.0.1: Tracable multi-source config management
Stabilityexperimental
Safe HaskellSafe-Inferred
LanguageGHC2021

Conftrack

Description

A typeclass-based library for reading in configuration values from multiple sources, attempting to be simple, avoid unecessarily complex types, and be able to track where each value came from.

Synopsis

How to use this library

This library models configuration files as a list of configuration Keys, for which values can be retrieved from generic sources, such as environment variables, a program's cli arguments, or a yaml (or json, etc.) file.

As a simple example, assume a program interacting with some API. We want it to read the API's base url (falling back to a default value if it is not given) and an API key (and error out if it is missing) from its config:

data ProgramConfig =
  { configBaseUrl :: URL
  , configApiKey  :: Text
  }

Then we can write an appropriate instance of Config for it:

instance Config ProgramConfig where
  readConfig = ProgramConfig
    <$> readValue "http://example.org" [key|baseUrl|]
    <*> readRequiredValue [key|apiKey|]

Config is an instance of Applicative. With the ApplicativeDo language extension enabled, the above can be equivalently written as:

instance Config ProgramConfig where
  readConfig = do
    configBaseUrl <- readValue "http://example.org" [key|baseUrl|]
    configApiKey <- readRequiredValue [key|apiKey|]
    pure (ProgramConfig {..})

Note that Config is not a Monad, so we cannot inspect the config values here, or make the reading of further keys depend on the value of earlier ones. This is to enable introspection-like uses as in configKeysOf.

To read our config we must provide a non-empty list of sources. Functions to construct these live in the Conftrack.Source.* modules; here we use mkYamlFileSource and mkEnvSource (from Conftrac.Source.Yaml and Conftrack.Source.Env respectively) to read values from either a yaml file or environment variables:

main = do
  result <- runFetchConfig
               [ mkEnvSource "CONFTRACK"
               , mkYamlFileSource [path|./config.yaml|]
               ]
  case result of
    Left _ -> ..
    Right (config, origins, warnings) -> ..

Now we can read in a config file like

baseUrl: http://localhost/api/v1
apiKey: very-very-secret

or from environment variables

CONFTRACK_BASEURL=http://localhost/api/v1
CONFTRACK_APIKEY=very-very-secret

Of course, sources can be mixed: Perhaps we do not want to have our program's api key inside the configuration file. Then we can simply omit it there and provide it via the CONFTRACK_APIKEY environment variable instead.

Multiple sources

The order of sources given to runFetchConfig matters: values given in earlier sources shadow values of the same key in all following sources.

Thus even if we have

apiKey: will-not-be-used

in our config.yaml file, it will be ignored if the CONFTRACK_APIKEY environment variable also has a value.

Keeping track of things

Conftrack is written to always keep track of the configuration values it reads. In particular, it is intended to avoid frustrating questions of the kind "I have clearly set this config key in the file, why does my software not use it?".

This is reflected in runFetchConfig's return type: if it does not produce an error, it will not only return a set of config values, but also a map of Origins and a list of Warnings indicating likely misconfiguration:

main = do
  result <- runFetchConfig
               [ mkEnvSource "CONFTRACK"
               , mkYamlFileSource [path|./config.yaml|]
               ]
  case result of
    Left _ -> ..
    Right (config, origins, warnings) -> do
      printConfigOrigins origins
      ...

May print something like this:

Environment variable CONFTRACK_APIKEY
  apiKey = "very-very-secret"
YAML file ./config.yaml
  baseUrl = "http://localhost/api/v1"

It is recommended that programs making use of conftrack include a --show-config option (or a similar method of introspection) to help in debugging such cases.

Defining a configuration format

class Config a where Source #

A class to model configurations. See Conftrack's documention for a usage example

Methods

readConfig :: Fetch a Source #

readValue :: forall a. ConfigValue a => a -> Key -> Fetch a Source #

read in a config value, or give the given default value if it is not present.

readOptionalValue :: forall a. ConfigValue a => Key -> Fetch (Maybe a) Source #

read an optional config value, resulting in a Just if it is present and a Nothing if it is not.

This is distinct from using readValue to produce a value of type Maybe a: the latter will require the key to be present, but allow it to be null or similarly empty.

readRequiredValue :: ConfigValue a => Key -> Fetch a Source #

read in a config value, and produce an error if it is not present.

readNested :: forall a. Config a => Key -> Fetch a Source #

read a nested set of configuration values, prefixed by a given key. This corresponds to nested objects in json.

readNestedOptional :: forall a. (Show a, Config a) => Key -> Fetch (Maybe a) Source #

same as readNested, but produce Nothing if the nested keys are not present. This can be used for optionally configurable sub-systems or similar constructs.

If only some but not all keys of the nested configuration are given, this will produce an error.

Defining sources

data SomeSource Source #

An opaque type for any kind of config sources. Values of this type can be acquired from they Conftrack.Source.* modules, or by implementing the ConfigSource type class.

Reading a config

data Fetch a Source #

A value of type Fetch a can be used to read in a value a, with configuration sources handled implicitly.

Note that this is an instance of Applicative but not Monad. In practical terms this means that values read from the configuration sources cannot be inspected while reading the rest of the config, and in particular which keys are read cannot depend on another key's value. This allows for introspection functions like configKeysOf.

For configuration keys whose presence depends on each other, use readNestedOptional to model similar behaviour.

Instances

Instances details
Applicative Fetch Source # 
Instance details

Defined in Conftrack

Methods

pure :: a -> Fetch a #

(<*>) :: Fetch (a -> b) -> Fetch a -> Fetch b #

liftA2 :: (a -> b -> c) -> Fetch a -> Fetch b -> Fetch c #

(*>) :: Fetch a -> Fetch b -> Fetch b #

(<*) :: Fetch a -> Fetch b -> Fetch a #

Functor Fetch Source # 
Instance details

Defined in Conftrack

Methods

fmap :: (a -> b) -> Fetch a -> Fetch b #

(<$) :: a -> Fetch b -> Fetch a #

Parsing config values

data Value Source #

A generic value read from a config source, to be parsed into a more useful type (see the ConfigValue class).

Constructors

ConfigString ByteString 
ConfigInteger Integer 
ConfigMaybeInteger ByteString Integer

A value which may be an integer, but the source cannot say for sure, e.g. because its values are entirely untyped. Use withString to handle such cases.

ConfigOther Text Text 
ConfigBool Bool 
ConfigNull 

Instances

Instances details
Show Value Source # 
Instance details

Defined in Conftrack.Value

Methods

showsPrec :: Int -> Value -> ShowS #

show :: Value -> String #

showList :: [Value] -> ShowS #

class ConfigValue a where Source #

Values which can be read from a config source must implement this class

Minimal complete definition

fromConfig

Methods

fromConfig :: Value -> Either ConfigError a Source #

prettyValue :: a -> Text Source #

optionally, a function to pretty-print values of this type, used by the functions of Conftrack.Pretty. If not given, defaults to a's Show instance.

default prettyValue :: Show a => a -> Text Source #

Basic types

newtype Key Source #

A configuration key is a non-empty list of parts. By convention, these parts are separated by dots when written, although dots withing parts are not disallowed.

For writing values easily, consider enabling the QuasiQuotes language extension to use key:

>>> [key|foo.bar|]
foo.bar

Constructors

Key (NonEmpty KeyPart) 

Instances

Instances details
Show Key Source # 
Instance details

Defined in Conftrack.Value

Methods

showsPrec :: Int -> Key -> ShowS #

show :: Key -> String #

showList :: [Key] -> ShowS #

Eq Key Source # 
Instance details

Defined in Conftrack.Value

Methods

(==) :: Key -> Key -> Bool #

(/=) :: Key -> Key -> Bool #

Ord Key Source # 
Instance details

Defined in Conftrack.Value

Methods

compare :: Key -> Key -> Ordering #

(<) :: Key -> Key -> Bool #

(<=) :: Key -> Key -> Bool #

(>) :: Key -> Key -> Bool #

(>=) :: Key -> Key -> Bool #

max :: Key -> Key -> Key #

min :: Key -> Key -> Key #

Lift Key Source # 
Instance details

Defined in Conftrack.Value

Methods

lift :: Quote m => Key -> m Exp #

liftTyped :: forall (m :: Type -> Type). Quote m => Key -> Code m Key #

newtype Warning Source #

Constructors

Warning Text 

Instances

Instances details
Show Warning Source # 
Instance details

Defined in Conftrack

data ConfigError Source #

Instances

Instances details
Show ConfigError Source # 
Instance details

Defined in Conftrack.Value

Utilities

configKeysOf :: forall a. Config a => IO [Key] Source #

a list of all keys which will be read when running runFetchConfig to produce a value of type a.

This runs inside the IO monad, but does not do any actual IO.

key :: QuasiQuoter Source #

to write values of Key easily