@ -9,7 +9,7 @@
@@ -9,7 +9,7 @@
module Network.XMPP.Types (
StanzaID ( .. ) ,
StanzaId ( .. ) ,
From ,
To ,
IQ ,
@ -64,9 +64,12 @@ MessageError (..),
@@ -64,9 +64,12 @@ MessageError (..),
HookId ( .. ) ,
Hook ( .. ) ,
HookPayload ( .. ) ,
State ( .. )
State ( .. ) ,
SessionSettings ( .. )
) where
-- import Network.XMPP.Utilities (idGenerator)
import GHC.IO.Handle ( Handle , hPutStr , hFlush , hSetBuffering , hWaitForInput )
import qualified Network as N
@ -93,6 +96,17 @@ import Control.Exception.Base (SomeException)
@@ -93,6 +96,17 @@ import Control.Exception.Base (SomeException)
import Control.Concurrent
import Data.Maybe ( fromJust )
-- | The string prefix MUST be
data SessionSettings =
SessionSettings { ssIdPrefix :: String
, ssIdGenerator :: IdGenerator
, ssStreamLang :: LangTag }
-- =============================================================================
-- STANZA TYPES
-- =============================================================================
@ -108,12 +122,14 @@ import Control.Concurrent
@@ -108,12 +122,14 @@ import Control.Concurrent
-- |
-- The StanzaID type wraps a string of random characters that in Pontarius XMPP
-- is guaranteed to be unique for the XMPP session. Clients can add a string
-- prefix for the IDs to guarantee that they are unique in a larger context by
-- specifying the stanzaIDPrefix setting. TODO
-- Wraps a string of random characters that, when using an appropriate
-- @IDGenerator@, is guaranteed to be unique for the XMPP session.
-- Stanza identifiers are generated by Pontarius.
data StanzaId = SI String deriving ( Eq )
data StanzaID = SID String deriving ( Eq , Show )
instance Show StanzaId where
show ( SI s ) = s
-- |
@ -128,18 +144,24 @@ type From = Address
@@ -128,18 +144,24 @@ type From = Address
type To = Address
-- |
-- An Info/Query (IQ) stanza is either of the type "request" ("get" or "set") or
-- "response" ("result" or "error"). The @IQ@ type wraps these two sub-types.
-- An Info/Query (IQ) stanza is either of the type "request" ("get" or
-- "set") or "response" ("result" or "error"). The @IQ@ type wraps
-- these two sub-types.
--
-- Objects of this type cannot be generated by Pontarius applications,
-- but are only created internally.
type IQ = Either IQRequest IQResponse
-- |
-- A "request" Info/Query (IQ) stanza is one with either "get" or "set" as type.
-- They are guaranteed to always contain a payload.
-- A "request" Info/Query (IQ) stanza is one with either "get" or
-- "set" as type. They are guaranteed to always contain a payload.
--
-- Objects of this type cannot be generated by Pontarius applications,
-- but are only created internally.
data IQRequest = IQRequest { iqRequestID :: Maybe StanzaID
data IQRequest = IQRequest { iqRequestID :: StanzaId
, iqRequestFrom :: Maybe From
, iqRequestTo :: Maybe To
, iqRequestLangTag :: LangTag
@ -148,63 +170,24 @@ data IQRequest = IQRequest { iqRequestID :: Maybe StanzaID
@@ -148,63 +170,24 @@ data IQRequest = IQRequest { iqRequestID :: Maybe StanzaID
deriving ( Show )
data InternalEvent m
= OpenStreamsEvent HostName PortNumber
-- | DisconnectEvent
| RegisterStreamsOpenedHook ( Maybe ( Maybe OpenStreamsFailureReason -> XMPPT m Bool ) ) ( Maybe OpenStreamsFailureReason -> XMPPT m Bool )
| EnumeratorFirstLevelElement Element
-- | IEEE EnumeratorEvent
| EnumeratorDone
| EnumeratorBeginStream ( Maybe String ) ( Maybe String ) ( Maybe String ) ( Maybe String ) ( Maybe String ) ( Maybe String )
| EnumeratorEndStream
| EnumeratorException CE . SomeException
-- |
-- The XMPP monad transformer. Contains internal state in order to
-- work with Pontarius. Pontarius clients needs to operate in this
-- context.
newtype XMPPT m a = XMPPT { runXMPPT :: StateT ( State m ) m a } deriving ( Monad , MonadIO )
-- Make XMPPT derive the Monad and MonadIO instances.
deriving instance ( Monad m , MonadIO m ) => MonadState ( State m ) ( XMPPT m )
-- We need a channel because multiple threads needs to append events,
-- and we need to wait for events when there are none.
data State m = State { evtChan :: Chan ( InternalEvent m )
, hookIdGenerator :: IdGenerator
, hooks :: [ Hook m ] }
data HookId = HookId String deriving ( Eq )
data HookPayload m = StreamsOpenedHook ( Maybe ( Maybe OpenStreamsFailureReason -> XMPPT m Bool ) ) ( Maybe OpenStreamsFailureReason -> XMPPT m Bool )
type Hook m = ( HookId , HookPayload m )
-- TODO: Possible ways opening a stream can fail.
data OpenStreamsFailureReason = OpenStreamsFailureReason deriving ( Show )
-- data TLSSecureFailureReason = TLSSecureFailureReason
-- data AuthenticateFailureReason = AuthenticateFailureReason
data DisconnectReason = DisconnectReason deriving ( Show )
data IQRequestType = Get | Set deriving ( Show )
-- |
-- A "response" Info/Query (IQ) stanza is one with either "result" or
-- "error" as type. We have devided IQ responses into two types.
--
-- Objects of this type cannot be generated by Pontarius applications,
-- but are only created internally.
type IQResponse = Either IQError IQResult
data IQResult = IQResult { iqResultID :: Maybe StanzaID
-- |
-- Objects of this type cannot be generated by Pontarius applications,
-- but are only created internally.
data IQResult = IQResult { iqResultID :: StanzaId
, iqResultFrom :: Maybe From
, iqResultTo :: Maybe To
, iqResultLangTag :: LangTag
@ -212,7 +195,11 @@ data IQResult = IQResult { iqResultID :: Maybe StanzaID
@@ -212,7 +195,11 @@ data IQResult = IQResult { iqResultID :: Maybe StanzaID
deriving ( Show )
data IQError = IQError { iqErrorID :: Maybe StanzaID
-- |
-- Objects of this type cannot be generated by Pontarius applications,
-- but are only created internally.
data IQError = IQError { iqErrorID :: StanzaId
, iqErrorFrom :: Maybe From
, iqErrorTo :: Maybe To
, iqErrorLangTag :: LangTag
@ -222,9 +209,12 @@ data IQError = IQError { iqErrorID :: Maybe StanzaID
@@ -222,9 +209,12 @@ data IQError = IQError { iqErrorID :: Maybe StanzaID
-- |
-- The message stanza - either a message or a message error.
-- A non-error message stanza.
--
-- Objects of this type cannot be generated by Pontarius applications,
-- but are only created internally.
data Message = Message { messageID :: Maybe StanzaID
data Message = Message { messageID :: Maybe StanzaId
, messageFrom :: Maybe From
, messageTo :: Maybe To
, messageLangTag :: LangTag
@ -233,7 +223,13 @@ data Message = Message { messageID :: Maybe StanzaID
@@ -233,7 +223,13 @@ data Message = Message { messageID :: Maybe StanzaID
deriving ( Show )
data MessageError = MessageError { messageErrorID :: Maybe StanzaID
-- |
-- An error message stanza.
--
-- Objects of this type cannot be generated by Pontarius applications,
-- but are only created internally.
data MessageError = MessageError { messageErrorID :: Maybe StanzaId
, messageErrorFrom :: Maybe From
, messageErrorTo :: Maybe To
, messageErrorLangTag :: LangTag
@ -242,18 +238,22 @@ data MessageError = MessageError { messageErrorID :: Maybe StanzaID
@@ -242,18 +238,22 @@ data MessageError = MessageError { messageErrorID :: Maybe StanzaID
deriving ( Show )
-- Objects of this type cannot be generated by Pontarius applications,
-- but are only created internally.
type InternalMessage = Either MessageError Message
-- |
-- @MessageType@ holds XMPP message types as defined in XMPP-IM. @Normal@ is t he
-- default message type. The "error" message type is left out as errors are
-- using @MessageError@.
-- @MessageType@ holds XMPP message types as defined in XMPP-IM. T he
-- "error" message type is left out as errors are wrapped in
-- @MessageError@.
data MessageType = Chat |
Groupchat |
Headline |
Normal deriving ( Eq )
data MessageType = Chat | -- ^
Groupchat | -- ^
Headline | -- ^
Normal -- ^ The default message type
deriving ( Eq )
instance Show MessageType where
@ -264,10 +264,10 @@ instance Show MessageType where
@@ -264,10 +264,10 @@ instance Show MessageType where
-- |
-- The presence stanza. It is used for both originating messages and replies.
-- For presence errors, see "PresenceError" .
-- Objects of this type cannot be generated by Pontarius applications,
-- but are only created internally .
data Presence = Presence { presenceID :: Maybe StanzaID
data Presence = Presence { presenceID :: StanzaId
, presenceFrom :: Maybe From
, presenceTo :: Maybe To
, presenceLangTag :: LangTag
@ -276,7 +276,11 @@ data Presence = Presence { presenceID :: Maybe StanzaID
@@ -276,7 +276,11 @@ data Presence = Presence { presenceID :: Maybe StanzaID
deriving ( Show )
data PresenceError = PresenceError { presenceErrorID :: Maybe StanzaID
-- |
-- Objects of this type cannot be generated by Pontarius applications,
-- but are only created internally.
data PresenceError = PresenceError { presenceErrorID :: Maybe StanzaId
, presenceErrorFrom :: Maybe From
, presenceErrorTo :: Maybe To
, presenceErrorLangTag :: LangTag
@ -285,12 +289,15 @@ data PresenceError = PresenceError { presenceErrorID :: Maybe StanzaID
@@ -285,12 +289,15 @@ data PresenceError = PresenceError { presenceErrorID :: Maybe StanzaID
deriving ( Show )
-- Objects of this type cannot be generated by Pontarius applications,
-- but are only created internally.
type InternalPresence = Either PresenceError Presence
-- |
-- @PresenceType@ holds XMPP presence types. The "error" message type is left
-- out as errors are using @PresenceError@.
-- @PresenceType@ holds XMPP presence types. The "error" message type
-- is left out as errors are using @PresenceError@.
data PresenceType = Subscribe | -- ^ Sender wants to subscribe to presence
Subscribed | -- ^ Sender has approved the subscription
@ -316,7 +323,7 @@ instance Show PresenceType where
@@ -316,7 +323,7 @@ instance Show PresenceType where
-- stream looks like <stanza-kind to='sender' type='error'>. These errors are
-- wrapped in the @StanzaError@ type.
-- Sender XML is optional and is not included.
-- TODO: Sender XML is ( optional and is) not included.
data StanzaError = StanzaError { stanzaErrorType :: StanzaErrorType
, stanzaErrorCondition :: StanzaErrorCondition
@ -490,10 +497,10 @@ type Password = String
@@ -490,10 +497,10 @@ type Password = String
type Resource = String
data TimeoutEvent s m = TimeoutEvent StanzaID Timeout ( StateT s m () )
data TimeoutEvent s m = TimeoutEvent StanzaId Timeout ( StateT s m () )
instance Show ( TimeoutEvent s m ) where
show ( TimeoutEvent ( SID i ) t _ ) = " TimeoutEvent (ID: " ++ ( show i ) ++ " , timeout: " ++ ( show t ) ++ " ) "
show ( TimeoutEvent ( SI i ) t _ ) = " TimeoutEvent (ID: " ++ ( show i ) ++ " , timeout: " ++ ( show t ) ++ " ) "
data StreamState = PreStream |
@ -593,6 +600,10 @@ data StreamError = StreamError
@@ -593,6 +600,10 @@ data StreamError = StreamError
-- =============================================================================
-- | Wraps a function that MUST generate a stream of unique Ids. The
-- strings MUST be appropriate for use in the stanza id attirubte.
-- For a default implementation, see @idGenerator@.
newtype IdGenerator = IdGenerator ( IORef [ String ] )
@ -633,6 +644,69 @@ instance Show LangTag where
@@ -633,6 +644,69 @@ instance Show LangTag where
-- Two language tags are considered equal of they contain the same tags (case-insensitive).
instance Eq LangTag where
( LangTag ap as ) == ( LangTag bp bs )
| length as == length bs && map toLower ap == map toLower bp = all ( \ ( a , b ) -> map toLower a == map toLower b ) $ zip as bs
( LangTag ap as ) == ( LangTag bp bs )
| length as == length bs && map toLower ap == map toLower bp =
all ( \ ( a , b ) -> map toLower a == map toLower b ) $ zip as bs
| otherwise = False
data InternalEvent m
= OpenStreamsEvent HostName PortNumber
-- | DisconnectEvent
| RegisterStreamsOpenedHook ( Maybe ( Maybe OpenStreamsFailureReason -> XMPPT m Bool ) ) ( Maybe OpenStreamsFailureReason -> XMPPT m Bool )
| EnumeratorFirstLevelElement Element
-- | IEEE EnumeratorEvent
| EnumeratorDone
| EnumeratorBeginStream ( Maybe String ) ( Maybe String ) ( Maybe String ) ( Maybe String ) ( Maybe String ) ( Maybe String )
| EnumeratorEndStream
| EnumeratorException CE . SomeException
-- |
-- The XMPP monad transformer. Contains internal state in order to
-- work with Pontarius. Pontarius clients needs to operate in this
-- context.
newtype XMPPT m a = XMPPT { runXMPPT :: StateT ( State m ) m a } deriving ( Monad , MonadIO )
-- Make XMPPT derive the Monad and MonadIO instances.
deriving instance ( Monad m , MonadIO m ) => MonadState ( State m ) ( XMPPT m )
-- We need a channel because multiple threads needs to append events,
-- and we need to wait for events when there are none.
data State m = State { evtChan :: Chan ( InternalEvent m )
, hookIdGenerator :: IdGenerator
, hooks :: [ Hook m ] }
data HookId = HookId String deriving ( Eq )
data HookPayload m = StreamsOpenedHook ( Maybe ( Maybe OpenStreamsFailureReason -> XMPPT m Bool ) ) ( Maybe OpenStreamsFailureReason -> XMPPT m Bool )
type Hook m = ( HookId , HookPayload m )
-- TODO: Possible ways opening a stream can fail.
data OpenStreamsFailureReason = OpenStreamsFailureReason deriving ( Show )
-- data TLSSecureFailureReason = TLSSecureFailureReason
-- data AuthenticateFailureReason = AuthenticateFailureReason
data DisconnectReason = DisconnectReason deriving ( Show )