diff --git a/Network/Protocol/XMPP/Monad.hs b/Network/Protocol/XMPP/Monad.hs
--- a/Network/Protocol/XMPP/Monad.hs
+++ b/Network/Protocol/XMPP/Monad.hs
@@ -35,6 +35,7 @@
 	, putStanza
 	) where
 import qualified Control.Applicative as A
+import qualified Control.Concurrent.MVar as M
 import Control.Monad (ap)
 import Control.Monad.Fix (MonadFix, mfix)
 import Control.Monad.Trans (MonadIO, liftIO)
@@ -73,7 +74,13 @@
 	| NoComponentStreamID
 	deriving (Show)
 
-data Session = Session H.Handle Text SAX.Parser
+data Session = Session
+	{ sessionHandle :: H.Handle
+	, sessionNamespace :: Text
+	, sessionParser :: SAX.Parser
+	, sessionReadLock :: M.MVar ()
+	, sessionWriteLock :: M.MVar ()
+	}
 
 newtype XMPP a = XMPP { unXMPP :: ErrorT Error (R.ReaderT Session IO) a }
 
@@ -105,22 +112,31 @@
 startXMPP :: H.Handle -> Text -> XMPP a -> IO (Either Error a)
 startXMPP h ns xmpp = do
 	sax <- SAX.newParser
-	runXMPP (Session h ns sax) xmpp
+	readLock <- M.newMVar ()
+	writeLock <- M.newMVar ()
+	runXMPP (Session h ns sax readLock writeLock) xmpp
 
 restartXMPP :: Maybe H.Handle -> XMPP a -> XMPP a
 restartXMPP newH xmpp = do
-	Session oldH ns _ <- getSession
+	Session oldH ns _ readLock writeLock <- getSession
 	sax <- liftIO SAX.newParser
-	let s = Session (maybe oldH id newH) ns sax
+	let s = Session (maybe oldH id newH) ns sax readLock writeLock
 	XMPP $ R.local (const s) (unXMPP xmpp)
 
+withLock :: (Session -> M.MVar ()) -> XMPP a -> XMPP a
+withLock getLock xmpp = do
+	s <- getSession
+	let mvar = getLock s
+	res <- liftIO $ M.withMVar mvar $ \_ -> runXMPP s xmpp
+	case res of
+		Left err -> E.throwError err
+		Right x -> return x
+
 getSession :: XMPP Session
 getSession = XMPP R.ask
 
 getHandle :: XMPP H.Handle
-getHandle = do
-	Session h _ _ <- getSession
-	return h
+getHandle = fmap sessionHandle getSession
 
 liftTLS :: ErrorT Text IO a -> XMPP a
 liftTLS io = do
@@ -138,12 +154,12 @@
 putElement = putBytes . encodeUtf8 . X.serialiseElement
 
 putStanza :: S.Stanza a => a -> XMPP ()
-putStanza = putElement . S.stanzaToElement
+putStanza = withLock sessionWriteLock . putElement . S.stanzaToElement
 
 readEvents :: (Integer -> SAX.Event -> Bool) -> XMPP [SAX.Event]
 readEvents done = xmpp where
 	xmpp = do
-		Session h _ p <- getSession
+		Session h _ p _ _ <- getSession
 		let nextEvents = do
 			-- TODO: read in larger increments
 			bytes <- liftTLS $ H.hGetBytes h 1
@@ -170,9 +186,9 @@
 	endOfTree _ _ = False
 
 getStanza :: XMPP S.ReceivedStanza
-getStanza = do
+getStanza = withLock sessionReadLock $ do
 	elemt <- getElement
-	Session _ ns _ <- getSession
+	Session _ ns _ _ _ <- getSession
 	case S.elementToStanza ns elemt of
 		Just x -> return x
 		Nothing -> E.throwError $ InvalidStanza elemt
diff --git a/network-protocol-xmpp.cabal b/network-protocol-xmpp.cabal
--- a/network-protocol-xmpp.cabal
+++ b/network-protocol-xmpp.cabal
@@ -1,5 +1,5 @@
 name: network-protocol-xmpp
-version: 0.3
+version: 0.3.1
 synopsis: Client <-> Server communication over XMPP
 license: GPL-3
 license-file: License.txt