diff --git a/README.md b/README.md index 93a4f5b..038d91f 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 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" @@ -30,10 +30,13 @@ 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 - - [] Find out which exceptions the SMTP module throws -- [] 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 + - [x] Find out which exceptions the SMTP module throws + - [ ] 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 diff --git a/app/Requester.hs b/app/Requester.hs index 2890757..bb88f5e 100644 --- a/app/Requester.hs +++ b/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 diff --git a/app/TableParser.hs b/app/TableParser.hs index 0bbd2cc..66a6491 100644 --- a/app/TableParser.hs +++ b/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 diff --git a/choirMail.cabal b/choirMail.cabal index 168d001..516436d 100644 --- a/choirMail.cabal +++ b/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. diff --git a/choirMail.nix b/choirMail.nix index 7763d97..6e2d449 100644 --- a/choirMail.nix +++ b/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;