diff --git a/README.md b/README.md index 944513c..93a4f5b 100644 --- a/README.md +++ b/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 as of now it makes not really use +The config file is a toml file, even though it as of now 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 password on the smtp server" +password = "the passwond 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" @@ -30,13 +30,10 @@ If you run `nix develop` you get a set up kakoune with an lsp. Be aware this depends on your local cabal cache. # TODO -- [ ] Better E-Mail generation -- [ ] Add the nix modules to the flake -- [ ] Better Error handling - - [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 +- [] Better E-Mail generation +- [] Add the nix modules to the flake +- [] Better Error handling + - [] Find out which exceptions the SMTP module throws +- [] 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 diff --git a/app/Main.hs b/app/Main.hs index 65ef276..cc6c243 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -25,9 +25,7 @@ reportErrorLocal :: MonadIO m => String -> m () reportErrorLocal = liftIO . hPutStr stderr reportErrorMail :: MonadIO m => Config -> String -> m () -reportErrorMail config error' = do - reportErrorLocal error' - send (mailDomain config) (mailUsername config) (mailPassword config) (mailErrorTo config) (mailFrom config) "choirMail Error" (LT.pack error') +reportErrorMail config 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 diff --git a/app/Requester.hs b/app/Requester.hs index bb88f5e..2890757 100644 --- a/app/Requester.hs +++ b/app/Requester.hs @@ -1,25 +1,18 @@ {-# LANGUAGE OverloadedStrings, DataKinds#-} module Requester(request) where -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 +import Network.HTTP.Req +-- import qualified Data.Text as T +import Control.Monad.IO.Class(MonadIO) +import qualified Data.ByteString as B -url :: String -url = "https://md.darmstadt.ccc.de/mathechor-probenplanung/download" +url :: Url 'Https +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 -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 + +requestRunner :: (MonadIO m)=> m BsResponse +requestRunner = runReq defaultHttpConfig $ req GET url NoReqBody bsResponse mempty + +request :: (MonadIO m) => m B.ByteString +request = fmap responseBody requestRunner diff --git a/app/Sender.hs b/app/Sender.hs index 1ac086a..c78850d 100644 --- a/app/Sender.hs +++ b/app/Sender.hs @@ -9,8 +9,9 @@ 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 (formatTime, defaultTimeLocale) +import Data.Time.Format (TimeLocale, formatTime, defaultTimeLocale) rfc5322Format :: String rfc5322Format = "%a, %d %b %0Y %T %z" diff --git a/app/TableParser.hs b/app/TableParser.hs index 66a6491..0bbd2cc 100644 --- a/app/TableParser.hs +++ b/app/TableParser.hs @@ -3,11 +3,12 @@ module TableParser(MailRecord(..), parseBString, parseTable) where import qualified Text.Parsec as P -- import qualified Text.Parsec.Char as P -import qualified Text.Parsec.Text.Lazy as P +import qualified Text.Parsec.Text as P import qualified Data.Text.Lazy as LT -import qualified Data.Text.Lazy.Encoding as LT +import qualified Data.Text as ST +import qualified Data.Text.Encoding as ST import qualified Data.Time.Calendar as D -import qualified Data.ByteString.Lazy as B +import qualified Data.ByteString as B import Control.Monad(void) @@ -69,7 +70,7 @@ parseTable = do P.eof return x -textToMailRecord :: LT.Text -> Either String [MailRecord] +textToMailRecord :: ST.Text -> Either String [MailRecord] textToMailRecord t = case P.parse parseTable "" t of Left x -> Left $ show x Right x -> Right x @@ -80,7 +81,7 @@ parseBString t = do text <- toText t textToMailRecord text -toText :: B.ByteString -> Either String LT.Text -toText t = case LT.decodeUtf8' t of +toText :: B.ByteString -> Either String ST.Text +toText t = case ST.decodeUtf8' t of Left x -> Left $ show x Right x -> Right x diff --git a/choirMail.cabal b/choirMail.cabal index 516436d..168d001 100644 --- a/choirMail.cabal +++ b/choirMail.cabal @@ -81,14 +81,13 @@ executable choirMail ,tomland >= 1.3.3.0 ,smtp-mail ,optparse-applicative - ,wreq + ,req ,parsec ,text ,time ,bytestring ,mime-mail - ,http-client - ,lens + ,modern-uri -- Directories containing source files. diff --git a/choirMail.nix b/choirMail.nix index 6e2d449..7763d97 100644 --- a/choirMail.nix +++ b/choirMail.nix @@ -1,6 +1,6 @@ -{ mkDerivation, base, bytestring, http-client, lens, lib, mime-mail -, optparse-applicative, parsec, smtp-mail, text, time, tomland -, transformers, wreq +{ mkDerivation, base, bytestring, lib, mime-mail, modern-uri +, optparse-applicative, parsec, req, smtp-mail, text, time, tomland +, transformers }: mkDerivation { pname = "choirMail"; @@ -9,8 +9,8 @@ mkDerivation { isLibrary = false; isExecutable = true; executableHaskellDepends = [ - base bytestring http-client lens mime-mail optparse-applicative - parsec smtp-mail text time tomland transformers wreq + base bytestring mime-mail modern-uri optparse-applicative parsec + req smtp-mail text time tomland transformers ]; homepage = ""https://git.nerfingen.de/nerf/choirMail""; license = lib.licenses.gpl3Plus;