Compare commits

..

No commits in common. "7f64d8f9268c520cf2432d263c5de6a67260ebfb" and "8cda69d30d3316f5af7ebd3b50f52b55cd345a31" have entirely different histories.

3 changed files with 19 additions and 50 deletions

View File

@ -31,7 +31,7 @@ import Database.Persist (Entity, entityVal, entityKey, get, (=.))
import Datarekisteri.Core.Types
import Datarekisteri.Backend.DB
import Datarekisteri.Backend.DB.Queries
import Datarekisteri.Backend.Email (sendVerificationEmail, sendApplicationAcceptedEmail, sendApplicationRejectedEmail)
import Datarekisteri.Backend.Email (sendVerificationEmail)
import Datarekisteri.Backend.Types
import Datarekisteri.Backend.Utils
import qualified "base64" Data.ByteString.Base64 as B64 (encodeBase64)
@ -143,7 +143,7 @@ sendVerificationSecret email = void $ do
maybeDBEmail <- runQuery $ get email
let email = dBEmailEmail <$> maybeDBEmail
secret = dBEmailVerificationSecret =<< maybeDBEmail
args = (,) <$> secret <*> email
args = (,) <$> email <*> secret
maybe (pure ()) (uncurry sendVerificationEmail) args
updateUser :: (MonadRandom m, MonadDB m, MonadEmail m, MonadError GQLError m) =>
@ -193,25 +193,15 @@ makeNewKey (KeyData {..}) user = do
, dBKeyIsPrimaryEncryptionKey = True
}
acceptApplication :: (MonadDB m, MonadTime m, MonadError GQLError m, MonadEmail m) => UserID -> m Unit
acceptApplication :: (MonadDB m, MonadTime m) => UserID -> m Unit
acceptApplication user = void $ do
maybeEmail <- getUserEmail user
case maybeEmail of
Nothing -> throwError $ "No valid application for " <> show user <> "!"
Just email -> do
time <- currentTime
markAsAccepted user time
void $ sendApplicationAcceptedEmail $ dBEmailEmail $ entityVal email
rejectApplication :: (MonadDB m, MonadTime m, MonadError GQLError m, MonadEmail m) => UserID -> m Unit
rejectApplication :: (MonadDB m, MonadTime m) => UserID -> m Unit
rejectApplication user = void $ do
maybeEmail <- getUserEmail user
case maybeEmail of
Nothing -> throwError $ "No valid application for " <> show user <> "!"
Just email -> do
time <- currentTime
markAsRejected user time
void $ sendApplicationRejectedEmail $ dBEmailEmail $ entityVal email
resolveQuery :: (MonadRequest m, MonadDB m, MonadError GQLError m, MonadPermissions m) => Query m
resolveQuery = Query

View File

@ -8,22 +8,11 @@ import Data.Text.Lazy (fromStrict)
import Datarekisteri.Core.Types
import Network.Mail.Mime
sendDatarekisteriEmail :: MonadEmail m => Text -> Text -> Email -> m ()
sendDatarekisteriEmail subject content to = do
sendVerificationEmail :: MonadEmail m => Email -> Text -> m ()
sendVerificationEmail to secret = do
from <- fromAddress
sendEmail $ simpleMail' (Address Nothing $ renderEmail to) from subject $ fromStrict content
sendVerificationEmail :: MonadEmail m => Text -> Email -> m ()
sendVerificationEmail secret = sendDatarekisteriEmail "Sähköpostin vahvistuskoodi" $
sendEmail $ simpleMail' (Address Nothing $ renderEmail to) from
"Sähköpostin vahvistuskoodi" $ fromStrict $
"Vahvista sähköpostisi syöttämällä alla oleva koodi rekisteriin:\n\n"
<> secret <> "\n\n"
<> "Mikäli et odottanut tätä viestiä, voit jättää sen turvallisesti huomiotta."
sendApplicationAcceptedEmail :: MonadEmail m => Email -> m ()
sendApplicationAcceptedEmail = sendDatarekisteriEmail "Jäsenhakemus hyväksytty" $
"Jäsenhakemuksesi Datat RY:lle on hyväksytty. Olet nyt yhdistyksen jäsen."
sendApplicationRejectedEmail :: MonadEmail m => Email -> m ()
sendApplicationRejectedEmail = sendDatarekisteriEmail "Jäsenhakemus hylätty" $
"Jäsenhakemuksesi Datat RY:lle on hylätty. Voit halutessasi kysyä hakemuksen"
<> " hylkäämisen syistä yhdistyksen hallitukselta <hallitus@datat.fi>."

