Wai Websockets

WebSockets.purs

websocketsOr :: WS.ConnectionOptions
             -> WS.ServerApp
             -> Wai.Application
             -> Wai.Application
websocketsOr opts app backup req sendResponse =
    case websocketsApp opts app req of
        Nothing -> backup req sendResponse
        Just res -> sendResponse res

websocketsApp :: WS.ConnectionOptions
              -> WS.ServerApp
              -> Wai.Request
              -> Maybe Wai.Response
websocketsApp opts app request
    | isWebSocketsReq request = do 
        Just $ Wai.responseSocket \socket ->
            runWebSockets opts (getRequestHead request) app socket
    | otherwise = Nothing

getRequestHead :: Wai.Request -> WS.RequestHead 
getRequestHead (Request req) = RequestHead
    { path: req.rawPathInfo <> "/" <> req.rawQueryString
    , headers: req.requestHeaders
    , secure: req.isSecure
    }

-- | Returns whether or not the given 'Wai.Request' is a WebSocket request.
isWebSocketsReq :: Wai.Request -> Boolean
isWebSocketsReq (Request req) =
    upgradeRequestHeader == (Just $ caseI "websocket")
    where 
        caseI          = CaseInsensitiveString
        requestHeaders = Map.fromFoldable $ req.requestHeaders
        upgradeRequestHeader  = map caseI (Map.lookup H.hUpgrade requestHeaders)

runWebSockets :: forall a.
    WS.ConnectionOptions
    -> WS.RequestHead
    -> (WS.PendingConnection -> Effect a)
    -> Net.Socket
    -> Effect a
runWebSockets options request app socket = do 
    wss <- WSS.createServer NoServer mempty
    app pc 
    where
        pc = WS.PendingConnection
            { options 
            , request
            , onAccept: \_ -> pure unit 
            , socket
            }