1 files changed, 26 insertions(+), 13 deletions(-)

M Main.hs

@@ 308,7 308,7 @@ sendRegisterVerification db toVitelity toComponent tel iq = do
 			iqPayload = Just verificationResponse
 		}
 
-handleVerificationCode db toComponent password iq = do
+handleVerificationCode db toComponent componentHost password iq = do
 	time <- getCurrentTime
 	codeAndTime <- fmap (readZ =<<) $ TC.runTCM $ TC.get db regKey
 	if (fmap expires codeAndTime > Just ((-300) `addUTCTime` time)) then


@@ 328,6 328,19 @@ handleVerificationCode db toComponent password iq = do
 
 				True <- TC.runTCM $ TC.put db (T.unpack (bareTxt from) <> "\0registered") (T.unpack tel)
 				tcPutJID db tel "registered" from
+
+				-- If there is a nick that doesn't end in _sms, add _sms
+				nick <- TC.runTCM (TC.get db $ tcKey tel "nick")
+				forM_ nick $ \nick -> do
+					let nick' = (fromMaybe (fromString nick) $ T.stripSuffix (fromString "_sms") (fromString nick)) <> fromString "_sms"
+
+					existingRoom <- (parseJID <=< fmap bareTxt) <$> tcGetJID db tel "joined"
+					forM_ existingRoom $ \room -> do
+						let toJoin = parseJID (bareTxt room <> fromString "/" <> nick')
+						forM_ toJoin $ joinRoom db toComponent componentHost tel
+
+					True <- TC.runTCM (TC.put db (tcKey tel "nick") (T.unpack nick'))
+					return ()
 			_ ->
 				writeStanzaChan toComponent $ iq {
 					iqTo = iqFrom iq,


@@ 342,7 355,7 @@ handleVerificationCode db toComponent password iq = do
 	where
 	regKey = (maybe mempty T.unpack $ bareTxt <$> iqFrom iq) <> "\0registration_code"
 
-handleRegister db _ toComponent iq@(IQ { iqType = IQGet }) _ = do
+handleRegister db _ toComponent _ iq@(IQ { iqType = IQGet }) _ = do
 	time <- getCurrentTime
 	codeAndTime <- fmap (readZ =<<) $ TC.runTCM $ TC.get db ((maybe mempty T.unpack $ bareTxt <$> iqFrom iq) <> "\0registration_code")
 	if fmap expires codeAndTime > Just ((-300) `addUTCTime` time) then


@@ 384,22 397,22 @@ handleRegister db _ toComponent iq@(IQ { iqType = IQGet }) _ = do
 					]
 				]
 		}
-handleRegister db toVitelity toComponent iq@(IQ { iqType = IQSet }) query
+handleRegister db toVitelity toComponent _ iq@(IQ { iqType = IQSet }) query
 	| [form] <- isNamed (fromString "{jabber:x:data}x") =<< elementChildren query,
 	  Just tel <- (normalizeTel . T.filter isDigit) =<< getFormField form (fromString "phone") =
 		sendRegisterVerification db toVitelity toComponent tel iq
-handleRegister db toVitelity toComponent iq@(IQ { iqType = IQSet }) query
+handleRegister db toVitelity toComponent _ iq@(IQ { iqType = IQSet }) query
 	| [phoneEl] <- isNamed (fromString "{jabber:iq:register}phone") =<< elementChildren query,
 	  Just tel <- normalizeTel $ T.filter (not . isDigit) $ mconcat (elementText phoneEl) =
 		sendRegisterVerification db toVitelity toComponent tel iq
-handleRegister db toVitelity toComponent iq@(IQ { iqType = IQSet }) query
+handleRegister db toVitelity toComponent componentHost iq@(IQ { iqType = IQSet }) query
 	| [form] <- isNamed (fromString "{jabber:x:data}x") =<< elementChildren query,
 	  Just password <- getFormField form (fromString "password") =
-		handleVerificationCode db toComponent password iq
-handleRegister db toVitelity toComponent iq@(IQ { iqType = IQSet, iqPayload = Just payload }) query
+		handleVerificationCode db toComponent componentHost password iq
+handleRegister db toVitelity toComponent componentHost iq@(IQ { iqType = IQSet, iqPayload = Just payload }) query
 	| [passwordEl] <- isNamed (fromString "{jabber:iq:register}password") =<< elementChildren query =
-		handleVerificationCode db toComponent (mconcat $ elementText passwordEl) iq
-handleRegister db _ toComponent iq@(IQ { iqType = IQSet }) query
+		handleVerificationCode db toComponent componentHost (mconcat $ elementText passwordEl) iq
+handleRegister db _ toComponent _ iq@(IQ { iqType = IQSet }) query
 	| [_] <- isNamed (fromString "{jabber:iq:register}remove") =<< elementChildren query = do
 		tel <- maybe mempty T.pack <$> TC.runTCM (TC.get db $ T.unpack (maybe mempty bareTxt $ iqFrom iq) <> "\0registered")
 		_ <- TC.runTCM $ TC.out db $ tcKey tel "registered"


@@ 410,7 423,7 @@ handleRegister db _ toComponent iq@(IQ { iqType = IQSet }) query
 			iqType = IQResult,
 			iqPayload = Just $ Element (fromString "{jabber:iq:register}query") [] []
 		}
-handleRegister _ _ toComponent iq@(IQ { iqType = typ }) _
+handleRegister _ _ toComponent _ iq@(IQ { iqType = typ }) _
 	| typ `elem` [IQGet, IQSet] =
 		writeStanzaChan toComponent $ iq {
 			iqTo = iqFrom iq,


@@ 420,7 433,7 @@ handleRegister _ _ toComponent iq@(IQ { iqType = typ }) _
 				[(fromString "{jabber:component:accept}type", [ContentText $ fromString "cancel"])]
 				[NodeElement $ Element (fromString "{urn:ietf:params:xml:ns:xmpp-stanzas}feature-not-implemented") [] []]
 		}
-handleRegister _ _ _ _ _ = return ()
+handleRegister _ _ _ _ _ _ = return ()
 
 componentStanza _ _ toComponent _ (ReceivedMessage (m@Message { messageTo = Just to, messageFrom = Just from}))
 	| [x] <- isNamed (fromString "{http://jabber.org/protocol/muc#user}x") =<< messagePayloads m,


@@ 498,10 511,10 @@ componentStanza _ _ toComponent _ (ReceivedPresence (Presence { presenceType = P
 			] []
 		]
 	}
-componentStanza db toVitelity toComponent _ (ReceivedIQ iq@(IQ { iqFrom = Just _, iqTo = Just (JID { jidNode = Nothing }), iqPayload = Just p }))
+componentStanza db toVitelity toComponent componentHost (ReceivedIQ iq@(IQ { iqFrom = Just _, iqTo = Just (JID { jidNode = Nothing }), iqPayload = Just p }))
 	| iqType iq `elem` [IQGet, IQSet],
 	  [query] <- isNamed (fromString "{jabber:iq:register}query") p =
-		handleRegister db toVitelity toComponent iq query
+		handleRegister db toVitelity toComponent componentHost iq query
 componentStanza _ _ toComponent _ (ReceivedIQ (IQ { iqType = IQGet, iqFrom = Just from, iqTo = Just to, iqID = id, iqPayload = Just p }))
 	| Nothing <- jidNode to,
 	  [_] <- isNamed (fromString "{http://jabber.org/protocol/disco#info}query") p =