~singpolyma/cheogram

cheogram/StanzaRec.hs -rw-r--r-- 1.3 KiB
a445129aStephen Paul Weber Blacklist uncommon file extensions 2 days 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
module StanzaRec (StanzaRec(..), mkStanzaRec, ensureId) where

import Prelude ()
import BasicPrelude
import qualified Data.UUID as UUID (toText)
import qualified Data.UUID.V1 as UUID (nextUUID)
import qualified Data.XML.Types as XML
import qualified Network.Protocol.XMPP as XMPP
import Network.Protocol.XMPP.Internal (Stanza(..))

import Util

data StanzaRec = StanzaRec (Maybe XMPP.JID) (Maybe XMPP.JID) (Maybe Text) (Maybe Text) [XML.Element] XML.Element deriving (Show)

instance Stanza StanzaRec where
	stanzaTo (StanzaRec to _ _ _ _ _) = to
	stanzaFrom (StanzaRec _ from _ _ _ _) = from
	stanzaID (StanzaRec _ _ sid _ _ _) = sid
	stanzaLang (StanzaRec _ _ _ lang _ _) = lang
	stanzaPayloads (StanzaRec _ _ _ _ payloads _) = payloads
	stanzaToElement (StanzaRec _ _ _ _ _ element) = element

mkStanzaRec :: (Stanza s) => s -> StanzaRec
mkStanzaRec x = StanzaRec (stanzaTo x) (stanzaFrom x) (stanzaID x) (stanzaLang x) (stanzaPayloads x) (stanzaToElement x)

ensureId :: StanzaRec -> IO StanzaRec
ensureId (StanzaRec to from Nothing lang payloads element) = do
	uuid <- (fmap.fmap) UUID.toText UUID.nextUUID
	return $ StanzaRec to from uuid lang payloads $ element {
			XML.elementAttributes =
				(s"id", [XML.ContentText $ fromMaybe mempty uuid]) :
				XML.elementAttributes element
		}
ensureId s = return s