View File

@ -19,7 +19,6 @@ import Datarekisteri.Frontend.Types
import Datarekisteri.Frontend.FormFields
import Data.Morpheus.Client
import Datarekisteri.Core.Types
import Data.Maybe (fromJust)
import Yesod hiding (emailField)
import Yesod.Auth
@ -34,7 +33,6 @@ query ProfilePage($id: UserID) {
homeplace
birthdate
phoneNumber
isMember
}
permissions
}
@ -94,18 +92,14 @@ profileForm userID user extraHtml = do
|]
return (profileUpdateRes, widget)
profile :: ProfilePageUser -> (Widget, Enctype) -> (Widget, Enctype) -> Widget
profile :: UserID -> (Widget, Enctype) -> (Widget, Enctype) -> Widget
profile user (profileWidget, profileEnctype) (passwordWidget, passwordEnctype) = do
setTitle "Muokkaa profiilia"
let userID = let ProfilePageUser {..} = user in id
passwordRoute <- handlerToWidget $ maybeAuthorized (UpdatePasswordR userID) True
passwordRoute <- handlerToWidget $ maybeAuthorized (UpdatePasswordR user) True
[whamlet|
<h1>
$if isMember user
Jäsentiedot
$else
Jäsenhakemuksen tiedot
<form action="@{ProfileR userID}" method="post" enctype="#{profileEnctype}">
Omat tiedot
<form action="@{ProfileR user}" method="post" enctype="#{profileEnctype}">
^{profileWidget}
<input type="submit" value="Päivitä tiedot">
$maybe route <- passwordRoute
@ -120,7 +114,7 @@ getProfile userID = do
passwordForm <- liftHandler $ generateFormPost passwordForm
profileForm <- liftHandler $ generateFormPost $
profileForm ((\x -> let ProfilePageUser {..} = x in id) <$> user) user
defaultLayout $ profile (fromJust user)
defaultLayout $ profile ((\x -> let ProfilePageUser {..} = x in id) $ fromJust user)
profileForm passwordForm
where fromJust = fromMaybe $ error "Tried to access the profile of an inexistent user"
@ -137,9 +131,7 @@ postProfileR userID = do
FormSuccess update -> apiRequest @UpdateProfile True update >> redirect (ProfileR userID)
_ -> do
passwordForm <- liftHandler $ generateFormPost passwordForm
ProfilePage {..} <- apiRequest True (ProfilePageArgs {id = Just userID})
defaultLayout $ profile (fromJust user) (widget, enctype) passwordForm
--- XXX fromJust explodes if the user no longer exists
defaultLayout $ profile userID (widget, enctype) passwordForm
postUpdatePasswordR :: (YesodAuth DataIdClient, AuthId DataIdClient ~ Text) => UserID -> Handler Html
postUpdatePasswordR userID = do
@ -149,6 +141,4 @@ postUpdatePasswordR userID = do
apiRequest @UpdatePassword True (UpdatePasswordArgs {password = new, user = Just userID}) >> redirect (ProfileR userID)
_ -> do
profileForm <- liftHandler $ generateFormPost $ profileForm (Just userID) Nothing
ProfilePage {..} <- apiRequest True (ProfilePageArgs {id = Just userID})
defaultLayout $ profile (fromJust user) profileForm (widget, enctype)
--- XXX fromJust explodes if the user no longer exists
defaultLayout $ profile userID profileForm (widget, enctype)