1 files changed, 44 insertions, 5 deletions
diff --git a/lib/Server/Util.hs b/lib/Server/Util.hs
index 5ffb829..0106428 100644
--- a/lib/Server/Util.hs
+++ b/lib/Server/Util.hs
@@ -1,28 +1,67 @@
+{-# LANGUAGE BlockArguments  #-}
+{-# LANGUAGE RecordWildCards #-}
 -- | mostly the monad the service runs in
-module Server.Util (Service, ServiceM, runService, sendErrorMsg, secondsNow, utcToSeconds) where
+module Server.Util (Service, ServiceM, runService, sendErrorMsg, secondsNow, utcToSeconds, runLogging) where
 
+import           Config                 (LoggingConfig (..))
+import           Control.Exception      (handle, try)
+import           Control.Monad.Extra    (void, whenJust)
 import           Control.Monad.IO.Class (MonadIO (liftIO))
-import           Control.Monad.Logger   (LoggingT, runStderrLoggingT)
+import           Control.Monad.Logger   (Loc, LogLevel (..), LogSource, LogStr,
+                                         LoggingT (..), defaultOutput,
+                                         fromLogStr, runStderrLoggingT)
+import           Control.Monad.Reader   (ReaderT (..))
 import qualified Data.Aeson             as A
 import           Data.ByteString        (ByteString)
+import qualified Data.ByteString        as C8
 import           Data.Text              (Text)
+import qualified Data.Text              as T
+import           Data.Text.Encoding     (decodeUtf8Lenient)
 import           Data.Time              (Day, UTCTime (..), diffUTCTime,
                                          getCurrentTime,
                                          nominalDiffTimeToSeconds)
+import           Fmt                    ((+|), (|+))
+import           GHC.IO.Exception       (IOException (IOError))
 import           GTFS                   (Seconds (..))
 import           Prometheus             (MonadMonitor (doIO))
 import           Servant                (Handler, ServerError, ServerT, err404,
                                          errBody, errHeaders, throwError)
+import           System.IO              (stderr)
+import           System.Process.Extra   (callProcess)
 
-type ServiceM  = LoggingT Handler
+type ServiceM  = LoggingT (ReaderT LoggingConfig Handler)
 type Service api = ServerT api ServiceM
 
-runService :: ServiceM a -> Handler a
-runService = runStderrLoggingT
+runService :: LoggingConfig -> ServiceM a -> Handler a
+runService conf m = runReaderT (runLogging conf m) conf
 
 instance MonadMonitor ServiceM where
   doIO = liftIO
 
+runLogging :: MonadIO m => LoggingConfig -> LoggingT m a -> m a
+runLogging LoggingConfig{..} logging = runLoggingT logging printLogMsg
+  where printLogMsg loc source level msg = do
+          -- this is what runStderrLoggingT does
+          defaultOutput stderr loc source level msg
+
+          whenJust loggingConfigNtfyToken \token -> handle ntfyFailed do
+            callProcess "ntfy"
+              [ "send"
+              , "--token=" <> T.unpack token
+              , "--title="+|loggingConfigHostname|+"/"+|"tracktrain"
+              , "--priority="+|show (ntfyPriority level)|+""
+              , T.unpack loggingConfigNtfyTopic
+              , T.unpack (decodeUtf8Lenient (fromLogStr msg)) ]
+
+        ntfyFailed (e :: IOError) =
+          putStrLn ("calling ntfy failed:"+|show e|+".")
+        ntfyPriority level = case level of
+          LevelDebug   -> 2
+          LevelInfo    -> 3
+          LevelWarn    -> 4
+          LevelError   -> 5
+          LevelOther _ -> 0
+
 
 sendErrorMsg :: Text -> ServiceM a
 sendErrorMsg msg = throwError err404