mirror of
https://git.nerfingen.de/nerf/choirMail.git
synced 2025-06-08 17:51:01 +00:00
Compare commits
1 commit
ab7c39b707
...
4c54800b98
Author | SHA1 | Date | |
---|---|---|---|
4c54800b98 |
7 changed files with 37 additions and 48 deletions
19
README.md
19
README.md
|
@ -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
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
|
||||||
|
|
|
@ -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"
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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.
|
||||||
|
|
|
@ -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;
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue