Show membership status on profile page

backend/src/Datarekisteri/Backend/API.hs

@@ -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
-    time <- currentTime
+    maybeEmail <- getUserEmail user
-    markAsAccepted user time
+    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
-    time <- currentTime
+    maybeEmail <- getUserEmail user
-    markAsRejected user time
+    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

backend/src/Datarekisteri/Backend/Email.hs

@@ -8,11 +8,22 @@ import Data.Text.Lazy (fromStrict)
 import Datarekisteri.Core.Types
 import Network.Mail.Mime
 
-sendVerificationEmail :: MonadEmail m => Email -> Text -> m ()
+sendDatarekisteriEmail :: MonadEmail m => Text -> Text -> Email -> m ()
-sendVerificationEmail to secret = do
+sendDatarekisteriEmail subject content to = do
     from <- fromAddress
-    sendEmail $ simpleMail' (Address Nothing $ renderEmail to) from
+    sendEmail $ simpleMail' (Address Nothing $ renderEmail to) from subject $ fromStrict content
-        "Sähköpostin vahvistuskoodi" $ fromStrict $
+
+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>."

frontend/src/Datarekisteri/Frontend/Handlers/Profile.hs

@@ -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
+        $if isMember user
-    <form action="@{ProfileR user}" method="post" enctype="#{profileEnctype}">
+            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