~singpolyma/cheogram

6c12cee0418835e6e37288cb305bf80db6408828 — Christopher Vollick 29 days ago 56e23b4
Expire JID Switch Key

I've added an expire command to the DB, and then I'm using it in the
JidSwitch branch.

I picked 24h as the expiry because I figure that'll give them enough
time to do some stuff but not clog up the DB or catch a bunch of people
unawares.
2 files changed, 11 insertions(+), 2 deletions(-)

M DB.hs
M Main.hs
M DB.hs => DB.hs +7 -1
@@ 1,4 1,4 @@
module DB (DB, Key(..), byJid, byNode, mk, get, getEnum, del, set, setEnum, sadd, srem, smembers, foldKeysM, hset, hdel, hgetall) where
module DB (DB, Key(..), byJid, byNode, mk, get, getEnum, del, set, expire, setEnum, sadd, srem, smembers, foldKeysM, hset, hdel, hgetall) where

import Prelude ()
import BasicPrelude


@@ 50,6 50,12 @@ set db key val = do
	Redis.Ok <- runRedisChecked db $ Redis.set (redisKey key) (encodeUtf8 val)
	return ()

expire :: (HasCallStack) => DB -> Key -> Integer -> IO ()
expire db key seconds = do
	-- True if set, False if key didn't exist, but actually I don't care
	_ <- runRedisChecked db $ Redis.expire (redisKey key) seconds
	return ()

setEnum :: (HasCallStack, Enum a) => DB -> Key -> a -> IO ()
setEnum db key val = do
	Redis.Ok <- runRedisChecked db $ Redis.set (redisKey key) (encodeUtf8 $ tshow $ fromEnum val)

M Main.hs => Main.hs +4 -1
@@ 923,7 923,10 @@ componentStanza (ComponentContext { db, componentJid }) (ReceivedIQ iq@(IQ { iqT
		let setJidSwitch newJid = do
			let from' = maybeUnescape componentJid from
			Just route <- (XMPP.parseJID <=< id) <$> DB.get db (DB.byJid from' ["direct-message-route"])
			DB.hset db (DB.byJid newJid ["jidSwitch"]) $ JidSwitch.toAssoc from' route
			let key = DB.byJid newJid ["jidSwitch"]
			DB.hset db key $ JidSwitch.toAssoc from' route
			-- I figure 24 hours is a wide enough window to accept a JID switch
			DB.expire db key $ 60 * 60 * 24
			return (from', newJid, route)
		in
		map mkStanzaRec <$> JidSwitch.receiveIq componentJid setJidSwitch iq