hsm-core/Hsm/Core/Env.hs


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26

module Hsm.Core.Env
  ( environment
  , deriveFromYaml
  ) where

import Data.Aeson (FromJSON, Result(Error, Success), fromJSON)
import Data.Aeson.Key (fromText)
import Data.Aeson.KeyMap ((!?))
import Data.Aeson.TH (defaultOptions, deriveFromJSON, rejectUnknownFields)
import Data.Maybe (fromMaybe)
import Data.Text (Text, unpack)
import Data.Yaml (decodeFileThrow)
import Language.Haskell.TH (Dec, Name, Q)

environment :: FromJSON env => Text -> Text -> IO env
environment name = fmap (check . fromJSON . load) . decodeFileThrow . unpack
  where
    load keymap =
      fromMaybe
        (error $ "Service configuration for " <> unpack name <> " not found)")
        $ keymap !? fromText name
    check (Success env) = env
    check (Error str) = error str

deriveFromYaml :: Name -> Q [Dec]
deriveFromYaml = deriveFromJSON defaultOptions {rejectUnknownFields = True}