~singpolyma/cheogram

ref: bebbcb16ef789b65790cd4fb53301a2a12d0b8ca cheogram/Util.hs -rw-r--r-- 1.3 KiB
bebbcb16Stephen Paul Weber Proxy through the registration form and record the route 6 years ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
module Util where

import Prelude ()
import BasicPrelude

import Data.Time (getCurrentTime)
import Data.XML.Types (Element(..), Node(NodeElement), isNamed, elementText, elementChildren, attributeText)
import qualified Data.Text as T
import qualified Network.Protocol.XMPP as XMPP

log :: (Show a, MonadIO m) => String -> a -> m ()
log tag x = liftIO $ do
	time <- getCurrentTime
	putStr (show time ++ s" " ++ fromString tag ++ s" :: ") >> print x >> putStrLn mempty

s :: (IsString a) => String -> a
s = fromString

escapeJid :: Text -> Text
escapeJid txt = T.concatMap (\char ->
		case char of
			' ' -> s"\\20"
			'"' -> s"\\22"
			'&' -> s"\\26"
			'\'' -> s"\\27"
			'/' -> s"\\2f"
			':' -> s"\\3a"
			'<' -> s"\\3c"
			'>' -> s"\\3e"
			'@' -> s"\\40"
			'\\' -> s"\\5c"
			c -> T.singleton c
	) txt

bareTxt (XMPP.JID (Just node) domain _) = mconcat [XMPP.strNode node, s"@", XMPP.strDomain domain]
bareTxt (XMPP.JID Nothing domain _) = XMPP.strDomain domain

getFormField form var =
		listToMaybe $ mapMaybe (\node ->
			case node of
				NodeElement el
					| elementName el == s"{jabber:x:data}field" &&
					  (attributeText (s"{jabber:x:data}var") el == Just var ||
					  attributeText (s"var") el == Just var) ->
						Just $ mconcat $
						elementText =<< isNamed (s"{jabber:x:data}value") =<< elementChildren el
				_ -> Nothing
		) (elementNodes form)