Compare commits
3 Commits
8cda69d30d
...
7f64d8f926
Author | SHA1 | Date |
---|---|---|
Saku Laesvuori | 7f64d8f926 | |
Saku Laesvuori | fb69b58f92 | |
Saku Laesvuori | 49536ad05b |
|
@ -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)
|
||||
import Datarekisteri.Backend.Email (sendVerificationEmail, sendApplicationAcceptedEmail, sendApplicationRejectedEmail)
|
||||
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 = (,) <$> email <*> secret
|
||||
args = (,) <$> secret <*> email
|
||||
maybe (pure ()) (uncurry sendVerificationEmail) args
|
||||
|
||||
updateUser :: (MonadRandom m, MonadDB m, MonadEmail m, MonadError GQLError m) =>
|
||||
|
@ -193,15 +193,25 @@ makeNewKey (KeyData {..}) user = do
|
|||
, dBKeyIsPrimaryEncryptionKey = True
|
||||
}
|
||||
|
||||
acceptApplication :: (MonadDB m, MonadTime m) => UserID -> m Unit
|
||||
acceptApplication :: (MonadDB m, MonadTime m, MonadError GQLError m, MonadEmail 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) => UserID -> m Unit
|
||||
rejectApplication :: (MonadDB m, MonadTime m, MonadError GQLError m, MonadEmail 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
|
||||
|
|
|
@ -8,11 +8,22 @@ import Data.Text.Lazy (fromStrict)
|
|||
import Datarekisteri.Core.Types
|
||||
import Network.Mail.Mime
|
||||
|
||||
sendVerificationEmail :: MonadEmail m => Email -> Text -> m ()
|
||||
sendVerificationEmail to secret = do
|
||||
sendDatarekisteriEmail :: MonadEmail m => Text -> Text -> Email -> m ()
|
||||
sendDatarekisteriEmail subject content to = do
|
||||
from <- fromAddress
|
||||
sendEmail $ simpleMail' (Address Nothing $ renderEmail to) from
|
||||
"Sähköpostin vahvistuskoodi" $ fromStrict $
|
||||
sendEmail $ simpleMail' (Address Nothing $ renderEmail to) from subject $ fromStrict content
|
||||
|
||||
sendVerificationEmail :: MonadEmail m => Text -> Email -> m ()
|
||||
sendVerificationEmail secret = sendDatarekisteriEmail "Sähköpostin vahvistuskoodi" $
|
||||
"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>."
|
||||
|
|
|
@ -19,6 +19,7 @@ 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
|
||||
|
||||
|
@ -33,6 +34,7 @@ query ProfilePage($id: UserID) {
|
|||
homeplace
|
||||
birthdate
|
||||
phoneNumber
|
||||
isMember
|
||||
}
|
||||
permissions
|
||||
}
|
||||
|
@ -92,14 +94,18 @@ profileForm userID user extraHtml = do
|
|||
|]
|
||||
return (profileUpdateRes, widget)
|
||||
|
||||
profile :: UserID -> (Widget, Enctype) -> (Widget, Enctype) -> Widget
|
||||
profile :: ProfilePageUser -> (Widget, Enctype) -> (Widget, Enctype) -> Widget
|
||||
profile user (profileWidget, profileEnctype) (passwordWidget, passwordEnctype) = do
|
||||
setTitle "Muokkaa profiilia"
|
||||
passwordRoute <- handlerToWidget $ maybeAuthorized (UpdatePasswordR user) True
|
||||
let userID = let ProfilePageUser {..} = user in id
|
||||
passwordRoute <- handlerToWidget $ maybeAuthorized (UpdatePasswordR userID) True
|
||||
[whamlet|
|
||||
<h1>
|
||||
Omat tiedot
|
||||
<form action="@{ProfileR user}" method="post" enctype="#{profileEnctype}">
|
||||
$if isMember user
|
||||
Jäsentiedot
|
||||
$else
|
||||
Jäsenhakemuksen tiedot
|
||||
<form action="@{ProfileR userID}" method="post" enctype="#{profileEnctype}">
|
||||
^{profileWidget}
|
||||
<input type="submit" value="Päivitä tiedot">
|
||||
$maybe route <- passwordRoute
|
||||
|
@ -114,7 +120,7 @@ getProfile userID = do
|
|||
passwordForm <- liftHandler $ generateFormPost passwordForm
|
||||
profileForm <- liftHandler $ generateFormPost $
|
||||
profileForm ((\x -> let ProfilePageUser {..} = x in id) <$> user) user
|
||||
defaultLayout $ profile ((\x -> let ProfilePageUser {..} = x in id) $ fromJust user)
|
||||
defaultLayout $ profile (fromJust user)
|
||||
profileForm passwordForm
|
||||
where fromJust = fromMaybe $ error "Tried to access the profile of an inexistent user"
|
||||
|
||||
|
@ -131,7 +137,9 @@ postProfileR userID = do
|
|||
FormSuccess update -> apiRequest @UpdateProfile True update >> redirect (ProfileR userID)
|
||||
_ -> do
|
||||
passwordForm <- liftHandler $ generateFormPost passwordForm
|
||||
defaultLayout $ profile userID (widget, enctype) passwordForm
|
||||
ProfilePage {..} <- apiRequest True (ProfilePageArgs {id = Just userID})
|
||||
defaultLayout $ profile (fromJust user) (widget, enctype) passwordForm
|
||||
--- XXX fromJust explodes if the user no longer exists
|
||||
|
||||
postUpdatePasswordR :: (YesodAuth DataIdClient, AuthId DataIdClient ~ Text) => UserID -> Handler Html
|
||||
postUpdatePasswordR userID = do
|
||||
|
@ -141,4 +149,6 @@ postUpdatePasswordR userID = do
|
|||
apiRequest @UpdatePassword True (UpdatePasswordArgs {password = new, user = Just userID}) >> redirect (ProfileR userID)
|
||||
_ -> do
|
||||
profileForm <- liftHandler $ generateFormPost $ profileForm (Just userID) Nothing
|
||||
defaultLayout $ profile userID profileForm (widget, enctype)
|
||||
ProfilePage {..} <- apiRequest True (ProfilePageArgs {id = Just userID})
|
||||
defaultLayout $ profile (fromJust user) profileForm (widget, enctype)
|
||||
--- XXX fromJust explodes if the user no longer exists
|
||||
|
|
Loading…
Reference in New Issue