Add asks notifications

Author: easafe

src/Client/Im/Changelog.purs

@@ -32,6 +32,7 @@ performChangelogAction action value model = model /\ effects
             Nothing → []
             Just OpenBackerPage → [ pure <<< Just $ SpecialRequest <<< ToggleModal $ Screen ShowBacker ]
             Just OpenExperimentsPage → [ pure <<< Just $ SpecialRequest <<< ToggleModal $ Screen ShowExperiments ]
+            Just OpenProfilePage → [ pure <<< Just $ SpecialRequest <<< ToggleModal $ Screen ShowProfile ]
             Just SendDoppelgangerMessage → [ pure <<< Just $ MessageFromExperiment (SU.fromJust value) SOD.message ]
 
 toggleChangelog ∷ ImModel → NoMessages

src/Client/Im/Main.purs

@@ -73,7 +73,7 @@ import Shared.Routes (routes)
 import Shared.Settings.Types (PrivacySettings)
 import Shared.Unsafe as SU
 import Shared.User as SUR
-import Test.Client.Model (model)
+
 import Type.Proxy (Proxy(..))
 import Web.DOM.Element as WDE
 import Web.DOM.Node as WDN

src/Server/Asks/Action.purs

@@ -10,6 +10,7 @@ import Data.String (Pattern(..))
 import Data.String as DS
 import Run.Except as RE
 import Server.Asks.Database as SAD
+import Server.Database as SD
 import Server.Database.Privileges as SDP
 import Server.Database.Privileges as SPD
 import Server.Effect (ServerEffect)
@@ -26,12 +27,14 @@ import Shared.Resource (Media(..), ResourceType(..))
 import Shared.Resource as SP
 import Shared.ResponseError (ResponseError(..))
 
-sendAsk ∷ Int → Int -> String → ServerEffect Boolean
+sendAsk ∷ Int → Int → String → ServerEffect Boolean
 sendAsk loggedUserId userId question = do
       let trimmed = DS.trim question
-      when (DS.length trimmed > maxAskCharacters) <<< RE.throw $ BadRequest { reason : "question too long" }
-      canSendAsk <- SPD.hasPrivilege loggedUserId SendAsks
-      unless canSendAsk <<< RE.throw $ BadRequest { reason : "not enough karma" }
+      when (DS.length trimmed > maxAskCharacters) <<< RE.throw $ BadRequest { reason: "question too long" }
+      canSendAsk ← SPD.hasPrivilege loggedUserId SendAsks
+      unless canSendAsk <<< RE.throw $ BadRequest { reason: "not enough karma" }
       allowedToAsk ← SAD.isAllowedToAsk loggedUserId userId
-      when allowedToAsk $ SAD.saveAsk loggedUserId userId question
+      when allowedToAsk <<< SD.withTransaction $ \connection -> do
+            SAD.saveAsk connection loggedUserId userId question
+            SAD.notifyAsk connection userId
       pure allowedToAsk

src/Server/Asks/Database.purs

@@ -3,33 +3,44 @@ module Server.Asks.Database where
 import Droplet.Language
 import Prelude hiding (not)
 
+import Data.Maybe (Maybe(..))
 import Data.Maybe as DM
 import Data.Tuple.Nested ((/\))
+import Droplet.Driver.Internal.Query (Connection(..))
 import Server.Database as SD
 import Server.Database.Asks (_answer, _answerer, _asker, asks)
 import Server.Database.Blocks (_blocked, _blocker, blocks)
+import Server.Database.Changelogs (_action, _changed, changelogs)
 import Server.Database.DoppelgangerQuestions (_question)
+import Server.Database.Experiments (_description)
 import Server.Database.Fields (_id, _recipient, _sender, l, s, u)
 import Server.Database.Histories (histories)
 import Server.Database.Types (Checked(..))
 import Server.Database.Users (_asksVisibility, _temporary, users)
 import Server.Effect (ServerEffect)
+import Shared.Changelog (ChangelogAction(..))
 import Shared.User (ProfileVisibility(..))
 
-isAllowedToAsk :: Int -> Int -> ServerEffect Boolean
+isAllowedToAsk ∷ Int → Int → ServerEffect Boolean
 isAllowedToAsk loggedUserId userId = do
-    found <- SD.single $ select _id # from (users # as u) # wher ( u ... _id .=. userId .&&.
-              ( _asksVisibility .=. Everyone
-                      .||. _asksVisibility
-                      .=. NoTemporaryUsers
-                      .&&. not (exists $ select (1 # as l) # from (users # as s) # wher (s ... _id .=. loggedUserId .&&. _temporary .=. Checked true))
-                      .||. _asksVisibility
-                      .=. Contacts
-                      .&&. (exists $ select (1 # as l) # from (histories # as s) # wher (_sender .=. loggedUserId .&&. _recipient .=. userId .||. _recipient .=. loggedUserId .&&. _sender .=. userId))
-              ) .&&. not (exists $ select (1 # as u) # from blocks # wher (_blocker .=. loggedUserId .&&. _blocked .=. u ... _id .||. _blocker .=. u ... _id .&&. _blocked .=. loggedUserId))
-                .&&. not (exists $ select (1 # as u) # from asks # wher (_answerer .=. (u ... _id) .&&. _asker .=. loggedUserId .&&. isNull _answer))
-      )
-    pure $ DM.isJust found
+      found ← SD.single $ select _id # from (users # as u) # wher
+            ( u ... _id .=. userId
+                    .&&.
+                          ( _asksVisibility .=. Everyone
+                                  .||. _asksVisibility
+                                  .=. NoTemporaryUsers
+                                  .&&. not (exists $ select (1 # as l) # from (users # as s) # wher (s ... _id .=. loggedUserId .&&. _temporary .=. Checked true))
+                                  .||. _asksVisibility
+                                  .=. Contacts
+                                  .&&. (exists $ select (1 # as l) # from (histories # as s) # wher (_sender .=. loggedUserId .&&. _recipient .=. userId .||. _recipient .=. loggedUserId .&&. _sender .=. userId))
+                          )
+                    .&&. not (exists $ select (1 # as u) # from blocks # wher (_blocker .=. loggedUserId .&&. _blocked .=. u ... _id .||. _blocker .=. u ... _id .&&. _blocked .=. loggedUserId))
+                    .&&. not (exists $ select (1 # as u) # from asks # wher (_answerer .=. (u ... _id) .&&. _asker .=. loggedUserId .&&. isNull _answer))
+            )
+      pure $ DM.isJust found
 
-saveAsk :: Int -> Int -> String -> ServerEffect Unit
-saveAsk loggedUserId useId question = SD.execute $ insert # into asks (_asker /\ _answerer /\ _question) # values (loggedUserId /\ useId /\ question)
+saveAsk ∷ Connection → Int → Int → String → _ Unit
+saveAsk connection loggedUserId useId question = SD.executeWith connection $ insert # into asks (_asker /\ _answerer /\ _question) # values (loggedUserId /\ useId /\ question)
+
+notifyAsk ∷ Connection → Int → _
+notifyAsk connection userId = SD.executeWith connection $ insert # into changelogs (_changed /\ _description /\ _action) # values (Just userId /\ "You have a new ask! Answer here" /\ Just OpenProfilePage)

src/Shared/Changelog.purs

@@ -24,7 +24,7 @@ type Changelog =
       , read ∷ Boolean
       }
 
-data ChangelogAction = OpenBackerPage | SendDoppelgangerMessage | OpenExperimentsPage
+data ChangelogAction = OpenBackerPage | SendDoppelgangerMessage | OpenExperimentsPage | OpenProfilePage
 
 derive instance Generic ChangelogAction _
 
@@ -42,7 +42,7 @@ instance ToValue ChangelogAction where
 
 instance Bounded ChangelogAction where
       bottom = OpenBackerPage
-      top = OpenExperimentsPage
+      top = OpenProfilePage
 
 instance BoundedEnum ChangelogAction where
       cardinality = Cardinality 1
@@ -51,23 +51,27 @@ instance BoundedEnum ChangelogAction where
             OpenBackerPage → 0
             SendDoppelgangerMessage → 1
             OpenExperimentsPage → 2
+            OpenProfilePage -> 3
 
       toEnum = case _ of
             0 → Just OpenBackerPage
             1 → Just SendDoppelgangerMessage
             2 → Just OpenExperimentsPage
+            3 -> Just OpenProfilePage
             _ → Nothing
 
 instance Enum ChangelogAction where
       succ = case _ of
             OpenBackerPage → Just SendDoppelgangerMessage
             SendDoppelgangerMessage → Just OpenExperimentsPage
-            OpenExperimentsPage → Nothing
+            OpenExperimentsPage → Just OpenProfilePage
+            OpenProfilePage -> Nothing
 
       pred = case _ of
             OpenBackerPage → Nothing
             SendDoppelgangerMessage → Just OpenBackerPage
             OpenExperimentsPage → Just SendDoppelgangerMessage
+            OpenProfilePage -> Just OpenExperimentsPage
 
 derive instance Eq ChangelogAction