import Network.WebSockets (shakeHands, getFrame, putFrame)
 import Network (listenOn, PortID(PortNumber), accept, withSocketsDo)
 import System.IO (Handle, hClose)
 import qualified Data.ByteString as B (append, null)
 import Data.ByteString.UTF8 (fromString) -- this is from utf8-string
 import Control.Monad (forever)
 import Control.Concurrent (forkIO)

 -- Accepts clients, spawns a single handler for each one.
 main :: IO ()
 main = withSocketsDo $ do
   socket <- listenOn (PortNumber 12345)
   putStrLn "Listening on port 12345."
   forever $ do
     (h, _, _) <- accept socket
     forkIO (talkTo h)
 
 -- Shakes hands with client. If no error, starts talking.
 talkTo :: Handle -> IO ()
 talkTo h = do
   request <- shakeHands h
   case request of
     Left err -> print err
     Right  _ -> do
       putFrame h (fromString "Do you read me, Lieutenant Bowie?")
       putStrLn "Shook hands, sent welcome message."
       talkLoop h
 
 -- Talks to the client (by echoing messages back) until EOF.
 talkLoop :: Handle -> IO ()
 talkLoop h = do
   msg <- getFrame h
   if B.null msg
      then do
        putStrLn "EOF encountered. Closing handle."
        hClose h
      else do
        putFrame h $ B.append msg (fromString ", meow.")
        talkLoop h