~singpolyma/cheogram

7b7f09ddc563870d08733ca04a59caa6d7605ce7 — Stephen Paul Weber 6 years ago 7f01706
No one cares about join/part

SMS users rarely do it, and social cues might be in place to handle that
anyway.  Data users flap way to much to be useful, and usually can read
backscroll anyway so they'll see you message when they come back.

If you really want to see join/part messages, you can explicitly ask for
them, with a set debounce (in seconds)
1 files changed, 15 insertions(+), 4 deletions(-)

M Main.hs
M Main.hs => Main.hs +15 -4
@@ 777,7 777,7 @@ stripCIPrefix prefix str
	where
	(prefix', rest) = T.splitAt (T.length $ CI.original prefix) str

data Command = Help | Create Text | Join JID | JoinInvited | JoinInvitedWrong | Send Text | Who | List | Leave | InviteCmd JID | SetNick Text | Whisper JID Text | VitelityBogus Text
data Command = Help | Create Text | Join JID | JoinInvited | JoinInvitedWrong | Debounce Int | Send Text | Who | List | Leave | InviteCmd JID | SetNick Text | Whisper JID Text | VitelityBogus Text
	deriving (Show, Eq)

parseCommand txt room nick componentHost


@@ 797,6 797,8 @@ parseCommand txt room nick componentHost
			telToJid to (fromString componentHost) <|>
			(parseJID =<< fmap (\r -> bareTxt r <> fromString "/" <> to) room)
		) <*> pure msg
	| Just stime <- stripCIPrefix (fromString "/debounce ") txt,
	  Just time <- readMay stime = Just $ Debounce time
	| citxt == fromString "/join" = Just JoinInvited
	| citxt == fromString "join" = Just JoinInvitedWrong
	| citxt == fromString "/leave" = Just Leave


@@ 993,6 995,9 @@ processSMS db toVitelity toComponent componentHost conferenceServers tel txt = d
			| fromString "(SMSSERVER) " `T.isPrefixOf` msg -> return () -- bogus message from vitelity, ignore
			| Just room <- existingRoom -> sendToRoom toComponent componentHost tel room msg
			| otherwise -> writeStanzaChan toVitelity $ mkSMS tel (fromString "You are not joined to a group")
		Just (Debounce time) -> do
			True <- TC.runTCM (TC.put db (tcKey tel "debounce") (show time))
			return ()
		Just Help -> do
			writeStanzaChan toVitelity $ mkSMS tel $ fromString $ mconcat [
					"Invite to group: /invite phone-number\n",


@@ 1185,13 1190,17 @@ roomPresences db toRoomPresences =

data JoinPartDebounce = DebounceJoin Text JID (Maybe JID) | DebouncePart Text JID | DebounceExpire Text JID UTCTime deriving (Show)

joinPartDebouncer toVitelity toRoomPresences toJoinPartDebouncer = next mempty
joinPartDebouncer db toVitelity toRoomPresences toJoinPartDebouncer = next mempty
	where
	next state = do
		msg <- atomically (readTChan toJoinPartDebouncer)
		log "DEBOUNCE JOIN/PART" (msg, state)
		go state msg >>= next

	recordJoinPart tel from mjid join
		| join = atomically $ writeTChan toRoomPresences $ RecordJoin tel from mjid
		| otherwise = atomically $ writeTChan toRoomPresences $ RecordPart tel from

	sendPart tel from time = do
		log "DEBOUNCE PART, GONNA SEND" (tel, from, time)
		atomically $ writeTChan toRoomPresences $ RecordPart tel from


@@ 1224,8 1233,10 @@ joinPartDebouncer toVitelity toRoomPresences toJoinPartDebouncer = next mempty
			Just (_, _, j) | j /= join -> return $! Map.delete (tel, from) state -- debounce
			Just (_, _, _) -> return state -- ignore dupe
			Nothing -> do
				expire <- fmap (fromMaybe (-1) . (readZ =<<)) (TC.runTCM $ TC.get db (tcKey tel "debounce"))
				time <- getCurrentTime
				void $ forkIO $ threadDelay 120000000 >> atomically (writeTChan toJoinPartDebouncer $ DebounceExpire tel from time)
				if expire < 0 then recordJoinPart tel from mjid join else
					void $ forkIO $ threadDelay (expire*1000000) >> atomically (writeTChan toJoinPartDebouncer $ DebounceExpire tel from time)
				return $! Map.insert (tel, from) (time, mjid, join) state

	go state (DebounceJoin tel from mjid) =


@@ 1261,7 1272,7 @@ main = do

	void $ forkIO $ forever $ threadDelay 1500000 >> atomically (writeTChan chunks TimerExpire)
	void $ forkIO $ multipartStitcher db chunks toVitelity toComponent name conferences
	void $ forkIO $ joinPartDebouncer toVitelity toRoomPresences toJoinPartDebouncer
	void $ forkIO $ joinPartDebouncer db toVitelity toRoomPresences toJoinPartDebouncer
	void $ forkIO $ roomPresences db toRoomPresences

	void $ forkIO $ forever $ atomically (writeTChan toRejoinManager CheckPings) >> threadDelay 120000000