module Network.WebSockets.Handshake
( HandshakeError (..)
, handshake
, response101
, response400
) where
import Data.Monoid (mappend, mconcat)
import Control.Monad.Error (Error (..), throwError)
import Data.Digest.Pure.SHA (bytestringDigest, sha1)
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString.Lazy as BL
import qualified Data.CaseInsensitive as CI
import Network.WebSockets.Types
data HandshakeError = HandshakeError String
deriving (Show)
instance Error HandshakeError where
noMsg = HandshakeError "Handshake error"
strMsg = HandshakeError
handshake :: Request -> Either HandshakeError Response
handshake (Request _ headers) = do
key <- getHeader "Sec-WebSocket-Key"
let hash = unlazy $ bytestringDigest $ sha1 $ lazy $ key `mappend` guid
let encoded = B64.encode hash
return $ response101 [("Sec-WebSocket-Accept", encoded)]
where
guid = "258EAFA5-E914-47DA-95CA-C5AB0DC85B11"
lazy = BL.fromChunks . return
unlazy = mconcat . BL.toChunks
getHeader k = case lookup k headers of
Just t -> return t
Nothing -> throwError $
HandshakeError $ "Header missing: " ++ BC.unpack (CI.original k)
response101 :: Headers -> Response
response101 headers = Response 101 "WebSocket Protocol Handshake" $
("Upgrade", "WebSocket") :
("Connection", "Upgrade") :
headers
response400 :: Headers -> Response
response400 headers = Response 400 "Bad Request" headers