mirror of
https://git.nerfingen.de/nerf/choirMail.git
synced 2025-06-08 09:41:00 +00:00
Compare commits
3 commits
4c54800b98
...
ab7c39b707
Author | SHA1 | Date | |
---|---|---|---|
ab7c39b707 | |||
a460fd561f | |||
6f50add62a |
7 changed files with 48 additions and 37 deletions
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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"
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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.
|
||||||
|
|
|
@ -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;
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue