mirror of
https://git.nerfingen.de/nerf/choirMail.git
synced 2025-06-08 09:41:00 +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.
|
||||
|
||||
### 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"
|
||||
|
@ -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.
|
||||
|
||||
# TODO
|
||||
- [ ] 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
|
||||
- [ ] Split config into secrets and non secret config
|
||||
- [ ] make the pad url configurable
|
||||
- [] Better E-Mail generation
|
||||
- [] Add the nix modules to the flake
|
||||
- [] Better Error handling
|
||||
- [] 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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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"
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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;
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue