summaryrefslogtreecommitdiffhomepage
path: root/Server.hs
blob: 5d919b899bf4ec7967ce917f966866a2b904d5b0 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
{-# LANGUAGE OverloadedStrings #-}

module Server where

import CmdLine

import Network.Wai
import Network.Wai.Handler.Warp
import Network.Wai.Handler.WebSockets
import qualified Network.WebSockets as WS
import Network.HTTP.Types
import Data.Text (Text)

server :: ServerOpts -> IO ()
server o = run (serverPort o) app

app :: Application
app = websocketsOr WS.defaultConnectionOptions websocketApp webapp
  where
	webapp _ respond = respond $
		responseLBS status400 [] "Not a WebSocket request"

websocketApp :: WS.ServerApp
websocketApp pending_conn = do
	conn <- WS.acceptRequest pending_conn
	WS.sendTextData conn ("Hello, client!" :: Text)