~singpolyma/network-protocol-xmpp

c18c1e7706cbc1367a45ef8077774586ad1c6569 — Stephen Paul Weber a month ago b8cf87e
sha1 from gnutls now

The one in gsasl was deprecated and then removed
1 files changed, 12 insertions(+), 6 deletions(-)

M lib/Network/Protocol/XMPP/Component.hs
M lib/Network/Protocol/XMPP/Component.hs => lib/Network/Protocol/XMPP/Component.hs +12 -6
@@ 20,6 20,8 @@ module Network.Protocol.XMPP.Component

import           Control.Applicative ((<|>))
import           Control.Monad (when)
import           Control.Monad.IO.Class (liftIO)
import qualified Control.Monad.Trans.Except as E
import           Data.Bits (shiftR, (.&.))
import           Data.Char (intToDigit)
import qualified Data.ByteString


@@ 27,8 29,8 @@ import           Data.ByteString (ByteString)
import qualified Data.Text
import           Data.Text (Text)
import           Data.Text.Encoding (encodeUtf8)
import           Network.Protocol.SASL.GNU (sha1)
import qualified System.IO as IO
import qualified Network.Protocol.TLS.GNU as TLS (DigestAlgorithm(SHA1), hash)

import qualified Network.Protocol.XMPP.Connections as C
import qualified Network.Protocol.XMPP.Handle as H


@@ 70,11 72,15 @@ parseStreamID _ = Nothing
authenticate :: Text -> Text -> M.XMPP ()
authenticate streamID password = do
	let bytes = buildSecret streamID password
	let digest = showDigest (sha1 bytes)
	M.putElement (X.element (s"handshake") [] [X.NodeContent (X.ContentText digest)])
	result <- M.getElement
	let nameHandshake = s"{jabber:component:accept}handshake"
	when (null (X.isNamed nameHandshake result)) (M.throwE (M.AuthenticationFailure result))
	msha1 <- liftIO $ E.runExceptT $ TLS.hash TLS.SHA1 bytes
        case msha1 of
		Left e -> M.throwE (M.AuthenticationError (Data.Text.pack $ show e))
                Right sha1 -> do
			let digest = showDigest sha1
			M.putElement (X.element (s"handshake") [] [X.NodeContent (X.ContentText digest)])
			result <- M.getElement
			let nameHandshake = s"{jabber:component:accept}handshake"
			when (null (X.isNamed nameHandshake result)) (M.throwE (M.AuthenticationFailure result))

buildSecret :: Text -> Text -> ByteString
buildSecret sid password = encodeUtf8 (X.escape (Data.Text.append sid password))