From f4a0c41eaadb0d0054e25442083bfe0d2e081cd1 Mon Sep 17 00:00:00 2001 From: Jon Kristensen Date: Mon, 2 Apr 2012 02:38:46 +0200 Subject: [PATCH] new dummy xmppt (statet-based) api, enumerator code commented and many features disabled, but pontarius with example now compiles, updated readme file, new credits file --- CREDITS | 1 + Examples/EchoClient.hs | 76 ------- Examples/IBR.hs | 60 ++++++ Network/XMPP.hs | 11 +- Network/XMPP/Session.hs | 413 ++++++++++++++++++++++--------------- Network/XMPP/SessionOld.hs | 64 +++--- Network/XMPP/Stanza.hs | 49 +---- Network/XMPP/Stream.hs | 138 ++++++------- Network/XMPP/Types.hs | 22 +- Network/XMPP/Utilities.hs | 91 ++++++-- README | 18 +- pontarius.cabal | 20 +- 12 files changed, 523 insertions(+), 440 deletions(-) create mode 100644 CREDITS delete mode 100644 Examples/EchoClient.hs create mode 100644 Examples/IBR.hs diff --git a/CREDITS b/CREDITS new file mode 100644 index 0000000..71efa68 --- /dev/null +++ b/CREDITS @@ -0,0 +1 @@ +Pontarius has been written by Jon Kristensen and Mahdi Abdinejadi. diff --git a/Examples/EchoClient.hs b/Examples/EchoClient.hs deleted file mode 100644 index 25ac327..0000000 --- a/Examples/EchoClient.hs +++ /dev/null @@ -1,76 +0,0 @@ -{- - -Copyright © 2010-2012 Jon Kristensen. - -This file (EchoClient.hs) illustrates how to connect, authenticate, -set a presence, and echo messages using Pontarius. The contents of -this file may be used freely, as if it is in the public domain. - --} - - -module Examples.EchoClient () where - -import Network.XMPP - - --- Account and server details. - -hostName = "nejla.com" -userName = "pontarius" -serverIdentifier = "nejla.com" -portNumber = 5222 -resource = "pontarius" -password = "" - - --- The main function initializes PontariusP and specifies the (XMPPT) --- actions the be executed, hooking the client into the appropriate --- events and tries to connect. - -main :: IO () - -main = runXMPPT $ do - hookConnectedEvent onConnectedEvent Nothing - hookMessageEvent onMessageEvent onMessageEventPredicate - hookDisconnectedEvent onDisonnectedEvent Nothing - connect hostName portNumber userName serverIdentifier password (Just resource) - - where - - -- When successfully connected, send a simple presence, and - -- unhook ourselves from further "connected" events. - - onConnectedEvent (Right r) = do - liftIO $ putStrLn $ "Connected with resource: " ++ (show r) - presence simplePresence - return False - - -- When the connection fails, print the error and shut down - -- the XMPP session. - - onConnectedEvent (Left e) = do - liftIO $ putStrLn $ "Could not connect due to the following error:" ++ (show e) - destroy - return True - - -- Predicate that makes sure that the messages processed by - -- onMessageEvent are sent from and to full (not bare) XMPP - -- addresses. - - onMessageEventPredicate = Just (\ m -> return $ and [isJust $ messageFrom m, isJust $ messageTo m]) - - -- Swap the from and to addresses and send the new message. - - onMessageEvent m = do - message $ m { messageFrom = fromJust $ messageTo m - , messageTo = fromJust $ messageFrom m } - return True - - -- When disconnected, print the reason and shut down the XMPP - -- session. - - onDisconnectedEvent r = do - liftIO $ putStrLn $ "Disconnected with the reason: " ++ (show r) - destroy - return True diff --git a/Examples/IBR.hs b/Examples/IBR.hs new file mode 100644 index 0000000..c8064a1 --- /dev/null +++ b/Examples/IBR.hs @@ -0,0 +1,60 @@ +{- + +Copyright © 2010-2012 Jon Kristensen. + +This file (IBR.hs) illustrates how to connect and perform a simple +In-Band Registration request using Pontarius. The contents of this +file may be used freely, as if it is in the public domain. + +-} + + +module Examples.IBR () where + +import Network.XMPP + +import Control.Monad.IO.Class (liftIO) + + +-- Server details. + +hostName = "nejla.com" +portNumber = 5222 + + +-- The main function initializes Pontarius and specifies the (XMPPT) +-- actions the be executed, hooking the client into the appropriate +-- events and tries to open the streams to the server. + +main :: IO () + +main = create $ do + hookStreamsOpenedEvent onStreamsOpened Nothing + hookDisconnectedEvent onDisconnected Nothing + openStreams hostName portNumber + + where + + -- When the streams has been opened, print a message and unhook + -- ourselves from future "Streams Opened" events. + + onStreamsOpened Nothing = do + liftIO $ putStrLn $ "The server streams has been successfully opened." + -- sendIQRequest Nothing hostName (LangTag "en" []) Set elem cb + return False + + -- When the opening of the streams fails, print the error and + -- shut down the XMPP session. + + onConnectedEvent (Just e) = do + liftIO $ putStrLn $ "Could not open the streams due to the following error: " ++ (show e) + destroy + return True + + -- When disconnected, print the reason and shut down the XMPP + -- session. + + onDisconnected r = do + liftIO $ putStrLn $ "Disconnected with the reason: " ++ (show r) + destroy + return True diff --git a/Network/XMPP.hs b/Network/XMPP.hs index 52ea548..57be806 100644 --- a/Network/XMPP.hs +++ b/Network/XMPP.hs @@ -36,6 +36,13 @@ module Network.XMPP ( -- Network.XMPP.JID , fromStrings -- Network.XMPP.Session + , runXMPPT + , hookStreamsOpenedEvent + , hookDisconnectedEvent + , destroy + , openStreams + , create + -- , ClientHandler (..) -- , ClientState (..) -- , ConnectResult (..) @@ -72,11 +79,11 @@ module Network.XMPP ( -- Network.XMPP.JID , iqPayload ) where import Network.XMPP.Address -import Network.XMPP.SASL +-- import Network.XMPP.SASL import Network.XMPP.Session import Network.XMPP.Stanza import Network.XMPP.Utilities import Network.XMPP.Types -import Network.XMPP.TLS +-- import Network.XMPP.TLS import Network.XMPP.Stream diff --git a/Network/XMPP/Session.hs b/Network/XMPP/Session.hs index d785d4d..a49648b 100644 --- a/Network/XMPP/Session.hs +++ b/Network/XMPP/Session.hs @@ -15,139 +15,230 @@ module Network.XMPP.Session ( XMPPT (runXMPPT) + , hookStreamsOpenedEvent + , hookDisconnectedEvent + , destroy + , openStreams + , create + , DisconnectReason ) where import Network.XMPP.Types +import Network.XMPP.Utilities -import Control.Concurrent (Chan, readChan, writeChan) +import Control.Concurrent (Chan, newChan, readChan, writeChan) import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Certificate.X509 (X509) import Data.Dynamic (Dynamic) -import Control.Monad.Reader (MonadReader, ReaderT, ask) +-- import Control.Monad.Reader (MonadReader, ReaderT, ask) +import Control.Monad.State.Lazy (MonadState, StateT, get, put, execStateT) + +import qualified Control.Exception as CE +import qualified Network as N +import System.IO (BufferMode, BufferMode(NoBuffering)) +import GHC.IO.Handle (Handle, hPutStr, hFlush, hSetBuffering, hWaitForInput) +import Codec.Binary.UTF8.String + -- | --- The XMPP monad transformer. XMPP clients will need to operate in this +-- 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 :: ReaderT (ReaderState m) m a } - deriving (Monad, MonadIO) +newtype XMPPT m a = XMPPT { runXMPPT :: StateT (State m) m a } deriving (Monad, MonadIO) -deriving instance (Monad m, MonadIO m) => MonadReader (ReaderState m) (XMPPT m) +-- Make XMPPT derive the Monad and MonadIO instances. -data ReaderState m = ReaderState { intEvtChan :: Chan InternalEvent - , hookModChan :: Chan (HookModification m) } +deriving instance (Monad m, MonadIO m) => MonadState (State m) (XMPPT m) --- | --- Events that may be emitted from Pontarius XMPP. +create :: MonadIO m => XMPPT m () -> m () -data ConnectedEvent = ConnectedEvent (Either ConnectedFailureReason Resource) +create main = do + chan <- liftIO $ newChan + idGen <- liftIO $ idGenerator "" + execStateT (runXMPPT init) (State chan idGen []) + return () + where + init = do + main + stateLoop --- data DynamicEvent = forall a. Dynamic a => DynamicEvent a -data DynamicEvent = DynamicEvent Dynamic -type OpenedStreamsEvent = Maybe OpenStreamsFailureReason +data HookId = HookId String + + +-- 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 + , streamsOpenedHooks :: [(HookId, (Maybe OpenStreamsFailureReason -> XMPPT m Bool, Maybe (Maybe OpenStreamsFailureReason -> XMPPT m Bool)))] } -type TLSSecuredEvent = Maybe TLSSecureFailureReason -type AuthenticatedEvent = Either AuthenticateFailureReason Resource +-- Internal events - events to be processed within Pontarius. ---data Event --- = ConnectedEvent (Either IntFailureReason Resource) --- -- | OpenedStreamsEvent (Maybe OpenStreamsFailureReason) --- -- | TLSSecuredEvent (Maybe TLSSecuringFailureReason) --- -- | AuthenticatedEvent (Either AuthenticationFailureReason Resource) --- -- | DisconnectEvent DisconnectReason --- -- | MessageEvent (Either MessageError Message) --- -- | PresenceEvent (Either PresenceError Presence) --- -- | IQEvent (Either IQResult IQRequest) --- | forall a. Dynamic a => DynamicEvent a --- deriving (Show) +-- data InternalEvent s m = IEC (ClientEvent s m) | IEE EnumeratorEvent | IET (TimeoutEvent s m) deriving (Show) + +data InternalEvent m + = OpenStreamsEvent HostName PortNumber + -- | DisconnectEvent + | RegisterStreamsOpenedHook (Maybe OpenStreamsFailureReason -> XMPPT m Bool) (Maybe (OpenStreamsFailureReason -> Bool)) + -- | IEEE EnumeratorEvent + +instance Show (InternalEvent m) where + show _ = "InternalEvent" + +-- | +-- Events that may be emitted from Pontarius. + +data Event = -- ConnectedEvent (Either IntFailureReason Resource) + {-|-} OpenedStreamsEvent (Maybe OpenStreamsFailureReason) + -- | TLSSecuredEvent (Maybe TLSSecuringFailureReason) + -- | AuthenticatedEvent (Either AuthenticationFailureReason Resource) + | DisconnectedEvent DisconnectReason + -- | MessageEvent (Either MessageError Message) + -- | PresenceEvent (Either PresenceError Presence) + -- | IQEvent (Either IQResult IQRequest) + -- | forall a. Dynamic a => DynamicEvent a + deriving (Show) + +-- data DynamicEvent = forall a. Dynamic a => DynamicEvent a +-- data DynamicEvent = DynamicEvent Dynamic -data ConnectedFailureReason - = COSFR OpenStreamsFailureReason - | CTSFR TLSSecureFailureReason - | CAFR AuthenticateFailureReason +-- data ConnectedFailureReason +-- = COSFR OpenStreamsFailureReason +-- | CTSFR TLSSecureFailureReason +-- | CAFR AuthenticateFailureReason -data OpenStreamsFailureReason = OpenStreamFailureReason +-- TODO: Possible ways opening a stream can fail. +data OpenStreamsFailureReason = OpenStreamFailureReason deriving (Show) -data TLSSecureFailureReason = TLSSecureFailureReason +-- data TLSSecureFailureReason = TLSSecureFailureReason + +-- data AuthenticateFailureReason = AuthenticateFailureReason + +data DisconnectReason = DisconnectReason deriving (Show) -data AuthenticateFailureReason = AuthenticateFailureReason -- The "hook modification" events have a higher priority than other events, and -- are thus sent through a Chan of their own. The boolean returns value signals -- whether or not the hook should be removed. -data HookModification m - = MonadIO m => RegisterConnectedHook (ConnectedEvent -> XMPPT m Bool) (Maybe (ConnectedEvent -> Bool)) - | RegisterStreamsOpenedHook (OpenedStreamsEvent -> XMPPT m Bool) (Maybe (OpenedStreamsEvent -> Bool)) - | RegisterTLSSecuredHook (TLSSecuredEvent -> XMPPT m Bool) (Maybe (TLSSecuredEvent -> Bool)) - | RegisterAuthenticatedHook (AuthenticatedEvent -> XMPPT m Bool) (Maybe (AuthenticatedEvent -> Bool)) - -- | forall a. Dynamic a => RegisterDynamicHook (DynamicEvent a -> XMPPT m Bool) - | RegisterDynamicHook (DynamicEvent -> XMPPT m Bool) (Maybe (DynamicEvent -> Bool)) +-- data HookModification m +-- = MonadIO m => -- RegisterConnectedHook (ConnectedEvent -> XMPPT m Bool) (Maybe (ConnectedEvent -> Bool)) + -- | RegisterTLSSecuredHook (TLSSecuredEvent -> XMPPT m Bool) (Maybe (TLSSecuredEvent -> Bool)) + -- | RegisterAuthenticatedHook (AuthenticatedEvent -> XMPPT m Bool) (Maybe (AuthenticatedEvent -> Bool)) + -- -- | forall a. Dynamic a => RegisterDynamicHook (DynamicEvent a -> XMPPT m Bool) + -- | RegisterDynamicHook (DynamicEvent -> XMPPT m Bool) (Maybe (DynamicEvent -> Bool)) + + +-- Reads an event from the internal event channel, processes it, +-- performs the generated impure actions, and loops. + +stateLoop :: MonadIO m => XMPPT m () + +stateLoop = do + rs <- get + event <- liftIO $ readChan $ evtChan rs + liftIO $ putStrLn $ "Processing " ++ (show event) ++ "..." + actions <- processEvent event + sequence actions + stateLoop + + +-- Processes an internal event and generates a list of impure actions. + +processEvent :: MonadIO m => InternalEvent m -> XMPPT m [XMPPT m (IO ())] + +processEvent (OpenStreamsEvent h p) = return [openStreamAction h p] + where + openStreamAction :: MonadIO m => HostName -> PortNumber -> XMPPT m (IO ()) + openStreamAction h p = do + -- CEB.assert (stateConnectionState state == Disconnected) (return ()) + let p' = fromIntegral p + handle <- liftIO $ {- CE.try $ -} N.connectTo h (N.PortNumber p') + return $ liftIO $ do -- $ case result of + -- Right handle -> do + hSetBuffering handle NoBuffering + hPutStr handle $ encodeString "" + hFlush handle + return () + -- -- threadID <- lift $ liftIO $ forkIO $ xmlEnumerator (stateChannel state) (Left handle) + -- -- lift $ liftIO $ putMVar (stateThreadID state) threadID + -- Left error -> do + -- -- let clientState = stateClientState state + -- -- ((), clientState') <- lift $ runStateT (callback OpenStreamFailure) clientState + -- -- put $ state { stateShouldExit = True } + -- -- return $ Just e + -- return $ Just error + + +-- hookConnectedEvent :: MonadIO m => (ConnectedEvent -> XMPPT m Bool) -> (Maybe (ConnectedEvent -> Bool)) -> XMPPT m () -data State = State +-- hookConnectedEvent cb pred = ask >>= \rs -> liftIO $ writeChan (hookModChan rs) (RegisterConnectedHook cb pred) -stateLoop :: State -> Chan InternalEvent -> IO () +-- | Hook the provided callback and (optional) predicate to the +-- "Streams Opened" event. -stateLoop s c = do - ie <- readChan c - let (s', ios) = processInternalEvent s ie in - -- forall ios, execute it - stateLoop s' c +hookStreamsOpenedEvent :: MonadIO m => (Maybe OpenStreamsFailureReason -> XMPPT m Bool) -> (Maybe (Maybe OpenStreamsFailureReason -> XMPPT m Bool)) -> XMPPT m HookId +hookStreamsOpenedEvent cb pred = do + rs <- get + hookId <- liftIO $ nextId $ hookIdGenerator rs + put $ rs { streamsOpenedHooks = (HookId hookId, (cb, pred)):streamsOpenedHooks rs } + return $ HookId hookId -processInternalEvent :: State -> InternalEvent -> (State, [IO ()]) -processInternalEvent s ie = (s, [connectIO]) +hookDisconnectedEvent :: MonadIO m => (DisconnectReason -> XMPPT m Bool) -> (Maybe (DisconnectReason -> XMPPT m Bool)) -> XMPPT m HookId +hookDisconnectedEvent cb pred = do + rs <- get + hookId <- liftIO $ nextId $ hookIdGenerator rs + -- TODO: Actually hook it. + return $ HookId hookId - where - connectIO :: IO () - connectIO = return () +-- hookTLSSecuredEvent :: MonadIO m => (TLSSecuredEvent -> XMPPT m Bool) -> (Maybe (TLSSecuredEvent -> Bool)) -> XMPPT m () +-- hookTLSSecuredEvent cb pred = ask >>= \rs -> liftIO $ writeChan (hookModChan rs) (RegisterTLSSecuredHook cb pred) -hookConnectedEvent :: MonadIO m => (ConnectedEvent -> XMPPT m Bool) -> (Maybe (ConnectedEvent -> Bool)) -> XMPPT m () -hookConnectedEvent cb pred = ask >>= \rs -> liftIO $ writeChan (hookModChan rs) (RegisterConnectedHook cb pred) +-- hookAuthenticatedEvent :: MonadIO m => (AuthenticatedEvent -> XMPPT m Bool) -> (Maybe (AuthenticatedEvent -> Bool)) -> XMPPT m () +-- hookAuthenticatedEvent cb pred = ask >>= \rs -> liftIO $ writeChan (hookModChan rs) (RegisterAuthenticatedHook cb pred) -hookDynamicEvent :: MonadIO m => (DynamicEvent -> XMPPT m Bool) -> (Maybe (DynamicEvent -> Bool)) -> XMPPT m () -hookDynamicEvent cb pred = ask >>= \rs -> liftIO $ writeChan (hookModChan rs) (RegisterDynamicHook cb pred) +-- hookDynamicEvent :: MonadIO m => (DynamicEvent -> XMPPT m Bool) -> (Maybe (DynamicEvent -> Bool)) -> XMPPT m () +-- hookDynamicEvent cb pred = ask >>= \rs -> liftIO $ writeChan (hookModChan rs) (RegisterDynamicHook cb pred) -hookStreamsOpenedEvent :: MonadIO m => (OpenedStreamsEvent -> XMPPT m Bool) -> (Maybe (OpenedStreamsEvent -> Bool)) -> XMPPT m () -hookStreamsOpenedEvent cb pred = ask >>= \rs -> liftIO $ writeChan (hookModChan rs) (RegisterStreamsOpenedHook cb pred) +-- | Asynchronously request to open a stream to an XMPP server on the +-- given host name and port. +openStreams :: MonadIO m => HostName -> PortNumber -> XMPPT m () -hookTLSSecuredEvent :: MonadIO m => (TLSSecuredEvent -> XMPPT m Bool) -> (Maybe (TLSSecuredEvent -> Bool)) -> XMPPT m () +openStreams h p = get >>= \rs -> liftIO $ writeChan (evtChan rs) (OpenStreamsEvent h p) -hookTLSSecuredEvent cb pred = ask >>= \rs -> liftIO $ writeChan (hookModChan rs) (RegisterTLSSecuredHook cb pred) +destroy = destroy -hookAuthenticatedEvent :: MonadIO m => (AuthenticatedEvent -> XMPPT m Bool) -> (Maybe (AuthenticatedEvent -> Bool)) -> XMPPT m () -hookAuthenticatedEvent cb pred = ask >>= \rs -> liftIO $ writeChan (hookModChan rs) (RegisterAuthenticatedHook cb pred) +-- tlsSecure = tlsSecure +-- authenticate = authenticate -openStreams = openStreams -tlsSecure = tlsSecure -authenticate = authenticate +-- fireConnectedEvent = fireConnectedEvent -fireConnectedEvent = fireConnectedEvent -- | -- connect is implemented using hookStreamOpenedEvent, hookTLSSecuredEvent, and @@ -168,96 +259,96 @@ fireConnectedEvent = fireConnectedEvent -- authenticate will not be used by the client. Calling those functions may -- generate events that can cause connect to behave incorrectly. -connect :: MonadIO m => HostName -> PortNumber -> Maybe (Maybe [X509], ([X509] -> Bool)) -> Maybe (UserName, Password, Maybe Resource) -> XMPPT m () - -connect h p Nothing Nothing = do - hookStreamsOpenedEvent onStreamsOpenedEvent Nothing - openStreams h p - - where - - onStreamsOpenedEvent Nothing = do - fireConnectedEvent Nothing - return False - - onStreamsOpenedEvent (Just e) = do - fireConnectedEvent $ Left $ COSFR e - return False - -connect h p (Just t) Nothing = do - hookStreamsOpenedEvent onStreamsOpenedEvent Nothing - openStreams h p - - where - - onStreamsOpenedEvent Nothing = do - hookTLSSecuredEvent onTLSSecuredEvent Nothing - tlsSecure - return False - - onStreamsOpenedEvent (Just e) = do - fireConnectedEvent $ Left $ COSFR e - return False - - onTLSSecuredEvent Nothing = do - fireConnectedEvent Nothing - return False - - onTLSSecuredEvent (Just e) = do - fireConnectedEvent $ Left $ CTSFR e - return False - -connect h p Nothing (Just a) = do - hookStreamsOpenedEvent onStreamsOpenedEvent Nothing - openStreams h p - - where - - onStreamsOpenedEvent Nothing = do - hookAuthenticatedEvent onAuthenticatedEvent Nothing - authenticate - return False - - onStreamsOpenedEvent (Just e) = do - fireConnectedEvent $ Left $ COSFR e - return False - - onAuthenticatedEvent (Right r) = do - fireConnectedEvent $ Just r - return False - - onAuthenticated (Left e) = do - fireConnectedEvent $ Left $ CAFR e - return False - -connect h p (Just t) (Just a) = do - hookStreamsOpenedEvent onStreamsOpenedEvent Nothing - openStreams h p - - where - - onStreamsOpenedEvent Nothing = do - hookTLSSecuredEvent onTLSSecuredEvent Nothing - tlsSecure - return False - - onStreamsOpenedEvent (Just e) = do - fireConnectedEvent $ Left $ COSFR e - return False - - onTLSSecuredEvent Nothing = do - hookAuthenticatedEvent onAuthenticatedEvent Nothing - authenticate - return False - - onTLSSecuredEvent (Just e) = do - fireConnectedEvent $ Left $ CTSFR e - return False - - onAuthenticatedEvent (Right r) = do - fireConnectedEvent $ Just r - return False - - onAuthenticated (Left e) = do - fireConnectedEvent $ Left $ CAFR e - return False +-- connect :: MonadIO m => HostName -> PortNumber -> Maybe (Maybe [X509], ([X509] -> Bool)) -> Maybe (UserName, Password, Maybe Resource) -> XMPPT m () +-- +-- connect h p Nothing Nothing = do +-- hookStreamsOpenedEvent onStreamsOpenedEvent Nothing +-- openStreams h p +-- +-- where +-- +-- onStreamsOpenedEvent Nothing = do +-- fireConnectedEvent Nothing +-- return False +-- +-- onStreamsOpenedEvent (Just e) = do +-- fireConnectedEvent $ Left $ COSFR e +-- return False +-- +-- connect h p (Just t) Nothing = do +-- hookStreamsOpenedEvent onStreamsOpenedEvent Nothing +-- openStreams h p +-- +-- where +-- +-- onStreamsOpenedEvent Nothing = do +-- hookTLSSecuredEvent onTLSSecuredEvent Nothing +-- tlsSecure +-- return False +-- +-- onStreamsOpenedEvent (Just e) = do +-- fireConnectedEvent $ Left $ COSFR e +-- return False +-- +-- onTLSSecuredEvent Nothing = do +-- fireConnectedEvent Nothing +-- return False +-- +-- onTLSSecuredEvent (Just e) = do +-- fireConnectedEvent $ Left $ CTSFR e +-- return False +-- +-- connect h p Nothing (Just a) = do +-- hookStreamsOpenedEvent onStreamsOpenedEvent Nothing +-- openStreams h p +-- +-- where +-- +-- onStreamsOpenedEvent Nothing = do +-- hookAuthenticatedEvent onAuthenticatedEvent Nothing +-- authenticate +-- return False +-- +-- onStreamsOpenedEvent (Just e) = do +-- fireConnectedEvent $ Left $ COSFR e +-- return False +-- +-- onAuthenticatedEvent (Right r) = do +-- fireConnectedEvent $ Just r +-- return False +-- +-- onAuthenticated (Left e) = do +-- fireConnectedEvent $ Left $ CAFR e +-- return False +-- +-- connect h p (Just t) (Just a) = do +-- hookStreamsOpenedEvent onStreamsOpenedEvent Nothing +-- openStreams h p +-- +-- where +-- +-- onStreamsOpenedEvent Nothing = do +-- hookTLSSecuredEvent onTLSSecuredEvent Nothing +-- tlsSecure +-- return False +-- +-- onStreamsOpenedEvent (Just e) = do +-- fireConnectedEvent $ Left $ COSFR e +-- return False +-- +-- onTLSSecuredEvent Nothing = do +-- hookAuthenticatedEvent onAuthenticatedEvent Nothing +-- authenticate +-- return False +-- +-- onTLSSecuredEvent (Just e) = do +-- fireConnectedEvent $ Left $ CTSFR e +-- return False +-- +-- onAuthenticatedEvent (Right r) = do +-- fireConnectedEvent $ Just r +-- return False +-- +-- onAuthenticated (Left e) = do +-- fireConnectedEvent $ Left $ CAFR e +-- return False \ No newline at end of file diff --git a/Network/XMPP/SessionOld.hs b/Network/XMPP/SessionOld.hs index 185fbf8..99f2bcc 100644 --- a/Network/XMPP/SessionOld.hs +++ b/Network/XMPP/SessionOld.hs @@ -83,8 +83,8 @@ import GHC.IO.Handle (Handle, hPutStr, hFlush, hSetBuffering, hWaitForInput) import Network.TLS import Network.TLS.Cipher import System.IO (BufferMode, BufferMode(NoBuffering)) -import Text.XML.Enumerator.Parse (parseBytes, decodeEntities) -import Text.XML.Enumerator.Document (fromEvents) +-- import Text.XML.Enumerator.Parse (parseBytes, decodeEntities) +-- import Text.XML.Enumerator.Document (fromEvents) import qualified Codec.Binary.Base64.String as CBBS import qualified Data.ByteString as DB import qualified Data.ByteString.Lazy as DBL (ByteString, append, pack, fromChunks, toChunks, null) @@ -112,8 +112,8 @@ import System.Random (randomIO) -- It holds information needed by Pontarius XMPP; its content is not -- accessible from the client. -data Session s m = Session { sessionChannel :: Chan (InternalEvent s m) - , sessionIDGenerator :: IDGenerator } +-- data Session s m = Session { sessionChannel :: Chan (InternalEvent s m) +-- , sessionIDGenerator :: IDGenerator } -- | A client typically needs one or more @ClientHandler@ objects to interact @@ -131,18 +131,18 @@ data Session s m = Session { sessionChannel :: Chan (InternalEvent s m) -- The 'sessionTerminated' callback function takes a 'TerminationReason' value -- along with the state and will be sent to all client handlers. -data MonadIO m => ClientHandler s m = - ClientHandler { messageReceived :: Maybe (Message -> StateT s m Bool) - , presenceReceived :: Maybe (Presence -> StateT s m Bool) - , iqReceived :: Maybe (IQ -> StateT s m Bool) - , sessionTerminated :: Maybe (TerminationReason -> - StateT s m ()) } +-- data MonadIO m => ClientHandler s m = +-- ClientHandler { messageReceived :: Maybe (Message -> StateT s m Bool) +-- , presenceReceived :: Maybe (Presence -> StateT s m Bool) +-- , iqReceived :: Maybe (IQ -> StateT s m Bool) +-- , sessionTerminated :: Maybe (TerminationReason -> +-- StateT s m ()) } -- | @TerminationReason@ contains information on why the XMPP session was -- terminated. -data TerminationReason = WhateverReason -- TODO +-- data TerminationReason = WhateverReason -- TODO -- | Creates an XMPP session. Blocks the current thread. The first parameter, @@ -418,25 +418,25 @@ processEvent e = get >>= \ state -> -- IEC (CEOpenStream hostName portNumber callback) -> do - CEB.assert (stateConnectionState state == Disconnected) (return ()) - - let portNumber' = fromIntegral portNumber - - connectResult <- liftIO $ CE.try $ N.connectTo hostName - (N.PortNumber portNumber') - - case connectResult of - Right handle -> do - put $ state { stateConnectionState = Connected (ServerAddress hostName portNumber') handle - , stateStreamState = PreStream - , stateOpenStreamsCallback = Just callback } - lift $ liftIO $ hSetBuffering handle NoBuffering - lift $ liftIO $ send ("") (Left handle) - threadID <- lift $ liftIO $ forkIO $ xmlEnumerator (stateChannel state) (Left handle) - lift $ liftIO $ putMVar (stateThreadID state) threadID - return Nothing + -- CEB.assert (stateConnectionState state == Disconnected) (return ()) + + -- let portNumber' = fromIntegral portNumber + + -- connectResult <- liftIO $ CE.try $ N.connectTo hostName + -- (N.PortNumber portNumber') + + -- case connectResult of + -- Right handle -> do + -- put $ state { stateConnectionState = Connected (ServerAddress hostName portNumber') handle + -- , stateStreamState = PreStream + -- , stateOpenStreamsCallback = Just callback } + -- lift $ liftIO $ hSetBuffering handle NoBuffering + -- lift $ liftIO $ send ("") (Left handle) + -- threadID <- lift $ liftIO $ forkIO $ xmlEnumerator (stateChannel state) (Left handle) + -- lift $ liftIO $ putMVar (stateThreadID state) threadID + -- return Nothing Left e -> do let clientState = stateClientState state ((), clientState') <- lift $ runStateT (callback OpenStreamFailure) clientState @@ -712,8 +712,8 @@ processEvent e = get >>= \ state -> send :: String -> Either Handle TLSCtx -> IO () send s o = case o of Left handle -> do - liftIO $ hPutStr handle $ encodeString $ s - liftIO $ hFlush handle + -- liftIO $ hPutStr handle $ encodeString $ s + -- liftIO $ hFlush handle return () Right tlsCtx -> do liftIO $ sendData tlsCtx $ DBLC.pack $ encodeString s diff --git a/Network/XMPP/Stanza.hs b/Network/XMPP/Stanza.hs index a9589e2..6666678 100644 --- a/Network/XMPP/Stanza.hs +++ b/Network/XMPP/Stanza.hs @@ -19,15 +19,12 @@ iqLangTag, iqPayload, iqPayloadNamespace, iqRequestPayloadNamespace, -iqResponsePayloadNamespace, -idGenerator, -nextID +iqResponsePayloadNamespace ) where import Network.XMPP.Address import Network.XMPP.Types -import Data.IORef (atomicModifyIORef, newIORef) import Data.XML.Types (Element, elementName, nameNamespace) import Data.Text (unpack) @@ -143,46 +140,4 @@ iqResponsePayloadNamespace i = case iqResponsePayload i of Nothing -> Nothing Just p -> case nameNamespace $ elementName p of Nothing -> Nothing - Just n -> Just (unpack n) - - --- | --- Creates a new stanza "IDGenerator". Internally, it will maintain an infinite --- list of stanza IDs ('[\'a\', \'b\', \'c\'...]'). - -idGenerator :: String -> IO IDGenerator - -idGenerator p = newIORef (ids p) >>= \ ioRef -> return $ IDGenerator ioRef - - --- | --- Extracts an ID from the "IDGenerator", and updates the generators internal --- state so that the same ID will not be generated again. - -nextID :: IDGenerator -> IO String - -nextID g = let IDGenerator ioRef = g - in atomicModifyIORef ioRef (\ (i:is) -> (is, i)) - - --- Generates an infinite and predictable list of IDs, all beginning with the --- provided prefix. - -ids :: String -> [String] - --- Adds the prefix to all combinations of IDs (ids'). -ids p = map (\ id -> p ++ id) ids' - where - - -- Generate all combinations of IDs, with increasing length. - ids' :: [String] - ids' = concatMap ids'' [1..] - - -- Generates all combinations of IDs with the given length. - ids'' :: Integer -> [String] - ids'' 0 = [""] - ids'' l = [x:xs | x <- repertoire, xs <- ids'' (l - 1)] - - -- Characters allowed in IDs. - repertoire :: String - repertoire = ['a'..'z'] + Just n -> Just (unpack n) \ No newline at end of file diff --git a/Network/XMPP/Stream.hs b/Network/XMPP/Stream.hs index 759d29b..feb6a02 100644 --- a/Network/XMPP/Stream.hs +++ b/Network/XMPP/Stream.hs @@ -6,7 +6,7 @@ {-# LANGUAGE OverloadedStrings #-} module Network.XMPP.Stream ( -xmlEnumerator, +-- xmlEnumerator, presenceToXML, iqToXML, messageToXML, @@ -35,8 +35,8 @@ import GHC.IO.Handle (Handle) import Network.TLS (TLSCtx, recvData) import Text.Parsec (char, count, digit, eof, many, many1, oneOf, parse) import Text.Parsec.ByteString (GenParser) -import Text.XML.Enumerator.Document (fromEvents) -import Text.XML.Enumerator.Parse (parseBytes, decodeEntities) +-- import Text.XML.Enumerator.Document (fromEvents) +-- import Text.XML.Enumerator.Parse (parseBytes, decodeEntities) import qualified Data.ByteString as DB (ByteString) import qualified Data.ByteString.Char8 as DBC (pack) @@ -46,94 +46,94 @@ import qualified Data.Enumerator.List as DEL (head) -- Reads from the provided handle or TLS context and sends the events to the -- internal event channel. -xmlEnumerator :: Chan InternalEvent -> Either Handle TLSCtx -> IO () -- Was: InternalEvent s m - -xmlEnumerator c s = do - enumeratorResult <- case s of - Left handle -> run $ enumHandle 1 handle $$ joinI $ - parseBytes decodeEntities $$ eventConsumer c [] 0 - Right tlsCtx -> run $ enumTLS tlsCtx $$ joinI $ - parseBytes decodeEntities $$ eventConsumer c [] 0 - case enumeratorResult of - Right _ -> return () -- writeChan c $ IEE EnumeratorDone - Left e -> return () -- writeChan c $ IEE (EnumeratorException e) - where - -- Behaves like enumHandle, but reads from the TLS context instead - -- TODO: Type? - enumTLS :: TLSCtx -> Enumerator DB.ByteString IO b - enumTLS c s = loop c s - - -- TODO: Type? - loop :: TLSCtx -> Step DB.ByteString IO b -> Iteratee DB.ByteString IO b - loop c (Continue k) = do - d <- recvData c - case null d of - True -> loop c (Continue k) - False -> k (Chunks $ toChunks d) >>== loop c - loop _ step = returnI step +-- xmlEnumerator :: Chan InternalEvent -> Either Handle TLSCtx -> IO () -- Was: InternalEvent s m + +-- xmlEnumerator c s = do +-- enumeratorResult <- case s of +-- Left handle -> run $ enumHandle 1 handle $$ joinI $ +-- parseBytes decodeEntities $$ eventConsumer c [] 0 +-- Right tlsCtx -> run $ enumTLS tlsCtx $$ joinI $ +-- parseBytes decodeEntities $$ eventConsumer c [] 0 +-- case enumeratorResult of +-- Right _ -> return () -- writeChan c $ IEE EnumeratorDone +-- Left e -> return () -- writeChan c $ IEE (EnumeratorException e) +-- where +-- -- Behaves like enumHandle, but reads from the TLS context instead +-- -- TODO: Type? +-- enumTLS :: TLSCtx -> Enumerator DB.ByteString IO b +-- enumTLS c s = loop c s +-- +-- -- TODO: Type? +-- loop :: TLSCtx -> Step DB.ByteString IO b -> Iteratee DB.ByteString IO b +-- loop c (Continue k) = do +-- d <- recvData c +-- case null d of +-- True -> loop c (Continue k) +-- False -> k (Chunks $ toChunks d) >>== loop c +-- loop _ step = returnI step -- Consumes XML events from the input stream, accumulating as necessary, and -- sends the proper events through the channel. The second parameter should be -- initialized to [] (no events) and the third to 0 (zeroth XML level). -eventConsumer :: Chan InternalEvent -> [Event] -> Int -> - Iteratee Event IO (Maybe Event) -- Was: InternalEvent s m +-- eventConsumer :: Chan InternalEvent -> [Event] -> Int -> +-- Iteratee Event IO (Maybe Event) -- Was: InternalEvent s m -- open event received. -eventConsumer chan [EventBeginElement (Name localName namespace prefixName) attribs] 0 - | localName == pack "stream" && isJust prefixName && fromJust prefixName == pack "stream" = do - liftIO $ return () -- writeChan chan $ IEE $ EnumeratorBeginStream from to id ver lang ns - eventConsumer chan [] 1 - where - from = case lookup "from" attribs of Nothing -> Nothing; Just fromAttrib -> Just $ show fromAttrib - to = case lookup "to" attribs of Nothing -> Nothing; Just toAttrib -> Just $ show toAttrib - id = case lookup "id" attribs of Nothing -> Nothing; Just idAttrib -> Just $ show idAttrib - ver = case lookup "version" attribs of Nothing -> Nothing; Just verAttrib -> Just $ show verAttrib - lang = case lookup "xml:lang" attribs of Nothing -> Nothing; Just langAttrib -> Just $ show langAttrib - ns = case namespace of Nothing -> Nothing; Just namespaceAttrib -> Just $ unpack namespaceAttrib +-- eventConsumer chan [EventBeginElement (Name localName namespace prefixName) attribs] 0 +-- | localName == pack "stream" && isJust prefixName && fromJust prefixName == pack "stream" = do +-- liftIO $ return () -- writeChan chan $ IEE $ EnumeratorBeginStream from to id ver lang ns +-- eventConsumer chan [] 1 +-- where +-- from = case lookup "from" attribs of Nothing -> Nothing; Just fromAttrib -> Just $ show fromAttrib +-- to = case lookup "to" attribs of Nothing -> Nothing; Just toAttrib -> Just $ show toAttrib +-- id = case lookup "id" attribs of Nothing -> Nothing; Just idAttrib -> Just $ show idAttrib +-- ver = case lookup "version" attribs of Nothing -> Nothing; Just verAttrib -> Just $ show verAttrib +-- lang = case lookup "xml:lang" attribs of Nothing -> Nothing; Just langAttrib -> Just $ show langAttrib +-- ns = case namespace of Nothing -> Nothing; Just namespaceAttrib -> Just $ unpack namespaceAttrib -- close event received. -eventConsumer chan [EventEndElement name] 1 - | namePrefix name == Just (pack "stream") && nameLocalName name == pack "stream" = do - liftIO $ return () -- writeChan chan $ IEE $ EnumeratorEndStream - return Nothing +-- eventConsumer chan [EventEndElement name] 1 +-- | namePrefix name == Just (pack "stream") && nameLocalName name == pack "stream" = do +-- liftIO $ return () -- writeChan chan $ IEE $ EnumeratorEndStream +-- return Nothing -- Ignore EventDocumentBegin event. -eventConsumer chan [EventBeginDocument] 0 = eventConsumer chan [] 0 +-- eventConsumer chan [EventBeginDocument] 0 = eventConsumer chan [] 0 -- We have received a complete first-level XML element. Process the accumulated -- values into an first-level element event. -eventConsumer chan ((EventEndElement e):es) 1 = do - liftIO $ return () -- writeChan chan $ IEE $ EnumeratorFirstLevelElement $ eventsToElement $ reverse ((EventEndElement e):es) - eventConsumer chan [] 1 +-- eventConsumer chan ((EventEndElement e):es) 1 = do +-- liftIO $ return () -- writeChan chan $ IEE $ EnumeratorFirstLevelElement $ eventsToElement $ reverse ((EventEndElement e):es) +-- eventConsumer chan [] 1 -- Normal condition - accumulate the event. -eventConsumer chan events level = do - event <- DEL.head - case event of - Just event' -> let level' = case event' of - EventBeginElement _ _ -> level + 1 - EventEndElement _ -> level - 1 - _ -> level - in eventConsumer chan (event':events) level' - Nothing -> eventConsumer chan events level - - -eventsToElement :: [Event] -> Either SomeException Element - -eventsToElement e = do - r <- run $ eventsEnum $$ fromEvents - case r of Right doc -> Right $ documentRoot doc; Left ex -> Left ex - where - -- TODO: Type? - eventsEnum (Continue k) = k $ Chunks e - eventsEnum step = returnI step +-- eventConsumer chan events level = do +-- event <- DEL.head +-- case event of +-- Just event' -> let level' = case event' of +-- EventBeginElement _ _ -> level + 1 +-- EventEndElement _ -> level - 1 +-- _ -> level +-- in eventConsumer chan (event':events) level' +-- Nothing -> eventConsumer chan events level + + +-- eventsToElement :: [Event] -> Either SomeException Element + +-- eventsToElement e = do +-- r <- run $ eventsEnum $$ fromEvents +-- case r of Right doc -> Right $ documentRoot doc; Left ex -> Left ex +-- where +-- -- TODO: Type? +-- eventsEnum (Continue k) = k $ Chunks e +-- eventsEnum step = returnI step -- Sending stanzas is done through functions, where LangTag is Maybe. diff --git a/Network/XMPP/Types.hs b/Network/XMPP/Types.hs index 9db049c..bee73ed 100644 --- a/Network/XMPP/Types.hs +++ b/Network/XMPP/Types.hs @@ -27,13 +27,12 @@ StanzaErrorCondition (..), EnumeratorEvent (..), Challenge (..), Success (..), -TLSState (..), +-- TLSState (..), Address (..), Localpart, Domainpart, Resourcepart, LangTag (..), -InternalEvent (..), ConnectionState (..), ClientEvent (..), StreamState (..), @@ -47,7 +46,7 @@ XMPPError (..), Timeout, TimeoutEvent (..), StreamError (..), -IDGenerator (..), +IdGenerator (..), Version (..), IQError (..), IQResult (..), @@ -440,19 +439,6 @@ data EnumeratorEvent = EnumeratorDone | deriving (Show) --- Type to contain the internal events. - --- data InternalEvent s m = IEC (ClientEvent s m) | IEE EnumeratorEvent | IET (TimeoutEvent s m) deriving (Show) - --- Internal events processed in the main state loop of Pontarius XMPP. They are --- either received from the client or from the enumerator. - -data InternalEvent - = IECE ClientEvent - | IEEE EnumeratorEvent - - - data TimeoutEvent s m = TimeoutEvent StanzaID Timeout (StateT s m ()) instance Show (TimeoutEvent s m) where @@ -501,7 +487,7 @@ type StreamID = String data ConnectionState = Disconnected | Connected ServerAddress Handle -data TLSState = NoTLS | PreProceed | PreHandshake | PostHandshake TLSCtx +-- data TLSState = NoTLS | PreProceed | PreHandshake | PostHandshake TLSCtx data Challenge = Chal String deriving (Show) @@ -556,7 +542,7 @@ data StreamError = StreamError -- ============================================================================= -newtype IDGenerator = IDGenerator (IORef [String]) +newtype IdGenerator = IdGenerator (IORef [String]) diff --git a/Network/XMPP/Utilities.hs b/Network/XMPP/Utilities.hs index 2f9fb37..8e53b7c 100644 --- a/Network/XMPP/Utilities.hs +++ b/Network/XMPP/Utilities.hs @@ -10,8 +10,13 @@ {-# LANGUAGE OverloadedStrings #-} -module Network.XMPP.Utilities ( elementToString - , elementsToString ) where +module Network.XMPP.Utilities ( idGenerator + , nextId + -- elementToString + -- , elementsToString ) where + ) where + +import Network.XMPP.Types import Prelude hiding (concat) @@ -23,40 +28,88 @@ import Data.Enumerator.List (consume) import Data.XML.Types (Document (..), Element (..), Event (..), Name (..), Prologue (..)) -import Text.XML.Enumerator.Render (renderBytes) -import Text.XML.Enumerator.Document (toEvents) +import Data.IORef (atomicModifyIORef, newIORef) + + +-- import Text.XML.Enumerator.Render (renderBytes) +-- import Text.XML.Enumerator.Document (toEvents) import System.IO.Unsafe (unsafePerformIO) +-- | +-- Creates a new stanza "IdGenerator". Internally, it will maintain an infinite +-- list of stanza IDs ('[\'a\', \'b\', \'c\'...]'). + +idGenerator :: String -> IO IdGenerator + +idGenerator p = newIORef (ids p) >>= \ ioRef -> return $ IdGenerator ioRef + + where + + -- Generates an infinite and predictable list of IDs, all + -- beginning with the provided prefix. + + ids :: String -> [String] + + -- Adds the prefix to all combinations of IDs (ids'). + ids p = map (\ id -> p ++ id) ids' + where + + -- Generate all combinations of IDs, with increasing length. + ids' :: [String] + ids' = concatMap ids'' [1..] + + -- Generates all combinations of IDs with the given length. + ids'' :: Integer -> [String] + ids'' 0 = [""] + ids'' l = [x:xs | x <- repertoire, xs <- ids'' (l - 1)] + + -- Characters allowed in IDs. + repertoire :: String + repertoire = ['a'..'z'] + + + +-- | +-- Extracts an ID from the "IDGenerator", and updates the generators internal +-- state so that the same ID will not be generated again. + +nextId :: IdGenerator -> IO String + +nextId g = let IdGenerator ioRef = g + in atomicModifyIORef ioRef (\ (i:is) -> (is, i)) + + + -- Converts the Element objects to a document, converts it into Events, strips -- the DocumentBegin event, generates a ByteString, and converts it into a -- String, aggregates the results and returns a string. -elementsToString :: [Element] -> String +-- elementsToString :: [Element] -> String -elementsToString [] = "" -elementsToString (e:es) = (elementToString (Just e)) ++ (elementsToString es) +-- elementsToString [] = "" +-- elementsToString (e:es) = (elementToString (Just e)) ++ (elementsToString es) -- Converts the Element object to a document, converts it into Events, strips -- the DocumentBegin event, generates a ByteString, and converts it into a -- String. -{-# NOINLINE elementToString #-} +-- {-# NOINLINE elementToString #-} -elementToString :: Maybe Element -> String +-- elementToString :: Maybe Element -> String -elementToString Nothing = "" -elementToString (Just elem) = unpack $ concat $ unsafePerformIO $ do - r <- run_ $ events $$ (joinI $ renderBytes $$ consume) - return r - where +-- elementToString Nothing = "" +-- elementToString (Just elem) = unpack $ concat $ unsafePerformIO $ do +-- r <- run_ $ events $$ (joinI $ renderBytes $$ consume) +-- return r +-- where -- Enumerator that "produces" the events to convert to the document - events :: Enumerator Event IO [ByteString] - events (Continue more) = more $ Chunks (tail $ toEvents $ dummyDoc elem) - events step = returnI step +-- events :: Enumerator Event IO [ByteString] +-- events (Continue more) = more $ Chunks (tail $ toEvents $ dummyDoc elem) +-- events step = returnI step - dummyDoc :: Element -> Document - dummyDoc e = Document (Prologue [] Nothing []) elem [] +-- dummyDoc :: Element -> Document +-- dummyDoc e = Document (Prologue [] Nothing []) elem [] diff --git a/README b/README index cb81938..333334c 100644 --- a/README +++ b/README @@ -1,5 +1,15 @@ Pontarius is a work in progress to build a Haskell XMPP library that -implements the client capabilities of RFC 6120 ("XMPP Core"). We are -currently working on cleaning up the code, the final architectural -details and towards feature-completeness to be able to move the -project into beta. +implements the client capabilities of RFC 6120 ("XMPP Core"). + +The latest version, 1.0 Alpha 8, is the first release since the +project was put on ice in around July, as well as the first release by +Nejla. The new release primarily brings a new API, a rewritten Session +module, a new event system and updated code to unbreak Pontarius with +regards to new versions of dependencies (most notably the conduit and +xml-conduit packages). However, there are a number of features that +are (temporarily) missing from this rewrite of library, such as TLS +security and SASL authentication. + +Overall, we are working on cleaning up the code, the final +architectural details and towards feature-completeness to be able to +move the project into beta. diff --git a/pontarius.cabal b/pontarius.cabal index 580973b..8eb5dbf 100644 --- a/pontarius.cabal +++ b/pontarius.cabal @@ -1,5 +1,5 @@ Name: pontarius -Version: 0.0.7.0 +Version: 0.0.8.0 Cabal-Version: >= 1.6 Build-Type: Simple -- License: @@ -11,14 +11,11 @@ Stability: alpha -- Homepage: Bug-Reports: mailto:jon.kristensen@nejla.com -- Package-URL: -Synopsis: A prototyped and incomplete implementation of RFC 6120: - XMPP: Core -Description: A work in progress of an implementation of RFC 6120: - XMPP: Core, as well as RFC 6122: XMPP: Address Format and - other depending standards. A new version of Pontarius - XMPP is released every three weeks. +Synopsis: An incomplete implementation of RFC 6120 (XMPP: Core) +Description: Pontarius is a work in progress of an implementation of + RFC 6120 (XMPP: Core). Category: Network -Tested-With: GHC ==7.0.2 +Tested-With: GHC ==7.0.4 -- Data-Files: -- Data-Dir: -- Extra-Source-Files: @@ -26,12 +23,11 @@ Tested-With: GHC ==7.0.2 Library Exposed: True - Build-Depends: base >= 2 && < 5, parsec, enumerator, - crypto-api ==0.6.3, base64-string, pureMD5, + Build-Depends: base >= 2 && < 5, parsec, enumerator, crypto-api, base64-string, pureMD5, utf8-string, network, xml-types, text, transformers, - bytestring, cereal ==0.3.3.0, random, xml-enumerator, + bytestring, cereal, random, xml-enumerator, tls, tls-extra, containers, mtl, text-icu, - stringprep, asn1-data, cryptohash ==0.7.0, time, + stringprep, asn1-data, cryptohash, time, certificate, ranges, uuid -- Other-Modules: -- HS-Source-Dirs: