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, 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
+    time <- currentTime
+    markAsAccepted user time
 
-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
+    time <- currentTime
+    markAsRejected user time
 
 resolveQuery :: (MonadRequest m, MonadDB m, MonadError GQLError m, MonadPermissions m) => Query m
 resolveQuery = Query

backend/src/Datarekisteri/Backend/Email.hs

@@ -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>."

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

@@ -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)