From 70d3e37b1a088209fe84abf07a39d14dec116c6b Mon Sep 17 00:00:00 2001
From: Paul Oliver <contact@pauloliver.dev>
Date: Sat, 24 Aug 2024 11:57:18 -0700
Subject: Initial commit

---
 hsm-core/Hsm/Core/App.hs | 75 ++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 75 insertions(+)
 create mode 100644 hsm-core/Hsm/Core/App.hs

(limited to 'hsm-core/Hsm/Core/App.hs')

diff --git a/hsm-core/Hsm/Core/App.hs b/hsm-core/Hsm/Core/App.hs
new file mode 100644
index 0000000..51f6d94
--- /dev/null
+++ b/hsm-core/Hsm/Core/App.hs
@@ -0,0 +1,75 @@
+{-# LANGUAGE ImportQualifiedPost #-}
+
+-- Module     : Hsm.Core.App
+-- Maintainer : contact@pauloliver.dev
+module Hsm.Core.App
+  ( launch
+  )
+where
+
+import Control.Applicative ((<**>))
+import Data.Aeson (FromJSON, Result (Error, Success), Value, fromJSON)
+import Data.Aeson.Key (fromString)
+import Data.Aeson.KeyMap (KeyMap, (!?))
+import Data.Maybe (fromMaybe)
+import Data.Text (pack, unpack)
+import Data.Yaml (decodeFileThrow)
+import Effectful.Log (LogLevel (LogInfo), Logger, readLogLevelEither, showLogLevel)
+import Log.Backend.StandardOutput (withStdOutLogger)
+import Options.Applicative qualified as P
+import System.IO.Echo (withoutInputEcho)
+
+data Options = Options String LogLevel
+
+parser :: P.Parser Options
+parser =
+  Options
+    <$> P.strOption
+      ( P.help "Path to services config file"
+          <> P.short 'c'
+          <> P.long "config"
+          <> P.metavar "PATH"
+          <> P.value "config.yaml"
+          <> P.showDefault
+      )
+    <*> P.option
+      (P.eitherReader $ readLogLevelEither . pack)
+      ( P.help "Log level"
+          <> P.short 'l'
+          <> P.long "log-level"
+          <> P.metavar "LEVEL"
+          <> P.value LogInfo
+          <> P.showDefaultWith (unpack . showLogLevel)
+      )
+
+-- Bootstraps an application by reading its settings from a provided
+-- configuration file. A configuration must exist in the config file for the name
+-- provided. A logger object, log level and read-only configuration are passed
+-- down to the provided application.
+launch :: FromJSON e => String -> (Logger -> LogLevel -> e -> IO a) -> IO a
+launch name app =
+  P.execParser info >>= \(Options path level) ->
+    returnEnv path >>= \env ->
+      withoutInputEcho $ withStdOutLogger $ \logger -> app logger level env
+ where
+  title :: String
+  title = "Launch " <> name <> " service"
+
+  description :: P.InfoMod Options
+  description = P.fullDesc <> P.progDesc title
+
+  info :: P.ParserInfo Options
+  info = P.info (parser <**> P.helper) description
+
+  err :: String
+  err = "Service configuration for " <> name <> " not found"
+
+  load :: KeyMap Value -> Value
+  load configs = fromMaybe (error err) $ configs !? fromString name
+
+  check :: Result e -> e
+  check (Success e) = e
+  check (Error str) = error str
+
+  returnEnv :: FromJSON e => String -> IO e
+  returnEnv = fmap (check . fromJSON . load) . decodeFileThrow
-- 
cgit v1.2.1