pending bang verdict notifications

1 files changed, 22 insertions, 4 deletions

diff --git a/src/Config.hs b/src/Config.hs
index 071cc26..2b2f341 100644
--- a/src/Config.hs
+++ b/src/Config.hs
@@ -1,22 +1,27 @@
-{-# LANGUAGE OverloadedStrings, LambdaCase #-}
+{-# LANGUAGE OverloadedStrings, LambdaCase, TemplateHaskell #-}
 
 module Config (
     Config(..),
     getConfig,
-    makeOpenSearch
+    makeOpenSearch,
+    sendEmail
 ) where
 
 import Prelude hiding (lookup)
 
 import Control.Applicative ((<|>))
+import Control.Monad.IO.Class (MonadIO, liftIO)
+import Control.Monad.Logger (MonadLogger, logInfo, logWarn, logError)
 import Data.Aeson.KeyMap (empty, lookup)
 import Data.Functor ((<&>))
 import Data.Maybe (fromMaybe)
 import Data.String (fromString, IsString)
-import Data.Text (Text)
+import Data.Text (Text, pack)
 import Data.Yaml
 import Network.Wai.Handler.Warp (HostPreference)
 import System.Environment (lookupEnv)
+import System.Exit (ExitCode(..))
+import System.Process (proc, createProcess, waitForProcess)
 
 data Config = Config {
     confPort :: Int,
@@ -24,7 +29,8 @@ data Config = Config {
     confBaseUrl :: Text,
     confFavicon :: Text,
     confUser :: Text,
-    confPwHash :: Text
+    confPwHash :: Text,
+    confEmailCmd :: Maybe FilePath
 } deriving (Show, Eq)
 
 getConfig :: IO Config
@@ -40,6 +46,7 @@ getConfig = do
         <*> resolveVal (lookup "favicon-url"   confFile) "FAVICON_URL"   ""
         <*> resolveVal (lookup "admin-user"    confFile) "ADMIN_USER"    "bleb"
         <*> resolveVal (lookup "admin-pw-hash" confFile) "ADMIN_PW_HASH" "" -- prevent login without manual pw
+        <*> fmap (<|> lookup "email-command" confFile) (lookupEnv "EMAIL_CMD")
 
   where resolveVal :: IsString s => Maybe String -> String -> String -> IO s
         resolveVal mayConf q def = do
@@ -60,3 +67,14 @@ makeOpenSearch cfg defBang =
   where (searchUrl, name) = case defBang of
             Nothing -> (confBaseUrl cfg <> "/#{searchTerms}", "FastBangs")
             Just b  -> (confBaseUrl cfg <> "/#" <> b <> "#{searchTerms}", "FastBangs (" <> b <> ")")
+
+sendEmail :: (MonadLogger m, MonadIO m) => Config -> String -> String -> String -> m ()
+sendEmail cfg to subject body = case confEmailCmd cfg of
+    Nothing -> do
+        $(logWarn) $ "Would've send email to " <> pack (show to) <> ", but no command was configured"
+    Just cmd -> do
+        (_, _, _, ph) <- liftIO $ createProcess $ proc cmd [to, subject, body]
+        exitCode <- liftIO $ waitForProcess ph
+        case exitCode of
+            ExitSuccess -> $(logInfo)  $ "Sent email to " <> pack (show to)
+            ExitFailure i -> $(logError) $ "Sending email returned " <> pack (show i)