Serialize availability on connection; use right join for suggestions;…

… improve error messages

src/Client/Im/WebSocket/Events.purs

@@ -89,6 +89,8 @@ setUpWebsocket webSocketStateRef = do
 handleOpen ∷ Ref WebSocketState → Event → Effect Unit
 handleOpen webSocketStateRef _ = do
       state ← ER.read webSocketStateRef
+      --when the connection is open and the user is on the page serialize their availability
+      sendSetOnline state.webSocket
       --close event may have set up to open a new connection after this timeout
       case state.reconnectId of
             Nothing → pure unit
@@ -111,6 +113,10 @@ handleOpen webSocketStateRef _ = do
             isFocused ← CCD.documentHasFocus
             FS.send imId $ SendPing isFocused
 
+      sendSetOnline webSocket = do
+            isFocused ← CCD.documentHasFocus
+            when isFocused $ CIW.sendPayload webSocket SetOnline
+
 -- | Handle an incoming (json encoded) message from the server
 handleMessage ∷ Ref WebSocketState → Event → Effect Unit
 handleMessage webSocketStateRef event = do

src/Server/Im/Database.purs

@@ -59,7 +59,7 @@ userFields =
             /\ _temporary
             /\ (_onlineStatus # as onlineStatus)
             /\ (_completedTutorial # as completedTutorial)
-            /\ (select (_date # as _lastSeen) # from last_seen # wher (_who .=. u ... _id) # orderBy _who # limit (Proxy ∷ _ 1))
+            /\ (l ... _date # as _lastSeen)
             /\ (_messageTimestamps # as messageTimestamps)
             /\ (select (array_agg (l ... _name # orderBy (l ... _name)) # as _languages) # from (((languages # as l) `join` (languages_users # as lu)) # on (l ... _id .=. lu ... _language .&&. lu ... _speaker .=. u ... _id)) # orderBy _languages # limit (Proxy ∷ _ 1))
             /\ _joined
@@ -75,7 +75,7 @@ userFields =
 senderRecipientFilter loggedUserId otherId = wher ((_sender .=. loggedUserId .&&. _recipient .=. otherId) .||. (_sender .=. otherId .&&. _recipient .=. loggedUserId))
 
 usersSource ∷ _
-usersSource = join (users # as u) (karma_leaderboard # as k) # on (u ... _id .=. k ... _ranker)
+usersSource = join (join (users # as u) (karma_leaderboard # as k) # on (u ... _id .=. k ... _ranker)) (last_seen # as l) # on (u ... _id .=. _who)
 
 presentUser ∷ Int → ServerEffect (Maybe FlatUser)
 presentUser loggedUserId = SD.single $ select userPresentationFields # from usersSource # wher (u ... _id .=. loggedUserId .&&. _visibility .<>. TemporarilyBanned)
@@ -90,7 +90,7 @@ suggest loggedUserId skip =
             All → SD.query $ suggestAllQuery loggedUserId skip baseFilter
 
       where
-      onlineFilter = baseFilter .&&. (l ... _date) .>=. (spy "min" (ST.unsafeAdjustFromNow $ Minutes (-1.0)))
+      onlineFilter = baseFilter .&&. (l ... _date) .>=. (ST.unsafeAdjustFromNow $ Minutes (-1.0))
       thisWeekFilter = baseFilter .&&. (l ... _date) .>=. (ST.unsafeAdjustFromNow $ Days (-7.0))
       lastTwoWeeksFilter = baseFilter .&&. (l ... _date) .>=. (ST.unsafeAdjustFromNow $ Days (-14.0))
       lastMonthFilter = baseFilter .&&. (l ... _date) .>=. (ST.unsafeAdjustFromNow $ Days (-30.0))
@@ -103,7 +103,7 @@ suggest loggedUserId skip =
 -- top level to avoid monomorphic filter
 suggestBaseQuery loggedUserId filter =
       select (userFields /\ _bin)
-            # from (join (leftJoin (join usersSource (suggestions # as s) # on (u ... _id .=. _suggested)) histories # on (_sender .=. u ... _id .&&. _recipient .=. (loggedUserId ∷ Int) .||. _sender .=. loggedUserId .&&. _recipient .=. u ... _id)) (last_seen # as l) # on (u ... _id .=. _who))
+            # from (leftJoin (join usersSource (suggestions # as s) # on (u ... _id .=. _suggested)) histories # on (_sender .=. u ... _id .&&. _recipient .=. (loggedUserId ∷ Int) .||. _sender .=. loggedUserId .&&. _recipient .=. u ... _id))
             # wher filter
 
 suggestMainQuery loggedUserId skip filter =

src/Server/Im/Database/Flat.purs

@@ -8,12 +8,14 @@ import Data.DateTime (DateTime)
 import Data.Int as DI
 import Data.Maybe (Maybe(..))
 import Data.Maybe as DM
+import Data.Time.Duration (Minutes(..))
 import Debug (spy)
 import Safe.Coerce as SC
 import Server.Database.Types (Checked(..))
 import Shared.Avatar as SA
 import Shared.Badge (Badge)
 import Shared.DateTime (DateTimeWrapper(..))
+import Shared.DateTime as ST
 import Shared.Im.Types (Contact, HM, ImUser, HistoryMessage)
 import Shared.Privilege (Privilege)
 import Shared.Unsafe as SU
@@ -42,7 +44,7 @@ type FlatFields rest =
       , onlineStatus ∷ Checked
       , name ∷ String
       , tags ∷ Maybe (Array String)
-      , lastSeen ∷ Maybe DateTime
+      , lastSeen ∷ DateTime
       | rest
       }
 
@@ -90,7 +92,7 @@ fromFlatUser fc =
       , avatar: SA.parseAvatar fc.avatar
       , tags: DM.fromMaybe [] fc.tags
       , karma: fc.karma
-      , availability: DM.maybe None (LastSeen <<< DateTimeWrapper) fc.lastSeen
+      , availability: if fc.lastSeen >= ST.unsafeAdjustFromNow (Minutes (-1.0)) then Online else LastSeen $ DateTimeWrapper fc.lastSeen
       , karmaPosition: fc.karmaPosition
       , gender: show <$> fc.gender
       , country: fc.country

src/Server/Landing/Database.purs

@@ -11,8 +11,6 @@ import Server.Effect
 
 import Data.Maybe (Maybe)
 import Data.Tuple.Nested ((/\))
-import Effect.Now as EN
-import Run as ER
 import Server.Database as SD
 import Server.Database.Types (Checked(..))
 import Shared.Unsafe as SU
@@ -29,11 +27,9 @@ type UserSignUp =
 --refactor: add support on droplet
 createUser ∷ UserSignUp → ServerEffect Int
 createUser user = do
-      now ← ER.liftEffect EN.nowDateTime
       SD.withTransaction $ \connection → do
             userId ← _.id <<< SU.fromJust <$> (SD.singleWith connection (insert # into users (_name /\ _password /\ _email /\ _headline /\ _description /\ _temporary) # values (user.name /\ user.password /\ user.email /\ user.headline /\ user.description /\ Checked user.temporary) # returning _id))
             SD.executeWith connection $ insert # into karma_histories (_amount /\ _target) # values (50 /\ userId)
             SD.unsafeExecuteWith connection ("insert into karma_leaderboard(ranker, current_karma, gained, position) values (@ranker, 50, 0, ((select count(1) from karma_leaderboard) + 1))") { ranker: userId }
             SD.executeWith connection $ insert # into suggestions (_suggested /\ _score) # values (userId /\ 0)
-            SD.executeWith connection $ insert # into last_seen (_who /\ _date) # values (userId /\ now)
             pure userId

src/Server/WebSocket/Events.purs

@@ -167,11 +167,17 @@ handleMessage payload = do
             OutgoingMessage message → sendOutgoingMessage context.token context.loggedUserId allUsersAvailability message
             ChangeStatus changes → sendStatusChange context.token context.loggedUserId allUsersAvailability changes
             Typing { id } → sendTyping context.loggedUserId allUsersAvailability id
+            SetOnline → setOnline context.loggedUserId
             UpdatePrivileges → sendUpdatedPrivileges context.loggedUserId allUsersAvailability
             UpdateHash → sendUpdatedHash context.loggedUserId allUsersAvailability
             UnavailableFor { id } → sendUnavailability context.loggedUserId allUsersAvailability id
             Ban { id } → sendBan allUsersAvailability id
 
+setOnline ∷ Int → WebSocketEffect
+setOnline loggedUserId = do
+      now ← liftEffect EN.nowDateTime
+      SID.upsertLastSeen $ SJS.writeJSON [ { who: loggedUserId, date: DT now } ]
+
 sendBan ∷ HashMap Int UserAvailability → Int → WebSocketEffect
 sendBan allUsersAvailability userId = do
       let userAvailability = DH.lookup userId allUsersAvailability
@@ -372,6 +378,7 @@ withConnections userAvailability handler =
             Just ua → DF.traverse_ handler $ DH.values ua.connections
             Nothing → pure unit
 
+--we could save some work here by only serializing availabilities that have changed
 -- | Last seen dates are serialized every minute
 persistLastSeen ∷ WebSocketReaderLite → Effect Unit
 persistLastSeen context = do

src/Shared/Im/Types.purs

@@ -337,6 +337,7 @@ data ImMessage
 data WebSocketPayloadServer
       = UpdateHash
       | UpdatePrivileges
+      | SetOnline
       | Ping
               { isActive ∷ Boolean
               , statusFor ∷ Array Int

src/Shared/Im/View/SuggestionProfile.purs

@@ -67,8 +67,10 @@ suggestionProfile model@{ suggestions, contacts, suggesting, chatting, fullConta
       notChatting = DM.isNothing chatting
 
       emptySuggestions = HE.div (HA.class' { "suggestion empty retry": true, hidden: DM.isJust chatting })
-            ( onlineOnlyFilter model :
-                    (SIVR.retryForm "Could not find new suggestions" $ SpecialRequest NextSuggestion)
+            ( if model.suggestionsFrom == OnlineOnly then
+                    onlineOnlyFilter model : (SIVR.retryForm "No users currently online :(" $ SpecialRequest NextSuggestion)
+              else
+                    SIVR.retryForm "Could not find suggestions" $ SpecialRequest NextSuggestion
             )
 
       suggestionWarning = HE.div (HA.class' { "suggestion": true, hidden: DM.isJust chatting }) $ welcome model