We are no longer offering accounts on this server. Consider https://gitlab.freedesktop.org/ as a place to host projects.

Commit 59b03387 authored by Mitchell Rosen's avatar Mitchell Rosen

update Message to Notification

parent 9a514e60
......@@ -43,13 +43,12 @@ import Yesod.Default.Main
-- Don't forget to add new modules to your cabal file!
import Handler.BuildFeed
import Handler.Contact
import Handler.Home
import Handler.HonorPledge
import Handler.Invitation
import Handler.JsLicense
import Handler.MarkdownTutorial
import Handler.Messages
import Handler.Notification
import Handler.PostLogin
import Handler.Privacy
import Handler.Project
......
......@@ -3,7 +3,7 @@ module Foundation where
import Model
import Model.Currency
import Model.Established.Internal (Established(..))
import Model.Message.Internal (MessageType(..), MessageDelivery(..))
import Model.Notification.Internal (NotificationType(..), NotificationDelivery(..))
import Model.SnowdriftEvent.Internal
import qualified Settings
import Settings (widgetFile, Extra (..))
......@@ -362,22 +362,22 @@ createUser ident passwd name avatar nick = do
forM_ default_tag_colors $ \ (Entity _ (DefaultTagColor tag color)) -> insert $ TagColor tag user_id color
--
insertDefaultMessagePrefs user_id
insertDefaultNotificationPrefs user_id
let message_text = Markdown $ T.unlines
let notif_text = Markdown $ T.unlines
[ "Thanks for registering!"
, "<br> Please read our [**welcome message**](/p/snowdrift/w/welcome), and let us know any questions."
]
-- TODO: change snowdrift_id to the generated site-project id
-- TODO(mitchell): This message doesn't get sent to the event channel. Is that okay?
insert_ $ Message now MessageDirect Nothing (Just snowdrift_id) user_id Nothing message_text False
-- TODO(mitchell): This notification doesn't get sent to the event channel. Is that okay?
insert_ $ Notification now NotifWelcome user_id (Just snowdrift_id) notif_text False
return $ Just user_id
Nothing -> do
lift $ addAlert "danger" "E-mail or handle already in use."
throwIO DBException
where
insertDefaultMessagePrefs :: UserId -> DB ()
insertDefaultMessagePrefs user_id = insert_ $ UserMessagePref user_id MessageReply DeliverInternal
insertDefaultNotificationPrefs :: UserId -> DB ()
insertDefaultNotificationPrefs user_id = insert_ (UserNotificationPref user_id NotifReply NotifDeliverInternal)
instance YesodJquery App
......
module Handler.Contact where
import Import
import Model.Message
import Widgets.Markdown
contactForm :: Form Markdown
contactForm = renderBootstrap3 $ areq' snowdriftMarkdownField "" Nothing
getContactR :: Text -> Handler Html
getContactR project_handle = do
(contact_form, _) <- generateFormPost contactForm
Entity _ project <- runYDB $ getBy404 (UniqueProjectHandle project_handle)
defaultLayout $ do
setTitle . toHtml $ "Contact " <> projectName project <> " | Snowdrift.coop"
$(widgetFile "contact")
postContactR :: Text -> Handler Html
postContactR project_handle = do
maybe_user_id <- maybeAuthId
((result, _), _) <- runFormPost contactForm
case result of
FormSuccess content -> do
runSYDB $ do
Entity project_id _ <- lift $ getBy404 $ UniqueProjectHandle project_handle
void $
case maybe_user_id of
Nothing -> sendAnonymousMessageDB project_id content
Just user_id -> sendU2PMessageDB user_id project_id content
alertSuccess "Comment submitted. Thank you for your input!"
_ -> alertDanger "Error occurred when submitting form."
redirect $ ContactR project_handle
module Handler.Messages where
import Import
import Model.Message
import Model.Project
import Model.User
import Widgets.Time
import Data.Maybe
import qualified Data.Map as M
getMessagesR :: Handler Html
getMessagesR = do
user@(Entity user_id _) <- requireAuth
(messages, user_map) <- runDB $ do
messages <- fetchUserMessagesDB user_id
let from_users = catMaybes (map (messageFromUser . entityVal) messages)
user_map <- entitiesMap . (user :) <$> fetchUsersInDB from_users
userReadMessagesDB user_id
return (messages, user_map)
defaultLayout $ do
setTitle "Messages | Snowdrift.coop"
$(widgetFile "messages")
-- TODO(mitchell): Share more code with getMessagesR?
getArchivedMessagesR :: Handler Html
getArchivedMessagesR = do
user@(Entity user_id _) <- requireAuth
(messages, user_map) <- runDB $ do
messages <- fetchUserArchivedMessagesDB user_id
let from_users = catMaybes (map (messageFromUser . entityVal) messages)
user_map <- entitiesMap . (user :) <$> fetchUsersInDB from_users
return (messages, user_map)
defaultLayout $ do
setTitle "Messages | Snowdrift.coop"
$(widgetFile "messages")
postArchiveMessageR :: MessageId -> Handler ()
postArchiveMessageR message_id = do
user_id <- requireAuthId
runYDB $ do
message <- get404 message_id
unless (user_id == messageToUser message) $
lift (permissionDenied "You can't archive this message.")
archiveMessageDB message_id
module Handler.Notification where
import Import
import Model.Notification
import Model.Project
import Model.User
import Widgets.Time
getNotificationsR :: Handler Html
getNotificationsR = do
user_id <- requireAuthId
notifs <- runDB $ do
userReadNotificationsDB user_id
fetchUserNotificationsDB user_id
defaultLayout $ do
setTitle "Notifications | Snowdrift.coop"
$(widgetFile "notifications")
getArchivedNotificationsR :: Handler Html
getArchivedNotificationsR = do
user_id <- requireAuthId
notifs <- runDB (fetchUserArchivedNotificationsDB user_id)
defaultLayout $ do
setTitle "Notifications | Snowdrift.coop"
$(widgetFile "notifications")
postArchiveNotificationR :: NotificationId -> Handler ()
postArchiveNotificationR notif_id = do
user_id <- requireAuthId
runYDB $ do
notif <- get404 notif_id
unless (user_id == notificationTo notif) $
lift (permissionDenied "You can't archive this notification.")
archiveNotificationDB notif_id
......@@ -8,7 +8,7 @@ import Data.Tree.Extra (sortForestBy)
import Handler.Wiki.Comment (getMaxDepth, processWikiComment)
import Model.Comment
import Model.Markdown
import Model.Message
import Model.Notification
import Model.Permission
import Model.Tag (getAllTagsMap)
import Model.User
......@@ -167,16 +167,15 @@ postWikiR project_handle target = do
lift $ insert_ $ Ticket now now "edit conflict" comment_id
render <- lift getUrlRenderParams
let message_text = Markdown $ T.unlines
let notif_text = Markdown $ T.unlines
[ "Edit conflict for wiki page *" <> target <> "*."
, "<br>[**Ticket created**](" <> render (DiscussCommentR project_handle target comment_id) [] <> ")"
]
-- TODO(mitchell): new MessageType for edit conflict
void $ sendNotificationMessageDB MessageDirect last_editor message_text
void $ sendNotificationMessageDB MessageDirect user_id message_text
sendNotificationDB_ NotifEditConflict last_editor Nothing notif_text
sendNotificationDB_ NotifEditConflict user_id Nothing notif_text
lift (lift (alertDanger "conflicting edits (ticket created, messages sent)"))
lift (lift (alertDanger "conflicting edits (ticket created, notification sent)"))
case either_last_edit of
Left (Entity to_update _) -> lift $
......
......@@ -2,27 +2,27 @@
module Model where
import Model.Comment.Internal (ClosureType, FlagReason)
import Model.Currency (Milray)
import Model.Established.Internal (Established(..))
import Model.Markdown.Diff (MarkdownDiff)
import Model.Message.Internal (MessageType, MessageDelivery)
import Model.Permission.Internal (PermissionLevel)
import Model.Role.Internal (Role)
import Model.Settings.Internal (UserSettingName)
import Model.ViewType.Internal (ViewType)
import Control.Exception (Exception)
import Data.Int (Int64)
import Data.Function (on)
import Data.Text (Text)
import Data.Time.Clock (UTCTime)
import Data.Typeable (Typeable)
import Model.Comment.Internal (ClosureType, FlagReason)
import Model.Currency (Milray)
import Model.Established.Internal (Established(..))
import Model.Markdown.Diff (MarkdownDiff)
import Model.Notification.Internal (NotificationType, NotificationDelivery)
import Model.Permission.Internal (PermissionLevel)
import Model.Role.Internal (Role)
import Model.Settings.Internal (UserSettingName)
import Model.ViewType.Internal (ViewType)
import Control.Exception (Exception)
import Data.Int (Int64)
import Data.Function (on)
import Data.Text (Text)
import Data.Time.Clock (UTCTime)
import Data.Typeable (Typeable)
import Database.Persist.Quasi
import Prelude
import Yesod
import Yesod.Auth.HashDB (HashDBUser (..))
import Yesod.Markdown (Markdown)
import Yesod.Auth.HashDB (HashDBUser (..))
import Yesod.Markdown (Markdown)
-- You can define all of your database entities in the entities file.
-- You can find more information on persistent and how to declare entities
......
......@@ -52,7 +52,7 @@ module Model.Comment
import Import
import Model.Comment.Sql
import Model.Message
import Model.Notification
import qualified Control.Monad.State as St
import Control.Monad.Writer.Strict (tell)
......@@ -162,7 +162,7 @@ approveCommentDB user_id comment_id comment = do
}
lift $ do
updateComment now
deleteUnapprovedMessages
deleteUnapprovedCommentNotifications
tell [ECommentPosted comment_id updated_comment]
where
updateComment now =
......@@ -172,16 +172,16 @@ approveCommentDB user_id comment_id comment = do
]
where_ (c ^. CommentId ==. val comment_id)
-- Delete all messages sent about this pending comment, as they no longer apply.
-- Also deletes the UnapprovedMessageComment entities, the EventMessageSent,
-- and any other rows with a foreign key on MessageId.
deleteUnapprovedMessages = do
msg_ids <- fmap (map unValue) $
select $
from $ \umc -> do
where_ (umc ^. UnapprovedMessageCommentComment ==. val comment_id)
return (umc ^. UnapprovedMessageCommentMessage)
deleteCascadeWhere [MessageId P.<-. msg_ids]
-- Delete all notifications sent about this pending comment, as they no longer apply.
-- Also deletes the UnapprovedCommentNotification entities, the EventNotificationSent,
-- and any other rows with a foreign key on NotificationId.
deleteUnapprovedCommentNotifications = do
notif_ids <- fmap (map unValue) $
select $
from $ \unc -> do
where_ (unc ^. UnapprovedCommentNotificationComment ==. val comment_id)
return (unc ^. UnapprovedCommentNotificationNotification)
deleteCascadeWhere [NotificationId P.<-. notif_ids]
insertApprovedCommentDB :: UTCTime
-> UTCTime
......@@ -242,7 +242,7 @@ deleteCommentDB :: CommentId -> DB ()
deleteCommentDB = deleteCascade
-- | Edit a comment's text. If the comment was flagged, unflag it and send a
-- message to the flagger.
-- notification to the flagger.
editCommentDB :: CommentId -> Markdown -> SYDB ()
editCommentDB comment_id text = do
lift updateCommentText
......@@ -254,16 +254,16 @@ editCommentDB comment_id text = do
commentFlaggingTarget
comment_id
permalink_text <- lift $ getUrlRender <*> pure permalink_route
let message_text = Markdown $ "A comment you flagged has been edited and reposted to the site. You can view it [here](" <> permalink_text <> ")."
lift $ deleteCascade comment_flagging_id -- delete flagging and all flagging reasons with it.
void $ sendNotificationMessageDB MessageDirect commentFlaggingFlagger message_text
let notif_text = Markdown $ "A comment you flagged has been edited and reposted to the site. You can view it [here](" <> permalink_text <> ")."
lift (deleteCascade comment_flagging_id) -- delete flagging and all flagging reasons with it.
sendNotificationDB_ NotifFlagRepost commentFlaggingFlagger Nothing notif_text
where
updateCommentText =
update $ \c -> do
set c [ CommentText =. val text ]
where_ (c ^. CommentId ==. val comment_id)
-- | Flag a comment. Send a message to the poster about the flagging. Return whether
-- | Flag a comment. Send a notification to the poster about the flagging. Return whether
-- or not the flag was successful (fails if the comment was already flagged.)
flagCommentDB :: Text -> Text -> CommentId -> Text -> UserId -> [FlagReason] -> Maybe Markdown -> SYDB Bool
flagCommentDB project_handle target comment_id permalink_route flagger_id reasons message = do
......@@ -274,7 +274,7 @@ flagCommentDB project_handle target comment_id permalink_route flagger_id reason
Just flagging_id -> do
lift $ void $ insertMany (map (CommentFlaggingReason flagging_id) reasons)
let message_text = Markdown . T.unlines $
let notif_text = Markdown . T.unlines $
[ "Another user flagged your comment as not meeting the standards of the Code of Conduct. We *want* your involvement as long as it remains respectful and friendly, so please don’t feel discouraged."
, ""
, "Please follow the link below for clarification and suggestions the flagger may have offered, and take this chance to improve your tone and clarify any misunderstanding. Your newly edited comment will then be publicly visible again."
......@@ -283,7 +283,7 @@ flagCommentDB project_handle target comment_id permalink_route flagger_id reason
, ""
, "[link to flagged comment](" <> permalink_route <> ")"
]
void $ sendNotificationMessageDB MessageDirect poster_id message_text
sendNotificationDB_ NotifFlag poster_id Nothing notif_text
return True
-- | Filter a list of comments per the permission filter (see Model.Comment.Sql.exprPermissionFilter)
......
module Model.Message
( archiveMessageDB
, sendAnonymousMessageDB
, sendNotificationMessageDB
, sendU2UMessageDB
, sendU2PMessageDB
, sendP2UMessageDB
, sendP2PMessageDB
, module Model.Message.Internal
) where
import Import
import Model.Message.Internal
import Model.Project
import Control.Monad.Writer.Strict (tell)
-- | Archive a message.
archiveMessageDB :: MessageId -> DB ()
archiveMessageDB message_id =
update $ \m -> do
set m [MessageArchived =. val True]
where_ (m ^. MessageId ==. val message_id)
-- | Send an anonymous Message to a Project (as feedback, presumably).
sendAnonymousMessageDB :: ProjectId -> Markdown -> SDB [MessageId]
sendAnonymousMessageDB = sendMessage2P Nothing Nothing
-- | Send a "notification" Message that doesn't come from any particular User or Project.
sendNotificationMessageDB :: MessageType -> UserId -> Markdown -> SDB MessageId
sendNotificationMessageDB message_type to_user = sendMessage message_type Nothing Nothing to_user Nothing
-- | Send User-to-User Message.
sendU2UMessageDB :: UserId -> UserId -> Markdown -> SDB MessageId
sendU2UMessageDB from_user to_user = sendMessage MessageDirect (Just from_user) Nothing to_user Nothing
-- | Send User-to-Project Message.
sendU2PMessageDB :: UserId -> ProjectId -> Markdown -> SDB [MessageId]
sendU2PMessageDB from_user = sendMessage2P (Just from_user) Nothing
-- | Send Project-to-User Message, possibly from an actual User (who is representing the Project).
sendP2UMessageDB :: MessageType -> Maybe UserId -> ProjectId -> UserId -> Markdown -> SDB MessageId
sendP2UMessageDB message_type mfrom_user from_project to_user =
sendMessage message_type mfrom_user (Just from_project) to_user Nothing
-- | Send Project-to-Project Message, possibly from an actual User (who is representing the Project).
sendP2PMessageDB :: Maybe UserId -> ProjectId -> ProjectId -> Markdown -> SDB [MessageId]
sendP2PMessageDB mfrom_user from_project = sendMessage2P mfrom_user (Just from_project)
-- | Abstract sending a Message to all team members of a Project.
sendMessage2P :: Maybe UserId -> Maybe ProjectId -> ProjectId -> Markdown -> SDB [MessageId]
sendMessage2P mfrom_user mfrom_project to_project content = lift (fetchProjectTeamMembersDB to_project) >>= mapM go
where
go :: UserId -> SDB MessageId
go to_user = sendMessage MessageDirect mfrom_user mfrom_project to_user (Just to_project) content
-- | Abstract sending all types of messages. Unexported.
sendMessage :: MessageType -> Maybe UserId -> Maybe ProjectId -> UserId -> Maybe ProjectId -> Markdown -> SDB MessageId
sendMessage message_type mfrom_user mfrom_project to_user mto_project content = do
now <- liftIO getCurrentTime
let message = Message now message_type mfrom_user mfrom_project to_user mto_project content False
message_id <- lift (insert message)
tell [EMessageSent message_id message]
return message_id
module Model.Message.Internal where
import Prelude
import Database.Persist.TH
import Data.Text (Text)
data MessageType
-- Generic "direct" message (can't be ignored)
= MessageDirect
-- Balance low (can't be ignored)
| MessageBalanceLow
-- Alert moderators about an unapproved comment.
-- These messages are auto-deleted when the comment is approved.
| MessageUnapprovedComment
-- Reply to a comment made.
| MessageReply
-- New projected created on Snowdrift.
| MessageNewProject
-- New pledger to a Project.
| MessageNewPledger
-- New WikiPage.
| MessageNewPage
deriving (Eq, Read, Show)
derivePersistField "MessageType"
showMessageType :: MessageType -> Text
showMessageType MessageDirect = "Snowdrift direct messages"
showMessageType MessageUnapprovedComment = "Unapproved comments"
showMessageType MessageBalanceLow = "Balance low"
showMessageType MessageReply = "Replies to my comments"
showMessageType MessageNewProject = "New project sign-ups"
showMessageType MessageNewPledger = "New pledgers"
showMessageType MessageNewPage = "New Wiki pages"
data MessageDelivery
= DeliverInternal -- Only send internal Snowdrift messages.
| DeliverEmail -- Send email in addition to internal messages.
| DeliverEmailDigest -- Send email digest in addition to internal messages (sent immediately)
deriving (Read, Show)
derivePersistField "MessageDelivery"
-- | Can this message type be filtered out entirely?
messagePreferenceCanBeNone :: MessageType -> Bool
messagePreferenceCanBeNone MessageDirect = False
messagePreferenceCanBeNone MessageBalanceLow = False
messagePreferenceCanBeNone MessageUnapprovedComment = True
messagePreferenceCanBeNone MessageReply = True
messagePreferenceCanBeNone MessageNewProject = True
messagePreferenceCanBeNone MessageNewPledger = True
messagePreferenceCanBeNone MessageNewPage = True
module Model.Notification
( archiveNotificationDB
, sendNotificationDB
, sendNotificationDB_
, module Model.Notification.Internal
) where
import Import
import Model.Notification.Internal
import Control.Monad.Writer.Strict (tell)
-- | Archive a notification.
archiveNotificationDB :: NotificationId -> DB ()
archiveNotificationDB notif_id =
update $ \n -> do
set n [NotificationArchived =. val True]
where_ (n ^. NotificationId ==. val notif_id)
-- | Send a notification to a user.
sendNotificationDB :: NotificationType -> UserId -> Maybe ProjectId -> Markdown -> SDB NotificationId
sendNotificationDB notif_type user_id mproject_id content = do
now <- liftIO getCurrentTime
let notif = Notification now notif_type user_id mproject_id content False
notif_id <- lift (insert notif)
tell [ENotificationSent notif_id notif]
return notif_id
sendNotificationDB_ :: NotificationType -> UserId -> Maybe ProjectId -> Markdown -> SDB ()
sendNotificationDB_ notif_type user_id mproject_id content = void (sendNotificationDB notif_type user_id mproject_id content)
module Model.Notification.Internal where
import Prelude
import Database.Persist.TH
import Data.Text (Text)
data NotificationType
= NotifWelcome
-- User has become eligible for establishment.
| NotifEligEstablish
-- Balance low (can't be ignored)
| NotifBalanceLow
-- Alert moderators about an unapproved comment.
-- These notifications are auto-deleted when the comment is approved.
| NotifUnapprovedComment
-- Reply to a comment made.
| NotifReply
-- Edit conflict.
| NotifEditConflict
-- Comment flagged.
| NotifFlag
-- Flagged comment was reposted.
| NotifFlagRepost
deriving (Eq, Read, Show)
derivePersistField "NotificationType"
showNotificationType :: NotificationType -> Text
showNotificationType NotifWelcome = "Snowdrift welcome message"
showNotificationType NotifEligEstablish = "You have become eligible for establishment"
showNotificationType NotifUnapprovedComment = "Unapproved comments"
showNotificationType NotifBalanceLow = "Balance low"
showNotificationType NotifReply = "Replies to my comments"
showNotificationType NotifEditConflict = "Edit conflict"
showNotificationType NotifFlag = "A comment of yours was flagged"
showNotificationType NotifFlagRepost = "A comment you flagged was edited and reposted"
data NotificationDelivery
= NotifDeliverInternal -- Only send notifications.
| NotifDeliverEmail -- Send email in addition to notifications.
| NotifDeliverEmailDigest -- Send email digest in addition to notifications (sent immediately).
deriving (Read, Show)
derivePersistField "NotificationDelivery"
......@@ -10,7 +10,7 @@ snowdriftEventNewestToOldest x y = compare (snowdriftEventTime y) (snowdriftEve
snowdriftEventTime :: SnowdriftEvent -> UTCTime
snowdriftEventTime (ECommentPosted _ Comment{..}) = fromMaybe commentCreatedTs commentModeratedTs
snowdriftEventTime (ECommentPending _ Comment{..}) = commentCreatedTs
snowdriftEventTime (EMessageSent _ Message{..}) = messageCreatedTs
snowdriftEventTime (ENotificationSent _ Notification{..}) = notificationCreatedTs
snowdriftEventTime (EWikiEdit _ WikiEdit{..}) = wikiEditTs
snowdriftEventTime (EWikiPage _ WikiPage{..}) = wikiPageCreatedTs
snowdriftEventTime (ENewPledge _ SharesPledged{..}) = sharesPledgedTs
......
......@@ -13,7 +13,7 @@ data SnowdriftEvent
= ECommentPosted CommentId Comment
-- Comment unapproved (pending approval).
| ECommentPending CommentId Comment
| EMessageSent MessageId Message
| ENotificationSent NotificationId Notification
-- New WikiEdit made.
| EWikiEdit WikiEditId WikiEdit
-- New WikiPage posted.
......
......@@ -17,12 +17,12 @@ module Model.User
, establishUserDB
, fetchAllUserRolesDB
, fetchCurUserRolesDB
, fetchNumUnreadMessagesDB
, fetchNumUnreadNotificationsDB
, fetchNumUnviewedCommentsOnProjectWikiPagesDB
, fetchNumUnviewedWikiEditsOnProjectDB
, fetchUserArchivedMessagesDB
, fetchUserMessagesDB
, fetchUserMessagePrefDB
, fetchUserArchivedNotificationsDB
, fetchUserNotificationsDB
, fetchUserNotificationPrefDB
, fetchUserProjectsAndRolesDB
, fetchUserRolesDB
, fetchUsersInDB
......@@ -35,7 +35,7 @@ module Model.User
, userIsProjectModeratorDB
, userIsProjectTeamMemberDB
, userIsWatchingProjectDB
, userReadMessagesDB
, userReadNotificationsDB
, userReadVolunteerApplicationsDB
, userUnwatchProjectDB
, userViewCommentsDB
......@@ -51,7 +51,7 @@ import Import
import Model.Comment
import Model.Comment.Sql
import Model.Message
import Model.Notification
import Model.Project.Sql
import Model.User.Sql
import Model.WikiPage.Sql
......@@ -73,7 +73,7 @@ data UserUpdate =
, userUpdateIrcNick :: Maybe Text
, userUpdateBlurb :: Maybe Markdown
, userUpdateStatement :: Maybe Markdown
, userUpdateMessagePreferences :: [(MessageType, MessageDelivery)]
, userUpdateNotificationPreferences :: [(NotificationType, NotificationDelivery)]
}
--------------------------------------------------------------------------------
......@@ -116,7 +116,7 @@ userDisplayName :: Entity User -> Text
userDisplayName (Entity user_id user) = fromMaybe ("user" <> toPathPiece user_id) (userName user)
-- | Apply a UserUpdate in memory, for preview. For this reason,
-- userUpdateMessagePreferences doesn't need to be touched.
-- userUpdateNotificationPreferences doesn't need to be touched.
updateUserPreview :: UserUpdate -> User -> User
updateUserPreview UserUpdate{..} user = user
{ userName = userUpdateName
......@@ -147,7 +147,7 @@ updateUserDB user_id UserUpdate{..} = do
from $ \ump -> do
where_ (ump ^. UserId ==. val user_id)
let new_prefs = map (uncurry (UserMessagePref user_id)) userUpdateMessagePreferences
let new_prefs = map (uncurry (UserNotificationPref user_id)) userUpdateNotificationPreferences
void (insertMany new_prefs)
-- | Establish a user, given their eligible-timestamp and reason for
......@@ -173,7 +173,7 @@ establishUserDB user_id elig_time reason = do
c ^. CommentUser ==. val user_id &&.
exprUnapproved c
-- | Make a user eligible for establishment. Put a message in their inbox
-- | Make a user eligible for establishment. Put a notification in their inbox
-- instructing them to read and accept the honor pledge.
eligEstablishUserDB :: UserId -> UserId -> Text -> SDB ()
eligEstablishUserDB establisher_id user_id reason = do
......@@ -181,16 +181,16 @@ eligEstablishUserDB establisher_id user_id reason = do
let est = EstEligible elig_time reason
lift $
update $ \u -> do
set u [ UserEstablished =. val est ]
set u [UserEstablished =. val est]
where_ (u ^. UserId ==. val user_id)
lift $ insert_ $ ManualEstablishment user_id establisher_id