~singpolyma/cheogram

ref: 8606b4149fb3c28967d118b79112280690ef4e70 cheogram/StanzaRec.hs -rw-r--r-- 1.3 KiB
8606b414Stephen Paul Weber Guix for CI now 5 months 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