diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,27 @@
+Copyright (c) 2014, Yoshikuni Jujo
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+  * Redistributions of source code must retain the above copyright notice,
+    this list of conditions and the following disclaimer.
+
+  * Redistributions in binary form must reproduce the above copyright
+    notice, this list of conditions and the following disclaimer in the
+    documentation and/or other materials provided with the distribution.
+
+  * Neither the name of the Yoshikuni Jujo nor the names of its
+    contributors may be used to endorse or promote products derived from
+    this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
+THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED. IN NO EVEN SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,1 @@
+import Distribution.Simple; main = defaultMain
diff --git a/core/Network/XMPiPe/Core/C2S/Client.hs b/core/Network/XMPiPe/Core/C2S/Client.hs
new file mode 100644
--- /dev/null
+++ b/core/Network/XMPiPe/Core/C2S/Client.hs
@@ -0,0 +1,116 @@
+{-# LANGUAGE OverloadedStrings, TypeFamilies,
+	FlexibleContexts, PackageImports #-}
+
+module Network.XMPiPe.Core.C2S.Client (
+	-- * Types and Values
+	Mpi(..), Feature, Jid(..), toJid,
+	Tags(..), tagsNull, tagsType,
+	-- * Functions
+	starttls, sasl, bind, input, output,
+	) where
+
+import Control.Monad
+import "monads-tf" Control.Monad.State
+import "monads-tf" Control.Monad.Writer
+import "monads-tf" Control.Monad.Error
+import Data.Maybe
+import Data.List
+import Data.Pipe
+import Text.XML.Pipe
+
+import qualified Data.ByteString as BS
+
+import Xmpp hiding (input, output, Feature)
+import qualified Xmpp as X
+import qualified SaslClient as SASL
+
+input :: Monad m => [Xmlns] -> Pipe BS.ByteString Mpi m ()
+input = inputMpi
+
+output :: Monad m => Pipe Mpi BS.ByteString m ()
+output = outputMpi
+
+begin :: Monad m => BS.ByteString -> BS.ByteString -> Pipe Xmpp Xmpp m ()
+begin h l = do
+	yield XCDecl
+	yield $ XCBegin [(To, h), (TagRaw $ nullQ "version", "1.0"), (Lang, l)]
+
+starttls :: Monad m => BS.ByteString -> Pipe BS.ByteString BS.ByteString m ()
+starttls hst = inputP3 =$= (begin hst "en" >> starttls_) =$= X.output
+
+starttls_ :: Monad m => Pipe Xmpp Xmpp m ()
+starttls_ = do
+	Just (XCBegin _as) <- await
+	Just (XCFeatures fs) <- await
+	unless (any isSt fs) $ fail "starttls_: not support tls"
+	yield XCStarttls
+	Just XCProceed <- await
+	return ()
+	where isSt (FtStarttls _) = True; isSt _ = False
+
+sasl :: (
+	MonadState m, SASL.SaslState (StateType m),
+	MonadError m, Error (ErrorType m)) =>
+	BS.ByteString -> [BS.ByteString] -> Pipe BS.ByteString BS.ByteString m ()
+sasl hst ms = inputP2 =$= sasl' hst ms =$= X.output
+
+sasl' :: (
+	MonadState m, SASL.SaslState (StateType m),
+	MonadError m, Error (ErrorType m)) =>
+	BS.ByteString -> [BS.ByteString] -> Pipe Xmpp Xmpp m ()
+sasl' hst ms = begin hst "en" >> sasl_ ms
+
+sasl_ :: (Monad m, MonadState m, SASL.SaslState (StateType m), MonadError m, Error (ErrorType m) ) =>
+	[BS.ByteString] -> Pipe Xmpp Xmpp m ()
+sasl_ sl = do
+	Just (XCBegin _as) <- await
+	Just (XCFeatures fs) <- await
+	let	Just (FtMechanisms ms) = find isFtMechanisms fs
+		Just n = listToMaybe $ sl `intersect` ms
+	SASL.sasl n
+	where
+	isFtMechanisms (FtMechanisms _) = True
+	isFtMechanisms _ = False
+
+bind :: (Monad m,
+	MonadWriter m, [Feature] ~ WriterType m,
+	MonadError m, Error (ErrorType m) ) =>
+	BS.ByteString -> BS.ByteString -> Pipe BS.ByteString BS.ByteString m [Xmlns]
+bind hst r = inputP3 =@= (begin hst "en" >> bind_ r) =$= X.output
+
+bind_ :: (
+	MonadWriter m, [Feature] ~ (WriterType m),
+	MonadError m, Error (ErrorType m) ) =>
+	BS.ByteString -> Pipe Xmpp Xmpp m ()
+bind_ r = await >>= \mr -> case mr of
+	Just (XCFeatures fs) -> do
+		let (b, fs') = sepBind fs
+		mapM_ yield . catMaybes $
+			map (responseToFeature r) $ filter notFtSession b
+		tell $ map getFeature fs'
+		bind_ r
+	Just _ -> bind_ r
+	_ -> return ()
+
+type Feature = XmlNode
+
+getFeature :: X.Feature -> Feature
+getFeature (FtRaw ft) = ft
+getFeature _ = error "Network.XMPiPe.Core.C2S.Client.getFeature: bad"
+
+sepBind :: [X.Feature] -> ([X.Feature], [X.Feature])
+sepBind = partition notFtRaw
+
+notFtSession :: X.Feature -> Bool
+notFtSession (FtSession _) = False
+notFtSession _ = True
+
+notFtRaw :: X.Feature -> Bool
+notFtRaw (FtRaw _) = False
+notFtRaw _ = True
+
+responseToFeature :: BS.ByteString -> X.Feature -> Maybe Xmpp
+responseToFeature r (FtBind _) = Just
+	. SRIqBind [(Type, "set"), (Id, "_xmpp_bind1")] . IqBind Nothing
+	$ Resource r
+responseToFeature _ _ = Nothing
diff --git a/core/Network/XMPiPe/Core/C2S/Server.hs b/core/Network/XMPiPe/Core/C2S/Server.hs
new file mode 100644
--- /dev/null
+++ b/core/Network/XMPiPe/Core/C2S/Server.hs
@@ -0,0 +1,112 @@
+{-# LANGUAGE OverloadedStrings, TypeFamilies, FlexibleContexts,
+	PackageImports #-}
+
+module Network.XMPiPe.Core.C2S.Server (
+	-- * Types and Values
+	Mpi(..), Feature, Jid(..), Tags(..), tagsType,
+	XmppState(..), Retrieve(..),
+	-- * Functions
+	starttls, sasl, bind, input, output,
+	) where
+
+import "monads-tf" Control.Monad.State
+import "monads-tf" Control.Monad.Error
+import Data.Pipe
+import Text.XML.Pipe
+
+import Xmpp hiding (input, output, Feature)
+import qualified Xmpp as X
+import SaslServer
+
+import qualified Data.ByteString as BS
+
+type Feature = XmlNode
+
+input :: Monad m => [Xmlns] -> Pipe BS.ByteString Mpi m ()
+input = inputMpi
+
+output :: Monad m => Pipe Mpi BS.ByteString m ()
+output = outputMpi
+
+starttls :: (MonadState m, [BS.ByteString] ~ StateType m) =>
+	BS.ByteString -> Pipe BS.ByteString BS.ByteString m ()
+starttls hst = inputP3 =$= processTls hst =$= X.output
+
+processTls :: (MonadState m, [BS.ByteString] ~ StateType m) =>
+	BS.ByteString -> Pipe Xmpp Xmpp m ()
+processTls hst = await >>= \mx -> case mx of
+	Just (XCBegin _as) -> do
+		u : us <- get
+		put us
+		yield XCDecl
+		yield $ XCBegin [
+			(Id, u), (From, hst),
+			(TagRaw $ nullQ "version", "1.0"), (Lang, "en") ]
+		yield $ XCFeatures [FtStarttls Required]
+		processTls hst
+	Just XCStarttls -> yield XCProceed
+	Just _ -> error "processTls: bad"
+	_ -> return ()
+
+sasl :: (
+	MonadState m, XmppState (StateType m),
+	MonadError m, SaslError (ErrorType m)) =>
+	BS.ByteString -> [Retrieve m] -> Pipe BS.ByteString BS.ByteString m ()
+sasl hst rt = inputP2 =$= makeSasl hst rt =$= X.output
+
+makeSasl :: (
+	MonadState m, XmppState (StateType m),
+	MonadError m, SaslError (ErrorType m)) =>
+	BS.ByteString -> [Retrieve m] -> Pipe Xmpp Xmpp m ()
+makeSasl hst rt = await >>= \p -> case p of
+	Just (XCBegin _) -> do
+		yield XCDecl
+		lift nextUuid >>= \u -> yield $ XCBegin [
+			(Id, u), (From, hst),
+			(TagRaw $ nullQ "version", "1.0"), (Lang, "en") ]
+		runSasl rt
+	_ -> return ()
+
+class SaslState xs => XmppState xs where
+	getXmppState :: xs -> (Jid, [BS.ByteString])
+	putXmppState :: (Jid, [BS.ByteString]) -> xs -> xs
+
+nextUuid :: (MonadState m, XmppState (StateType m)) => m BS.ByteString
+nextUuid = do
+	xs <- get
+	let (r, u : us) = getXmppState xs
+	modify $ putXmppState (r, us)
+	return u
+
+setResource :: XmppState xs => BS.ByteString -> xs -> xs
+setResource r xs | (Jid a d _, ul) <- getXmppState xs =
+	putXmppState (Jid a d $ Just r, ul) xs
+
+bind :: (
+	MonadState m, XmppState (StateType m),
+	MonadError m, SaslError (ErrorType m)) =>
+	BS.ByteString -> [Feature] -> Pipe BS.ByteString BS.ByteString m [Xmlns]
+bind hst fts = inputP3 =@= makeBind hst fts =$= X.output
+
+makeBind :: (
+	MonadState m, XmppState (StateType m),
+	MonadError m, SaslError (ErrorType m)) =>
+	BS.ByteString -> [Feature] -> Pipe Xmpp Xmpp m ()
+makeBind hst fts = await >>= \p -> case p of
+	Just (XCBegin _) -> do
+		yield XCDecl
+		lift nextUuid >>= \u -> yield $ XCBegin [
+			(Id, u),
+			(From, hst),
+			(TagRaw $ nullQ "version", "1.0"),
+			(Lang, "en") ]
+		yield . XCFeatures . (FtBind Required :) $ map FtRaw fts
+		makeBind hst fts
+	Just (SRIqBind ts (IqBind (Just Required) (Resource n)))
+		| Just "set" <- lookup Type ts, Just i <- lookup Id ts -> do
+			lift . modify $ setResource n
+			j <- lift $ fst `liftM` gets getXmppState
+			yield . SRIqBind [(Type, "result"), (Id, i)]
+				. IqBind Nothing $ BJid j
+			makeBind hst fts
+	_ -> return ()
diff --git a/core/Network/XMPiPe/Core/S2S/Client.hs b/core/Network/XMPiPe/Core/S2S/Client.hs
new file mode 100644
--- /dev/null
+++ b/core/Network/XMPiPe/Core/S2S/Client.hs
@@ -0,0 +1,86 @@
+{-# LANGUAGE OverloadedStrings, FlexibleContexts, PackageImports #-}
+
+module Network.XMPiPe.Core.S2S.Client (
+	-- * Types and Values
+	Mpi(..), Jid(..), Tags(..), tagsNull, tagsType,
+	-- * Functions
+	starttls, sasl, begin, input, output,
+	) where
+
+import "monads-tf" Control.Monad.State
+import "monads-tf" Control.Monad.Error
+import Data.Pipe
+import Text.XML.Pipe
+
+import qualified Data.ByteString as BS
+
+import SaslClient hiding (sasl)
+import qualified SaslClient as S
+import Xmpp hiding (input, output)
+
+input :: Monad m => [Xmlns] -> Pipe BS.ByteString Mpi m ()
+input = inputMpi
+
+output :: Monad m => Pipe Mpi BS.ByteString m ()
+output = outputMpi
+
+starttls :: Monad m =>
+	BS.ByteString -> BS.ByteString -> Pipe BS.ByteString BS.ByteString m ()
+starttls fr to = inputP3 =$= processTls fr to =$= outputS
+
+processTls :: Monad m => BS.ByteString -> BS.ByteString -> Pipe Xmpp Xmpp m ()
+processTls fr to = do
+	yield XCDecl
+	yield $ XCBegin [(From, fr), (To, to), (TagRaw $ nullQ "version", "1.0")]
+	procTls
+
+procTls :: Monad m => Pipe Xmpp Xmpp m ()
+procTls = await >>= \mx -> case mx of
+	Just (XCBegin _as) -> procTls
+	Just (XCFeatures [FtStarttls _]) -> do
+		yield XCStarttls
+		procTls
+	Just XCProceed -> return ()
+	Just _ -> return ()
+	_ -> return ()
+
+sasl :: (
+	MonadState m, SaslState (StateType m),
+	MonadError m, Error (ErrorType m) ) =>
+	BS.ByteString -> BS.ByteString -> Pipe BS.ByteString BS.ByteString m ()
+sasl fr to = inputP3 =$= processSasl fr to =$= outputS
+
+processSasl :: (
+	MonadState m, SaslState (StateType m),
+	MonadError m, Error (ErrorType m) ) =>
+	BS.ByteString -> BS.ByteString -> Pipe Xmpp Xmpp m ()
+processSasl fr to = do
+	yield XCDecl
+	yield $ XCBegin [ (From, fr), (To, to), (TagRaw $ nullQ "version", "1.0")]
+	procSasl
+
+procSasl :: (
+	MonadState m, SaslState (StateType m),
+	MonadError m, Error (ErrorType m)
+	) => Pipe Xmpp Xmpp m ()
+procSasl = await >>= \mx -> case mx of
+	Just (XCBegin _as) -> procSasl
+	Just (XCFeatures [FtMechanisms ["EXTERNAL"]]) -> do
+		st <- lift $ gets getSaslState
+		lift . modify . putSaslState $ ("username", "") : st
+		S.sasl "EXTERNAL"
+		lift . modify $ putSaslState st
+	_ -> return ()
+
+begin :: Monad m =>
+	BS.ByteString -> BS.ByteString -> Pipe BS.ByteString BS.ByteString m [Xmlns]
+begin fr to = inputFeature =@= process fr to =$= outputS
+
+process :: Monad m => BS.ByteString -> BS.ByteString -> Pipe Xmpp Xmpp m ()
+process fr to = do
+	yield XCDecl
+	yield $ XCBegin [(From, fr), (To, to), (TagRaw $ nullQ "version", "1.0")]
+	Just (XCBegin _as) <- await
+	Just (XCFeatures []) <- await
+	_ <- await
+	return ()
diff --git a/core/Network/XMPiPe/Core/S2S/Server.hs b/core/Network/XMPiPe/Core/S2S/Server.hs
new file mode 100644
--- /dev/null
+++ b/core/Network/XMPiPe/Core/S2S/Server.hs
@@ -0,0 +1,128 @@
+{-# LANGUAGE OverloadedStrings, TypeFamilies, FlexibleContexts, PackageImports #-}
+
+module Network.XMPiPe.Core.S2S.Server (
+	-- * Types and Values
+	Mpi(..), XmppState(..), Tags(..), tagsNull, tagsType, SaslState, SaslError,
+	-- * Functions
+	starttls, sasl, begin, input, output,
+	) where
+
+import "monads-tf" Control.Monad.State
+import "monads-tf" Control.Monad.Error
+import Data.Maybe
+import Data.Pipe
+import Text.XML.Pipe
+
+import Xmpp hiding (input, output)
+import SaslServer
+
+import qualified Data.ByteString as BS
+
+input :: Monad m => [Xmlns] -> Pipe BS.ByteString Mpi m ()
+input = inputMpi
+
+output :: Monad m => Pipe Mpi BS.ByteString m ()
+output = outputMpi
+
+starttls :: (MonadState m, XmppState ~ StateType m) =>
+	Pipe BS.ByteString BS.ByteString m ()
+starttls = inputP3 =$= processTls =$= outputS
+
+processTls :: (MonadState m, XmppState ~ StateType m) => Pipe Xmpp Xmpp m ()
+processTls = await >>= \mx -> case mx of
+	Just (XCBegin _as) -> do
+		yield XCDecl
+		nextUuid >>= yield . begin_
+		yield $ XCFeatures [FtStarttls Required]
+		processTls
+	Just XCStarttls -> yield XCProceed
+	_ -> return ()
+
+begin_ :: BS.ByteString -> Xmpp
+begin_ u = XCBegin [
+	(From, "otherhost"), (To, "localhost"),
+	(TagRaw $ nullQ "version", "1.0"), (Id, u) ]
+
+nextUuid :: (MonadState m, StateType m ~ XmppState) => Pipe a b m BS.ByteString
+nextUuid = lift $ do
+	u <- gets $ head . xsUuid
+	modify dropUuid
+	return u
+
+data XmppState = XmppState {
+	xsDomainName :: Maybe BS.ByteString,
+	xsUuid :: [BS.ByteString] }
+	deriving Show
+
+instance SaslState XmppState where
+	getSaslState _ = [("username", "")]
+	putSaslState _ = id
+
+dropUuid :: XmppState -> XmppState
+dropUuid xs = xs { xsUuid = tail $ xsUuid xs }
+
+sasl :: (
+	MonadState m, StateType m ~ XmppState,
+	MonadError m, SaslError (ErrorType m) ) =>
+	(BS.ByteString -> Bool) -> Pipe BS.ByteString BS.ByteString m ()
+sasl rt = inputP2 =$= processSasl rt' =$= outputS
+	where
+	rt' n = if rt n then return () else
+		throwError $ fromSaslError NotAuthorized n
+
+processSasl :: (
+	MonadState m, StateType m ~ XmppState,
+	MonadError m, SaslError (ErrorType m) ) =>
+	(BS.ByteString -> m ()) -> Pipe Xmpp Xmpp m ()
+processSasl rt = await >>= \mx -> case mx of
+	Just (XCBegin as) -> do
+		modify $ \st -> st { xsDomainName = lookup From as }
+		yield XCDecl
+		nextUuid >>= yield . begin_
+		yield $ XCFeatures [FtMechanisms ["EXTERNAL"]]
+		Just (XCAuth "EXTERNAL" i) <- await
+		flip sasl_ i . fromJust . lookup "EXTERNAL" . mkSaslServers
+			. (: []) . RTExternal
+			. rt' . fromJust $ lookup From as
+	_ -> return ()
+	where
+	rt' d "" = rt d
+	rt' _ hn = throwError $ fromSaslError NotAuthorized hn
+
+sasl_ :: (
+	MonadState m, SaslState (StateType m),
+	MonadError m, SaslError (ErrorType m) ) =>
+	(Bool, Pipe BS.ByteString (Either Success BS.ByteString) m ())
+		-> Maybe BS.ByteString -> Pipe Xmpp Xmpp m ()
+sasl_ r i = let (b, s) = r in saslPipe b i s
+
+saslPipe :: (MonadState m, SaslState (StateType m)) => Bool
+	-> Maybe BS.ByteString
+	-> Pipe BS.ByteString (Either Success BS.ByteString) m ()
+	-> Pipe Xmpp Xmpp m ()
+saslPipe True (Just i) s =
+	(yield i >> convert (\(SRResponse r) -> r)) =$= s =$= outputScram
+saslPipe True _ s =
+	convert (\(SRResponse r) -> r) =$= s =$= (yield (SRChallenge "") >> outputScram)
+saslPipe False Nothing s = convert (\(SRResponse r) -> r) =$= s =$= outputScram
+saslPipe _ _ _ = error "saslPipe: no need of initial data"
+
+outputScram :: (MonadState m, SaslState (StateType m)) =>
+	Pipe (Either Success BS.ByteString) Xmpp m ()
+outputScram = await >>= \mch -> case mch of
+	Just (Right r) -> yield (SRChallenge r) >> outputScram
+	Just (Left (Success r)) -> yield $ XCSaslSuccess r
+	Nothing -> return ()
+
+begin :: (MonadState m, StateType m ~ XmppState) =>
+	Pipe BS.ByteString BS.ByteString m [Xmlns]
+begin = inputBegin =@= process  =$= outputS
+
+process :: (MonadState m, StateType m ~ XmppState) => Pipe Xmpp Xmpp m ()
+process = await >>= \mx -> case mx of
+	Just (XCBegin _as) -> do
+		yield XCDecl
+		nextUuid >>= yield . begin_
+		yield $ XCFeatures []
+		process
+	_ -> return ()
diff --git a/core/SaslClient.hs b/core/SaslClient.hs
new file mode 100644
--- /dev/null
+++ b/core/SaslClient.hs
@@ -0,0 +1,52 @@
+{-# LANGUAGE TypeFamilies, FlexibleContexts, PackageImports #-}
+
+module SaslClient (SaslState(..), sasl) where
+
+import "monads-tf" Control.Monad.State
+import "monads-tf" Control.Monad.Error
+import Data.Maybe
+import Data.List
+import Data.Pipe
+
+import qualified Data.ByteString as BS
+
+import Network.Sasl
+import qualified Network.Sasl.Plain.Client as Pln
+import qualified Network.Sasl.External.Client as Ext
+import qualified Network.Sasl.DigestMd5.Client as DM5
+import qualified Network.Sasl.ScramSha1.Client as SS1
+import XmppType
+
+saslClients :: (
+	MonadState m, SaslState (StateType m),
+	MonadError m, Error (ErrorType m) ) => [(
+	BS.ByteString,
+	(Bool, Pipe (Either Success BS.ByteString) BS.ByteString m ()) )]
+saslClients = [DM5.sasl, SS1.sasl, Pln.sasl, Ext.sasl]
+
+sasl :: (Monad m,
+		MonadState m, SaslState (StateType m),
+		MonadError m, Error (ErrorType m)
+	) => BS.ByteString -> Pipe Xmpp Xmpp m ()
+sasl n = saslPipe . fromJust $ find ((== n) . fst) saslClients
+
+saslPipe :: (Monad m, MonadState m, SaslState (StateType m)) => (
+		BS.ByteString,
+		(Bool, Pipe (Either Success BS.ByteString) BS.ByteString m ())
+	) -> Pipe Xmpp Xmpp m ()
+saslPipe m =
+	inputScramSha1 =$= snd (snd m) =$= outputScramSha1 (fst (snd m)) (fst m)
+
+inputScramSha1 :: Monad m => Pipe Xmpp (Either Success BS.ByteString) m ()
+inputScramSha1 = await >>= \mc -> case mc of
+	Just (SRChallenge c) -> yield (Right c) >> inputScramSha1
+	Just (XCSaslSuccess d) -> yield . Left $ Network.Sasl.Success d
+	_ -> error "inputScramSha1: bad"
+
+outputScramSha1 :: Monad m =>
+	Bool -> BS.ByteString -> Pipe BS.ByteString Xmpp m ()
+outputScramSha1 ci mn = do
+	if ci
+	then await >>= maybe (return ()) (yield . XCAuth mn . Just)
+	else yield $ XCAuth mn Nothing
+	convert SRResponse
diff --git a/core/SaslServer.hs b/core/SaslServer.hs
new file mode 100644
--- /dev/null
+++ b/core/SaslServer.hs
@@ -0,0 +1,96 @@
+{-# LANGUAGE OverloadedStrings, TypeFamilies, FlexibleContexts, PackageImports #-}
+
+module SaslServer (
+	SaslState(..), SaslError(..),
+--	saslServers,
+	SaslErrorType(..), Success(..),
+	mkSaslServers, Retrieve(..),
+
+	runSasl,
+	) where
+
+import "monads-tf" Control.Monad.State
+import "monads-tf" Control.Monad.Error
+import Data.Pipe
+import Network.Sasl
+
+import qualified Data.ByteString as BS
+import qualified Network.Sasl.Plain.Server as Pln
+import qualified Network.Sasl.External.Server as Ext
+import qualified Network.Sasl.DigestMd5.Server as DM5
+import qualified Network.Sasl.ScramSha1.Server as SS1
+
+import XmppType
+
+{-
+sampleRetrieves :: (
+	MonadState m, SaslState (StateType m),
+	MonadError m, SaslError (ErrorType m)) => [Retrieve m]
+sampleRetrieves = [
+	RTPlain retrievePln, RTExternal retrieveEx,
+	RTDigestMd5 retrieveDM5, RTScramSha1 retrieveSS1 ]
+	-}
+
+runSasl :: (
+	MonadState m, SaslState (StateType m),
+	MonadError m, SaslError (ErrorType m) ) =>
+	[Retrieve m] -> Pipe Xmpp Xmpp m ()
+runSasl rt = do
+	yield $ XCFeatures [FtMechanisms $ map getMechanism rt]
+	await >>= \a -> case a of
+		Just (XCAuth m i) -> sasl_ rt m i
+		_ -> throwError $ fromSaslError
+			(SaslErrorType "EOF") "unexpected EOF"
+
+sasl_ :: (
+	MonadState m, SaslState (StateType m),
+	MonadError m, SaslError (ErrorType m) ) =>
+	[Retrieve m] -> BS.ByteString -> Maybe BS.ByteString -> Pipe Xmpp Xmpp m ()
+sasl_ rt n i = case lookup n $ mkSaslServers rt of
+	Just (b, s) -> saslPipe b i s
+	_ -> throwError $ fromSaslError InvalidMechanism "no such mechanisms"
+
+saslPipe :: (
+	MonadState m, SaslState (StateType m),
+	MonadError m, SaslError (ErrorType m) ) => Bool
+	-> Maybe BS.ByteString
+	-> Pipe BS.ByteString (Either Success BS.ByteString) m ()
+	-> Pipe Xmpp Xmpp m ()
+saslPipe True (Just i) s =
+	(yield i >> convert (\(SRResponse r) -> r)) =$= s =$= saslOutput
+saslPipe True _ s = convert (\(SRResponse r) -> r) =$= s
+		=$= (yield (SRChallenge "") >> saslOutput)
+saslPipe False Nothing s = convert (\(SRResponse r) -> r) =$= s =$= saslOutput
+saslPipe _ _ _ = throwError $
+	fromSaslError MalformedRequest "no need of initial data"
+
+saslOutput :: (MonadState m, SaslState (StateType m)) =>
+	Pipe (Either Success BS.ByteString) Xmpp m ()
+saslOutput = await >>= \mch -> case mch of
+	Just (Right r) -> yield (SRChallenge r) >> saslOutput
+	Just (Left (Success r)) -> yield $ XCSaslSuccess r
+	_ -> return ()
+
+data Retrieve m
+	= RTPlain (BS.ByteString -> BS.ByteString -> BS.ByteString -> m ())
+	| RTExternal (BS.ByteString -> m ())
+	| RTDigestMd5 (BS.ByteString -> m BS.ByteString)
+	| RTScramSha1 (BS.ByteString ->
+		m (BS.ByteString, BS.ByteString, BS.ByteString, Int))
+
+getMechanism :: Retrieve m -> BS.ByteString
+getMechanism (RTPlain _) = "PLAIN"
+getMechanism (RTExternal _) = "EXTERNAL"
+getMechanism (RTDigestMd5 _) = "DIGEST-MD5"
+getMechanism (RTScramSha1 _) = "SCRAM-SHA-1"
+
+mkSaslServers :: (
+	MonadState m, SaslState (StateType m),
+	MonadError m, SaslError (ErrorType m)) => [Retrieve m] -> [(
+	BS.ByteString,
+	(Bool, Pipe BS.ByteString (Either Success BS.ByteString) m ()) )]
+mkSaslServers = map $ \rts -> case rts of
+	RTPlain rt -> Pln.sasl rt
+	RTExternal rt -> Ext.sasl rt
+	RTDigestMd5 rt -> DM5.sasl rt
+	RTScramSha1 rt -> SS1.sasl rt
diff --git a/core/Tools.hs b/core/Tools.hs
new file mode 100644
--- /dev/null
+++ b/core/Tools.hs
@@ -0,0 +1,45 @@
+{-# LANGUAGE OverloadedStrings, TupleSections, TypeFamilies, PackageImports #-}
+
+module Tools (
+	SHandle(..),
+	fromHandleLike, toHandleLike,
+	hlpDebug, voidM, nullQ, myFromJust,
+	) where
+
+import "monads-tf" Control.Monad.State
+import Data.Pipe
+import Data.HandleLike
+import Text.XML.Pipe
+
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Char8 as BSC
+
+fromHandleLike :: HandleLike h => h -> Pipe () BS.ByteString (HandleMonad h) ()
+fromHandleLike h = lift (hlGetContent h) >>= ((>> fromHandleLike h) . yield)
+
+toHandleLike :: HandleLike h => h -> Pipe BS.ByteString () (HandleMonad h) ()
+toHandleLike h = await >>= maybe (return ()) ((>> toHandleLike h) . lift . hlPut h)
+
+hlpDebug :: (HandleLike h, Show a) => h -> Pipe a a (HandleMonad h) ()
+hlpDebug h = await >>= maybe (return ())
+	(\x -> lift (hlPrint h x) >> yield x >> hlpDebug h)
+
+hlPrint :: (HandleLike h, Show a) => h -> a -> HandleMonad h ()
+hlPrint h = hlDebug h "critical" . BSC.pack . (++ "\n") . show
+
+data SHandle s h = SHandle h
+
+instance HandleLike h => HandleLike (SHandle s h) where
+	type HandleMonad (SHandle s h) = StateT s (HandleMonad h)
+	type DebugLevel (SHandle s h) = DebugLevel h
+	hlPut (SHandle h) = lift . hlPut h
+	hlGet (SHandle h) = lift . hlGet h
+	hlClose (SHandle h) = lift $ hlClose h
+	hlDebug (SHandle h) = (lift .) . hlDebug h
+
+voidM :: Monad m => m a -> m ()
+voidM = (>> return ())
+
+myFromJust :: String -> Maybe a -> a
+myFromJust _ (Just x) = x
+myFromJust msg _ = error msg
diff --git a/core/Xmpp.hs b/core/Xmpp.hs
new file mode 100644
--- /dev/null
+++ b/core/Xmpp.hs
@@ -0,0 +1,79 @@
+{-# LANGUAGE OverloadedStrings, FlexibleContexts #-}
+
+module Xmpp (
+	inputBegin, inputFeature, inputP2, inputP3, input, output, outputS, inputMpi, outputMpi,
+	Mpi(..),
+
+	Xmpp(..), fromCommon,
+	Tags(..),
+	Jid(..), toJid, fromJid,
+	Side(..),
+	Feature(..), Tag(..),
+	Query(..), Bind(..), Requirement(..), toRequirement, fromRequirement,
+
+	voidM, hlpDebug, SHandle(..),
+
+	nullQ, tagsNull, tagsType,
+
+	fromHandleLike, toHandleLike,
+	) where
+
+import Debug.Trace
+
+import Data.Maybe
+import Data.Pipe
+import Text.XML.Pipe
+
+import qualified Data.ByteString as BS
+
+import XmppType
+import Tools (voidM, hlpDebug, SHandle(..), fromHandleLike, toHandleLike)
+
+tagsNull :: Tags
+tagsNull = Tags Nothing Nothing Nothing Nothing Nothing []
+
+tagsType :: BS.ByteString -> Tags
+tagsType tp = tagsNull { tagType = Just tp }
+
+inputP2 :: Monad m => Pipe BS.ByteString Xmpp m ()
+inputP2 = xmlEvent =$= convert fromJust =$= mapOut toCommon xmlReborn
+
+isSaslSuccess :: XmlNode -> Bool
+isSaslSuccess (XmlNode ((_, Just "jabber:client"), "iq")
+	_ _ [XmlNode ((_, Just "urn:ietf:params:xml:ns:xmpp-bind"), "bind") _ _ _]) = True
+isSaslSuccess _ = False
+
+isFeature :: XmlNode -> Bool
+isFeature (XmlNode
+	((_, Just "http://etherx.jabber.org/streams"), "features") _ [] []) = True
+isFeature n = trace ("isFeature: " ++ show n) False
+
+inputBegin :: Monad m => Pipe BS.ByteString Xmpp m [Xmlns]
+inputBegin = xmlEvent =$= convert fromJust =$= mapOut toCommon xmlBegin
+
+inputFeature :: Monad m => Pipe BS.ByteString Xmpp m [Xmlns]
+inputFeature = xmlEvent =$= convert fromJust =$= mapOut toCommon xmlFeature
+
+inputP3 :: Monad m => Pipe BS.ByteString Xmpp m [Xmlns]
+inputP3 = xmlEvent =$= convert fromJust =$= mapOut toCommon xmlPipe
+
+xmlPipe :: Monad m => Pipe XmlEvent XmlNode m [Xmlns]
+xmlPipe = xmlBegin >>= \ns -> xmlNodeUntil isSaslSuccess ns >> return ns
+
+xmlFeature :: Monad m => Pipe XmlEvent XmlNode m [Xmlns]
+xmlFeature = xmlBegin >>= \ns -> xmlNodeUntil isFeature ns >> return ns
+
+input :: Monad m => [Xmlns] -> Pipe BS.ByteString Xmpp m ()
+input ns = xmlEvent =$= convert fromJust =$= xmlNode ns =$= convert toCommon
+
+inputMpi :: Monad m => [Xmlns] -> Pipe BS.ByteString Mpi m ()
+inputMpi ns = xmlEvent =$= convert fromJust =$= xmlNode ns =$= convert toMpi
+
+output :: Monad m => Pipe Xmpp BS.ByteString m ()
+output = convert $ xmlString . (: []) . fromCommon Client
+
+outputS :: Monad m => Pipe Xmpp BS.ByteString m ()
+outputS = convert $ xmlString . (: []) . fromCommon Server
+
+outputMpi :: Monad m => Pipe Mpi BS.ByteString m ()
+outputMpi = convert $ xmlString . (: []) . fromMpi
diff --git a/core/XmppType.hs b/core/XmppType.hs
new file mode 100644
--- /dev/null
+++ b/core/XmppType.hs
@@ -0,0 +1,340 @@
+{-# LANGUAGE OverloadedStrings, TupleSections #-}
+
+module XmppType (
+	Xmpp(..), toCommon, fromCommon,
+	Tags(..),
+	Jid(..), toJid, fromJid,
+	Side(..),
+	Tag(..), toTag, fromTag,
+	Feature(..),
+	Query(..), Bind(..),
+	Requirement(..), toRequirement, fromRequirement,
+
+	Mpi(..), toMpi, fromMpi,
+	) where
+
+import Control.Applicative
+import Control.Arrow
+import Data.Maybe
+import Text.XML.Pipe
+
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Char8 as BSC
+import qualified Data.ByteString.Base64 as B64
+
+data Xmpp
+	= XCDecl
+	| XCBegin [(Tag, BS.ByteString)]
+	| XCEnd
+	| XCFeatures [Feature]
+	| XCStarttls
+	| XCProceed
+
+	| XCAuth BS.ByteString (Maybe BS.ByteString)
+	| SRChallenge BS.ByteString
+	| SRResponse BS.ByteString
+	| XCSaslSuccess (Maybe BS.ByteString)
+
+	| SRIqBind [(Tag, BS.ByteString)] Query
+
+	| SRMessage Tags [XmlNode]
+	| SRPresence Tags [XmlNode]
+	| SRIq Tags [XmlNode]
+--	| SRIq [(Tag, BS.ByteString)] [XmlNode]
+
+	| XCRaw XmlNode
+	deriving (Eq, Show)
+
+data Mpi
+	= Message Tags [XmlNode]
+	| Presence Tags [XmlNode]
+	| Iq Tags [XmlNode]
+	| End
+	| MpiRaw XmlNode
+	deriving (Eq, Show)
+
+data Tags = Tags {
+	tagId :: Maybe BS.ByteString,
+	tagType :: Maybe BS.ByteString,
+	tagFrom :: Maybe Jid,
+	tagTo :: Maybe Jid,
+	tagLang :: Maybe BS.ByteString,
+	tagOthers :: [(QName, BS.ByteString)] } deriving (Eq, Show)
+
+toTags :: [(QName, BS.ByteString)] -> Tags
+toTags as = Tags {
+	tagId = i, tagType = tp, tagFrom = fr, tagTo = to, tagLang = ln,
+	tagOthers = ot }
+	where
+	ts = map (first toTag) as
+	i = lookup Id ts
+	tp = lookup Type ts
+	fr = toJid <$> lookup From ts
+	to = toJid <$> lookup To ts
+	ln = lookup Lang ts
+	ot = map (first $ \(TagRaw a) -> a) $ filter (isTagRaw . fst) ts
+
+fromTags :: Tags -> [(QName, BS.ByteString)]
+fromTags Tags { tagId = i, tagType = tp, tagFrom = fr, tagTo = to, tagLang = ln,
+	tagOthers = ot } = (++ ot) . map (first fromTag) $ catMaybes [
+		(Id ,) <$> i, (Type ,) <$> tp, (From ,) . fromJid <$> fr,
+		(To ,) . fromJid <$> to, (Lang ,) <$> ln ]
+
+data Query = IqBind (Maybe Requirement) Bind deriving (Eq, Show)
+
+data Bind
+	= Resource BS.ByteString
+	| BJid Jid
+	| BindRaw XmlNode
+	deriving (Eq, Show)
+
+data Tag
+	= Id | Type | From | To | Lang | TagRaw QName
+	deriving (Eq, Show)
+
+isTagRaw :: Tag -> Bool
+isTagRaw (TagRaw _) = True
+isTagRaw _ = False
+
+toTag :: QName -> Tag
+toTag ((_, Just "jabber:client"), "id") = Id
+toTag ((_, Just "jabber:server"), "id") = Id
+toTag ((_, Just "jabber:client"), "type") = Type
+toTag ((_, Just "jabber:server"), "type") = Type
+toTag ((_, Just "jabber:client"), "from") = From
+toTag ((_, Just "jabber:server"), "from") = From
+toTag ((_, Just "jabber:client"), "to") = To
+toTag ((_, Just "jabber:server"), "to") = To
+toTag (("xml", Nothing), "lang") = Lang
+toTag n = TagRaw n
+
+fromTag :: Tag -> QName
+fromTag Id = nullQ "id"
+fromTag Type = nullQ "type"
+fromTag From = nullQ "from"
+fromTag To = nullQ "to"
+fromTag Lang = (("xml", Nothing), "lang")
+fromTag (TagRaw n) = n
+
+data Requirement = Optional | Required | NoRequirement [XmlNode]
+	deriving (Eq, Ord, Show)
+
+toRequirement :: [XmlNode] -> Requirement
+toRequirement [XmlNode (_, "optional") _ [] []] = Optional
+toRequirement [XmlNode (_, "required") _ [] []] = Required
+toRequirement n = NoRequirement n
+
+fromRequirement :: Requirement -> XmlNode
+fromRequirement Optional = XmlNode (nullQ "optional") [] [] []
+fromRequirement Required = XmlNode (nullQ "required") [] [] []
+fromRequirement (NoRequirement _) = undefined
+
+data Feature
+	= FtMechanisms [BS.ByteString]
+	| FtStarttls Requirement
+	| FtBind Requirement
+	| FtSession Requirement
+	| FtRaw XmlNode
+	deriving (Eq, Ord, Show)
+
+toFeature :: XmlNode -> Feature
+toFeature (XmlNode ((_, Just "urn:ietf:params:xml:ns:xmpp-tls"), "starttls")
+	_ [] r) = FtStarttls $ toRequirement r
+toFeature (XmlNode ((_, Just "urn:ietf:params:xml:ns:xmpp-sasl"), "mechanisms")
+	_ [] ns) = FtMechanisms $ map toMechanism ns
+toFeature (XmlNode ((_, Just "urn:ietf:params:xml:ns:xmpp-bind"), "bind") _ [] r) =
+	FtBind $ toRequirement r
+toFeature (XmlNode ((_, Just "urn:ietf:params:xml:ns:xmpp-session"), "session")
+	_ [] r) = FtSession $ toRequirement r
+toFeature n = FtRaw n
+
+fromFeature :: Feature -> XmlNode
+fromFeature (FtStarttls r) = XmlNode (nullQ "starttls")
+	[("", "urn:ietf:params:xml:ns:xmpp-tls")] [] [fromRequirement r]
+fromFeature (FtMechanisms ms) = XmlNode (nullQ "mechanisms")
+	[("", "urn:ietf:params:xml:ns:xmpp-sasl")] [] $
+	map fromMechanism ms
+fromFeature (FtBind r) = XmlNode (nullQ "bind")
+	[("", "urn:ietf:params:xml:ns:xmpp-bind")] [] [fromRequirement r]
+fromFeature (FtSession r) = XmlNode (nullQ "session")
+	[("", "urn:ietf:params:xml:ns:xmpp-session")] [] [fromRequirement r]
+fromFeature (FtRaw n) = n
+
+toMechanism :: XmlNode -> BS.ByteString
+toMechanism (XmlNode ((_, Just "urn:ietf:params:xml:ns:xmpp-sasl"), "mechanism")
+	_ [] [XmlCharData m]) = m
+toMechanism _ = error "toMechanism: bad"
+
+fromMechanism :: BS.ByteString -> XmlNode
+fromMechanism m = XmlNode (nullQ "mechanism") [] [] [XmlCharData m]
+
+data Jid = Jid BS.ByteString BS.ByteString (Maybe BS.ByteString) deriving (Eq, Show)
+
+fromJid :: Jid -> BS.ByteString
+fromJid (Jid a d r) = a `BS.append` "@" `BS.append` d `BS.append`
+	maybe "" ("/" `BS.append`) r
+
+toJid :: BS.ByteString -> Jid
+toJid j = case rst of
+	"" -> Jid "" a Nothing
+	_ -> Jid a d (if BS.null r then Nothing else Just $ BS.tail r)
+	where
+	(a, rst) = BSC.span (/= '@') j
+	(d, r) = BSC.span (/= '/') $ BS.tail rst
+
+toCommon :: XmlNode -> Xmpp
+toCommon (XmlDecl (1, 0)) = XCDecl
+toCommon (XmlStart ((_, Just "http://etherx.jabber.org/streams"), "stream") _ as) =
+	XCBegin $ map (first toTag) as
+toCommon (XmlEnd ((_, Just "http://etherx.jabber.org/streams"), "stream")) = XCEnd
+toCommon (XmlNode ((_, Just "http://etherx.jabber.org/streams"), "features")
+	_ [] nds) = XCFeatures $ map toFeature nds
+toCommon (XmlNode ((_, Just "urn:ietf:params:xml:ns:xmpp-tls"), "starttls")
+	_ [] []) = XCStarttls
+toCommon (XmlNode ((_, Just "urn:ietf:params:xml:ns:xmpp-tls"), "proceed")
+	_ [] []) = XCProceed
+toCommon (XmlNode ((_, Just "urn:ietf:params:xml:ns:xmpp-sasl"), "auth")
+	_ as [])
+	| [(((_, Just "urn:ietf:params:xml:ns:xmpp-sasl"), "mechanism"), m)] <- as =
+	XCAuth m Nothing
+-- toTag ((_, Just "urn:ietf:params:xml:ns:xmpp-sasl"), "mechanism") = Mechanism
+toCommon (XmlNode ((_, Just "urn:ietf:params:xml:ns:xmpp-sasl"), "auth")
+	_ as [XmlCharData i])
+	| [(((_, Just "urn:ietf:params:xml:ns:xmpp-sasl"), "mechanism"), m)] <- as =
+--	| [(Mechanism, m)] <- map (first toTag) as =
+	XCAuth m . Just . (\(Right r) -> r) $ case i of
+		"=" -> Right ""
+		_ -> B64.decode i
+toCommon (XmlNode ((_, Just "urn:ietf:params:xml:ns:xmpp-sasl"), "success")
+	_ [] []) = XCSaslSuccess Nothing
+toCommon (XmlNode ((_, Just "urn:ietf:params:xml:ns:xmpp-sasl"), "success")
+	_ [] [XmlCharData d]) =
+	XCSaslSuccess . Just . (\(Right r) -> r) $ B64.decode d
+toCommon (XmlNode ((_, Just "urn:ietf:params:xml:ns:xmpp-sasl"), "challenge")
+	_ [] []) = SRChallenge ""
+toCommon (XmlNode ((_, Just "urn:ietf:params:xml:ns:xmpp-sasl"), "challenge")
+	_ [] [XmlCharData c]) = let Right d = B64.decode c in SRChallenge d
+toCommon (XmlNode ((_, Just "urn:ietf:params:xml:ns:xmpp-sasl"), "response")
+	_ [] [XmlCharData cd]) = let Right s = B64.decode cd in SRResponse s
+toCommon (XmlNode ((_, Just "urn:ietf:params:xml:ns:xmpp-sasl"), "response")
+	_ [] []) = SRResponse ""
+
+toCommon (XmlNode ((_, Just q), "message") _ as ns)
+	| q `elem` ["jabber:client", "jabber:server"] =
+		SRMessage (toTags as) ns
+toCommon (XmlNode ((_, Just q), "iq") _ as ns)
+	| q `elem` ["jabber:client", "jabber:server"], Just b <- toIqBody ns =
+		SRIqBind ts b
+	where ts = map (first toTag) as
+toCommon (XmlNode ((_, Just q), "iq") _ as ns)
+	| q `elem` ["jabber:client", "jabber:server"] = SRIq ts ns
+	where ts = toTags as
+toCommon (XmlNode ((_, Just "jabber:client"), "presence") _ as ns) =
+	SRPresence (toTags as) ns
+toCommon (XmlNode ((_, Just "jabber:server"), "presence") _ as ns) =
+	SRPresence (toTags as) ns
+
+toCommon n = XCRaw n
+
+toMpi :: XmlNode -> Mpi
+toMpi (XmlNode ((_, Just q), "message") _ as ns)
+	| q `elem` ["jabber:client", "jabber:server"] = Message (toTags as) ns
+toMpi (XmlNode ((_, Just q), "iq") _ as ns)
+	| q `elem` ["jabber:client", "jabber:server"] = Iq ts ns
+	where ts = toTags as
+toMpi (XmlNode ((_, Just "jabber:client"), "presence") _ as ns) =
+	Presence (toTags as) ns
+toMpi (XmlNode ((_, Just "jabber:server"), "presence") _ as ns) =
+	Presence (toTags as) ns
+toMpi (XmlEnd ((_, Just "http://etherx.jabber.org/streams"), "stream")) = End
+toMpi n = MpiRaw n
+
+toIqBody :: [XmlNode] -> Maybe Query
+toIqBody [XmlNode ((_, Just "urn:ietf:params:xml:ns:xmpp-bind"), "bind") _ []
+	[n]] = Just . IqBind Nothing $ toBind n
+toIqBody [XmlNode ((_, Just "urn:ietf:params:xml:ns:xmpp-bind"), "bind") _ []
+	[n, n']] | r <- toRequirement [n] = Just . IqBind (Just r) $ toBind n'
+toIqBody _ = Nothing
+
+toBind :: XmlNode -> Bind
+toBind (XmlNode ((_, Just "urn:ietf:params:xml:ns:xmpp-bind"), "resource") [] []
+	[XmlCharData cd]) = Resource cd
+toBind n = BindRaw n
+
+fromBind :: Bind -> [XmlNode]
+fromBind (BJid _) = error "fromBind: not implemented"
+fromBind (Resource r) = [
+	XmlNode (nullQ "bind") [("", "urn:ietf:params:xml:ns:xmpp-bind")] []
+		[XmlNode (nullQ "required") [] [] [], resource r]
+	]
+fromBind (BindRaw n) = [n]
+
+resource :: BS.ByteString -> XmlNode
+resource r = XmlNode (nullQ "resource") [] [] [XmlCharData r]
+
+data Side = Client | Server deriving Show
+
+jabberQ :: Side -> BS.ByteString
+jabberQ Client = "jabber:client"
+jabberQ Server = "jabber:server"
+
+fromCommon :: Side -> Xmpp -> XmlNode
+fromCommon _ (XCDecl) = XmlDecl (1, 0)
+fromCommon s (XCBegin ts) = XmlStart (("stream", Nothing), "stream")
+	[	("", jabberQ s),
+		("stream", "http://etherx.jabber.org/streams") ]
+	(map (first fromTag) ts)
+fromCommon _ XCEnd = XmlEnd (("stream", Nothing), "stream")
+fromCommon _ (XCFeatures fs) =
+	XmlNode (("stream", Nothing), "features") [] [] $ map fromFeature fs
+fromCommon _ XCStarttls = XmlNode (nullQ "starttls")
+	[("", "urn:ietf:params:xml:ns:xmpp-tls")] [] []
+fromCommon _ XCProceed = XmlNode (nullQ "proceed")
+	[("", "urn:ietf:params:xml:ns:xmpp-tls")] [] []
+fromCommon _ (XCAuth m Nothing) = XmlNode (nullQ "auth")
+	[("", "urn:ietf:params:xml:ns:xmpp-sasl")]
+	[(nullQ "mechanism", m)] []
+fromCommon _ (XCAuth m (Just i)) = XmlNode (nullQ "auth")
+	[("", "urn:ietf:params:xml:ns:xmpp-sasl")]
+	[(nullQ "mechanism", m)]
+	[XmlCharData $ case i of "" -> "="; _ -> B64.encode i]
+fromCommon _ (XCSaslSuccess Nothing) =
+	XmlNode (nullQ "success") [("", "urn:ietf:params:xml:ns:xmpp-sasl")] [] []
+fromCommon _ (XCSaslSuccess (Just d)) =
+	XmlNode (nullQ "success") [("", "urn:ietf:params:xml:ns:xmpp-sasl")] []
+	[XmlCharData $ B64.encode d]
+fromCommon _ (SRChallenge "") = XmlNode (nullQ "challenge")
+	[("", "urn:ietf:params:xml:ns:xmpp-sasl")] [] []
+fromCommon _ (SRChallenge c) = XmlNode (nullQ "challenge")
+	[("", "urn:ietf:params:xml:ns:xmpp-sasl")] [] .
+		(: []) . XmlCharData $ B64.encode c
+fromCommon _ (SRResponse "") = drnToXmlNode
+fromCommon _ (SRResponse s) = drToXmlNode s
+fromCommon _ (SRMessage ts ns) =
+	XmlNode (nullQ "message") [] (fromTags ts) ns
+fromCommon _ (SRIqBind ts q) = XmlNode (nullQ "iq") [] (map (first fromTag) ts)
+	(fromQuery q)
+fromCommon _ (SRIq ts q) = XmlNode (nullQ "iq") [] (fromTags ts) q
+fromCommon _ (SRPresence ts c) = XmlNode (nullQ "presence") [] (fromTags ts) c
+fromCommon _ (XCRaw n) = n
+
+fromMpi :: Mpi -> XmlNode
+fromMpi (Message ts ns) = XmlNode (nullQ "message") [] (fromTags ts) ns
+fromMpi (Iq ts q) = XmlNode (nullQ "iq") [] (fromTags ts) q
+fromMpi (Presence ts c) = XmlNode (nullQ "presence") [] (fromTags ts) c
+fromMpi End = XmlEnd (("stream", Nothing), "stream")
+fromMpi (MpiRaw n) = n
+
+drToXmlNode :: BS.ByteString -> XmlNode
+drToXmlNode dr = XmlNode (nullQ "response")
+	[("", "urn:ietf:params:xml:ns:xmpp-sasl")] []
+	[XmlCharData $ B64.encode dr]
+
+drnToXmlNode :: XmlNode
+drnToXmlNode = XmlNode (nullQ "response")
+	[("", "urn:ietf:params:xml:ns:xmpp-sasl")] [] []
+
+fromQuery :: Query -> [XmlNode]
+fromQuery (IqBind Nothing (BJid j)) =
+	[XmlNode (nullQ "jid") [] [] [XmlCharData $ fromJid j]]
+fromQuery (IqBind r b) = maybe id ((:) . fromRequirement) r $ fromBind b
diff --git a/examples/simpleClient.hs b/examples/simpleClient.hs
new file mode 100644
--- /dev/null
+++ b/examples/simpleClient.hs
@@ -0,0 +1,67 @@
+{-# LANGUAGE OverloadedStrings, PackageImports #-}
+
+import Prelude hiding (filter)
+
+import Control.Applicative
+import "monads-tf" Control.Monad.State
+import "monads-tf" Control.Monad.Writer
+import Control.Concurrent hiding (yield)
+import Data.Maybe
+import Data.Pipe
+import Data.Pipe.Flow
+import Data.Pipe.ByteString
+import System.IO
+import System.Environment
+import Text.XML.Pipe
+import Network
+import Network.Sasl
+import Network.XMPiPe.Core.C2S.Client
+
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Char8 as BSC
+
+mechanisms :: [BS.ByteString]
+mechanisms = ["SCRAM-SHA-1", "DIGEST-MD5", "PLAIN"]
+
+data St = St [(BS.ByteString, BS.ByteString)]
+instance SaslState St where getSaslState (St ss) = ss; putSaslState ss _ = St ss
+
+main :: IO ()
+main = do
+	(me_ : pw : you_ : _) <- map BSC.pack <$> getArgs
+	let	me@(Jid un d (Just rsc)) = toJid me_; you = toJid you_
+		ss = St [
+			("username", un), ("authcid", un), ("password", pw),
+			("cnonce", "00DEADBEEF00") ]
+	h <- connectTo (BSC.unpack d) $ PortNumber 5222
+	void . (`evalStateT` ss) . runPipe $
+		fromHandle h =$= sasl d mechanisms =$= toHandle h
+	(Just ns, _fts) <- runWriterT . runPipe $
+		fromHandle h =$= bind d rsc =@= toHandle h
+	void . forkIO . void . runPipe $ fromHandle h =$= input ns
+		=$= convert fromMessage =$= filter isJust =$= convert fromJust
+		=$= toHandleLn stdout
+	void . (`runStateT` 0) . runPipe $ do
+		yield (presence me) =$= output =$= toHandle h
+		fromHandleLn stdin =$= before (== "/quit")
+			=$= mkMessage you =$= output =$= toHandle h
+		yield End =$= output =$= toHandle h
+
+presence :: Jid -> Mpi
+presence me = Presence
+	(tagsNull { tagFrom = Just me }) [XmlNode (nullQ "presence") [] [] []]
+
+mkMessage :: Jid -> Pipe BS.ByteString Mpi (StateT Int IO) ()
+mkMessage you = (await >>=) . maybe (return ()) $ \m -> do
+	n <- get; modify succ
+	yield $ toM n m
+	mkMessage you
+	where toM n msg = Message (tagsType "chat") {
+			tagId = Just . BSC.pack . ("msg_" ++) $ show n,
+			tagTo = Just you }
+		[XmlNode (nullQ "body") [] [] [XmlCharData msg]]
+
+fromMessage :: Mpi -> Maybe BS.ByteString
+fromMessage (Message ts [XmlNode _ [] [] [XmlCharData m]])
+	| Just (Jid n d _) <- tagFrom ts = Just $ BS.concat [n, "@", d, ": ", m]
+fromMessage _ = Nothing
diff --git a/examples/simpleServer.hs b/examples/simpleServer.hs
new file mode 100644
--- /dev/null
+++ b/examples/simpleServer.hs
@@ -0,0 +1,98 @@
+{-# LANGUAGE OverloadedStrings, FlexibleContexts, PackageImports #-}
+
+import Control.Applicative
+import Control.Arrow
+import Control.Monad
+import "monads-tf" Control.Monad.State
+import "monads-tf" Control.Monad.Error
+import Control.Concurrent hiding (yield)
+import Control.Concurrent.STM
+import Data.Pipe
+import Data.Pipe.ByteString
+import Data.Pipe.TChan
+import Network
+import Network.Sasl
+import Network.XMPiPe.Core.C2S.Server
+
+import qualified Data.ByteString as BS
+import qualified Network.Sasl.DigestMd5.Server as DM5
+import qualified Network.Sasl.ScramSha1.Server as SS1
+
+main :: IO ()
+main = do
+	userlist <- atomically $ newTVar []
+	soc <- listenOn $ PortNumber 5222
+	forever $ accept soc >>= \(h, _, _) -> forkIO $ do
+		c <- atomically newTChan
+		(Just ns, st) <- (`runStateT` initXSt) . runPipe $ do
+			fromHandle h =$= sasl "localhost" retrieves =$= toHandle h
+			fromHandle h =$= bind "localhost" [] =@= toHandle h
+		let u = user st; sl = selector userlist
+		atomically $ modifyTVar userlist ((u, c) :)
+		void . forkIO . runPipe_ $ fromTChan c =$= output =$= toHandle h
+		runPipe_ $ fromHandle h =$= input ns =$= select u =$= toTChansM sl
+
+selector :: TVar [(Jid, TChan Mpi)] -> IO [(Jid -> Bool, TChan Mpi)]
+selector ul = map (first eq) <$> atomically (readTVar ul)
+	where
+	eq (Jid u d _) (Jid v e Nothing) = u == v && d == e
+	eq j k = j == k
+
+select :: Monad m => Jid -> Pipe Mpi (Jid, Mpi) m ()
+select f = (await >>=) . maybe (return ()) $ \mpi -> case mpi of
+	End -> yield (f, End)
+	Message tgs@(Tags { tagTo = Just to }) b ->
+		yield (to, Message tgs { tagFrom = Just f } b) >> select f
+	_ -> select f
+
+initXSt :: XSt
+initXSt = XSt {
+	user = Jid "" "localhost" Nothing, rands = repeat "00DEADBEEF00",
+	sSt = [	("realm", "localhost"), ("qop", "auth"), ("charset", "utf-8"),
+		("algorithm", "md5-sess") ] }
+
+retrieves :: (
+	MonadState m, SaslState (StateType m),
+	MonadError m, SaslError (ErrorType m) ) => [Retrieve m]
+retrieves = [RTPlain retrievePln, RTDigestMd5 retrieveDM5, RTScramSha1 retrieveSS1]
+
+retrievePln :: (
+	MonadState m, SaslState (StateType m),
+	MonadError m, SaslError (ErrorType m) ) =>
+	BS.ByteString -> BS.ByteString -> BS.ByteString -> m ()
+retrievePln "" "yoshikuni" "password" = return ()
+retrievePln "" "yoshio" "password" = return ()
+retrievePln _ _ _ = throwError $ fromSaslError NotAuthorized "auth failure"
+
+retrieveDM5 :: (
+	MonadState m, SaslState (StateType m),
+	MonadError m, SaslError (ErrorType m) ) => BS.ByteString -> m BS.ByteString
+retrieveDM5 "yoshikuni" = return $ DM5.mkStored "yoshikuni" "localhost" "password"
+retrieveDM5 "yoshio" = return $ DM5.mkStored "yoshio" "localhost" "password"
+retrieveDM5 _ = throwError $ fromSaslError NotAuthorized "auth failure"
+
+retrieveSS1 :: (
+	MonadState m, SaslState (StateType m),
+	MonadError m, SaslError (ErrorType m) ) => BS.ByteString ->
+	m (BS.ByteString, BS.ByteString, BS.ByteString, Int)
+retrieveSS1 "yoshikuni" = return (slt, stk, svk, i)
+	where slt = "pepper"; i = 4492; (stk, svk) = SS1.salt "password" slt i
+retrieveSS1 "yoshio" = return (slt, stk, svk, i)
+	where slt = "sugar"; i = 4492; (stk, svk) = SS1.salt "password" slt i
+retrieveSS1 _ = throwError $ fromSaslError NotAuthorized "auth failure"
+
+type Pairs a = [(a, a)]
+data XSt = XSt { user :: Jid, rands :: [BS.ByteString], sSt :: Pairs BS.ByteString }
+
+instance XmppState XSt where
+	getXmppState xs = (user xs, rands xs)
+	putXmppState (usr, rl) xs = xs { user = usr, rands = rl }
+
+instance SaslState XSt where
+	getSaslState XSt { user = Jid n _ _, rands = nnc : _, sSt = ss } =
+		("username", n) : ("nonce", nnc) : ("snonce", nnc) : ss
+	getSaslState _ = error "XSt.getSaslState: null random list"
+	putSaslState ss xs@XSt { user = Jid _ d r, rands = _ : rs } =
+		xs { user = Jid n d r, rands = rs, sSt = ss }
+		where Just n = lookup "username" ss
+	putSaslState _ _ = error "XSt.getSaslState: null random list"
diff --git a/xmpipe.cabal b/xmpipe.cabal
new file mode 100644
--- /dev/null
+++ b/xmpipe.cabal
@@ -0,0 +1,269 @@
+build-type:	Simple
+cabal-version:	>= 1.8
+
+name:		xmpipe
+version:	0.0.0.0
+stability:	Experimental
+author:		Yoshikuni Jujo <PAF01143@nifty.ne.jp>
+maintainer:	Yoshikuni Jujo <PAF01143@nifty.ne.jp>
+homepage:	https://github.com/YoshikuniJujo/xmpipe/wiki
+
+license:	BSD3
+license-file:	LICENSE
+
+category:	Network
+synopsis:	XMPP implementation using simple-PIPE
+description:
+    This package includes XMPP libraries.
+    Now this contains only core (RFC 6120).
+    This package needs more improvement yet.
+    It has following features.
+    .
+    C2S
+    .
+    * TLS: use package <https://hackage.haskell.org/package/peyotls> (sample programs are coming soon)
+    .
+    * SASL: PLAIN, DIGEST-MD5, SCRAM-SHA-1, EXTERNAL (XEP-0178)
+    .
+    S2S
+    .
+    * TLS: use package <https://hackage.haskell.org/package/peyotls> (sample programs are comming soon)
+    .
+    * SASL: EXTERNAL (XEP-0178)
+    .
+    It does not have following features yet.
+    .
+    S2S
+    .
+    * DIALBACK (XEP-0220)
+    .
+    Example programs
+    .
+    Client
+    .
+    examples/simpleClient.hs
+    .
+    > % runhaskell simpleClient.hs yoshikuni@localhost/im password yoshio@localhost
+    > Hello, my name is Yoshikuni!
+    > yoshio@localhost: Hi, I'm Yoshio.
+    > yoshio@localhost: I am busy.
+    > Good-bye!
+    > /quit
+    .
+    extensions
+    .
+    * OverloadedStrings
+    .
+    * PackageImports
+    .
+    replace
+    .
+    * &#38;&#35;123; to '&#123;'
+    .
+    * &#38;&#35;125; to '&#125;'
+    .
+    > import Prelude hiding (filter)
+    >
+    > import Control.Applicative
+    > import "monads-tf" Control.Monad.State
+    > import "monads-tf" Control.Monad.Writer
+    > import Control.Concurrent hiding (yield)
+    > import Data.Maybe
+    > import Data.Pipe
+    > import Data.Pipe.Flow
+    > import Data.Pipe.ByteString
+    > import System.IO
+    > import System.Environment
+    > import Text.XML.Pipe
+    > import Network
+    > import Network.Sasl
+    > import Network.XMPiPe.Core.C2S.Client
+    >
+    > import qualified Data.ByteString as BS
+    > import qualified Data.ByteString.Char8 as BSC
+    >
+    > mechanisms :: [BS.ByteString]
+    > mechanisms = ["SCRAM-SHA-1", "DIGEST-MD5", "PLAIN"]
+    >
+    > data St = St [(BS.ByteString, BS.ByteString)]
+    > instance SaslState St where getSaslState (St ss) = ss; putSaslState ss _ = St ss
+    >
+    > main :: IO ()
+    > main = do
+    > 	(me_ : pw : you_ : _) <- map BSC.pack <$> getArgs
+    > 	let	me@(Jid un d (Just rsc)) = toJid me_; you = toJid you_
+    > 		ss = St [
+    > 			("username", un), ("authcid", un), ("password", pw),
+    > 			("cnonce", "00DEADBEEF00") ]
+    > 	h <- connectTo (BSC.unpack d) $ PortNumber 5222
+    > 	void . (`evalStateT` ss) . runPipe $
+    > 		fromHandle h =$= sasl d mechanisms =$= toHandle h
+    > 	(Just ns, _fts) <- runWriterT . runPipe $
+    > 		fromHandle h =$= bind d rsc =@= toHandle h
+    > 	void . forkIO . void . runPipe $ fromHandle h =$= input ns
+    > 		=$= convert fromMessage =$= filter isJust =$= convert fromJust
+    > 		=$= toHandleLn stdout
+    > 	void . (`runStateT` 0) . runPipe $ do
+    > 		yield (presence me) =$= output =$= toHandle h
+    > 		fromHandleLn stdin =$= before (== "/quit")
+    > 			=$= mkMessage you =$= output =$= toHandle h
+    > 		yield End =$= output =$= toHandle h
+    >
+    > presence :: Jid -> Mpi
+    > presence me = Presence
+    > 	(tagsNull &#123; tagFrom = Just me &#125;) [XmlNode (nullQ "presence") [] [] []]
+    >
+    > mkMessage :: Jid -> Pipe BS.ByteString Mpi (StateT Int IO) ()
+    > mkMessage you = (await >>=) . maybe (return ()) $ \m -> do
+    > 	n <- get; modify succ
+    > 	yield $ toM n m
+    > 	mkMessage you
+    > 	where toM n msg = Message (tagsType "chat") &#123;
+    > 			tagId = Just . BSC.pack . ("msg_" ++) $ show n,
+    > 			tagTo = Just you &#125;
+    > 		[XmlNode (nullQ "body") [] [] [XmlCharData msg]]
+    >
+    > fromMessage :: Mpi -> Maybe BS.ByteString
+    > fromMessage (Message ts [XmlNode _ [] [] [XmlCharData m]])
+    > 	| Just (Jid n d _) <- tagFrom ts = Just $ BS.concat [n, "@", d, ": ", m]
+    > fromMessage _ = Nothing
+    .
+    Server
+    .
+    examples/simpleServer.hs
+    .
+    This simple server can process only chat between same domain (localhost) users.
+    Because this code use only C2S modules.
+    You can implement S2S connection by S2S modules.
+    But now this package contain only EXTERNAL authentification.
+    This package is not contain DIALBACK yet.
+    S2S examples which use EXTERNAL are comming soon.
+    .
+    extensions
+    .
+    * OverloadedStrings
+    .
+    * PackageImports
+    .
+    replace
+    .
+    * &#38;&#35;123; to '&#123;'
+    .
+    * &#38;&#35;125; to '&#125;'
+    .
+    > import Control.Applicative
+    > import Control.Arrow
+    > import Control.Monad
+    > import "monads-tf" Control.Monad.State
+    > import "monads-tf" Control.Monad.Error
+    > import Control.Concurrent hiding (yield)
+    > import Control.Concurrent.STM
+    > import Data.Pipe
+    > import Data.Pipe.ByteString
+    > import Data.Pipe.TChan
+    > import Network
+    > import Network.Sasl
+    > import Network.XMPiPe.Core.C2S.Server
+    >
+    > import qualified Data.ByteString as BS
+    > import qualified Network.Sasl.DigestMd5.Server as DM5
+    > import qualified Network.Sasl.ScramSha1.Server as SS1
+    >
+    > main :: IO ()
+    > main = do
+    > 	userlist <- atomically $ newTVar []
+    > 	soc <- listenOn $ PortNumber 5222
+    > 	forever $ accept soc >>= \(h, _, _) -> forkIO $ do
+    > 		c <- atomically newTChan
+    > 		(Just ns, st) <- (`runStateT` initXSt) . runPipe $ do
+    > 			fromHandle h =$= sasl "localhost" retrieves =$= toHandle h
+    > 			fromHandle h =$= bind "localhost" [] =@= toHandle h
+    > 		let u = user st; sl = selector userlist
+    > 		atomically $ modifyTVar userlist ((u, c) :)
+    > 		void . forkIO . runPipe_ $ fromTChan c =$= output =$= toHandle h
+    > 		runPipe_ $ fromHandle h =$= input ns =$= select u =$= toTChansM sl
+    >
+    > selector :: TVar [(Jid, TChan Mpi)] -> IO [(Jid -> Bool, TChan Mpi)]
+    > selector ul = map (first eq) <$> atomically (readTVar ul)
+    > 	where
+    > 	eq (Jid u d _) (Jid v e Nothing) = u == v && d == e
+    > 	eq j k = j == k
+    >
+    > select :: Monad m => Jid -> Pipe Mpi (Jid, Mpi) m ()
+    > select f = (await >>=) . maybe (return ()) $ \mpi -> case mpi of
+    > 	End -> yield (f, End)
+    > 	Message tgs@(Tags &#123; tagTo = Just to &#125;) b ->
+    > 		yield (to, Message tgs &#123; tagFrom = Just f &#125; b) >> select f
+    > 	_ -> select f
+    >
+    > initXSt :: XSt
+    > initXSt = XSt &#123;
+    > 	user = Jid "" "localhost" Nothing, rands = repeat "00DEADBEEF00",
+    > 	sSt = [	("realm", "localhost"), ("qop", "auth"), ("charset", "utf-8"),
+    > 		("algorithm", "md5-sess") ] &#125;
+    >
+    > retrieves :: (
+    > 	MonadState m, SaslState (StateType m),
+    > 	MonadError m, SaslError (ErrorType m) ) => [Retrieve m]
+    > retrieves = [RTPlain retrievePln, RTDigestMd5 retrieveDM5, RTScramSha1 retrieveSS1]
+    >
+    > retrievePln :: (
+    > 	MonadState m, SaslState (StateType m),
+    > 	MonadError m, SaslError (ErrorType m) ) =>
+    > 	BS.ByteString -> BS.ByteString -> BS.ByteString -> m ()
+    > retrievePln "" "yoshikuni" "password" = return ()
+    > retrievePln "" "yoshio" "password" = return ()
+    > retrievePln _ _ _ = throwError $ fromSaslError NotAuthorized "auth failure"
+    >
+    > retrieveDM5 :: (
+    > 	MonadState m, SaslState (StateType m),
+    > 	MonadError m, SaslError (ErrorType m) ) => BS.ByteString -> m BS.ByteString
+    > retrieveDM5 "yoshikuni" = return $ DM5.mkStored "yoshikuni" "localhost" "password"
+    > retrieveDM5 "yoshio" = return $ DM5.mkStored "yoshio" "localhost" "password"
+    > retrieveDM5 _ = throwError $ fromSaslError NotAuthorized "auth failure"
+    >
+    > retrieveSS1 :: (
+    > 	MonadState m, SaslState (StateType m),
+    > 	MonadError m, SaslError (ErrorType m) ) => BS.ByteString ->
+    > 	m (BS.ByteString, BS.ByteString, BS.ByteString, Int)
+    > retrieveSS1 "yoshikuni" = return (slt, stk, svk, i)
+    > 	where slt = "pepper"; i = 4492; (stk, svk) = SS1.salt "password" slt i
+    > retrieveSS1 "yoshio" = return (slt, stk, svk, i)
+    > 	where slt = "sugar"; i = 4492; (stk, svk) = SS1.salt "password" slt i
+    > retrieveSS1 _ = throwError $ fromSaslError NotAuthorized "auth failure"
+    >
+    > type Pairs a = [(a, a)]
+    > data XSt = XSt &#123; user :: Jid, rands :: [BS.ByteString], sSt :: Pairs BS.ByteString &#125;
+    >
+    > instance XmppState XSt where
+    > 	getXmppState xs = (user xs, rands xs)
+    > 	putXmppState (usr, rl) xs = xs &#123; user = usr, rands = rl &#125;
+    >
+    > instance SaslState XSt where
+    > 	getSaslState XSt &#123; user = Jid n _ _, rands = nnc : _, sSt = ss &#125; =
+    > 		("username", n) : ("nonce", nnc) : ("snonce", nnc) : ss
+    > 	getSaslState _ = error "XSt.getSaslState: null random list"
+    > 	putSaslState ss xs@XSt &#123; user = Jid _ d r, rands = _ : rs &#125; =
+    > 		xs &#123; user = Jid n d r, rands = rs, sSt = ss &#125;
+    > 		where Just n = lookup "username" ss
+    > 	putSaslState _ _ = error "XSt.getSaslState: null random list"
+
+extra-source-files:
+    examples/simpleClient.hs,
+    examples/simpleServer.hs
+
+library
+    hs-source-dirs:	core
+    exposed-modules:
+        Network.XMPiPe.Core.C2S.Client,
+        Network.XMPiPe.Core.C2S.Server,
+        Network.XMPiPe.Core.S2S.Client,
+        Network.XMPiPe.Core.S2S.Server
+    other-modules:
+        Xmpp, XmppType, Tools, SaslClient, SaslServer
+    build-depends:
+        base == 4.*, bytestring == 0.10.*, xml-pipe == 0.0.0.*,
+        simple-pipe == 0.0.0.*, uuid == 1.3.*, base64-bytestring == 1.0.*,
+        handle-like == 0.1.*, sasl == 0.0.0.*, monads-tf == 0.1.*
+    ghc-options:	-Wall
+    extensions:		PatternGuards, DoAndIfThenElse