Browse Source

add Finished state to ConnectionState

master
Philipp Balzarek 13 years ago
parent
commit
3ac2079f27
  1. 37
      source/Network/Xmpp/Stream.hs
  2. 7
      source/Network/Xmpp/Tls.hs
  3. 1
      source/Network/Xmpp/Types.hs

37
source/Network/Xmpp/Stream.hs

@ -122,11 +122,12 @@ startStream = runErrorT $ do
-- state of the stream. -- state of the stream.
let expectedTo = case ( streamConnectionState st let expectedTo = case ( streamConnectionState st
, toJid $ streamConfiguration st) of , toJid $ streamConfiguration st) of
(Plain , (Just (jid, True))) -> Just jid (Plain , (Just (jid, True))) -> Just jid
(Plain , _ ) -> Nothing (Plain , _ ) -> Nothing
(Secured, (Just (jid, _ ))) -> Just jid (Secured , (Just (jid, _ ))) -> Just jid
(Secured, Nothing ) -> Nothing (Secured , Nothing ) -> Nothing
(Closed , _ ) -> Nothing (Closed , _ ) -> Nothing
(Finished , _ ) -> Nothing
case streamAddress st of case streamAddress st of
Nothing -> do Nothing -> do
lift $ lift $ errorM "Pontarius.XMPP" "Server sent no hostname." lift $ lift $ errorM "Pontarius.XMPP" "Server sent no hostname."
@ -338,6 +339,7 @@ closeStreams' = do
threadDelay 3000000 -- TODO: Configurable value threadDelay 3000000 -- TODO: Configurable value
void ((Ex.try cc) :: IO (Either Ex.SomeException ())) void ((Ex.try cc) :: IO (Either Ex.SomeException ()))
return () return ()
put xmppNoStream{ streamConnectionState = Finished }
collectElems [] collectElems []
where where
-- Pulls elements from the stream until the stream ends, or an error is -- Pulls elements from the stream until the stream ends, or an error is
@ -470,18 +472,21 @@ catchPush p = ExL.catch
_ -> ExL.throwIO e _ -> ExL.throwIO e
) )
zeroHandle :: StreamHandle
zeroHandle = StreamHandle { streamSend = \_ -> return False
, streamReceive = \_ -> do
errorM "Pontarius.XMPP"
"xmppNoStream: Stream is closed."
ExL.throwIO XmppOtherFailure
, streamFlush = return ()
, streamClose = return ()
}
-- Stream state used when there is no connection. -- Stream state used when there is no connection.
xmppNoStream :: StreamState xmppNoStream :: StreamState
xmppNoStream = StreamState { xmppNoStream = StreamState {
streamConnectionState = Closed streamConnectionState = Closed
, streamHandle = StreamHandle { streamSend = \_ -> return False , streamHandle = zeroHandle
, streamReceive = \_ -> do
errorM "Pontarius.XMPP" "xmppNoStream: No stream on receive."
ExL.throwIO $
XmppOtherFailure
, streamFlush = return ()
, streamClose = return ()
}
, streamEventSource = zeroSource , streamEventSource = zeroSource
, streamFeatures = StreamFeatures Nothing [] [] , streamFeatures = StreamFeatures Nothing [] []
, streamAddress = Nothing , streamAddress = Nothing
@ -705,14 +710,14 @@ srvLookup realm resolvSeed = ErrorT $ do
rest <- orderSublist sublist'' rest <- orderSublist sublist''
return $ ((priority, weight, port, domain):rest) return $ ((priority, weight, port, domain):rest)
-- Closes the connection and updates the XmppConMonad Stream state. -- | Close the connection and updates the XmppConMonad Stream state. Does
-- killStream :: Stream -> IO (Either ExL.SomeException ()) -- not send the stream end tag.
killStream :: Stream -> IO (Either XmppFailure ()) killStream :: Stream -> IO (Either XmppFailure ())
killStream = withStream $ do killStream = withStream $ do
cc <- gets (streamClose . streamHandle) cc <- gets (streamClose . streamHandle)
err <- wrapIOException cc err <- wrapIOException cc
-- (ExL.try cc :: IO (Either ExL.SomeException ())) -- (ExL.try cc :: IO (Either ExL.SomeException ()))
put xmppNoStream put xmppNoStream{ streamConnectionState = Finished }
return err return err
-- Sends an IQ request and waits for the response. If the response ID does not -- Sends an IQ request and waits for the response. If the response ID does not

7
source/Network/Xmpp/Tls.hs

@ -51,10 +51,13 @@ tls con = Ex.handle (return . Left . TlsError)
case sState of case sState of
Plain -> return () Plain -> return ()
Closed -> do Closed -> do
liftIO $ errorM "Pontarius.Xmpp" "startTls: The stream is closed." liftIO $ errorM "Pontarius.Xmpp.Tls" "The stream is closed."
throwError XmppNoStream
Finished -> do
liftIO $ errorM "Pontarius.Xmpp.Tls" "The stream is finished."
throwError XmppNoStream throwError XmppNoStream
Secured -> do Secured -> do
liftIO $ errorM "Pontarius.Xmpp" "startTls: The stream is already secured." liftIO $ errorM "Pontarius.Xmpp.Tls" "The stream is already secured."
throwError TlsStreamSecured throwError TlsStreamSecured
features <- lift $ gets streamFeatures features <- lift $ gets streamFeatures
case (tlsBehaviour conf, streamTls features) of case (tlsBehaviour conf, streamTls features) of

1
source/Network/Xmpp/Types.hs

@ -803,6 +803,7 @@ data ConnectionState
= Closed -- ^ No stream has been established = Closed -- ^ No stream has been established
| Plain -- ^ Stream established, but not secured via TLS | Plain -- ^ Stream established, but not secured via TLS
| Secured -- ^ Stream established and secured via TLS | Secured -- ^ Stream established and secured via TLS
| Finished -- ^ Stream is closed
deriving (Show, Eq, Typeable) deriving (Show, Eq, Typeable)
-- | Defines operations for sending, receiving, flushing, and closing on a -- | Defines operations for sending, receiving, flushing, and closing on a

Loading…
Cancel
Save