pontarius-xmpp-extras (empty) → 0.1.0.0

raw patch · 5 files changed

+119/−0 lines, 5 filesdep +basedep +data-defaultdep +pontarius-xmppsetup-changed

Dependencies added: base, data-default, pontarius-xmpp, text, time, xml-types

Files

• LICENSE +14/−0
• Network/Xmpp/Extras/DateTime.hs +12/−0
• Network/Xmpp/Extras/MUC.hs +53/−0
• Setup.hs +2/−0
• pontarius-xmpp-extras.cabal +38/−0

@@ -0,0 +1,14 @@+            DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE+                    Version 2, December 2004++ Copyright (C) 2004 Sam Hocevar+  22 rue de Plaisance, 75014 Paris, France+ Everyone is permitted to copy and distribute verbatim or modified+ copies of this license document, and changing it is allowed as long+ as the name is changed.++            DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE+   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION++  0. You just DO WHAT THE FUCK YOU WANT TO.+

@@ -0,0 +1,12 @@+-- |+-- Stability   :  Ultra-Violence+-- Portability :  I'm too young to die+-- XEP-0082: XMPP Date and Time Profiles++module Network.Xmpp.Extras.DateTime where++import Data.Time++-- |No milliseconds yet as `formatTime` lacks the required feature+toDateTime :: UTCTime -> String+toDateTime t = formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ" t

@@ -0,0 +1,53 @@+-- |+-- Stability   :  Ultra-Violence+-- Portability :  I'm too young to die+-- XEP-0045: Multi-User Chat++{-# LANGUAGE OverloadedStrings #-}++module Network.Xmpp.Extras.MUC+	( MUCHistoryReq(..)+	, joinMUC+	, sendMUC+	) where++import Data.Default+import Data.Maybe+import Data.Text as T+import Data.Time+import Data.XML.Types+import Network.Xmpp.Extras.DateTime+import Network.Xmpp.Internal hiding (priority, status)++--data MUCJID = MUCJID+--	{ mjService :: Text+--	, mjRoom :: Text+--	} deriving Show+--+--mUCJIDToJid (MUCJID s r) = jidFromTexts (Just s) r++data MUCHistoryReq = MUCHistoryReq+	{ mhrMaxChars :: Maybe Integer+	, mhrMaxStanzas :: Maybe Integer+	, mhrSeconds :: Maybe Integer+	, mhrSince :: Maybe UTCTime+	}++instance Default MUCHistoryReq where+	def = MUCHistoryReq Nothing Nothing Nothing Nothing++-- |Join the specified MUC or change your nickname in the already joined one. The resource part of the `Jid` sets the desired nickname.+joinMUC :: Jid -> Maybe MUCHistoryReq -> Session -> IO (Either XmppFailure ())+joinMUC jid mhr = sendPresence (maybe id (\hr x -> x { presencePayload = [Element "x" [("xmlns", [ContentText "http://jabber.org/protocol/muc"])] [+		NodeElement $ Element "history" (+			(elementify "maxchars" show $ mhrSeconds hr) +++			(elementify "maxstanzas" show $ mhrSeconds hr) +++			(elementify "seconds" show $ mhrSeconds hr) +++			(elementify "since" toDateTime $ mhrSince hr)+		) []]+	] } ) mhr $ (presTo presence jid))+	where elementify name show content = fmap (\s -> ("seconds", [ContentText $ T.pack $ show s])) $ maybeToList content++-- |Send a broadcast message. `Jid` must be bare.+sendMUC :: Jid -> Text -> Session -> IO (Either XmppFailure ())+sendMUC jid text = sendMessage ((simpleIM jid text) { messageType = GroupChat })

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,38 @@+name:                pontarius-xmpp-extras+version:             0.1.0.0+synopsis:            XEPs implementation on top of pontarius-xmpp+-- description:+license:             OtherLicense+license-file:        LICENSE+author:              Sergey Alirzaev+maintainer:          zl29ah@gmail.com+-- copyright:+category:            Network+build-type:          Simple+cabal-version:       >=1.10++Source-repository head+  type:              git+  location:          https://github.com/l29ah/pontarius-xmpp-extras.git++Source-repository this+  type:              git+  location:          https://github.com/l29ah/pontarius-xmpp-extras.git+  tag:               0.1.0.0++library+  exposed-modules:+    Network.Xmpp.Extras.DateTime+    Network.Xmpp.Extras.MUC+  -- other-modules:+  -- other-extensions:+  build-depends:+    base >=4.12 && <4.13,+    pontarius-xmpp >= 0.5 && < 0.6,+    data-default >= 0.7.1.1 && < 0.8,+    text >= 1.2 && < 1.3,+    time >= 1.8 && < 1.9,+    xml-types >= 0.3 && < 0.4+  -- hs-source-dirs:+  default-language:    Haskell2010+  ghc-options: -fno-warn-tabs