if we send an error mail, we also print the error to stderr

README.md

@@ -12,14 +12,14 @@ Just run the binary to send a mail, it requires exactly one
 parameter that points to a config file.
 
 ### Configuration
-The config file is a toml file, even though it as of now makes not really use
+The config file is a toml file, even though as of now it makes not really use
 of any toml features.
 
 ```toml
 [mail]
 domain   = "the domain of the smtp server to send messages with"
 user     = "the username on the smtp server"
-password = "the passwond on the smtp server"
+password = "the password on the smtp server"
 to       = "the mail to send to"
 from     = "the sender of the mail"
 errorTo  = "the address to send a mail to in case of error"
@@ -33,7 +33,10 @@ this depends on your local cabal cache.
 - [ ] Better E-Mail generation
 - [ ] Add the nix modules to the flake
 - [ ] Better Error handling
-  - [] Find out which exceptions the SMTP module throws
+  - [x] Find out which exceptions the SMTP module throws
+  - [x] also log to stderr if we send an error E-Mail
+  - [ ] move from MonadFail to MonadError from Control.Monad.Except
 - [ ] Split config into secrets and non secret config
   - [ ] make the pad url configurable
 - [x] Clean up Strict vs Lazy Text
+- [ ] decide finally if we want to use wreq or req and don't flip flop between both libs

app/Main.hs

@@ -25,7 +25,9 @@ reportErrorLocal :: MonadIO m => String -> m ()
 reportErrorLocal = liftIO . hPutStr stderr
 
 reportErrorMail :: MonadIO m => Config -> String -> m ()
-reportErrorMail config error' = send (mailDomain config) (mailUsername config) (mailPassword config) (mailErrorTo config) (mailFrom config) "choirMail Error" (LT.pack error')
+reportErrorMail config error' = do
+  reportErrorLocal error'
+  send (mailDomain config) (mailUsername config) (mailPassword config) (mailErrorTo config) (mailFrom config) "choirMail Error" (LT.pack error')
 
 findChoirDay :: Day -> [MailRecord] -> Either String MailRecord
 findChoirDay today table = maybe

app/Requester.hs

@@ -1,18 +1,25 @@
 {-# LANGUAGE OverloadedStrings, DataKinds#-}
 module Requester(request) where
   
-import Network.HTTP.Req
--- import qualified Data.Text as T
-import Control.Monad.IO.Class(MonadIO)
-import qualified Data.ByteString as B
+import qualified Network.Wreq as N
+import Network.HTTP.Client (HttpException)
+import qualified Control.Exception as E
+import Control.Lens.Getter ((^.))
+import qualified Data.ByteString.Lazy as LBS
+import Monad
 
-url :: Url 'Https
-url = https "md.darmstadt.ccc.de" /: "mathechor-probenplanung" /: "download"
+url :: String
+url = "https://md.darmstadt.ccc.de/mathechor-probenplanung/download"
 
+eitherToFail :: (Show a, MonadFail m) => Either a b -> m b
+eitherToFail (Right a) = return a
+eitherToFail (Left b)  = fail $ show b
 
-
-requestRunner :: (MonadIO m)=> m BsResponse
-requestRunner = runReq defaultHttpConfig $ req GET url NoReqBody bsResponse mempty
-
-request :: (MonadIO m) => m B.ByteString
-request = fmap responseBody requestRunner
+request :: (MonadIO m, MonadFail m) => m LBS.ByteString
+request = do
+  -- catch might seem to be more convenient instead of catch. But the handler in catch forces
+  -- IO and not MonadIO, so we can't call fail. We use try to escape so we can escape IO first
+  -- and then handle the error (with fail in scope)
+  responseWithError <- liftIO (E.try (N.get url) :: IO (Either HttpException (N.Response LBS.ByteString)))
+  response <- eitherToFail responseWithError
+  return $ response ^. N.responseBody  

app/Sender.hs

@@ -1,19 +1,31 @@
 {-# 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 Data.Time.LocalTime (getZonedTime)
+import Data.Time.Format (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
 

app/TableParser.hs

@@ -3,12 +3,11 @@ module TableParser(MailRecord(..), parseBString, parseTable) where
   
 import qualified Text.Parsec as P
 -- import qualified Text.Parsec.Char as P
-import qualified Text.Parsec.Text as P
+import qualified Text.Parsec.Text.Lazy as P
 import qualified Data.Text.Lazy as LT
-import qualified Data.Text as ST
-import qualified Data.Text.Encoding as ST
+import qualified Data.Text.Lazy.Encoding as LT
 import qualified Data.Time.Calendar as D
-import qualified Data.ByteString as B
+import qualified Data.ByteString.Lazy as B
 import Control.Monad(void)
 
 
@@ -70,7 +69,7 @@ parseTable = do
   P.eof
   return x
 
-textToMailRecord :: ST.Text -> Either String [MailRecord]
+textToMailRecord :: LT.Text -> Either String [MailRecord]
 textToMailRecord t = case P.parse parseTable "" t of
   Left x -> Left $ show x
   Right x -> Right x
@@ -81,7 +80,7 @@ parseBString t = do
   text <- toText t
   textToMailRecord text
 
-toText :: B.ByteString -> Either String ST.Text
-toText t = case ST.decodeUtf8' t of
+toText :: B.ByteString -> Either String LT.Text
+toText t = case LT.decodeUtf8' t of
   Left x -> Left $ show x
   Right x -> Right x

choirMail.cabal

@@ -81,13 +81,14 @@ executable choirMail
                       ,tomland >= 1.3.3.0
                       ,smtp-mail
                       ,optparse-applicative
-                      ,req
+                      ,wreq
                       ,parsec
                       ,text
                       ,time
                       ,bytestring
                       ,mime-mail
-                      ,modern-uri
+                      ,http-client
+                      ,lens
 
 
     -- Directories containing source files.

choirMail.nix

@@ -1,6 +1,6 @@
-{ mkDerivation, base, bytestring, lib, mime-mail, modern-uri
-, optparse-applicative, parsec, req, smtp-mail, text, time, tomland
-, transformers
+{ mkDerivation, base, bytestring, http-client, lens, lib, mime-mail
+, optparse-applicative, parsec, smtp-mail, text, time, tomland
+, transformers, wreq
 }:
 mkDerivation {
   pname = "choirMail";
@@ -9,8 +9,8 @@ mkDerivation {
   isLibrary = false;
   isExecutable = true;
   executableHaskellDepends = [
-    base bytestring mime-mail modern-uri optparse-applicative parsec
-    req smtp-mail text time tomland transformers
+    base bytestring http-client lens mime-mail optparse-applicative
+    parsec smtp-mail text time tomland transformers wreq
   ];
   homepage = ""https://git.nerfingen.de/nerf/choirMail"";
   license = lib.licenses.gpl3Plus;