Compare commits

...

3 Commits

  1. 2
      config.yaml
  2. 4
      shell.nix
  3. 14
      src/Types/Settings.hs
  4. 12
      src/Util.hs

2
config.yaml

@ -8,5 +8,5 @@ listen_port: 8000
#max_connections_per_client: 10
currency: "meow"
currency_fraction: 2
block_registration: false
#block_registration: false
sendmail_path: "/run/wrappers/bin/sendmail"

4
shell.nix

@ -31,7 +31,7 @@ let
, base64-bytestring, bytestring, case-insensitive, clock
, containers, directory, extra, haskell-gettext, hspec
, hspec-discover, hspec-wai, hspec-wai-json, http-api-data
, http-types, iproute, lib, mime-mail, mtl, network, opaleye
, http-types, iproute, lib, libyaml, mime-mail, mtl, network, opaleye
, optparse-applicative, postgresql-simple
, postgresql-simple-migration, product-profunctors, profunctors
, pureMD5, random-bytestring, resource-pool, servant, servant-rawm
@ -48,7 +48,7 @@ let
libraryHaskellDepends = [
aeson base base16-bytestring base64-bytestring bytestring
containers directory extra haskell-gettext http-api-data http-types
mime-mail mtl opaleye postgresql-simple product-profunctors
libyaml mime-mail mtl opaleye postgresql-simple product-profunctors
profunctors pureMD5 random-bytestring servant servant-rawm
servant-rawm-server servant-server stm text time wai wai-logger
warp

14
src/Types/Settings.hs

@ -1,25 +1,21 @@
{-# LANGUAGE TypeFamilies #-}
module Types.Settings where
import qualified Data.Text as T
import Classes
data Settings = Settings
{ settingsCurrency :: T.Text
, settingsDecimalPlaces :: Int
, settingsBlockRegistration :: Bool
{ settingsBlockRegistration :: Bool
}
deriving (Show)
instance ToDatabase Settings where
type InTuple Settings = (T.Text, Int, Bool)
type InTuple Settings = Bool
toDatabase (Settings currency places reg) = (currency, places, reg)
toDatabase (Settings reg) = reg
instance FromDatabase Settings where
type OutTuple Settings = (T.Text, Int, Bool)
type OutTuple Settings = Bool
fromDatabase (currency, places, reg) = Settings currency places reg
fromDatabase reg = Settings reg

12
src/Util.hs

@ -63,7 +63,7 @@ sendUserNotification recipient subject message =
, mailTo =
[ Address
(Just $ userDetailsIdent recipient)
(email)
email
]
, mailCc = []
, mailBcc = []
@ -90,12 +90,14 @@ sendAdminNotification subject message =
-- TODO: Grab administrators from settings and actually send the mails to them
return ()
sendNotification :: Mail -> MateHandler ()
sendNotification mail = do
sendmail <- asks rsSendmailPath
sendmailPath <- asks rsSendmailPath
liftIO $ do
existence <- doesFileExist sendmail
existence <- doesFileExist sendmailPath
if existence
then
renderSendMailCustom sendmail [] mail
renderSendMailCustom sendmailPath [] mail
else
print "Warning: sending notification failed: Sendmail not present!"
print ("Warning: sending notification failed: Sendmail not present!"
:: String)

Loading…
Cancel
Save