Compare commits

..

3 commits

7 changed files with 48 additions and 37 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
- [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 - [ ] 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

@ -25,7 +25,9 @@ reportErrorLocal :: MonadIO m => String -> m ()
reportErrorLocal = liftIO . hPutStr stderr reportErrorLocal = liftIO . hPutStr stderr
reportErrorMail :: MonadIO m => Config -> String -> m () 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 :: Day -> [MailRecord] -> Either String MailRecord
findChoirDay today table = maybe findChoirDay today table = maybe

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

@ -9,9 +9,8 @@ import Network.Mail.SMTP
import qualified Data.Text as ST import qualified Data.Text as ST
import qualified Data.Text.Lazy as LT import qualified Data.Text.Lazy as LT
import Monad import Monad
import Control.Monad.IO.Class
import Data.Time.LocalTime (getZonedTime) import Data.Time.LocalTime (getZonedTime)
import Data.Time.Format (TimeLocale, formatTime, defaultTimeLocale) import Data.Time.Format (formatTime, defaultTimeLocale)
rfc5322Format :: String rfc5322Format :: String
rfc5322Format = "%a, %d %b %0Y %T %z" rfc5322Format = "%a, %d %b %0Y %T %z"

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;