diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,28 @@
+Copyright (c) Sebastiaan Visser 2008
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+1. Redistributions of source code must retain the above copyright
+   notice, this list of conditions and the following disclaimer.
+2. 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.
+3. Neither the name of the author nor the names of his contributors
+   may be used to endorse or promote products derived from this software
+   without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE REGENTS 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 EVENT SHALL THE AUTHORS 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.lhs b/Setup.lhs
new file mode 100644
--- /dev/null
+++ b/Setup.lhs
@@ -0,0 +1,6 @@
+#! /usr/bin/env runhaskell
+
+>import Distribution.Simple
+
+>main = defaultMain
+
diff --git a/salvia-websocket.cabal b/salvia-websocket.cabal
new file mode 100644
--- /dev/null
+++ b/salvia-websocket.cabal
@@ -0,0 +1,27 @@
+Name:             salvia-websocket
+Version:          1.0.0
+Description:      Websocket implementation for the Salvia Webserver.
+Synopsis:         Websocket implementation for the Salvia Webserver.
+Category:         Network, Web
+License:          BSD3
+License-file:     LICENSE
+Author:           Sebastiaan Visser
+Maintainer:       sfvisser@cs.uu.nl
+Cabal-version:    >= 1.6
+Build-Type:       Simple
+
+Library
+  GHC-Options:      -Wall
+  HS-Source-Dirs:   src
+
+  Build-Depends:    base ==4.*,
+                    bytestring ==0.9.*,
+                    salvia ==1.0.*,
+                    salvia-protocol ==1.0.*,
+                    fclabels ==0.4.*,
+                    monads-fd ==0.0.*,
+                    stm ==2.1.*,
+                    utf8-string ==0.3.*
+
+  Exposed-modules:  Network.Salvia.Handler.WebSocket
+
diff --git a/src/Network/Salvia/Handler/WebSocket.hs b/src/Network/Salvia/Handler/WebSocket.hs
new file mode 100644
--- /dev/null
+++ b/src/Network/Salvia/Handler/WebSocket.hs
@@ -0,0 +1,92 @@
+{-# LANGUAGE FlexibleContexts, TypeOperators #-}
+module Network.Salvia.Handler.WebSocket
+( Protocol
+, WebSocketT
+, wsOrigin
+, wsLocation
+, wsProtocol
+, hWebSocket
+, hRecvFrameNonBlocking
+, hSendFrame
+
+, hOnMessage
+, hSendTMVar
+, hOnMessageUpdateTMVar
+)
+where
+
+import Control.Concurrent
+import Control.Concurrent.STM
+import Control.Monad.State
+import Data.Record.Label hiding (get)
+import Network.Protocol.Http hiding (NotFound)
+import Network.Salvia.Handlers
+import Network.Salvia.Interface
+import qualified Data.ByteString.Lazy as B
+import qualified Data.ByteString.Lazy.UTF8 as U
+
+type Protocol = String
+type WebSocketT m a = StateT U.ByteString m a
+
+wsOrigin, wsLocation, wsProtocol :: Http a :-> Maybe Value
+wsOrigin   = header "WebSocket-Origin"
+wsLocation = header "WebSocket-Location"
+wsProtocol = header "WebSocket-Protocol"
+
+hWebSocket :: (RawHttpM Request m, FlushM Response m, HttpM' m) => Value -> WebSocketT m a -> m a
+hWebSocket proto act =
+  do loc <- rawRequest (getM hostname)
+     raw <- rawRequest (getM uri)
+     org <- request (getM (header "Origin"))
+     response $
+       do headers    =: emptyHeaders
+          status     =: CustomStatus 101 "Web Socket Protocol Handshake"
+          upgrade    =: Just "WebSocket"
+          connection =: Just "Upgrade"
+          wsOrigin   =: org
+          wsLocation =: fmap (("ws://" ++) . (++ raw)) loc 
+          wsProtocol =: Just proto
+     hFlushResponseHeaders
+     evalStateT act B.empty
+
+hRecvFrameNonBlocking :: (MonadIO m, HandleM m) => Int -> StateT U.ByteString m (Maybe String)
+hRecvFrameNonBlocking size =
+  do prev <- get
+     (frame, rest) <- lift $
+       do s <- handle
+          raw <- liftIO (B.hGetNonBlocking s size)
+          let (first, rest) = B.break (== 0xFF) raw
+          if not (B.null rest) && B.head rest == 0xFF
+            then let frame = U.toString (B.dropWhile (== 0) (prev `B.append` first)) in
+                 return (Just frame, B.tail rest)
+            else return (Nothing, prev `B.append` first)
+     put rest
+     return frame
+
+hSendFrame :: (FlushM Response m, SendM m) => String -> m ()
+hSendFrame str =
+  do sendBs (B.singleton 0x00)
+     send str
+     sendBs (B.singleton 0xFF)
+     flushQueue forResponse
+
+hOnMessage :: (HandleM m, MonadIO m) => Int -> (String -> m ()) -> WebSocketT m ()
+hOnMessage ms act = forever $
+  do lift . liftIO $ threadDelay (ms * 1000)
+     frame <- hRecvFrameNonBlocking 100
+     case frame of
+       Nothing -> return ()
+       Just f  -> lift (act f)
+
+hSendTMVar :: (SendM m, MonadIO m, FlushM Response m, Eq a) => Int -> TMVar a -> (a -> String) -> m ()
+hSendTMVar ms var f = loop Nothing
+  where 
+  loop prev =
+    do cur <- liftIO $ (threadDelay (ms * 1000) >> atomically (readTMVar var))
+       when (Just cur /= prev) $ hSendFrame (f cur)
+       loop (Just cur)
+
+hOnMessageUpdateTMVar :: (HandleM m, MonadIO m) => Int -> (String -> a -> a) -> TMVar a -> WebSocketT m ()
+hOnMessageUpdateTMVar ms f var =
+  hOnMessage ms $ \msg -> (liftIO . atomically) (takeTMVar var >>= putTMVar var . (f msg))
+