Compare commits

..

1 commit

7 changed files with 37 additions and 48 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 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. 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 password on the smtp server" password = "the passwond 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"
@ -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. this depends on your local cabal cache.
# TODO # TODO
- [ ] 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
- [x] Find out which exceptions the SMTP module throws - [] Find out which exceptions the SMTP module throws
- [x] also log to stderr if we send an error E-Mail - [] Split config into secrets and non secret config
- [ ] move from MonadFail to MonadError from Control.Monad.Except - [] make the pad url configurable
- [ ] Split config into secrets and non secret config
- [ ] 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,9 +25,7 @@ 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' = do reportErrorMail config error' = send (mailDomain config) (mailUsername config) (mailPassword config) (mailErrorTo config) (mailFrom config) "choirMail Error" (LT.pack error')
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,25 +1,18 @@
{-# LANGUAGE OverloadedStrings, DataKinds#-} {-# LANGUAGE OverloadedStrings, DataKinds#-}
module Requester(request) where module Requester(request) where
import qualified Network.Wreq as N import Network.HTTP.Req
import Network.HTTP.Client (HttpException) -- import qualified Data.Text as T
import qualified Control.Exception as E import Control.Monad.IO.Class(MonadIO)
import Control.Lens.Getter ((^.)) import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as LBS
import Monad
url :: String url :: Url 'Https
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
request = do requestRunner :: (MonadIO m)=> m BsResponse
-- catch might seem to be more convenient instead of catch. But the handler in catch forces requestRunner = runReq defaultHttpConfig $ req GET url NoReqBody bsResponse mempty
-- 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) request :: (MonadIO m) => m B.ByteString
responseWithError <- liftIO (E.try (N.get url) :: IO (Either HttpException (N.Response LBS.ByteString))) request = fmap responseBody requestRunner
response <- eitherToFail responseWithError
return $ response ^. N.responseBody

View file

@ -9,8 +9,9 @@ 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 (formatTime, defaultTimeLocale) import Data.Time.Format (TimeLocale, formatTime, defaultTimeLocale)
rfc5322Format :: String rfc5322Format :: String
rfc5322Format = "%a, %d %b %0Y %T %z" rfc5322Format = "%a, %d %b %0Y %T %z"

View file

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

View file

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

View file

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