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/examples/clientD.hs b/examples/clientD.hs
new file mode 100644
--- /dev/null
+++ b/examples/clientD.hs
@@ -0,0 +1,37 @@
+{-# LANGUAGE OverloadedStrings, PackageImports #-}
+
+import "monads-tf" Control.Monad.State
+import Data.Pipe
+import Data.Pipe.ByteString
+import System.IO
+import Network.Sasl
+import Network.Sasl.DigestMd5.Client
+
+import qualified Data.ByteString as BS
+
+data St = St [(BS.ByteString, BS.ByteString)] deriving Show
+
+instance SaslState St where
+	getSaslState (St s) = s
+	putSaslState s _ = St s
+
+serverFile :: String
+serverFile = "examples/digestMd5sv.txt"
+
+main :: IO ()
+main = do
+	let (_, (_, p)) = sasl
+	r <- runPipe (fromFileLn serverFile =$= input =$= p =$= toHandleLn stdout)
+		`runStateT` St [
+			("username", "yoshikuni"),
+			("password", "password"),
+			("cnonce", "00DEADBEEF00"),
+			("nc", "00000001"),
+			("uri", "xmpp/localhost") ]
+	print r
+
+input :: Pipe BS.ByteString (Either Success BS.ByteString) (StateT St IO) ()
+input = await >>= \mbs -> case mbs of
+	Just "success" -> yield . Left $ Success Nothing
+	Just ch -> yield (Right ch) >> input
+	_ -> return ()
diff --git a/examples/clientE.hs b/examples/clientE.hs
new file mode 100644
--- /dev/null
+++ b/examples/clientE.hs
@@ -0,0 +1,32 @@
+{-# LANGUAGE OverloadedStrings, PackageImports #-}
+
+import "monads-tf" Control.Monad.State
+import Data.Pipe
+import Data.Pipe.ByteString
+import System.IO
+import Network.Sasl
+import Network.Sasl.External.Client
+
+import qualified Data.ByteString as BS
+
+data St = St [(BS.ByteString, BS.ByteString)] deriving Show
+
+instance SaslState St where
+	getSaslState (St s) = s
+	putSaslState s _ = St s
+
+serverFile :: String
+serverFile = "examples/externalSv.txt"
+
+main :: IO ()
+main = do
+	let (_, (_, p)) = sasl
+	r <- runPipe (fromFileLn serverFile =$= input =$= p =$= toHandleLn stdout)
+		`runStateT` St [("username", "yoshikuni")]
+	print r
+
+input :: Pipe BS.ByteString (Either Success BS.ByteString) (StateT St IO) ()
+input = await >>= \mbs -> case mbs of
+	Just "success" -> yield . Left $ Success Nothing
+	Just ch -> yield (Right ch) >> input
+	_ -> return ()
diff --git a/examples/clientP.hs b/examples/clientP.hs
new file mode 100644
--- /dev/null
+++ b/examples/clientP.hs
@@ -0,0 +1,32 @@
+{-# LANGUAGE OverloadedStrings, PackageImports #-}
+
+import "monads-tf" Control.Monad.State
+import Data.Pipe
+import Data.Pipe.ByteString
+import System.IO
+import Network.Sasl
+import Network.Sasl.Plain.Client
+
+import qualified Data.ByteString as BS
+
+data St = St [(BS.ByteString, BS.ByteString)] deriving Show
+
+instance SaslState St where
+	getSaslState (St s) = s
+	putSaslState s _ = St s
+
+serverFile :: String
+serverFile = "examples/plainSv.txt"
+
+main :: IO ()
+main = do
+	let (_, (_, p)) = sasl
+	r <- runPipe (fromFileLn serverFile =$= input =$= p =$= toHandleLn stdout)
+		`runStateT` St [("authcid", "yoshikuni"), ("password", "password")]
+	print r
+
+input :: Pipe BS.ByteString (Either Success BS.ByteString) (StateT St IO) ()
+input = await >>= \mbs -> case mbs of
+	Just "success" -> yield . Left $ Success Nothing
+	Just ch -> yield (Right ch) >> input
+	_ -> return ()
diff --git a/examples/clientS.hs b/examples/clientS.hs
new file mode 100644
--- /dev/null
+++ b/examples/clientS.hs
@@ -0,0 +1,39 @@
+{-# LANGUAGE OverloadedStrings, PackageImports #-}
+
+import "monads-tf" Control.Monad.State
+import Data.Pipe
+import Data.Pipe.ByteString
+import System.IO
+import Network.Sasl
+import Network.Sasl.ScramSha1.Client
+
+import qualified Data.ByteString as BS
+
+data St = St [(BS.ByteString, BS.ByteString)] deriving Show
+
+instance SaslState St where
+	getSaslState (St s) = s
+	putSaslState s _ = St s
+
+serverFile :: String
+serverFile = "examples/scramSha1sv.txt"
+
+main :: IO ()
+main = do
+	let	(_, (_, p)) = sasl
+		sp = saltedPassword "password" "pepper" 4492
+	r <- runPipe (fromFileLn serverFile =$= input =$= p =$= toHandleLn stdout)
+		`runStateT` St [
+			("username", "yoshikuni"),
+			("password", "password"),
+--			("ClientKey", clientKey sp), ("ServerKey", serverKey sp),
+--			("SaltedPassword", sp),
+			("cnonce", "00DEADBEEF00")
+			]
+	print r
+
+input :: Pipe BS.ByteString (Either Success BS.ByteString) (StateT St IO) ()
+input = await >>= \mbs -> case mbs of
+	Just "success" -> yield . Left $ Success Nothing
+	Just ch -> yield (Right ch) >> input
+	_ -> return ()
diff --git a/examples/serverD.hs b/examples/serverD.hs
new file mode 100644
--- /dev/null
+++ b/examples/serverD.hs
@@ -0,0 +1,38 @@
+{-# LANGUAGE OverloadedStrings, PackageImports #-}
+
+import "monads-tf" Control.Monad.State
+import Data.Pipe
+import Data.Pipe.ByteString
+import Network.Sasl
+import Network.Sasl.DigestMd5.Server
+import System.IO
+
+import qualified Data.ByteString as BS
+
+data St = St [(BS.ByteString, BS.ByteString)] deriving Show
+
+instance SaslState St where
+	getSaslState (St s) = s
+	putSaslState s _ = St s
+
+clientFile :: String
+clientFile = "examples/digestMd5cl.txt"
+
+main :: IO ()
+main = do
+	let (_, (_, p)) = sasl $ \"yoshikuni" -> return $
+		mkStored "yoshikuni" "localhost" "password"
+	r <- runPipe (fromFileLn clientFile =$= p =$= output =$= toHandleLn stdout)
+		`runStateT` St [
+			("realm", "localhost"),
+			("nonce", "7658cddf-0e44-4de2-87df-41323bce97f4"),
+			("qop", "auth"),
+			("charset", "utf-8"),
+			("algorithm", "md5-sess") ]
+	print r
+
+output :: Pipe (Either Success BS.ByteString) BS.ByteString (StateT St IO) ()
+output = await >>= \mch -> case mch of
+	Just (Left (Success Nothing)) -> yield "success"
+	Just (Right bs) -> yield bs >> output
+	_ -> return ()
diff --git a/examples/serverE.hs b/examples/serverE.hs
new file mode 100644
--- /dev/null
+++ b/examples/serverE.hs
@@ -0,0 +1,38 @@
+{-# LANGUAGE OverloadedStrings, FlexibleContexts, PackageImports #-}
+
+import "monads-tf" Control.Monad.State
+import "monads-tf" Control.Monad.Error
+import Data.Pipe
+import Data.Pipe.ByteString
+import Network.Sasl
+import Network.Sasl.External.Server
+import System.IO
+
+import qualified Data.ByteString as BS
+
+data St = St [(BS.ByteString, BS.ByteString)] deriving Show
+
+instance SaslState St where
+	getSaslState (St s) = s
+	putSaslState s _ = St s
+
+clientFile :: String
+clientFile = "examples/externalCl.txt"
+
+main :: IO ()
+main = do
+	let (_, (_, p)) = sasl check
+	r <- runPipe (fromFileLn clientFile =$= p =$= output =$= toHandleLn stdout)
+		`runStateT` St []
+	print r
+
+check :: (MonadError m, SaslError (ErrorType m)) =>
+	BS.ByteString -> m ()
+check "yoshikuni" = return ()
+check _ = throwError $ fromSaslError NotAuthorized "incorrct username"
+
+output :: Pipe (Either Success BS.ByteString) BS.ByteString (StateT St IO) ()
+output = await >>= \mch -> case mch of
+	Just (Left (Success Nothing)) -> yield "success"
+	Just (Right bs) -> yield bs >> output
+	_ -> return ()
diff --git a/examples/serverP.hs b/examples/serverP.hs
new file mode 100644
--- /dev/null
+++ b/examples/serverP.hs
@@ -0,0 +1,39 @@
+{-# LANGUAGE OverloadedStrings, FlexibleContexts, PackageImports #-}
+
+import "monads-tf" Control.Monad.State
+import "monads-tf" Control.Monad.Error
+import Data.Pipe
+import Data.Pipe.ByteString
+import Network.Sasl
+import Network.Sasl.Plain.Server
+import System.IO
+
+import qualified Data.ByteString as BS
+
+data St = St [(BS.ByteString, BS.ByteString)] deriving Show
+
+instance SaslState St where
+	getSaslState (St s) = s
+	putSaslState s _ = St s
+
+clientFile :: String
+clientFile = "examples/plainCl.txt"
+
+main :: IO ()
+main = do
+	let (_, (_, p)) = sasl check
+	r <- runPipe (fromFileLn clientFile =$= p =$= output =$= toHandleLn stdout)
+		`runStateT` St []
+	print r
+
+check :: (Monad m, MonadError m, SaslError (ErrorType m)) =>
+	BS.ByteString -> BS.ByteString -> BS.ByteString -> m ()
+check "" "yoshikuni" "password" = return ()
+check _ _ _ = throwError $
+	fromSaslError NotAuthorized "incorrect username or password"
+
+output :: Pipe (Either Success BS.ByteString) BS.ByteString (StateT St IO) ()
+output = await >>= \mch -> case mch of
+	Just (Left (Success Nothing)) -> yield "success"
+	Just (Right bs) -> yield bs >> output
+	_ -> return ()
diff --git a/examples/serverS.hs b/examples/serverS.hs
new file mode 100644
--- /dev/null
+++ b/examples/serverS.hs
@@ -0,0 +1,36 @@
+{-# LANGUAGE OverloadedStrings, PackageImports #-}
+
+import "monads-tf" Control.Monad.State
+import Data.Pipe
+import Data.Pipe.ByteString
+import System.IO
+import Network.Sasl
+import Network.Sasl.ScramSha1.Server
+
+import qualified Data.ByteString as BS
+
+data St = St [(BS.ByteString, BS.ByteString)] deriving Show
+
+instance SaslState St where
+	getSaslState (St s) = s
+	putSaslState s _ = St s
+
+clientFile :: String
+clientFile = "examples/scramSha1cl.txt"
+
+main :: IO ()
+main = do
+	let	slt = "pepper"
+		i = 4492
+		(stk, svk) = salt "password" slt i
+		(_, (_, p)) = sasl $ \"yoshikuni" -> return (slt, stk, svk, i)
+	r <- runPipe (fromFileLn clientFile =$= p =$= output =$= toHandleLn stdout)
+		`runStateT` St [("snonce", "7658cddf-0e44-4de2-87df-4132bce97f4")]
+	print r
+
+output :: Pipe (Either Success BS.ByteString) BS.ByteString (StateT St IO) ()
+output = await >>= \mch -> case mch of
+	Just (Left (Success Nothing)) -> yield "success"
+	Just (Left (Success (Just bs))) -> yield bs
+	Just (Right bs) -> yield bs >> output
+	_ -> return ()
diff --git a/sasl.cabal b/sasl.cabal
new file mode 100644
--- /dev/null
+++ b/sasl.cabal
@@ -0,0 +1,157 @@
+build-type:	Simple
+cabal-version:	>= 1.8
+
+name:		sasl
+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/sasl/wiki
+
+license:	BSD3
+license-file:	LICENSE
+
+category:	Network
+synopsis:	SASL implementation using simple-pipe
+description:
+    Example programs
+    .
+    SCRAM-SHA-1 Client sample
+    .
+    scramSha1sv.txt
+    .
+    > r=00DEADBEEF007658cddf-0e44-4de2-87df-4132bce97f4,s=cGVwcGVy,i=4492
+    > v=q0+IZgUtQTHYItaurlNyET1imLI=
+    > success
+    .
+    examples/clientS.hs
+    .
+    extensions
+    .
+    * OverloadedStrings
+    .
+    * PackageImports
+    .
+    > import "monads-tf" Control.Monad.State
+    > import Data.Pipe
+    > import Data.Pipe.ByteString
+    > import System.IO
+    > import Network.Sasl
+    > import Network.Sasl.ScramSha1.Client
+    >
+    > import qualified Data.ByteString as BS
+    >
+    > data St = St [(BS.ByteString, BS.ByteString)] deriving Show
+    > 
+    > instance SaslState St where
+    > 	getSaslState (St s) = s
+    > 	putSaslState s _ = St s
+    >
+    > serverFile :: String
+    > serverFile = "examples/scramSha1sv.txt"
+    >
+    > main :: IO ()
+    > main = do
+    > 	let	(_, (_, p)) = sasl
+    > 	r <- runPipe (fromFileLn serverFile =$= input =$= p =$= toHandleLn stdout)
+    > 		`runStateT` St [
+    > 			("username", "yoshikuni"),
+    > 			("password", "password"),
+    > 			("cnonce", "00DEADBEEF00") ]
+    > 	print r
+    >
+    > input :: Pipe BS.ByteString (Either Success BS.ByteString) (StateT St IO) ()
+    > input = await >>= \mbs -> case mbs of
+    > 	Just "success" -> yield . Left $ Success Nothing
+    > 	Just ch -> yield (Right ch) >> input
+    > 	_ -> return ()
+    .
+    SCRAM-SHA-1 Server sample
+    .
+    scramSha1cl.txt
+    .
+    > n,,n=yoshikuni,r=00DEADBEEF00
+    > c=biws,r=00DEADBEEF007658cddf-0e44-4de2-87df-4132bce97f4,p=zup7ghwpAW43cP4Xu3YZTNnHo0g=
+    >
+    .
+    examples/serverS.hs
+    .
+    extensions
+    .
+    * OverloadedStrings
+    .
+    * PackageImports
+    .
+    > import "monads-tf" Control.Monad.State
+    > import Data.Pipe
+    > import Data.Pipe.ByteString
+    > import System.IO
+    > import Network.Sasl
+    > import Network.Sasl.ScramSha1.Server
+    >
+    > import qualified Data.ByteString as BS
+    >
+    > data St = St [(BS.ByteString, BS.ByteString)] deriving Show
+    >
+    > instance SaslState St where
+    > 	getSaslState (St s) = s
+    > 	putSaslState s _ = St s
+    >
+    > clientFile :: String
+    > clientFile = "examples/scramSha1cl.txt"
+    >
+    > main :: IO ()
+    > main = do
+    > 	let	slt = "pepper"
+    > 		i = 4492
+    > 		(stk, svk) = salt "password" slt i
+    > 		(_, (_, p)) = sasl $ \"yoshikuni" -> return (slt, stk, svk, i)
+    > 	r <- runPipe (fromFileLn clientFile =$= p =$= output =$= toHandleLn stdout)
+    > 		`runStateT` St [("snonce", "7658cddf-0e44-4de2-87df-4132bce97f4")]
+    > 	print r
+    >
+    > output :: Pipe (Either Success BS.ByteString) BS.ByteString (StateT St IO) ()
+    > output = await >>= \mch -> case mch of
+    > 	Just (Left (Success Nothing)) -> yield "success"
+    > 	Just (Left (Success (Just bs))) -> yield bs
+    > 	Just (Right bs) -> yield bs >> output
+    > 	_ -> return ()
+    .
+    See examples directory for more examples.
+
+extra-source-files:
+    examples/clientD.hs
+    examples/serverD.hs
+    examples/clientS.hs
+    examples/serverS.hs
+    examples/clientP.hs
+    examples/serverP.hs
+    examples/clientE.hs
+    examples/serverE.hs
+
+source-repository	head
+    type:	git
+    location:	git://github.com/YoshikuniJujo/sasl.git
+
+source-repository	this
+    type:	git
+    location:	git://github.com/YoshikuniJujo/sasl.git
+    tag:	sasl-0.0.0.0
+
+library
+    hs-source-dirs:	src
+    exposed-modules:
+        Network.Sasl,
+        Network.Sasl.Plain.Client, Network.Sasl.Plain.Server,
+        Network.Sasl.External.Client, Network.Sasl.External.Server,
+        Network.Sasl.DigestMd5.Client, Network.Sasl.DigestMd5.Server,
+        Network.Sasl.ScramSha1.Client, Network.Sasl.ScramSha1.Server
+    other-modules:
+        Network.Sasl.DigestMd5.DigestMd5, Network.Sasl.DigestMd5.Papillon,
+        Network.Sasl.ScramSha1.Fields, Network.Sasl.ScramSha1.Hmac,
+        Network.Sasl.ScramSha1.ScramSha1, Network.Sasl.ScramSha1.Functions
+    build-depends:
+        base == 4.*, bytestring == 0.10.*, simple-pipe == 0.0.0.*,
+        papillon == 0.1.*, cryptohash == 0.11.*, base64-bytestring == 1.0.*,
+        monads-tf == 0.1.*
+    ghc-options:	-Wall
diff --git a/src/Network/Sasl.hs b/src/Network/Sasl.hs
new file mode 100644
--- /dev/null
+++ b/src/Network/Sasl.hs
@@ -0,0 +1,89 @@
+{-# LANGUAGE OverloadedStrings, TupleSections,
+ 	FlexibleContexts, TypeSynonymInstances, PackageImports #-}
+
+module Network.Sasl (
+	-- * Main
+	Client(..), client, Server(..), server, Success(..),
+	-- * Types and Classes
+	SaslState(..), Send, Receive,
+	-- * Error
+	SaslError(..), SaslErrorType(..) ) where
+
+import "monads-tf" Control.Monad.Error
+import "monads-tf" Control.Monad.Error.Class
+import Data.Maybe
+import Data.Pipe
+
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Char8 as BSC
+
+class SaslState s where
+	getSaslState :: s -> [(BS.ByteString, BS.ByteString)]
+	putSaslState :: [(BS.ByteString, BS.ByteString)] -> s -> s
+
+data Server m = Server (Maybe (Receive m)) [(Send m, Receive m)] (Maybe (Send m))
+data Client m = Client (Maybe (Send m)) [(Receive m, Send m)] (Maybe (Receive m))
+
+type Send m = m BS.ByteString
+type Receive m = BS.ByteString -> m ()
+
+data Success = Success (Maybe BS.ByteString) deriving Show
+
+data SaslErrorType
+	= Aborted
+	| AccountDisabled
+	| CredentialExpired
+	| EncryptionRequired
+	| IncorrectEncoding
+	| InvalidAuthzid
+	| InvalidMechanism
+	| MalformedRequest
+	| MechanismTooWeak
+	| NotAuthorized
+	| TemporaryAuthFailure
+	| SaslErrorType BS.ByteString
+	deriving Show
+
+class Error e => SaslError e where
+	fromSaslError :: SaslErrorType -> BS.ByteString -> e
+
+instance SaslError IOError where
+	fromSaslError et em = strMsg $ show et ++ ":" ++ BSC.unpack em
+
+server :: Monad m =>
+	Server m -> (Bool, Pipe BS.ByteString (Either Success BS.ByteString) m ())
+server s@(Server i _ _) = (isJust i, pipeSv_ s)
+
+pipeSv_ :: Monad m =>
+	Server m -> Pipe BS.ByteString (Either Success BS.ByteString) m ()
+pipeSv_ (Server (Just rcv) srs send') = await >>=
+	maybe (return ()) ((>> pipeSv_ (Server Nothing srs send')) . lift . rcv)
+pipeSv_ (Server _ [] (Just send')) = lift send' >>= yield . Left . Success . Just
+pipeSv_ (Server _ [] _) = yield . Left $ Success Nothing
+pipeSv_ (Server _ ((send, rcv) : srs) send') = do
+	lift send >>= yield . Right
+	await >>= maybe (return ())
+		((>> pipeSv_ (Server Nothing srs send')) . lift . rcv)
+
+client :: Monad m => Client m -> (Bool,
+	Pipe (Either Success BS.ByteString) BS.ByteString m ())
+client c@(Client i _ _) = (isJust i, pipeCl_ c)
+
+voidM :: Monad m => m a -> m ()
+voidM = (>> return ())
+
+pipeCl_ :: Monad m =>
+	Client m -> Pipe (Either Success BS.ByteString) BS.ByteString m ()
+pipeCl_ (Client (Just i) rss rcv') =
+	lift i >>= yield >> pipeCl_ (Client Nothing rss rcv')
+pipeCl_ (Client _ [] (Just rcv)) = await >>= \mi -> case mi of
+	Just (Left (Success (Just d))) -> lift $ rcv d
+	Just (Right d) -> lift (rcv d) >> yield "" >> await >>= \mi' -> case mi' of
+		Just (Left (Success Nothing)) -> return ()
+		_ -> error $ "pipeCl_: " ++ show mi'
+	_ -> return ()
+pipeCl_ (Client _ [] _) = voidM await
+pipeCl_ (Client _ ((rcv, send) : rss) rcv') = await >>= \mbs -> case mbs of
+	Just (Right bs) -> lift (rcv bs) >> lift send >>= yield >>
+		pipeCl_ (Client Nothing rss rcv')
+	_ -> return ()
diff --git a/src/Network/Sasl/DigestMd5/Client.hs b/src/Network/Sasl/DigestMd5/Client.hs
new file mode 100644
--- /dev/null
+++ b/src/Network/Sasl/DigestMd5/Client.hs
@@ -0,0 +1,77 @@
+{-# LANGUAGE OverloadedStrings, FlexibleContexts, PackageImports #-}
+
+module Network.Sasl.DigestMd5.Client (sasl) where
+
+import "monads-tf" Control.Monad.State
+import "monads-tf" Control.Monad.Error
+import Data.Pipe
+
+import Network.Sasl
+import Network.Sasl.DigestMd5.DigestMd5
+import Network.Sasl.DigestMd5.Papillon
+
+import qualified Data.ByteString as BS
+
+sasl :: (
+	MonadState m, SaslState (StateType m),
+	MonadError m, Error (ErrorType m) ) => (
+	BS.ByteString,
+	(Bool, Pipe (Either Success BS.ByteString) BS.ByteString m ()) )
+sasl = ("DIGEST-MD5", client digestMd5Cl)
+
+
+digestMd5Cl :: (
+	MonadState m, SaslState (StateType m),
+	MonadError m, Error (ErrorType m) ) => Client m
+digestMd5Cl = Client Nothing (zip svs cls) (Just . const $ return ()) -- Nothing
+
+cls :: (MonadState m, SaslState (StateType m)) => [Send m]
+-- client = [mkResponse, return ""]
+cls = [mkResponse]
+
+svs :: (MonadState m, SaslState (StateType m)) => [Receive m]
+svs = [putReceive]
+
+mkResponse :: (MonadState m, SaslState (StateType m)) => Send m
+mkResponse = do
+	st <- gets getSaslState
+	let	Just ps = lookup "password" st
+		Just rlm = lookup "realm" st
+		Just n = lookup "nonce" st
+		Just q = lookup "qop" st
+		Just c = lookup "charset" st
+		Just un = lookup "username" st
+		Just uri = lookup "uri" st
+		Just cn = lookup "cnonce" st
+		Just nc = lookup "nc" st
+	modify . putSaslState $ [
+		("username", un),
+		("digest-uri", uri),
+		("nc", nc),
+		("cnonce", cn) ] ++ st
+	return . fromDigestResponse $ DR {
+		drUserName = un,
+		drRealm = rlm,
+		drPassword = ps,
+		drCnonce = cn,
+		drNonce = n,
+		drNc = nc,
+		drQop = q,
+		drDigestUri = uri,
+		drCharset = c }
+
+putReceive :: (MonadState m, SaslState (StateType m)) => Receive m
+putReceive bs = do
+	let Just ch = parseAtts bs
+	st <- gets getSaslState
+	let	Just rlm = lookup "realm" ch
+		Just n = lookup "nonce" ch
+		Just q = lookup "qop" ch
+		Just c = lookup "charset" ch
+		Just a = lookup "algorithm" ch
+	modify . putSaslState $ [
+		("realm", rlm),
+		("nonce", n),
+		("qop", q),
+		("charset", c),
+		("algorithm", a) ] ++ st
diff --git a/src/Network/Sasl/DigestMd5/DigestMd5.hs b/src/Network/Sasl/DigestMd5/DigestMd5.hs
new file mode 100644
--- /dev/null
+++ b/src/Network/Sasl/DigestMd5/DigestMd5.hs
@@ -0,0 +1,101 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Network.Sasl.DigestMd5.DigestMd5 (
+	DigestResponse(..), fromDigestResponse,
+	mkStored, digestMd5,
+
+	DigestMd5Challenge(..), fromDigestMd5Challenge,
+) where
+
+import Control.Applicative
+import Crypto.Hash.MD5
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Char8 as BSC
+import Numeric
+import Data.Word
+
+(+++) :: ByteString -> ByteString -> ByteString
+(+++) = BS.append
+
+hash32 :: ByteString -> ByteString
+hash32 = BSC.pack . concatMap hex2 . BS.unpack . hash
+
+hex2 :: Word8 -> String
+hex2 w = replicate (2 - length s) '0' ++ s
+	where
+	s = showHex w ""
+
+mkStored :: ByteString -> ByteString -> ByteString -> ByteString
+mkStored username rlm password =
+	hash $ username +++ ":" +++ rlm +++ ":" +++ password
+
+digestMd5 :: Bool -> ByteString -> ByteString -> ByteString ->
+	ByteString -> ByteString -> ByteString -> ByteString
+digestMd5 isClient y q uri n nc cnonce = z
+	where
+	a1 = y +++ ":" +++ n +++ ":" +++ cnonce
+	ha1 = hash32 a1
+	a2 = (if isClient then "AUTHENTICATE" else "") +++ ":" +++ uri
+	ha2 = hash32 a2
+	kd = ha1 +++ ":" +++ n +++ ":" +++ nc +++ ":" +++ cnonce +++ ":" +++
+		q +++ ":" +++ ha2
+	z = hash32 kd
+
+data DigestResponse = DR {
+	drUserName :: BS.ByteString,
+	drRealm :: BS.ByteString,
+	drPassword :: BS.ByteString,
+	drCnonce :: BS.ByteString,
+	drNonce :: BS.ByteString,
+	drNc :: BS.ByteString,
+	drQop :: BS.ByteString,
+	drDigestUri :: BS.ByteString,
+	drCharset :: BS.ByteString }
+	deriving Show
+
+fromDigestResponse :: DigestResponse -> BS.ByteString
+fromDigestResponse = kvsToS . responseToKvs True
+
+kvsToS :: [(BS.ByteString, BS.ByteString)] -> BS.ByteString
+kvsToS [] = ""
+kvsToS [(k, v)] = k `BS.append` "=" `BS.append` v
+kvsToS ((k, v) : kvs) =
+	k `BS.append` "=" `BS.append` v `BS.append` "," `BS.append` kvsToS kvs
+
+responseToKvs :: Bool -> DigestResponse -> [(BS.ByteString, BS.ByteString)]
+responseToKvs isClient rsp = [
+	("username", quote $ drUserName rsp),
+	("realm", quote $ drRealm rsp),
+	("nonce", quote $ drNonce rsp),
+	("cnonce", quote $ drCnonce rsp),
+	("nc", drNc rsp),
+	("qop", drQop rsp),
+	("digest-uri", quote $ drDigestUri rsp),
+	("response", calcMd5 isClient rsp),
+	("charset", drCharset rsp)
+	]
+
+quote :: BS.ByteString -> BS.ByteString
+quote = (`BS.append` "\"") . ("\"" `BS.append`)
+
+calcMd5 :: Bool -> DigestResponse -> BS.ByteString
+calcMd5 isClient = digestMd5 isClient
+	<$> (mkStored <$> drUserName <*> drRealm <*> drPassword)
+	<*> drQop <*> drDigestUri
+	<*> drNonce <*> drNc <*> drCnonce
+
+data DigestMd5Challenge = DigestMd5Challenge {
+	realm :: BS.ByteString,
+	nonce :: BS.ByteString,
+	qop :: BS.ByteString,
+	charset :: BS.ByteString,
+	algorithm :: BS.ByteString }
+	deriving Show
+
+fromDigestMd5Challenge :: DigestMd5Challenge -> BS.ByteString
+fromDigestMd5Challenge c = BS.concat [
+	"realm=", BSC.pack . show $ realm c, ",",
+	"nonce=", BSC.pack . show $ nonce c, ",",
+	"qop=", BSC.pack . show $ qop c, ",",
+	"charset=", charset c, ",", "algorithm=", algorithm c ]
diff --git a/src/Network/Sasl/DigestMd5/Papillon.hs b/src/Network/Sasl/DigestMd5/Papillon.hs
new file mode 100644
--- /dev/null
+++ b/src/Network/Sasl/DigestMd5/Papillon.hs
@@ -0,0 +1,41 @@
+{-# LANGUAGE OverloadedStrings, TypeFamilies, QuasiQuotes #-}
+
+module Network.Sasl.DigestMd5.Papillon (parseAtts) where
+
+import Text.Papillon
+import Data.ByteString.Char8 (ByteString, pack)
+
+import qualified Data.ByteString as BS
+-- import qualified Data.ByteString.Char8 as BSC
+
+parseAtts :: BS.ByteString -> Maybe [(BS.ByteString, BS.ByteString)]
+parseAtts = either (const Nothing) (Just . fst) . runError . atts . parse
+
+isTextChar :: Char -> Bool
+isTextChar = (`elem` (['0' .. '9'] ++ ['a' .. 'z'] ++ ['A' .. 'Z'] ++ "-"))
+
+[papillon|
+
+source: ByteString
+
+atts :: [(ByteString, ByteString)]
+	= a:att ',' as:atts		{ a : as }
+	/ a:att				{ [a] }
+
+att :: (ByteString, ByteString)
+	= k:(<(`notElem` "=")>)+ '=' v:txt	{ (pack k, v) }
+
+txt :: ByteString
+	= '"' t:(<(`notElem` "\"")>)* '"'	{ pack t }
+	/ t:(<isTextChar>)+			{ pack t }
+
+|]
+
+{-
+instance Source ByteString where
+	type Token ByteString = Char
+	data Pos ByteString = NoPos
+	getToken = BSC.uncons
+	initialPos = NoPos
+	updatePos _ _ = NoPos
+	-}
diff --git a/src/Network/Sasl/DigestMd5/Server.hs b/src/Network/Sasl/DigestMd5/Server.hs
new file mode 100644
--- /dev/null
+++ b/src/Network/Sasl/DigestMd5/Server.hs
@@ -0,0 +1,99 @@
+{-# LANGUAGE OverloadedStrings, FlexibleContexts, TypeSynonymInstances,
+	PackageImports #-}
+
+module Network.Sasl.DigestMd5.Server (
+	Success(..), SaslError(..), sasl, mkStored) where
+
+import "monads-tf" Control.Monad.State
+import "monads-tf" Control.Monad.Error
+import "monads-tf" Control.Monad.Error.Class
+import Data.Pipe
+
+import qualified Data.ByteString as BS
+
+import Network.Sasl
+import Network.Sasl.DigestMd5.DigestMd5
+import Network.Sasl.DigestMd5.Papillon
+
+sasl :: (
+	MonadState m, SaslState (StateType m),
+	MonadError m, SaslError (ErrorType m) ) =>
+	(BS.ByteString -> m BS.ByteString) -> (
+		BS.ByteString,
+		(Bool, Pipe BS.ByteString (Either Success BS.ByteString) m ()) )
+sasl rt = ("DIGEST-MD5", server $ digestMd5Sv rt)
+
+digestMd5Sv :: (
+	MonadState m, SaslState (StateType m),
+	MonadError m, Error (ErrorType m) ) =>
+	(BS.ByteString -> m BS.ByteString) -> Server m
+digestMd5Sv lu = Server Nothing (zip svs cls) (Just $ mkRspAuth lu)
+
+svs :: (
+	MonadState m, SaslState (StateType m),
+	MonadError m, Error (ErrorType m) ) => [Send m]
+svs = [mkChallenge]
+
+cls :: (MonadState m, SaslState (StateType m)) => [Receive m]
+cls = [putResponse]
+
+mkChallenge :: (
+	MonadState m, SaslState (StateType m),
+	MonadError m, Error (ErrorType m)) => Send m
+mkChallenge = do
+	st <- gets getSaslState
+	let	Just rlm = lookup "realm" st
+		Just n = lookup "nonce" st
+		Just q = lookup "qop" st
+		Just c = lookup "charset" st
+		Just a = lookup "algorithm" st
+	return $ fromDigestMd5Challenge DigestMd5Challenge {
+		realm = rlm,
+		nonce = n,
+		qop = q,
+		charset = c,
+		algorithm = a }
+
+
+mkRspAuth :: (
+	MonadState m, SaslState (StateType m),
+	MonadError m, Error (ErrorType m)) =>
+	(BS.ByteString -> m BS.ByteString) -> Send m
+mkRspAuth lu = do
+	st <- gets getSaslState
+	let	Just un = lookup "username" st
+	stored <- lu un
+	let	Just q = lookup "qop" st
+		Just uri = lookup "digest-uri" st
+		Just n = lookup "nonce" st
+		Just nc = lookup "nc" st
+		Just cn = lookup "cnonce" st
+		Just rsp = lookup "response" st
+		clc = digestMd5 True stored q uri n nc cn
+		clcs = digestMd5 False stored q uri n nc cn
+	unless (clc == rsp) . throwError $ strMsg "not authenticated"
+	return $ "rspauth=" `BS.append` clcs
+
+putResponse :: (MonadState m, SaslState (StateType m)) => Receive m
+putResponse bs = do
+	st <- gets getSaslState
+	let	Just rs = parseAtts bs
+		Just rlm = lookup "realm" rs
+--		Just n = lookup "nonce" rs
+		Just q = lookup "qop" rs
+		Just c = lookup "charset" rs
+		Just un = lookup "username" rs
+		Just uri = lookup "digest-uri" rs
+		Just cn = lookup "cnonce" rs
+		Just nc = lookup "nc" rs
+		Just rsp = lookup "response" rs
+	modify . putSaslState $ [
+		("realm", rlm),
+--		("nonce", n),
+		("qop", q),
+		("charset", c),
+		("username", un),
+		("digest-uri", uri),
+		("cnonce", cn),
+		("nc", nc),
+		("response", rsp) ] ++ st
diff --git a/src/Network/Sasl/External/Client.hs b/src/Network/Sasl/External/Client.hs
new file mode 100644
--- /dev/null
+++ b/src/Network/Sasl/External/Client.hs
@@ -0,0 +1,31 @@
+{-# LANGUAGE OverloadedStrings, FlexibleContexts, PackageImports #-}
+
+module Network.Sasl.External.Client (sasl) where
+
+import "monads-tf" Control.Monad.State
+import "monads-tf" Control.Monad.Error
+import Data.Pipe
+
+import qualified Data.ByteString as BS
+
+import Network.Sasl
+
+sasl :: (
+	MonadState m, SaslState (StateType m),
+	MonadError m, Error (ErrorType m) ) => (
+	BS.ByteString,
+	(Bool, Pipe (Either Success BS.ByteString) BS.ByteString m ()) )
+sasl = ("EXTERNAL", client script)
+
+script :: (
+	MonadState m, SaslState (StateType m),
+	MonadError m, Error (ErrorType m) ) => Client m
+script = Client (Just clientMessage) [] Nothing
+
+clientMessage :: (
+	MonadState m, SaslState (StateType m),
+	MonadError m, Error (ErrorType m) ) => Send m
+clientMessage = do
+	st <- gets getSaslState
+	let	Just username = lookup "username" st
+	return username
diff --git a/src/Network/Sasl/External/Server.hs b/src/Network/Sasl/External/Server.hs
new file mode 100644
--- /dev/null
+++ b/src/Network/Sasl/External/Server.hs
@@ -0,0 +1,35 @@
+{-# LANGUAGE OverloadedStrings, FlexibleContexts, PackageImports #-}
+
+module Network.Sasl.External.Server (sasl) where
+
+import "monads-tf" Control.Monad.State
+import "monads-tf" Control.Monad.Error
+import Data.Pipe
+
+import qualified Data.ByteString as BS
+
+import Network.Sasl
+
+sasl :: (
+	MonadState m, SaslState (StateType m),
+	MonadError m, SaslError (ErrorType m) ) =>
+	(BS.ByteString -> m ()) -> (
+		BS.ByteString,
+		(Bool, Pipe BS.ByteString (Either Success BS.ByteString) m ()) )
+sasl rt = ("EXTERNAL", server $ script rt)
+
+script :: (
+	MonadState m, SaslState (StateType m),
+	MonadError m, Error (ErrorType m) ) =>
+	(BS.ByteString -> m ()) -> Server m
+script rt = Server (Just $ clientMessage rt) [] Nothing
+
+clientMessage :: (
+	MonadState m, SaslState (StateType m),
+	MonadError m, Error (ErrorType m) ) =>
+	(BS.ByteString -> m ()) -> Receive m
+clientMessage rt rs = do
+	rt rs
+--	unless ok . throwError $ strMsg "not authenticate"
+	st <- gets getSaslState
+	modify . putSaslState $ ("username", rs) : st
diff --git a/src/Network/Sasl/Plain/Client.hs b/src/Network/Sasl/Plain/Client.hs
new file mode 100644
--- /dev/null
+++ b/src/Network/Sasl/Plain/Client.hs
@@ -0,0 +1,34 @@
+{-# LANGUAGE OverloadedStrings, FlexibleContexts, PackageImports #-}
+
+module Network.Sasl.Plain.Client (sasl) where
+
+import "monads-tf" Control.Monad.State
+import "monads-tf" Control.Monad.Error
+import Data.Maybe
+import Data.Pipe
+
+import qualified Data.ByteString as BS
+
+import Network.Sasl
+
+sasl :: (
+	MonadState m, SaslState (StateType m),
+	MonadError m, Error (ErrorType m) ) => (
+	BS.ByteString,
+	(Bool, Pipe (Either Success BS.ByteString) BS.ByteString m ()) )
+sasl = ("PLAIN", client script)
+
+script :: (
+	MonadState m, SaslState (StateType m),
+	MonadError m, Error (ErrorType m) ) => Client m
+script = Client (Just clientMessage) [] Nothing
+
+clientMessage :: (
+	MonadState m, SaslState (StateType m),
+	MonadError m, Error (ErrorType m) ) => Send m
+clientMessage = do
+	st <- gets getSaslState
+	let	az = fromMaybe "" $ lookup "authzid" st
+		Just ac = lookup "authcid" st
+		Just ps = lookup "password" st
+	return $ BS.concat [az, "\0", ac, "\0", ps]
diff --git a/src/Network/Sasl/Plain/Server.hs b/src/Network/Sasl/Plain/Server.hs
new file mode 100644
--- /dev/null
+++ b/src/Network/Sasl/Plain/Server.hs
@@ -0,0 +1,43 @@
+{-# LANGUAGE OverloadedStrings, FlexibleContexts, PackageImports #-}
+
+module Network.Sasl.Plain.Server (sasl) where
+
+import Control.Arrow
+import "monads-tf" Control.Monad.State
+import "monads-tf" Control.Monad.Error
+import Data.Pipe
+
+import qualified Data.ByteString as BS
+
+import Network.Sasl
+
+sasl :: (
+	MonadState m, SaslState (StateType m),
+	MonadError m, SaslError (ErrorType m) ) =>
+	(BS.ByteString -> BS.ByteString -> BS.ByteString -> m ()) -> (
+		BS.ByteString,
+		(Bool, Pipe BS.ByteString (Either Success BS.ByteString) m ()) )
+sasl rt = ("PLAIN", server $ script rt)
+
+readResponse :: BS.ByteString -> (BS.ByteString, BS.ByteString, BS.ByteString)
+readResponse rs = (az, ac, ps)
+	where
+	(az, rst) = second BS.tail $ BS.span (/= 0) rs
+	(ac, ps) = second BS.tail $ BS.span (/= 0) rst
+
+script :: (
+	MonadState m, SaslState (StateType m),
+	MonadError m, Error (ErrorType m) ) =>
+	(BS.ByteString -> BS.ByteString -> BS.ByteString -> m ()) -> Server m
+script rt = Server (Just $ clientMessage rt) [] Nothing
+
+clientMessage :: (
+	MonadState m, SaslState (StateType m),
+	MonadError m, Error (ErrorType m) ) =>
+	(BS.ByteString -> BS.ByteString -> BS.ByteString -> m ()) -> Receive m
+clientMessage rt rs = do
+	let (az, ac, ps) = readResponse rs
+	rt az ac ps
+--	unless ok . throwError $ strMsg "not authenticate"
+	st <- gets getSaslState
+	modify . putSaslState $ ("username", ac) : st
diff --git a/src/Network/Sasl/ScramSha1/Client.hs b/src/Network/Sasl/ScramSha1/Client.hs
new file mode 100644
--- /dev/null
+++ b/src/Network/Sasl/ScramSha1/Client.hs
@@ -0,0 +1,108 @@
+{-# LANGUAGE OverloadedStrings, FlexibleContexts, PackageImports #-}
+
+module Network.Sasl.ScramSha1.Client (
+	sasl, saltedPassword, clientKey, serverKey ) where
+
+import Control.Applicative
+import "monads-tf" Control.Monad.State
+import "monads-tf" Control.Monad.Error
+import "monads-tf" Control.Monad.Error.Class
+import Data.Pipe
+
+import Network.Sasl
+import Network.Sasl.ScramSha1.ScramSha1
+
+import qualified Data.ByteString.Char8 as BSC
+
+sasl :: (
+	MonadState m, SaslState (StateType m),
+	MonadError m, Error (ErrorType m) ) => (
+	BSC.ByteString,
+	(Bool, Pipe (Either Success BSC.ByteString) BSC.ByteString m ()) )
+sasl = ("SCRAM-SHA-1", client scramSha1Client)
+
+scramSha1Client :: (
+	MonadState m, SaslState (StateType m),
+	MonadError m, Error (ErrorType m) ) => Client m
+scramSha1Client =
+	Client (Just clientFirst) [(serverFirst, clientFinal)] (Just serverFinal)
+
+clientFirst :: (MonadState m, SaslState (StateType m)) => Send m
+clientFirst = do
+	st <- gets getSaslState
+	let	Just un = lookup "username" st
+		Just nnc = lookup "cnonce" st
+		cfmb = clientFirstMessageBare un nnc
+	modify . putSaslState $ ("client-first-message-bare", cfmb) : st
+	return $ "n,," `BSC.append` cfmb
+
+serverFirst :: (MonadState m, SaslState (StateType m)) => Receive m
+serverFirst ch = do
+	let Just (nnc, slt, i) = readServerFirstMessage ch
+	st <- gets getSaslState
+	modify . putSaslState $ [
+		("server-first-message", ch),
+		("nonce", nnc),
+		("salt", slt),
+		("i", BSC.pack $ show i) ] ++ st
+
+clientFinal :: (MonadState m, SaslState (StateType m)) => Send m
+clientFinal = do
+	st <- gets getSaslState
+	let	Just ck = case lookup "ClientKey" st of
+			Just c -> Just c
+			_ -> case lookup "SaltedPassword" st of
+				Just sp -> Just $ clientKey sp
+				_ -> do	(ps, slt, i) <- psslti st
+				{-
+				_ -> do	ps <- lookup "password" st
+					slt <- lookup "salt" st
+					i <- lookup "i" st
+					-}
+					return . clientKey . saltedPassword ps slt
+						. read $ BSC.unpack i
+		cb = "n,,"
+		Just nonce = lookup "nonce" st
+		Just cfmb = lookup "client-first-message-bare" st
+		Just sfm = lookup "server-first-message" st
+		cfmwop = clientFinalMessageWithoutProof cb nonce
+		am = BSC.concat [cfmb, ",", sfm, ",", cfmwop]
+	modify . putSaslState $ ("client-final-message-without-proof", cfmwop) : st
+	return $ cfmwop `BSC.append` ",p="
+		`BSC.append` clientProof ck am
+--			(clientKey $ saltedPassword ps slt . read $ BSC.unpack i)
+--			am
+
+psslti :: [(BSC.ByteString, BSC.ByteString)] ->
+	Maybe (BSC.ByteString, BSC.ByteString, BSC.ByteString)
+psslti st = (,,) <$> lookup "password" st <*> lookup "salt" st <*> lookup "i" st
+
+serverFinal :: (
+		MonadState m, SaslState (StateType m),
+		MonadError m, Error (ErrorType m)
+	) => Receive m
+serverFinal ch = do
+	let Just v = readServerFinalMessage ch
+	st <- gets getSaslState
+	let	Just sk = case lookup "ServerKey" st of
+			Just s -> Just s
+			_ -> case lookup "SaltedPassword" st of
+				Just sp -> Just $ serverKey sp
+				_ -> do	(ps, slt, i) <- psslti st
+				{-
+				_ -> do	ps <- lookup "password" st
+					slt <- lookup "salt" st
+					i <- lookup "i" st
+					-}
+					return . serverKey . saltedPassword ps slt
+						. read $ BSC.unpack i
+		Just cfmb = lookup "client-first-message-bare" st
+		Just sfm = lookup "server-first-message" st
+		Just cfmwop = lookup "client-final-message-without-proof" st
+		am = BSC.concat [cfmb, ",", sfm, ",", cfmwop]
+		sfnm = serverFinalMessage sk
+--			(serverKey . saltedPassword ps slt . read $ BSC.unpack i)
+			am
+	let Just v' = readServerFinalMessage sfnm
+	unless (v == v') . throwError $ strMsg "serverFinal: bad"
+	modify . putSaslState $ [("verify", v), ("sfm", sfm)] ++ st
diff --git a/src/Network/Sasl/ScramSha1/Fields.hs b/src/Network/Sasl/ScramSha1/Fields.hs
new file mode 100644
--- /dev/null
+++ b/src/Network/Sasl/ScramSha1/Fields.hs
@@ -0,0 +1,18 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Network.Sasl.ScramSha1.Fields (readFields) where
+
+import qualified Data.ByteString.Char8 as BSC
+
+readFields :: BSC.ByteString -> [(BSC.ByteString, BSC.ByteString)]
+readFields = map sepKV . sepByComma
+
+sepKV :: BSC.ByteString -> (BSC.ByteString, BSC.ByteString)
+sepKV bs = case BSC.span (/= '=') bs of
+	(k, "") -> (k, "")
+	(k, v) -> (k, BSC.tail v)
+
+sepByComma :: BSC.ByteString -> [BSC.ByteString]
+sepByComma bs = case BSC.span (/= ',') bs of
+	(itm, "") -> [itm]
+	(itm, rst) -> itm : sepByComma (BSC.tail rst)
diff --git a/src/Network/Sasl/ScramSha1/Functions.hs b/src/Network/Sasl/ScramSha1/Functions.hs
new file mode 100644
--- /dev/null
+++ b/src/Network/Sasl/ScramSha1/Functions.hs
@@ -0,0 +1,55 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Network.Sasl.ScramSha1.Functions (
+	xo, SHA1.hash,
+
+	saltedPassword,
+	clientKey,
+	storedKey,
+	serverKey,
+
+	clientSignature,
+	clientProof,
+	serverSignature,
+	) where
+
+import Data.Bits
+
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Base64 as B64
+import qualified Crypto.Hash.SHA1 as SHA1
+
+import Network.Sasl.ScramSha1.Hmac
+
+int1 :: BS.ByteString
+int1 = "\0\0\0\1"
+
+xo :: BS.ByteString -> BS.ByteString -> BS.ByteString
+"" `xo` b2 = b2
+b1 `xo` "" = b1
+b1 `xo` b2 = BS.pack $ zipWith xor (BS.unpack b1) (BS.unpack b2)
+
+hi :: BS.ByteString -> BS.ByteString -> Int -> BS.ByteString
+hi str salt i =
+	foldl1 xo . take i . tail . iterate (hmac SHA1.hash 64 str) $ salt `BS.append` int1
+
+saltedPassword :: BS.ByteString -> BS.ByteString -> Int -> BS.ByteString
+saltedPassword = hi
+
+clientKey :: BS.ByteString -> BS.ByteString
+clientKey sp = hmac SHA1.hash 64 sp "Client Key"
+
+storedKey :: BS.ByteString -> BS.ByteString
+storedKey = SHA1.hash . clientKey
+
+clientSignature :: BS.ByteString -> BS.ByteString -> BS.ByteString
+clientSignature = hmac SHA1.hash 64
+
+clientProof :: BS.ByteString -> BS.ByteString -> BS.ByteString
+clientProof ck am = B64.encode $ ck `xo` clientSignature (SHA1.hash ck) am
+
+serverKey :: BS.ByteString -> BS.ByteString
+serverKey sp = hmac SHA1.hash 64 sp "Server Key"
+
+serverSignature :: BS.ByteString -> BS.ByteString -> BS.ByteString
+serverSignature sk am = B64.encode $ hmac SHA1.hash 64 sk am
diff --git a/src/Network/Sasl/ScramSha1/Hmac.hs b/src/Network/Sasl/ScramSha1/Hmac.hs
new file mode 100644
--- /dev/null
+++ b/src/Network/Sasl/ScramSha1/Hmac.hs
@@ -0,0 +1,33 @@
+module Network.Sasl.ScramSha1.Hmac (hmac, bsToHex) where
+
+import Data.Word
+import Data.Bits
+import Numeric
+
+import qualified Data.ByteString as BS
+
+type Hash = BS.ByteString -> BS.ByteString
+
+ipad, opad :: [Word8]
+ipad = repeat 0x36
+opad = repeat 0x5c
+
+hmac :: Hash -> Int -> BS.ByteString -> BS.ByteString -> BS.ByteString
+hmac h bs k = h . (makePad opad k' `BS.append`) . h . (makePad ipad k' `BS.append`)
+	where
+	k' = makeKey h bs k
+
+makeKey :: Hash -> Int -> BS.ByteString -> BS.ByteString
+makeKey h bs k
+	| BS.length k > bs = makeKey h bs $ h k
+	| otherwise = k `BS.append` BS.replicate (bs - BS.length k) 0
+
+makePad :: [Word8] -> BS.ByteString -> BS.ByteString
+makePad iop = BS.pack . mkp iop . BS.unpack
+	where
+	mkp _ [] = []
+	mkp (p : ps) (k : ks) = p `xor` k : mkp ps ks
+	mkp _ _ = error "makePad: bad"
+
+bsToHex :: BS.ByteString -> String
+bsToHex = concatMap (`showHex` "") . BS.unpack
diff --git a/src/Network/Sasl/ScramSha1/ScramSha1.hs b/src/Network/Sasl/ScramSha1/ScramSha1.hs
new file mode 100644
--- /dev/null
+++ b/src/Network/Sasl/ScramSha1/ScramSha1.hs
@@ -0,0 +1,66 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Network.Sasl.ScramSha1.ScramSha1 (
+	clientFirstMessageBare,
+	serverFirstMessage,
+	clientFinalMessageWithoutProof,
+	serverFinalMessage,
+
+	readClientFirstMessage,
+	readServerFirstMessage,
+	readClientFinalMessage,
+	readServerFinalMessage,
+
+	xo, hash,
+	saltedPassword, clientKey, storedKey, serverKey,
+	clientSignature, clientProof,
+	) where
+
+import Control.Applicative
+
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Char8 as BSC
+import qualified Data.ByteString.Base64 as B64
+
+import Network.Sasl.ScramSha1.Fields
+import Network.Sasl.ScramSha1.Functions
+
+clientFirstMessageBare :: BS.ByteString -> BS.ByteString -> BS.ByteString
+clientFirstMessageBare un nnc = BS.concat ["n=", un, ",r=", nnc]
+
+serverFirstMessage :: BS.ByteString -> BS.ByteString -> Int -> BS.ByteString
+serverFirstMessage snnc slt i = BS.concat
+	["r=", snnc, ",s=", B64.encode slt, ",i=", BSC.pack $ show i]
+
+clientFinalMessageWithoutProof :: BS.ByteString -> BS.ByteString -> BS.ByteString
+clientFinalMessageWithoutProof cb snnc =
+	BS.concat ["c=", B64.encode cb, ",r=", snnc]
+
+serverFinalMessage :: BS.ByteString -> BS.ByteString -> BS.ByteString
+serverFinalMessage sk am = BS.concat ["v=", serverSignature sk am]
+--	serverSignature (serverKey $ saltedPassword ps slt i) am ]
+
+readClientFirstMessage :: BS.ByteString -> Maybe (BS.ByteString, BS.ByteString)
+readClientFirstMessage rs = case BS.splitAt 3 rs of
+	("n,,", rs') -> do
+		let kv = readFields rs'
+		(,) <$> lookup "n" kv <*> lookup "r" kv
+	_ -> Nothing
+
+readServerFirstMessage :: BS.ByteString -> Maybe (BS.ByteString, BS.ByteString, Int)
+readServerFirstMessage ch = do
+	let kv = readFields ch
+	(,,)	<$> lookup "r" kv
+		<*> ((\(Right r) -> r) . B64.decode <$> lookup "s" kv)
+		<*> (read . BSC.unpack <$> lookup "i" kv)
+
+readClientFinalMessage ::
+ 	BS.ByteString -> Maybe (BS.ByteString, BS.ByteString, BS.ByteString)
+readClientFinalMessage rs = do
+	let kv = readFields rs
+	(,,)	<$> ((\(Right r) -> r) . B64.decode <$> lookup "c" kv)
+		<*> lookup "r" kv
+		<*> ((\(Right r) -> r) . B64.decode <$> lookup "p" kv)
+
+readServerFinalMessage :: BS.ByteString -> Maybe BS.ByteString
+readServerFinalMessage = lookup "v" . readFields
diff --git a/src/Network/Sasl/ScramSha1/Server.hs b/src/Network/Sasl/ScramSha1/Server.hs
new file mode 100644
--- /dev/null
+++ b/src/Network/Sasl/ScramSha1/Server.hs
@@ -0,0 +1,105 @@
+{-# LANGUAGE OverloadedStrings, FlexibleContexts, PackageImports #-}
+
+module Network.Sasl.ScramSha1.Server (sasl, salt) where
+
+import "monads-tf" Control.Monad.State
+import "monads-tf" Control.Monad.Error
+import "monads-tf" Control.Monad.Error.Class
+import Data.Pipe
+
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Char8 as BSC
+
+import Network.Sasl
+import Network.Sasl.ScramSha1.ScramSha1
+
+sasl :: (
+	MonadState m, SaslState (StateType m),
+	MonadError m, SaslError (ErrorType m) ) =>
+	(BS.ByteString -> m (BS.ByteString, BS.ByteString, BS.ByteString, Int)) -> (
+		BSC.ByteString,
+		(Bool, Pipe BS.ByteString (Either Success BS.ByteString) m ()) )
+sasl rt = ("SCRAM-SHA-1", server $ scramSha1Server rt)
+
+salt :: BSC.ByteString -> BSC.ByteString -> Int -> (BSC.ByteString, BSC.ByteString)
+salt ps slt i = (storedKey sp, serverKey sp)
+	where sp = saltedPassword ps slt i
+
+scramSha1Server :: (
+		MonadState m, SaslState (StateType m),
+		MonadError m, Error (ErrorType m) ) =>
+	(BSC.ByteString -> m (BSC.ByteString, BSC.ByteString, BSC.ByteString, Int))
+		-> Server m
+scramSha1Server rt = Server
+	(Just clientFirst) [(serverFirst rt, clientFinal rt)] (Just $ serverFinal rt)
+
+clientFirst :: (MonadState m, SaslState (StateType m)) => Receive m
+clientFirst rs = do
+	let Just (un, cnnc) = readClientFirstMessage rs
+	st <- gets getSaslState
+	modify . putSaslState $ [
+		("client-first-message-bare", BSC.drop 3 rs),
+		("username", un),
+		("cnonce", cnnc) ] ++ st
+
+serverFirst :: (MonadState m, SaslState (StateType m)) =>
+	(BSC.ByteString -> m (BSC.ByteString, BSC.ByteString, BSC.ByteString, Int))
+		-> Send m
+serverFirst rt = do
+	st <- gets getSaslState
+	let	Just un = lookup "username" st
+		Just cnnc = lookup "cnonce" st
+		Just snnc = lookup "snonce" st
+--		Just slt = lookup "salt" st
+--		Just i = lookup "i" st
+	(slt, _, _, i) <- rt un
+	let	sfm = serverFirstMessage (cnnc `BSC.append` snnc) slt i
+	modify . putSaslState $ ("server-first-message", sfm) : st
+	return sfm
+
+dropProof :: String -> String
+dropProof "" = ""
+dropProof (',' : 'p' : '=' : _) = ""
+dropProof (c : cs) = c : dropProof cs
+
+dropProofBS :: BSC.ByteString -> BSC.ByteString
+dropProofBS = BSC.pack . dropProof . BSC.unpack
+
+clientFinal :: (
+		MonadState m, SaslState (StateType m),
+		MonadError m, Error (ErrorType m) ) =>
+	(BSC.ByteString -> m (BSC.ByteString, BSC.ByteString, BSC.ByteString, Int))
+		-> Receive m
+clientFinal rt rs = do
+	st <- gets getSaslState
+	let	Just ("n,,", nnc, prf) = readClientFinalMessage rs
+		Just un = lookup "username" st
+	(_, sk, _, _) <- rt un
+	let	Just cfmb = lookup "client-first-message-bare" st
+		Just sfm = lookup "server-first-message" st
+		cfmwop = dropProofBS rs
+		am = BSC.concat [cfmb, ",", sfm, ",", cfmwop]
+		cs = clientSignature sk am
+		ck = prf `xo` cs
+		sk' = hash ck
+	unless (sk == sk') . throwError $ strMsg "clientFinal: bad"
+	modify . putSaslState $ [
+		("client-final-message-without-proof", cfmwop),
+		("nonce", nnc),
+		("proof", prf),
+		("StoredKey", sk),
+		("StoredKey'", sk')
+		] ++ st
+
+serverFinal :: (MonadState m, SaslState (StateType m)) =>
+	(BSC.ByteString -> m (BSC.ByteString, BSC.ByteString, BSC.ByteString, Int))
+		-> Send m
+serverFinal rt = do
+	st <- gets getSaslState
+	let	Just un = lookup "username" st
+	(_, _, sk, _) <- rt un
+	let	Just cfmb = lookup "client-first-message-bare" st
+		Just sfm = lookup "server-first-message" st
+		Just cfmwop = lookup "client-final-message-without-proof" st
+		am = BSC.concat [cfmb, ",", sfm, ",", cfmwop]
+	return $ serverFinalMessage sk am