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.
### 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"
@ -33,10 +33,7 @@ this depends on your local cabal cache.
- [] 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
- [] 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

View file

@ -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

View file

@ -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

View file

@ -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"

View file

@ -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

View file

@ -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.

View file

@ -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;