diff -durN -x '*~' -x Test.hs orig/haskell-xmpp-1.0/haskell-xmpp.cabal haskell-xmpp-1.0/haskell-xmpp.cabal
--- orig/haskell-xmpp-1.0/haskell-xmpp.cabal	2011-01-15 16:50:14.000000000 -0600
+++ haskell-xmpp-1.0/haskell-xmpp.cabal	2012-04-16 21:03:49.125224872 -0500
@@ -32,7 +32,7 @@
 
 library
   Hs-Source-Dirs: ./src
-  Build-Depends: base > 3 && <=5, random, pretty, array, HaXml >= 1.20.2, mtl >= 1.0, network, html, polyparse, regex-compat, stm, utf8-string
+  Build-Depends: base > 3 && <=5, random, pretty, array, HaXml >= 1.20.2 && < 1.21, mtl >= 1.0, network, html, polyparse, regex-compat, stm, utf8-string, gnutls, bytestring
   Exposed-modules: Network.XMPP
                 , Network.XMPP.Sasl
                 , Network.XMPP.Core
diff -durN -x '*~' -x Test.hs orig/haskell-xmpp-1.0/src/Network/XMPP/Concurrent.hs haskell-xmpp-1.0/src/Network/XMPP/Concurrent.hs
--- orig/haskell-xmpp-1.0/src/Network/XMPP/Concurrent.hs	2011-01-15 16:50:14.000000000 -0600
+++ haskell-xmpp-1.0/src/Network/XMPP/Concurrent.hs	2012-04-16 21:46:04.405285127 -0500
@@ -36,6 +36,8 @@
 import Network.XMPP.XEP.Version 
 import Network.XMPP.IM.Presence    
 import Network.XMPP.Utils
+import qualified Network.Protocol.TLS.GNU as TLS
+import qualified Data.ByteString.Lazy.Char8 as BC8
 
 import System.IO
     
@@ -54,7 +56,7 @@
   liftIO $ forkIO $ runReaderT a (Thread in' out')
   s <- get
   liftIO $ forkIO $ loopWrite s out'
-  liftIO $ forkIO $ connPersist (handle s)
+  liftIO $ forkIO $ connPersist (transport s)
   loopRead in' 
     where 
       loopRead in' = loop $ 
@@ -105,10 +107,20 @@
     else do
       waitFor f
 
-connPersist :: Handle -> IO ()
-connPersist h = do
+connPersist :: Transport -> IO ()
+connPersist (HandleTransport h) = do
   hPutStr h " "
   putStrLn "<space added>"
   threadDelay 30000000
-  connPersist h
-    
+  connPersist (HandleTransport h)
+connPersist (TLSTransport t) = do
+  r <- TLS.runTLS t $ do
+    TLS.putBytes (BC8.pack " ")
+  case r of
+    Left x -> fail (show x)
+    Right _ -> return ()
+  putStrLn "<space added>"
+  threadDelay 30000000
+  connPersist (TLSTransport t)
+  
+
diff -durN -x '*~' -x Test.hs orig/haskell-xmpp-1.0/src/Network/XMPP/Core.hs haskell-xmpp-1.0/src/Network/XMPP/Core.hs
--- orig/haskell-xmpp-1.0/src/Network/XMPP/Core.hs	2011-01-15 16:50:14.000000000 -0600
+++ haskell-xmpp-1.0/src/Network/XMPP/Core.hs	2012-04-16 21:33:28.101267152 -0500
@@ -26,6 +26,9 @@
 import Network.XMPP.JID
 import Network.XMPP.IQ
 import Network.XMPP.Utils
