added SessionSettings record, made the stanza types internal (forced StanzaId), StanzaId show instance, Session.hs is broken

Network/XMPP/Session.hs

@@ -132,7 +132,6 @@ processEvent (OpenStreamsEvent h p) = openStreamAction h p
                              result <- liftIO $ CE.try (computation $ evtChan rs)
                              case result of
                                Right () -> do
-                                 fireStreamsOpenedEvent Nothing
                                  return ()
                                  -- -- lift $ liftIO $ putMVar (stateThreadID state) threadID
                                Left (CE.SomeException e) -> do -- TODO: Safe to do this?

Network/XMPP/Types.hs

@@ -9,7 +9,7 @@
 
 
 module Network.XMPP.Types (
-StanzaID (..),
+StanzaId (..),
 From,
 To,
 IQ,
@@ -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)
 
 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
 
 
 -- |
--- The StanzaID type wraps a string of random characters that in Pontarius XMPP
+-- Wraps a string of random characters that, when using an appropriate
--- is guaranteed to be unique for the XMPP session. Clients can add a string
+-- @IDGenerator@, is guaranteed to be unique for the XMPP session.
--- prefix for the IDs to guarantee that they are unique in a larger context by
+-- Stanza identifiers are generated by Pontarius.
--- specifying the stanzaIDPrefix setting. TODO
+
+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
 type To = Address
 
 
--- |
+-- An Info/Query (IQ) stanza is either of the type "request" ("get" or
--- An Info/Query (IQ) stanza is either of the type "request" ("get" or "set") or
+-- "set") or "response" ("result" or "error"). The @IQ@ type wraps
--- "response" ("result" or "error"). The @IQ@ type wraps these two sub-types.
+-- 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.
+-- A "request" Info/Query (IQ) stanza is one with either "get" or
--- They are guaranteed to always contain a payload.
+-- "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
                  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
                 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
 
 
 -- |
--- 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
                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
                     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 the
+-- @MessageType@ holds XMPP message types as defined in XMPP-IM. The
--- default message type. The "error" message type is left out as errors are
+-- "error" message type is left out as errors are wrapped in
--- using @MessageError@.
+-- @MessageError@.
 
-data MessageType = Chat |
+data MessageType = Chat      | -- ^ 
-                   Groupchat |
+                   Groupchat | -- ^ 
-                   Headline |
+                   Headline  | -- ^ 
-                   Normal deriving (Eq)
+                   Normal      -- ^ The default message type
+                   deriving (Eq)
 
 
 instance Show MessageType where
@@ -264,10 +264,10 @@ instance Show MessageType where
 
 
 -- |
--- The presence stanza. It is used for both originating messages and replies.
+-- Objects of this type cannot be generated by Pontarius applications,
--- For presence errors, see "PresenceError".
+-- 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
                 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
                      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
+-- @PresenceType@ holds XMPP presence types. The "error" message type
--- out as errors are using @PresenceError@.
+-- 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
 -- 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
 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
 -- =============================================================================
 
 
+-- | 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
 -- Two language tags are considered equal of they contain the same tags (case-insensitive).
 
 instance Eq LangTag where
-    (LangTag ap as) == (LangTag bp 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
+        | 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)