added error handling to the web request (and changed from req to wreq)

This commit is contained in:
Dennis Frieberg 2025-06-07 03:33:27 +02:00
parent 6f50add62a
commit a460fd561f
Signed by: nerf
GPG key ID: 7C58AFED036072C5
5 changed files with 44 additions and 34 deletions

View file

@ -12,14 +12,14 @@ Just run the binary to send a mail, it requires exactly one
parameter that points to a config file. parameter that points to a config file.
### Configuration ### 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. of any toml features.
```toml ```toml
[mail] [mail]
domain = "the domain of the smtp server to send messages with" domain = "the domain of the smtp server to send messages with"
user = "the username on the smtp server" 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" to = "the mail to send to"
from = "the sender of the mail" from = "the sender of the mail"
errorTo = "the address to send a mail to in case of error" 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 - [ ] Better E-Mail generation
- [ ] Add the nix modules to the flake - [ ] Add the nix modules to the flake
- [ ] Better Error handling - [ ] Better Error handling
- [] Find out which exceptions the SMTP module throws - [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 - [ ] Split config into secrets and non secret config
- [ ] make the pad url configurable - [ ] make the pad url configurable
- [x] Clean up Strict vs Lazy Text - [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

View file

@ -1,18 +1,25 @@
{-# LANGUAGE OverloadedStrings, DataKinds#-} {-# LANGUAGE OverloadedStrings, DataKinds#-}
module Requester(request) where module Requester(request) where
import Network.HTTP.Req import qualified Network.Wreq as N
-- import qualified Data.Text as T import Network.HTTP.Client (HttpException)
import Control.Monad.IO.Class(MonadIO) import qualified Control.Exception as E
import qualified Data.ByteString as B import Control.Lens.Getter ((^.))
import qualified Data.ByteString.Lazy as LBS
import Monad
url :: Url 'Https url :: String
url = https "md.darmstadt.ccc.de" /: "mathechor-probenplanung" /: "download" 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
requestRunner :: (MonadIO m)=> m BsResponse request = do
requestRunner = runReq defaultHttpConfig $ req GET url NoReqBody bsResponse mempty -- 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
request :: (MonadIO m) => m B.ByteString -- and then handle the error (with fail in scope)
request = fmap responseBody requestRunner responseWithError <- liftIO (E.try (N.get url) :: IO (Either HttpException (N.Response LBS.ByteString)))
response <- eitherToFail responseWithError
return $ response ^. N.responseBody

View file

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

View file

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

View file

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