From 5c203e5a95763e3aa2a7d142fe77e1d22488d67b Mon Sep 17 00:00:00 2001
From: Dennis Frieberg <dennis@frieberg.de>
Date: Fri, 6 Jun 2025 18:39:58 +0200
Subject: [PATCH 1/3] flake update

---
 flake.lock | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/flake.lock b/flake.lock
index 123b37c..a566d94 100644
--- a/flake.lock
+++ b/flake.lock
@@ -20,11 +20,11 @@
     },
     "nixpkgs": {
       "locked": {
-        "lastModified": 1746576598,
-        "narHash": "sha256-FshoQvr6Aor5SnORVvh/ZdJ1Sa2U4ZrIMwKBX5k2wu0=",
+        "lastModified": 1749174413,
+        "narHash": "sha256-urN9UMK5cd1dzhR+Lx0xHeTgBp2MatA5+6g9JaxjuQs=",
         "owner": "NixOS",
         "repo": "nixpkgs",
-        "rev": "b3582c75c7f21ce0b429898980eddbbf05c68e55",
+        "rev": "6ad174a6dc07c7742fc64005265addf87ad08615",
         "type": "github"
       },
       "original": {

From 72e53eea4f0dc74c88d98ee20e7d657a84b536cd Mon Sep 17 00:00:00 2001
From: Dennis Frieberg <dennis@frieberg.de>
Date: Fri, 6 Jun 2025 19:04:57 +0200
Subject: [PATCH 2/3] some minor code cleanup

---
 app/Main.hs  | 11 ++++-------
 app/Monad.hs | 12 ++++++++++++
 flake.nix    |  2 +-
 3 files changed, 17 insertions(+), 8 deletions(-)

diff --git a/app/Main.hs b/app/Main.hs
index 363759a..cc6c243 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -37,20 +37,17 @@ findChoirDay today table = maybe
 main' :: App ()
 main' = do
   args <- liftIO getArgs
-  case L.uncons args of
-    Nothing -> fail "We need exactly one config path as option"
-    Just (headArgs,_) ->  do
+  case args of
+    [] -> fail "Please provide a config file"
+    (headArgs : _) ->  do
       config <- parseConfigFile headArgs
       -- we want to handle these while we have the config in scope
-      result <- liftIO $ runApp $ do
+      handleE (\error' -> reportErrorMail config error') $ do
         bs <- request
         table <- except $ parseBString bs
         today <- liftIO getToday
         record <- except $ findChoirDay today table
         send (mailDomain config) (mailUsername config) (mailPassword config) (mailTo config) (mailFrom config) (mailSubject record) (mailText record)
-      case result of
-        Right x -> return x
-        Left error' -> reportErrorMail config error'
 
 
 
diff --git a/app/Monad.hs b/app/Monad.hs
index 42b4593..80631cb 100644
--- a/app/Monad.hs
+++ b/app/Monad.hs
@@ -3,6 +3,8 @@ module Monad(
     App
   ,module Control.Monad.Fail
   ,module Control.Monad.IO.Class
+  ,handleE
+  ,catchE
   ,throwE
   ,except
   ,runApp
@@ -29,6 +31,16 @@ instance MonadFail App where
 throwE :: String -> App a
 throwE = App . T.throwE
 
+catchE :: App a -> (String -> App a) -> App a
+catchE a f = do
+  result <- liftIO $ runApp a
+  case result of
+    Left err  -> f err
+    Right res -> return res
+
+handleE :: (String -> App a) -> App a -> App a
+handleE = flip catchE
+
 except :: Either String a -> App a
 except = App . T.except
 
diff --git a/flake.nix b/flake.nix
index 0d3fe28..402d985 100644
--- a/flake.nix
+++ b/flake.nix
@@ -62,7 +62,7 @@
                    });
                  in
                    pkgs.kakoune.override {
-                     plugins = with pkgs.kakounePlugins; [fzf-kak kak-lsp config];
+                     plugins = with pkgs.kakounePlugins; [fzf-kak kakoune-lsp config];
                    };
             in
               pkgs.mkShell {

From 4c54800b980663f420f7166927be9a429e95f7c8 Mon Sep 17 00:00:00 2001
From: Dennis Frieberg <dennis@frieberg.de>
Date: Fri, 6 Jun 2025 20:39:28 +0200
Subject: [PATCH 3/3] Added mandatory `Date:` header to E-Mail (why doesn't the
 library do that?)

---
 app/Sender.hs | 25 +++++++++++++++++++------
 1 file changed, 19 insertions(+), 6 deletions(-)

diff --git a/app/Sender.hs b/app/Sender.hs
index efbe8d2..c78850d 100644
--- a/app/Sender.hs
+++ b/app/Sender.hs
@@ -1,19 +1,32 @@
 {-# LANGUAGE OverloadedStrings #-}
-module Sender where
+module Sender
+  (generateMail
+  ,send
+  ) where
   
 import Network.Mail.Mime
 import Network.Mail.SMTP
 import qualified Data.Text as ST
 import qualified Data.Text.Lazy as LT
 import Monad
+import Control.Monad.IO.Class
+import Data.Time.LocalTime (getZonedTime)
+import Data.Time.Format (TimeLocale, formatTime, defaultTimeLocale)
 
+rfc5322Format :: String
+rfc5322Format = "%a, %d %b %0Y %T %z"
 
-generateMail :: ST.Text -> ST.Text -> ST.Text -> LT.Text -> Mail
-generateMail to from subj = simpleMail' (Address Nothing to) (Address Nothing from) subj
+generateMail :: (MonadIO m) => ST.Text -> ST.Text -> ST.Text -> LT.Text -> m Mail
+generateMail to from subj body = do
+  time <- liftIO getZonedTime
+  let timeString = ST.pack $ formatTime defaultTimeLocale rfc5322Format time
+      mailWithoutDate = simpleMail' (Address Nothing to) (Address Nothing from) subj body
+      mailWithDate = mailWithoutDate {mailHeaders = ("Date",timeString) : mailHeaders mailWithoutDate}
+  return mailWithDate
 
 --     domain -> Username -> password -> To  -> From   -> Subject -> Body
 send :: (MonadIO m) => String -> String -> String -> ST.Text -> ST.Text -> ST.Text -> LT.Text -> m ()
-send domain user pass to from subj body = liftIO $ sendMailWithLoginTLS domain user pass mail
-  where
-    mail = generateMail to from subj body
+send domain user pass to from subj body = do
+  mail <- liftIO $ generateMail to from subj body
+  liftIO $ sendMailWithLoginTLS domain user pass mail