+import Text.XML.HaXml.Xtract.Parse (xtract)
+import qualified Network.Protocol.TLS.GNU as TLS
+
 
 -- | Open connection to specified server and return `Stream' coming from it
 initiateStream :: Handle
@@ -50,7 +53,48 @@
      
      debug "Stream started"
      --debug $ "Observing: " ++ render (P.content m)
-     m <- xtractM "/stream:features/mechanisms/mechanism/-"
+     
+     -- First, we read stream:features
+     sf_ <- xtractM "/stream:features"
+     let sf = case sf_ of
+               [] -> error "Did not get stream:features"
+               [x] -> x
+               x -> error "Got many stream:features"
+               
+     -- Now, we look for starttls.
+     newsf <- case xtract id "/stream:features/starttls" sf of
+           [] -> do debug "Did not see starttls in features"
+                    return sf
+           x -> do debug $ "Saw starttls: " ++ show x
+                   out $ toContent $ ptag "starttls" 
+                     [xmlns "urn:ietf:params:xml:ns:xmpp-tls"]
+                     []
+                   nm <- nextM
+                   case xtract id "/proceed" nm of
+                     [] -> fail "Did not get proceed after starttls"
+                     _ -> return ()
+                   debug $ "Starting TLS"
+                   session <- liftIO $ TLS.runClient (TLS.handleTransport h) $ do
+                     TLS.setPriority [TLS.X509]
+                     TLS.setCredentials =<< TLS.certificateCredentials
+                     TLS.handshake
+                     TLS.getSession
+                   case session of
+                     Left x -> fail (show x)
+                     Right x -> do 
+                       debug $ "Got TLS session"
+                       resetStreamTLS h x
+                       debug $ "Stream reset"
+                       out $ toContent $ stream Client server
+                       startM
+                       tlssf_ <- xtractM "/stream:features"
+                       debug $ "Got new features"
+                       return $ case tlssf_ of
+                             [] -> error "Did not get stream:features"
+                             [x] -> x
+                             x -> error "Got many stream:features"
+               
+     let m = xtract id "/stream:features/mechanisms/mechanism/-" newsf
      let mechs = map getText m
      debug $ "Mechanisms: " ++ show mechs
 
diff -durN -x '*~' -x Test.hs orig/haskell-xmpp-1.0/src/Network/XMPP/Stream.hs haskell-xmpp-1.0/src/Network/XMPP/Stream.hs
--- orig/haskell-xmpp-1.0/src/Network/XMPP/Stream.hs	2011-01-15 16:50:14.000000000 -0600
+++ haskell-xmpp-1.0/src/Network/XMPP/Stream.hs	2012-04-16 21:50:42.369291734 -0500
@@ -24,6 +24,7 @@
   , withNewStream
   , withStream
   , resetStreamHandle
+  , resetStreamTLS
   , getText
   , getText_
   , loopWithPlugins
@@ -49,18 +50,29 @@
 import Network.XMPP.Types
 import Network.XMPP.UTF8
 
+import qualified Network.Protocol.TLS.GNU as TLS
+import System.IO.Unsafe(unsafeInterleaveIO)
+import qualified Data.ByteString.Lazy.Char8 as BC8
+
 -- For a definition of 'Stream' see Network.XMPP.Types.
 
 -- In the beginning, all Stream buffers are empty, and by default it is bound to stdin.
 -- Functions like 'openStreamTo' or 'openStreamViaProxyTo' could override this.
 newStream :: Stream 
-newStream = Stream { handle=stdin, idx=0, lexemes=[] }
+newStream = Stream { transport=HandleTransport stdin, idx=0, lexemes=[] }
 
 -- Main 'workhorses' for Stream are 'out', 'nextM', 'peekM' and 'selectM':
 -- | Sends message into Stream
 out :: XmppMessage -> XmppStateT ()
-out xmpp = do h <- gets handle
-              liftIO $ hPutXmpp h xmpp
+out xmpp = do h <- gets transport
+              case h of
+                HandleTransport h -> liftIO $ hPutXmpp h xmpp
+                TLSTransport t -> do let str = renderXmpp xmpp
+                                     liftIO $ putStrLn $ "TLS Sending: " ++ str
+                                     r <- liftIO $ TLS.runTLS t $ TLS.putBytes (BC8.pack . toUTF8 $ str)
+                                     case r of
+                                       Left x -> fail (show x)
+                                       Right _ -> return ()
 
 -- | Selects next messages from stream
 nextM :: XmppStateT XmppMessage
@@ -125,8 +137,49 @@
 -- | Replaces contents of the Stream with the contents
 --   coming from given handle.
 resetStreamHandle h =
-  do c <- liftIO $ hGetContents h
-     modify (\stream -> stream { handle=h , lexemes = xmlLex "stream" (fromUTF8 c) })
+  do c <- liftIO $ hGetContentsNoClose h
+     modify (\stream -> stream { transport=HandleTransport h , lexemes = xmlLex "stream" (fromUTF8 c) })
+
+-- This is inefficient, but the moment we get to TLS, we ditch it.
+hGetContentsNoClose h =
+  unsafeInterleaveIO $ do
+    c <- hGetChar h
+    next <- hGetContentsNoClose h
+    return (c:next)
+    
+
+-- | Replaces contents of the Stream with the contents
+-- coming from the TLS stream.
+resetStreamTLS h t =
+  do c <- liftIO $ getTLSStream t
+     modify (\stream -> stream { transport=TLSTransport t , lexemes = xmlLex "stream" (fromUTF8 c) })
+  where getTLSStream :: TLS.Session -> IO String
+        getTLSStream s = unsafeInterleaveIO (runner s)
+        waitForData =
+          do -- liftIO $ putStrLn "before first checkpending"
+             pending <- TLS.checkPending
+             if pending == 0
+                {-
+                then do liftIO $ putStrLn "pending was 0"
+                        liftIO (hWaitForInput h (- 1) >> return ())
+                        liftIO $ putStrLn "after wait"
+                        waitForData -}
+                then return 1
+                else return pending
+        runner :: TLS.Session -> IO String
+        runner s = 
+          do r <- TLS.runTLS s $ do
+               -- liftIO $ putStrLn "before waitForData"
+               pendingBytes <- waitForData
+               -- liftIO $ putStrLn "before getBytes"
+               lazy <- TLS.getBytes pendingBytes
+               -- liftIO $ putStrLn $ "got bytes"
+               return $ BC8.unpack lazy
+             case r of
+               Left x -> fail (show x)
+               Right y -> do remainder <- getTLSStream s
+                             return (y ++ remainder)
+               
 
 -------------------------------
 -- Basic plugin support
diff -durN -x '*~' -x Test.hs orig/haskell-xmpp-1.0/src/Network/XMPP/Types.hs haskell-xmpp-1.0/src/Network/XMPP/Types.hs
--- orig/haskell-xmpp-1.0/src/Network/XMPP/Types.hs	2011-01-15 16:50:14.000000000 -0600
+++ haskell-xmpp-1.0/src/Network/XMPP/Types.hs	2012-04-16 21:38:57.201274975 -0500
@@ -12,6 +12,7 @@
 module Network.XMPP.Types
   ( XmppMessage
   , XmppStateT
+  , Transport(..)
   , Stream(..)
   , StreamType(..)
   , Stanza(..)
@@ -29,14 +30,17 @@
     
 import Text.PrettyPrint.HughesPJ    (render, hcat)
 import qualified Text.XML.HaXml.Pretty as P (content)
+import qualified Network.Protocol.TLS.GNU as TLS
 
 import Network.XMPP.JID
 
 -- | XMPP message in the parsed form
 type XmppMessage = Content Posn    
 
+data Transport = HandleTransport Handle | TLSTransport TLS.Session
+
 -- | XMPP stream, used as a state in XmppStateT state transformer
-data Stream = Stream { handle::Handle 
+data Stream = Stream { transport :: Transport
                      -- ^ IO handle to the underlying file or socket
                      , idx :: !Int
                      -- ^ id of the next message (if needed)
