diff options
| -rw-r--r-- | src/Conftrack.hs | 172 | ||||
| -rw-r--r-- | src/Conftrack/Source.hs | 16 | ||||
| -rw-r--r-- | src/Conftrack/Source/Aeson.hs | 7 | ||||
| -rw-r--r-- | src/Conftrack/Source/Trivial.hs | 1 | ||||
| -rw-r--r-- | src/Conftrack/Source/Yaml.hs | 1 | ||||
| -rw-r--r-- | src/Conftrack/Value.hs | 18 |
6 files changed, 205 insertions, 10 deletions
diff --git a/src/Conftrack.hs b/src/Conftrack.hs index e1652b1..4e1f17a 100644 --- a/src/Conftrack.hs +++ b/src/Conftrack.hs @@ -9,19 +9,39 @@ {-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} +{-| +Module: Conftrack +Stability: experimental + +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. + +-} module Conftrack - ( Config(..) - , Warning(..) - , runFetchConfig + ( -- * How to use this library + -- $use + + -- * Defining a configuration format + Config(..) , readValue , readOptionalValue , readRequiredValue , readNested , readNestedOptional + -- * Defining sources , SomeSource - , ConfigError(..) - , Key(..) + -- * Reading a config + , runFetchConfig + , Fetch + -- * Parsing config values , Value(..) + , ConfigValue(..) + -- * Basic types + , Key(..) + , Warning(..) + , ConfigError(..) + -- * Utilities , configKeysOf , key ) where @@ -43,6 +63,7 @@ import Data.Map (Map) import qualified Data.Map.Strict as M +-- | A class to model configurations. See "Conftrack"'s documention for a usage example class Config a where readConfig :: Fetch a @@ -54,6 +75,16 @@ data FetcherState = FetcherState , fetcherErrors :: [ConfigError] } +-- | 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 +-- 'Conftrack.readNestedOptional' to model similar behaviour. newtype Fetch a = Fetch (FetcherState -> IO (a, FetcherState)) deriving (Functor) @@ -84,6 +115,10 @@ runFetchConfig sources = do then pure $ Right (result, origins, unusedWarnings <> warnings) else pure $ Left errors +-- | 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. configKeysOf :: forall a. Config a => IO [Key] configKeysOf = do let (Fetch m) = readConfig @a @@ -92,8 +127,12 @@ configKeysOf = do let keys = mapMaybe (\case {(NotPresent k) -> Just k; _ -> Nothing }) errors pure keys - - +-- | 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. readOptionalValue :: forall a. ConfigValue a => Key -> Fetch (Maybe a) readOptionalValue bareKey = Fetch $ \s1@FetcherState{..} -> do @@ -114,7 +153,7 @@ readOptionalValue bareKey = Fetch $ \s1@FetcherState{..} -> do pure (fst val, s1 { fetcherSources = sources , fetcherOrigins = M.insertWith (<>) k (snd val) fetcherOrigins }) - +-- | read in a config value, and produce an error if it is not present. readRequiredValue :: ConfigValue a => Key -> Fetch a readRequiredValue k = let @@ -128,6 +167,7 @@ readRequiredValue k = pure (dummy, s { fetcherErrors = NotPresent (k `prefixedWith` fetcherPrefix s) : fetcherErrors s }) Just v -> pure (v, s))) +-- | read in a config value, or give the given default value if it is not present. readValue :: forall a. ConfigValue a => a -> Key -> Fetch a readValue defaultValue k = let @@ -156,12 +196,19 @@ firstMatchInSources k (SomeSource (source, sourceState):sources) = do Right _ -> pure $ (eitherValue, SomeSource (source, newState)) : fmap (Left Shadowed ,) sources +-- | read a nested set of configuration values, prefixed by a given key. This +-- corresponds to nested objects in json. readNested :: forall a. Config a => Key -> Fetch a readNested (Key prefix') = Fetch $ \s1 -> do let (Fetch nested) = readConfig @a (config, s2) <- nested (s1 { fetcherPrefix = fetcherPrefix s1 <> NonEmpty.toList prefix' }) pure (config, s2 { fetcherPrefix = fetcherPrefix s1 }) +-- | 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. readNestedOptional :: forall a. (Show a, Config a) => Key -> Fetch (Maybe a) readNestedOptional (Key prefix) = Fetch $ \s1 -> do let (Fetch nested) = readConfig @a @@ -200,3 +247,112 @@ collectUnused sources = do <&> fmap (\(Just a) -> Warning $ "Unused Keys " <> T.pack (show a)) . filter (\(Just a) -> not (null a)) . filter isJust + + +{- $use + +This library models configuration files as a list of configuration 'Key's, +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 +'Conftrack.Source.Yaml.mkYamlFileSource' and 'Conftrack.Source.Env.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 'Origin's and a list +of 'Warning's 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. +-} diff --git a/src/Conftrack/Source.hs b/src/Conftrack/Source.hs index ecfa20d..ab13172 100644 --- a/src/Conftrack/Source.hs +++ b/src/Conftrack/Source.hs @@ -12,11 +12,27 @@ import Control.Monad.State (StateT (..)) import Data.Text (Text) +-- | An abstraction over "config sources". This might mean file formats, +-- environment variables, or any other kind of format that can be seen as a +-- key-value store. class ConfigSource s where + -- | Some sources require state, e.g. to keep track of which values were + -- already read. type SourceState s + + -- | read a single value from the source. fetchValue :: Key -> s -> StateT (SourceState s) IO (Either ConfigError (Value, Text)) + + -- | given @s@, determine if any keys are "left over" and were not used. + -- This is used to produce warnings for unknown configuration options; + -- since not all sources can support this, this function's return type + -- includes @Maybe@ and sources are free to return @Nothing@ if they + -- cannot determine if any unknown keys are present. leftovers :: s -> StateT (SourceState s) IO (Maybe [Key]) +-- | 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. data SomeSource = forall source. ConfigSource source => SomeSource (source, SourceState source) diff --git a/src/Conftrack/Source/Aeson.hs b/src/Conftrack/Source/Aeson.hs index 97353d0..17ea4ee 100644 --- a/src/Conftrack/Source/Aeson.hs +++ b/src/Conftrack/Source/Aeson.hs @@ -7,7 +7,8 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE LambdaCase #-} -module Conftrack.Source.Aeson (JsonSource(..), mkJsonSource, mkJsonSourceWith, mkJsonFileSource) where +-- | Functions for producing sources reading from json strings or files, using the aeson library. +module Conftrack.Source.Aeson (mkJsonSource, mkJsonSourceWith, mkJsonFileSource, JsonSource(..)) where import Conftrack.Value (Key (..), ConfigError(..), Value (..), KeyPart) import Conftrack.Source (SomeSource(..), ConfigSource (..)) @@ -37,13 +38,17 @@ data JsonSource = JsonSource , jsonSourceDescription :: Text } deriving (Show) +-- | Make a source from an aeson value mkJsonSource :: A.Value -> SomeSource mkJsonSource value = mkJsonSourceWith ("JSON string " <> LT.toStrict (A.encodeToLazyText value)) value +-- | same as 'mkJsonSource', but with an additional description to be shown +-- in output of 'Conftrack.Pretty.printConfigOrigins'. mkJsonSourceWith :: Text -> A.Value -> SomeSource mkJsonSourceWith description value = SomeSource (source, []) where source = JsonSource value description +-- | Make a source from a json file. mkJsonFileSource :: OsPath -> IO (Maybe SomeSource) mkJsonFileSource path = do bytes <- readFile path diff --git a/src/Conftrack/Source/Trivial.hs b/src/Conftrack/Source/Trivial.hs index d4151c2..842ca46 100644 --- a/src/Conftrack/Source/Trivial.hs +++ b/src/Conftrack/Source/Trivial.hs @@ -5,6 +5,7 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE OverloadedStrings #-} +-- | A trivial source reading from a @Map Key Value@, only useful as a demonstration or for tests. module Conftrack.Source.Trivial where import Conftrack.Value (Key, Value(..), ConfigError(..)) diff --git a/src/Conftrack/Source/Yaml.hs b/src/Conftrack/Source/Yaml.hs index 6adc798..4642922 100644 --- a/src/Conftrack/Source/Yaml.hs +++ b/src/Conftrack/Source/Yaml.hs @@ -6,6 +6,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE UndecidableInstances #-} +-- | Functions for producing sources reading from yaml strings or files, using the aeson library. module Conftrack.Source.Yaml (YamlSource(..), mkYamlSource, mkYamlSourceWith, mkYamlFileSource) where import Conftrack.Source (SomeSource(..), ConfigSource (..)) diff --git a/src/Conftrack/Value.hs b/src/Conftrack/Value.hs index 3eda24a..1d6e6a7 100644 --- a/src/Conftrack/Value.hs +++ b/src/Conftrack/Value.hs @@ -8,7 +8,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE DefaultSignatures #-} -module Conftrack.Value (key, Value(..), ConfigError(..), Key(..), ConfigValue(..), Origin(..), KeyPart, prefixedWith) where +module Conftrack.Value (key, Value(..), ConfigError(..), Key(..), ConfigValue(..), Origin(..), KeyPart, prefixedWith, withString) where import Data.Text(Text) import qualified Data.Text as T @@ -21,9 +21,13 @@ import qualified Data.Text.Encoding as BS import Language.Haskell.TH.Quote (QuasiQuoter(..)) import Language.Haskell.TH.Syntax (Lift(lift)) +-- | A generic value read from a config source, to be parsed into a more useful type +-- (see the 'ConfigValue' class). data Value = ConfigString BS.ByteString | ConfigInteger 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. | ConfigMaybeInteger BS.ByteString Integer | ConfigOther Text Text | ConfigBool Bool @@ -32,6 +36,14 @@ data Value = type KeyPart = Text +-- | 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 newtype Key = Key (NonEmpty KeyPart) deriving newtype (Eq, Ord) deriving (Lift) @@ -39,6 +51,7 @@ newtype Key = Key (NonEmpty KeyPart) instance Show Key where show (Key parts) = T.unpack (T.intercalate "." (NonEmpty.toList parts)) +-- | to write values of 'Key' easily key :: QuasiQuoter key = QuasiQuoter { quoteExp = lift . Key . NonEmpty.fromList . T.splitOn "." . T.pack @@ -57,8 +70,11 @@ data ConfigError = | Shadowed deriving Show +-- | Values which can be read from a config source must implement this class class ConfigValue a where fromConfig :: Value -> Either ConfigError a + -- | 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. prettyValue :: a -> Text default prettyValue :: Show a => a -> Text |