From 703de46360da6f35b3a3b1cc04c2c83f1fcbf42a Mon Sep 17 00:00:00 2001 From: Stephen Paul Weber Date: Tue, 26 Jan 2016 21:15:31 -0500 Subject: [PATCH] Change nick to add _sms after register --- Main.hs | 39 ++++++++++++++++++++++++++------------- 1 file changed, 26 insertions(+), 13 deletions(-) diff --git a/Main.hs b/Main.hs index 7aa42cb..c375539 100644 --- a/Main.hs +++ b/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 = -- 2.45.2