Initial

1 files changed, 29 insertions, 0 deletions

diff --git a/hsm-core/Hsm/Core/Env.hs b/hsm-core/Hsm/Core/Env.hs
new file mode 100644
index 0000000..4e7986f
--- /dev/null
+++ b/hsm-core/Hsm/Core/Env.hs
@@ -0,0 +1,29 @@
+module Hsm.Core.Env
+  ( environment
+  , deriveFromYaml
+  ) where
+
+import Data.Aeson (FromJSON, Result(Error, Success), Value, fromJSON)
+import Data.Aeson.Key (fromText)
+import Data.Aeson.KeyMap (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 Value -> Value
+    load keymap =
+      fromMaybe
+        (error $ "Service configuration for " <> unpack name <> " not found)")
+        $ keymap !? fromText name
+    --
+    check :: Result env -> env
+    check (Success env) = env
+    check (Error str) = error str
+
+deriveFromYaml :: Name -> Q [Dec]
+deriveFromYaml = deriveFromJSON defaultOptions {rejectUnknownFields = True}