{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeApplications #-}
module Polysemy.WebServer (WebServer(..), PendingWebRequest, startWebServer,
startWebServerSettings,
respondWebRequest, getBody, upgradeToWebSocketsResponse,
acceptPendingWebSocketConnection, rejectPendingWebSocketConnection,
whilePingingWebSocket, sendWebSocketDataMessages, receiveWebSocketDataMessage,
sendWebSocketCloseCode, runWebServerFinal) where
import qualified Network.Wai as Wai
import qualified Network.Wai.Handler.Warp as Warp
import qualified Network.Wai.Handler.WebSockets as WaiWs
import qualified Network.HTTP.Types.Status as HTTP
import qualified Network.WebSockets.Connection as WS
import qualified Network.WebSockets as WS
import Polysemy
import Polysemy.Final
import Data.Functor
import Control.Monad
import Control.Exception (catch)
import Data.Word (Word16)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
newtype PendingWebRequest =
PendingWebRequest (Wai.Response -> IO Wai.ResponseReceived)
data WebServer m a where
StartWebServer :: Warp.Port -> (
Wai.Request -> PendingWebRequest -> m Wai.ResponseReceived) ->
WebServer m ()
StartWebServerSettings :: Warp.Settings -> (
Wai.Request -> PendingWebRequest -> m Wai.ResponseReceived) ->
WebServer m ()
RespondWebRequest :: PendingWebRequest -> Wai.Response ->
WebServer m Wai.ResponseReceived
GetBody :: Int -> Wai.Request -> WebServer m (Maybe BS.ByteString)
UpgradeToWebSocketsResponse :: WS.ConnectionOptions ->
(WS.PendingConnection -> m ()) -> Wai.Request -> WebServer m (Maybe Wai.Response)
AcceptPendingWebSocketConnection :: WS.PendingConnection -> WS.AcceptRequest ->
WebServer m (Either (Either WS.HandshakeException WS.ConnectionException) WS.Connection)
RejectPendingWebSocketConnection :: WS.PendingConnection -> WS.RejectRequest ->
WebServer m ()
WhilePingingWebSocket :: WS.Connection -> Int -> m a -> WebServer m (Maybe a)
SendWebSocketDataMessages :: WS.Connection -> [WS.DataMessage] -> WebServer m ()
ReceiveWebSocketDataMessage :: WS.Connection -> WebServer m (Either WS.ConnectionException WS.DataMessage)
SendWebSocketCloseCode :: WS.WebSocketsData a => WS.Connection -> Word16 -> a -> WebServer m ()
makeSem ''WebServer
runStartWebServer :: forall rInitial r f.
((Final IO) `Member` r, Functor f) =>
Warp.Port -> (
Wai.Request -> PendingWebRequest ->
Sem rInitial Wai.ResponseReceived) ->
Sem (WithTactics WebServer f (Sem rInitial) r) (f ())
runStartWebServer :: Int
-> (Request -> PendingWebRequest -> Sem rInitial ResponseReceived)
-> Sem (WithTactics WebServer f (Sem rInitial) r) (f ())
runStartWebServer Int
port Request -> PendingWebRequest -> Sem rInitial ResponseReceived
app = do
f ()
s0 <- Sem (WithTactics WebServer f (Sem rInitial) r) (f ())
forall (f :: * -> *) (m :: * -> *) (r :: [Effect]) (e :: Effect).
Sem (WithTactics e f m r) (f ())
getInitialStateT
f (Request, PendingWebRequest)
-> Sem (WebServer : r) (f ResponseReceived)
appFnS <- ((Request, PendingWebRequest) -> Sem rInitial ResponseReceived)
-> Sem
(WithTactics WebServer f (Sem rInitial) r)
(f (Request, PendingWebRequest)
-> Sem (WebServer : r) (f ResponseReceived))
forall a (m :: * -> *) b (e :: Effect) (f :: * -> *)
(r :: [Effect]).
(a -> m b) -> Sem (WithTactics e f m r) (f a -> Sem (e : r) (f b))
bindT (((Request, PendingWebRequest) -> Sem rInitial ResponseReceived)
-> Sem
(WithTactics WebServer f (Sem rInitial) r)
(f (Request, PendingWebRequest)
-> Sem (WebServer : r) (f ResponseReceived)))
-> ((Request, PendingWebRequest) -> Sem rInitial ResponseReceived)
-> Sem
(WithTactics WebServer f (Sem rInitial) r)
(f (Request, PendingWebRequest)
-> Sem (WebServer : r) (f ResponseReceived))
forall a b. (a -> b) -> a -> b
$ (Request -> PendingWebRequest -> Sem rInitial ResponseReceived)
-> (Request, PendingWebRequest) -> Sem rInitial ResponseReceived
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Request -> PendingWebRequest -> Sem rInitial ResponseReceived
app
Inspector f
ins <- Sem (WithTactics WebServer f (Sem rInitial) r) (Inspector f)
forall (e :: Effect) (f :: * -> *) (m :: * -> *) (r :: [Effect]).
Sem (WithTactics e f m r) (Inspector f)
getInspectorT
let
appFn :: (Wai.Request, PendingWebRequest) ->
Sem r (Maybe Wai.ResponseReceived)
appFn :: (Request, PendingWebRequest) -> Sem r (Maybe ResponseReceived)
appFn = Sem (WebServer : r) (Maybe ResponseReceived)
-> Sem r (Maybe ResponseReceived)
forall (r :: [Effect]) a.
Member (Final IO) r =>
Sem (WebServer : r) a -> Sem r a
runWebServerFinal (Sem (WebServer : r) (Maybe ResponseReceived)
-> Sem r (Maybe ResponseReceived))
-> ((Request, PendingWebRequest)
-> Sem (WebServer : r) (Maybe ResponseReceived))
-> (Request, PendingWebRequest)
-> Sem r (Maybe ResponseReceived)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((f ResponseReceived -> Maybe ResponseReceived)
-> Sem (WebServer : r) (f ResponseReceived)
-> Sem (WebServer : r) (Maybe ResponseReceived)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Inspector f -> forall x. f x -> Maybe x
forall (f :: * -> *). Inspector f -> forall x. f x -> Maybe x
inspect Inspector f
ins)) (Sem (WebServer : r) (f ResponseReceived)
-> Sem (WebServer : r) (Maybe ResponseReceived))
-> ((Request, PendingWebRequest)
-> Sem (WebServer : r) (f ResponseReceived))
-> (Request, PendingWebRequest)
-> Sem (WebServer : r) (Maybe ResponseReceived)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Request, PendingWebRequest)
-> Sem (WebServer : r) (f ResponseReceived)
appFnS (f (Request, PendingWebRequest)
-> Sem (WebServer : r) (f ResponseReceived))
-> ((Request, PendingWebRequest) -> f (Request, PendingWebRequest))
-> (Request, PendingWebRequest)
-> Sem (WebServer : r) (f ResponseReceived)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f ()
s0 f ()
-> (Request, PendingWebRequest) -> f (Request, PendingWebRequest)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$>)
Strategic
IO (Sem (WithTactics WebServer f (Sem rInitial) r)) (f ())
-> Sem (WithTactics WebServer f (Sem rInitial) r) (f ())
forall (m :: * -> *) (r :: [Effect]) a.
Member (Final m) r =>
Strategic m (Sem r) a -> Sem r a
withStrategicToFinal (Strategic
IO (Sem (WithTactics WebServer f (Sem rInitial) r)) (f ())
-> Sem (WithTactics WebServer f (Sem rInitial) r) (f ()))
-> Strategic
IO (Sem (WithTactics WebServer f (Sem rInitial) r)) (f ())
-> Sem (WithTactics WebServer f (Sem rInitial) r) (f ())
forall a b. (a -> b) -> a -> b
$ do
f (Request, PendingWebRequest) -> IO (f (Maybe ResponseReceived))
appFnS' <- ((Request, PendingWebRequest)
-> Sem
(WithTactics WebServer f (Sem rInitial) r)
(Maybe ResponseReceived))
-> Sem
(WithStrategy
IO f (Sem (WithTactics WebServer f (Sem rInitial) r)))
(f (Request, PendingWebRequest) -> IO (f (Maybe ResponseReceived)))
forall a (n :: * -> *) b (m :: * -> *) (f :: * -> *).
(a -> n b) -> Sem (WithStrategy m f n) (f a -> m (f b))
bindS (Sem r (Maybe ResponseReceived)
-> Sem
(WithTactics WebServer f (Sem rInitial) r) (Maybe ResponseReceived)
forall (e :: Effect) (r :: [Effect]) a. Sem r a -> Sem (e : r) a
raise (Sem r (Maybe ResponseReceived)
-> Sem
(WithTactics WebServer f (Sem rInitial) r)
(Maybe ResponseReceived))
-> ((Request, PendingWebRequest) -> Sem r (Maybe ResponseReceived))
-> (Request, PendingWebRequest)
-> Sem
(WithTactics WebServer f (Sem rInitial) r) (Maybe ResponseReceived)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Request, PendingWebRequest) -> Sem r (Maybe ResponseReceived)
appFn)
Inspector f
ins' <- Sem
(WithStrategy
IO f (Sem (WithTactics WebServer f (Sem rInitial) r)))
(Inspector f)
forall (m :: * -> *) (f :: * -> *) (n :: * -> *).
Sem (WithStrategy m f n) (Inspector f)
getInspectorS
f ()
s1 <- Sem
(WithStrategy
IO f (Sem (WithTactics WebServer f (Sem rInitial) r)))
(f ())
forall (m :: * -> *) (f :: * -> *) (n :: * -> *).
Sem (WithStrategy m f n) (f ())
getInitialStateS
let
appFn' :: (Wai.Request, PendingWebRequest) ->
IO (Maybe Wai.ResponseReceived)
appFn' :: (Request, PendingWebRequest) -> IO (Maybe ResponseReceived)
appFn' = ((f (Maybe ResponseReceived) -> Maybe ResponseReceived)
-> IO (f (Maybe ResponseReceived)) -> IO (Maybe ResponseReceived)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe (Maybe ResponseReceived) -> Maybe ResponseReceived
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe ResponseReceived) -> Maybe ResponseReceived)
-> (f (Maybe ResponseReceived) -> Maybe (Maybe ResponseReceived))
-> f (Maybe ResponseReceived)
-> Maybe ResponseReceived
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inspector f -> forall x. f x -> Maybe x
forall (f :: * -> *). Inspector f -> forall x. f x -> Maybe x
inspect Inspector f
ins')) (IO (f (Maybe ResponseReceived)) -> IO (Maybe ResponseReceived))
-> ((Request, PendingWebRequest)
-> IO (f (Maybe ResponseReceived)))
-> (Request, PendingWebRequest)
-> IO (Maybe ResponseReceived)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Request, PendingWebRequest) -> IO (f (Maybe ResponseReceived))
appFnS' (f (Request, PendingWebRequest) -> IO (f (Maybe ResponseReceived)))
-> ((Request, PendingWebRequest) -> f (Request, PendingWebRequest))
-> (Request, PendingWebRequest)
-> IO (f (Maybe ResponseReceived))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f ()
s1 f ()
-> (Request, PendingWebRequest) -> f (Request, PendingWebRequest)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$>)
IO (f (f ()))
-> Sem
(WithStrategy
IO f (Sem (WithTactics WebServer f (Sem rInitial) r)))
(IO (f (f ())))
forall (m :: * -> *) a. Monad m => a -> m a
return (IO (f (f ()))
-> Sem
(WithStrategy
IO f (Sem (WithTactics WebServer f (Sem rInitial) r)))
(IO (f (f ()))))
-> IO (f (f ()))
-> Sem
(WithStrategy
IO f (Sem (WithTactics WebServer f (Sem rInitial) r)))
(IO (f (f ())))
forall a b. (a -> b) -> a -> b
$ do
let
doRequestIO :: Wai.Request -> (Wai.Response -> IO Wai.ResponseReceived) ->
IO Wai.ResponseReceived
doRequestIO :: Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived
doRequestIO Request
req Response -> IO ResponseReceived
respond = do
Maybe ResponseReceived
maybeRR <- (Request, PendingWebRequest) -> IO (Maybe ResponseReceived)
appFn' (Request
req, (Response -> IO ResponseReceived) -> PendingWebRequest
PendingWebRequest Response -> IO ResponseReceived
respond)
case Maybe ResponseReceived
maybeRR of
Just ResponseReceived
rr -> ResponseReceived -> IO ResponseReceived
forall (m :: * -> *) a. Monad m => a -> m a
return ResponseReceived
rr
Maybe ResponseReceived
Nothing -> Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$
Status -> ResponseHeaders -> ByteString -> Response
Wai.responseLBS (Status
HTTP.status500) [] ByteString
"Internal server error"
Int
-> (Request
-> (Response -> IO ResponseReceived) -> IO ResponseReceived)
-> IO ()
Warp.run Int
port ((Request
-> (Response -> IO ResponseReceived) -> IO ResponseReceived)
-> IO ())
-> (Request
-> (Response -> IO ResponseReceived) -> IO ResponseReceived)
-> IO ()
forall a b. (a -> b) -> a -> b
$ \Request
req Response -> IO ResponseReceived
reply -> Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived
doRequestIO Request
req Response -> IO ResponseReceived
reply
f (f ()) -> IO (f (f ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (f (f ()) -> IO (f (f ()))) -> f (f ()) -> IO (f (f ()))
forall a b. (a -> b) -> a -> b
$ f ()
s1 f () -> f () -> f (f ())
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> f ()
s0
runStartWebServerSettings :: forall rInitial r f.
((Final IO) `Member` r, Functor f) =>
Warp.Settings -> (
Wai.Request -> PendingWebRequest ->
Sem rInitial Wai.ResponseReceived) ->
Sem (WithTactics WebServer f (Sem rInitial) r) (f ())
runStartWebServerSettings :: Settings
-> (Request -> PendingWebRequest -> Sem rInitial ResponseReceived)
-> Sem (WithTactics WebServer f (Sem rInitial) r) (f ())
runStartWebServerSettings Settings
settings Request -> PendingWebRequest -> Sem rInitial ResponseReceived
app = do
f ()
s0 <- Sem (WithTactics WebServer f (Sem rInitial) r) (f ())
forall (f :: * -> *) (m :: * -> *) (r :: [Effect]) (e :: Effect).
Sem (WithTactics e f m r) (f ())
getInitialStateT
f (Request, PendingWebRequest)
-> Sem (WebServer : r) (f ResponseReceived)
appFnS <- ((Request, PendingWebRequest) -> Sem rInitial ResponseReceived)
-> Sem
(WithTactics WebServer f (Sem rInitial) r)
(f (Request, PendingWebRequest)
-> Sem (WebServer : r) (f ResponseReceived))
forall a (m :: * -> *) b (e :: Effect) (f :: * -> *)
(r :: [Effect]).
(a -> m b) -> Sem (WithTactics e f m r) (f a -> Sem (e : r) (f b))
bindT (((Request, PendingWebRequest) -> Sem rInitial ResponseReceived)
-> Sem
(WithTactics WebServer f (Sem rInitial) r)
(f (Request, PendingWebRequest)
-> Sem (WebServer : r) (f ResponseReceived)))
-> ((Request, PendingWebRequest) -> Sem rInitial ResponseReceived)
-> Sem
(WithTactics WebServer f (Sem rInitial) r)
(f (Request, PendingWebRequest)
-> Sem (WebServer : r) (f ResponseReceived))
forall a b. (a -> b) -> a -> b
$ (Request -> PendingWebRequest -> Sem rInitial ResponseReceived)
-> (Request, PendingWebRequest) -> Sem rInitial ResponseReceived
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Request -> PendingWebRequest -> Sem rInitial ResponseReceived
app
Inspector f
ins <- Sem (WithTactics WebServer f (Sem rInitial) r) (Inspector f)
forall (e :: Effect) (f :: * -> *) (m :: * -> *) (r :: [Effect]).
Sem (WithTactics e f m r) (Inspector f)
getInspectorT
let
appFn :: (Wai.Request, PendingWebRequest) ->
Sem r (Maybe Wai.ResponseReceived)
appFn :: (Request, PendingWebRequest) -> Sem r (Maybe ResponseReceived)
appFn = Sem (WebServer : r) (Maybe ResponseReceived)
-> Sem r (Maybe ResponseReceived)
forall (r :: [Effect]) a.
Member (Final IO) r =>
Sem (WebServer : r) a -> Sem r a
runWebServerFinal (Sem (WebServer : r) (Maybe ResponseReceived)
-> Sem r (Maybe ResponseReceived))
-> ((Request, PendingWebRequest)
-> Sem (WebServer : r) (Maybe ResponseReceived))
-> (Request, PendingWebRequest)
-> Sem r (Maybe ResponseReceived)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((f ResponseReceived -> Maybe ResponseReceived)
-> Sem (WebServer : r) (f ResponseReceived)
-> Sem (WebServer : r) (Maybe ResponseReceived)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Inspector f -> forall x. f x -> Maybe x
forall (f :: * -> *). Inspector f -> forall x. f x -> Maybe x
inspect Inspector f
ins)) (Sem (WebServer : r) (f ResponseReceived)
-> Sem (WebServer : r) (Maybe ResponseReceived))
-> ((Request, PendingWebRequest)
-> Sem (WebServer : r) (f ResponseReceived))
-> (Request, PendingWebRequest)
-> Sem (WebServer : r) (Maybe ResponseReceived)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Request, PendingWebRequest)
-> Sem (WebServer : r) (f ResponseReceived)
appFnS (f (Request, PendingWebRequest)
-> Sem (WebServer : r) (f ResponseReceived))
-> ((Request, PendingWebRequest) -> f (Request, PendingWebRequest))
-> (Request, PendingWebRequest)
-> Sem (WebServer : r) (f ResponseReceived)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f ()
s0 f ()
-> (Request, PendingWebRequest) -> f (Request, PendingWebRequest)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$>)
Strategic
IO (Sem (WithTactics WebServer f (Sem rInitial) r)) (f ())
-> Sem (WithTactics WebServer f (Sem rInitial) r) (f ())
forall (m :: * -> *) (r :: [Effect]) a.
Member (Final m) r =>
Strategic m (Sem r) a -> Sem r a
withStrategicToFinal (Strategic
IO (Sem (WithTactics WebServer f (Sem rInitial) r)) (f ())
-> Sem (WithTactics WebServer f (Sem rInitial) r) (f ()))
-> Strategic
IO (Sem (WithTactics WebServer f (Sem rInitial) r)) (f ())
-> Sem (WithTactics WebServer f (Sem rInitial) r) (f ())
forall a b. (a -> b) -> a -> b
$ do
f (Request, PendingWebRequest) -> IO (f (Maybe ResponseReceived))
appFnS' <- ((Request, PendingWebRequest)
-> Sem
(WithTactics WebServer f (Sem rInitial) r)
(Maybe ResponseReceived))
-> Sem
(WithStrategy
IO f (Sem (WithTactics WebServer f (Sem rInitial) r)))
(f (Request, PendingWebRequest) -> IO (f (Maybe ResponseReceived)))
forall a (n :: * -> *) b (m :: * -> *) (f :: * -> *).
(a -> n b) -> Sem (WithStrategy m f n) (f a -> m (f b))
bindS (Sem r (Maybe ResponseReceived)
-> Sem
(WithTactics WebServer f (Sem rInitial) r) (Maybe ResponseReceived)
forall (e :: Effect) (r :: [Effect]) a. Sem r a -> Sem (e : r) a
raise (Sem r (Maybe ResponseReceived)
-> Sem
(WithTactics WebServer f (Sem rInitial) r)
(Maybe ResponseReceived))
-> ((Request, PendingWebRequest) -> Sem r (Maybe ResponseReceived))
-> (Request, PendingWebRequest)
-> Sem
(WithTactics WebServer f (Sem rInitial) r) (Maybe ResponseReceived)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Request, PendingWebRequest) -> Sem r (Maybe ResponseReceived)
appFn)
Inspector f
ins' <- Sem
(WithStrategy
IO f (Sem (WithTactics WebServer f (Sem rInitial) r)))
(Inspector f)
forall (m :: * -> *) (f :: * -> *) (n :: * -> *).
Sem (WithStrategy m f n) (Inspector f)
getInspectorS
f ()
s1 <- Sem
(WithStrategy
IO f (Sem (WithTactics WebServer f (Sem rInitial) r)))
(f ())
forall (m :: * -> *) (f :: * -> *) (n :: * -> *).
Sem (WithStrategy m f n) (f ())
getInitialStateS
let
appFn' :: (Wai.Request, PendingWebRequest) ->
IO (Maybe Wai.ResponseReceived)
appFn' :: (Request, PendingWebRequest) -> IO (Maybe ResponseReceived)
appFn' = ((f (Maybe ResponseReceived) -> Maybe ResponseReceived)
-> IO (f (Maybe ResponseReceived)) -> IO (Maybe ResponseReceived)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe (Maybe ResponseReceived) -> Maybe ResponseReceived
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe ResponseReceived) -> Maybe ResponseReceived)
-> (f (Maybe ResponseReceived) -> Maybe (Maybe ResponseReceived))
-> f (Maybe ResponseReceived)
-> Maybe ResponseReceived
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inspector f -> forall x. f x -> Maybe x
forall (f :: * -> *). Inspector f -> forall x. f x -> Maybe x
inspect Inspector f
ins')) (IO (f (Maybe ResponseReceived)) -> IO (Maybe ResponseReceived))
-> ((Request, PendingWebRequest)
-> IO (f (Maybe ResponseReceived)))
-> (Request, PendingWebRequest)
-> IO (Maybe ResponseReceived)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Request, PendingWebRequest) -> IO (f (Maybe ResponseReceived))
appFnS' (f (Request, PendingWebRequest) -> IO (f (Maybe ResponseReceived)))
-> ((Request, PendingWebRequest) -> f (Request, PendingWebRequest))
-> (Request, PendingWebRequest)
-> IO (f (Maybe ResponseReceived))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f ()
s1 f ()
-> (Request, PendingWebRequest) -> f (Request, PendingWebRequest)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$>)
IO (f (f ()))
-> Sem
(WithStrategy
IO f (Sem (WithTactics WebServer f (Sem rInitial) r)))
(IO (f (f ())))
forall (m :: * -> *) a. Monad m => a -> m a
return (IO (f (f ()))
-> Sem
(WithStrategy
IO f (Sem (WithTactics WebServer f (Sem rInitial) r)))
(IO (f (f ()))))
-> IO (f (f ()))
-> Sem
(WithStrategy
IO f (Sem (WithTactics WebServer f (Sem rInitial) r)))
(IO (f (f ())))
forall a b. (a -> b) -> a -> b
$ do
let
doRequestIO :: Wai.Request -> (Wai.Response -> IO Wai.ResponseReceived) ->
IO Wai.ResponseReceived
doRequestIO :: Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived
doRequestIO Request
req Response -> IO ResponseReceived
respond = do
Maybe ResponseReceived
maybeRR <- (Request, PendingWebRequest) -> IO (Maybe ResponseReceived)
appFn' (Request
req, (Response -> IO ResponseReceived) -> PendingWebRequest
PendingWebRequest Response -> IO ResponseReceived
respond)
case Maybe ResponseReceived
maybeRR of
Just ResponseReceived
rr -> ResponseReceived -> IO ResponseReceived
forall (m :: * -> *) a. Monad m => a -> m a
return ResponseReceived
rr
Maybe ResponseReceived
Nothing -> Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$
Status -> ResponseHeaders -> ByteString -> Response
Wai.responseLBS (Status
HTTP.status500) [] ByteString
"Internal server error"
Settings
-> (Request
-> (Response -> IO ResponseReceived) -> IO ResponseReceived)
-> IO ()
Warp.runSettings Settings
settings ((Request
-> (Response -> IO ResponseReceived) -> IO ResponseReceived)
-> IO ())
-> (Request
-> (Response -> IO ResponseReceived) -> IO ResponseReceived)
-> IO ()
forall a b. (a -> b) -> a -> b
$ \Request
req Response -> IO ResponseReceived
reply -> Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived
doRequestIO Request
req Response -> IO ResponseReceived
reply
f (f ()) -> IO (f (f ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (f (f ()) -> IO (f (f ()))) -> f (f ()) -> IO (f (f ()))
forall a b. (a -> b) -> a -> b
$ f ()
s1 f () -> f () -> f (f ())
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> f ()
s0
ioToWebServerTactics ::
forall a rInitial r f. (Functor f, Final IO `Member` r) =>
IO a -> Sem (WithTactics WebServer f (Sem rInitial) r) (f a)
ioToWebServerTactics :: IO a -> Sem (WithTactics WebServer f (Sem rInitial) r) (f a)
ioToWebServerTactics IO a
action = a -> Sem (WithTactics WebServer f (Sem rInitial) r) (f a)
forall (f :: * -> *) a (e :: Effect) (m :: * -> *) (r :: [Effect]).
Functor f =>
a -> Sem (WithTactics e f m r) (f a)
pureT (a -> Sem (WithTactics WebServer f (Sem rInitial) r) (f a))
-> Sem (WithTactics WebServer f (Sem rInitial) r) a
-> Sem (WithTactics WebServer f (Sem rInitial) r) (f a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO a -> Sem (WithTactics WebServer f (Sem rInitial) r) a
forall (m :: * -> *) (r :: [Effect]) a.
(Member (Final m) r, Functor m) =>
m a -> Sem r a
embedFinal IO a
action
runRespondWebRequest :: forall rInitial r f.
((Final IO) `Member` r, Functor f) =>
PendingWebRequest -> Wai.Response ->
Sem (WithTactics WebServer f (Sem rInitial) r) (f Wai.ResponseReceived)
runRespondWebRequest :: PendingWebRequest
-> Response
-> Sem
(WithTactics WebServer f (Sem rInitial) r) (f ResponseReceived)
runRespondWebRequest (PendingWebRequest Response -> IO ResponseReceived
respond) Response
resp =
IO ResponseReceived
-> Sem
(WithTactics WebServer f (Sem rInitial) r) (f ResponseReceived)
forall a (rInitial :: [Effect]) (r :: [Effect]) (f :: * -> *).
(Functor f, Member (Final IO) r) =>
IO a -> Sem (WithTactics WebServer f (Sem rInitial) r) (f a)
ioToWebServerTactics (Response -> IO ResponseReceived
respond Response
resp)
runGetBody :: forall rInitial r f.
((Final IO) `Member` r, Functor f) =>
Int -> Wai.Request ->
Sem (WithTactics WebServer f (Sem rInitial) r) (f (Maybe BS.ByteString))
runGetBody :: Int
-> Request
-> Sem
(WithTactics WebServer f (Sem rInitial) r) (f (Maybe ByteString))
runGetBody Int
maxLen Request
req = do
ByteString
body <- IO ByteString
-> Sem (WithTactics WebServer f (Sem rInitial) r) ByteString
forall (m :: * -> *) (r :: [Effect]) a.
(Member (Final m) r, Functor m) =>
m a -> Sem r a
embedFinal (IO ByteString
-> Sem (WithTactics WebServer f (Sem rInitial) r) ByteString)
-> IO ByteString
-> Sem (WithTactics WebServer f (Sem rInitial) r) ByteString
forall a b. (a -> b) -> a -> b
$ Request -> IO ByteString
Wai.lazyRequestBody Request
req
let strictBody :: ByteString
strictBody = ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int64 -> ByteString -> ByteString
LBS.take (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> Int -> Int64
forall a b. (a -> b) -> a -> b
$ Int
maxLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ByteString
body
if ByteString -> Int
BS.length ByteString
strictBody Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxLen
then Maybe ByteString
-> Sem
(WithTactics WebServer f (Sem rInitial) r) (f (Maybe ByteString))
forall (f :: * -> *) a (e :: Effect) (m :: * -> *) (r :: [Effect]).
Functor f =>
a -> Sem (WithTactics e f m r) (f a)
pureT Maybe ByteString
forall a. Maybe a
Nothing
else Maybe ByteString
-> Sem
(WithTactics WebServer f (Sem rInitial) r) (f (Maybe ByteString))
forall (f :: * -> *) a (e :: Effect) (m :: * -> *) (r :: [Effect]).
Functor f =>
a -> Sem (WithTactics e f m r) (f a)
pureT (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
strictBody)
runUpgradeToWebSocketsResponse :: forall rInitial r f. (Final IO `Member` r, Functor f) =>
WS.ConnectionOptions ->
(WS.PendingConnection -> Sem rInitial ()) ->
Wai.Request ->
Sem (WithTactics WebServer f (Sem rInitial) r) (f (Maybe Wai.Response))
runUpgradeToWebSocketsResponse :: ConnectionOptions
-> (PendingConnection -> Sem rInitial ())
-> Request
-> Sem
(WithTactics WebServer f (Sem rInitial) r) (f (Maybe Response))
runUpgradeToWebSocketsResponse ConnectionOptions
opts PendingConnection -> Sem rInitial ()
app Request
req = do
f ()
stT <- Sem (WithTactics WebServer f (Sem rInitial) r) (f ())
forall (f :: * -> *) (m :: * -> *) (r :: [Effect]) (e :: Effect).
Sem (WithTactics e f m r) (f ())
getInitialStateT
f PendingConnection -> Sem (WebServer : r) (f ())
boundTApp' <- (PendingConnection -> Sem rInitial ())
-> Sem
(WithTactics WebServer f (Sem rInitial) r)
(f PendingConnection -> Sem (WebServer : r) (f ()))
forall a (m :: * -> *) b (e :: Effect) (f :: * -> *)
(r :: [Effect]).
(a -> m b) -> Sem (WithTactics e f m r) (f a -> Sem (e : r) (f b))
bindT PendingConnection -> Sem rInitial ()
app
let boundTApp :: WS.PendingConnection -> Sem r ()
boundTApp :: PendingConnection -> Sem r ()
boundTApp = Sem (WebServer : r) () -> Sem r ()
forall (r :: [Effect]) a.
Member (Final IO) r =>
Sem (WebServer : r) a -> Sem r a
runWebServerFinal (Sem (WebServer : r) () -> Sem r ())
-> (PendingConnection -> Sem (WebServer : r) ())
-> PendingConnection
-> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sem (WebServer : r) (f ()) -> () -> Sem (WebServer : r) ()
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()) (Sem (WebServer : r) (f ()) -> Sem (WebServer : r) ())
-> (PendingConnection -> Sem (WebServer : r) (f ()))
-> PendingConnection
-> Sem (WebServer : r) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f PendingConnection -> Sem (WebServer : r) (f ())
boundTApp' (f PendingConnection -> Sem (WebServer : r) (f ()))
-> (PendingConnection -> f PendingConnection)
-> PendingConnection
-> Sem (WebServer : r) (f ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f ()
stT f () -> PendingConnection -> f PendingConnection
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$>)
Strategic
IO
(Sem (WithTactics WebServer f (Sem rInitial) r))
(f (Maybe Response))
-> Sem
(WithTactics WebServer f (Sem rInitial) r) (f (Maybe Response))
forall (m :: * -> *) (r :: [Effect]) a.
Member (Final m) r =>
Strategic m (Sem r) a -> Sem r a
withStrategicToFinal (Strategic
IO
(Sem (WithTactics WebServer f (Sem rInitial) r))
(f (Maybe Response))
-> Sem
(WithTactics WebServer f (Sem rInitial) r) (f (Maybe Response)))
-> Strategic
IO
(Sem (WithTactics WebServer f (Sem rInitial) r))
(f (Maybe Response))
-> Sem
(WithTactics WebServer f (Sem rInitial) r) (f (Maybe Response))
forall a b. (a -> b) -> a -> b
$ do
f ()
stS <- Sem
(WithStrategy
IO f (Sem (WithTactics WebServer f (Sem rInitial) r)))
(f ())
forall (m :: * -> *) (f :: * -> *) (n :: * -> *).
Sem (WithStrategy m f n) (f ())
getInitialStateS
f PendingConnection -> IO (f ())
boundTSApp' <- (PendingConnection
-> Sem (WithTactics WebServer f (Sem rInitial) r) ())
-> Sem
(WithStrategy
IO f (Sem (WithTactics WebServer f (Sem rInitial) r)))
(f PendingConnection -> IO (f ()))
forall a (n :: * -> *) b (m :: * -> *) (f :: * -> *).
(a -> n b) -> Sem (WithStrategy m f n) (f a -> m (f b))
bindS (Sem r () -> Sem (WithTactics WebServer f (Sem rInitial) r) ()
forall (e :: Effect) (r :: [Effect]) a. Sem r a -> Sem (e : r) a
raise (Sem r () -> Sem (WithTactics WebServer f (Sem rInitial) r) ())
-> (PendingConnection -> Sem r ())
-> PendingConnection
-> Sem (WithTactics WebServer f (Sem rInitial) r) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PendingConnection -> Sem r ()
boundTApp)
let boundTSApp :: WS.PendingConnection -> IO ()
boundTSApp :: PendingConnection -> IO ()
boundTSApp = (IO (f ()) -> () -> IO ()
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()) (IO (f ()) -> IO ())
-> (PendingConnection -> IO (f ())) -> PendingConnection -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f PendingConnection -> IO (f ())
boundTSApp' (f PendingConnection -> IO (f ()))
-> (PendingConnection -> f PendingConnection)
-> PendingConnection
-> IO (f ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f ()
stS f () -> PendingConnection -> f PendingConnection
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$>)
finalResp :: Maybe Wai.Response
finalResp :: Maybe Response
finalResp = ConnectionOptions
-> (PendingConnection -> IO ()) -> Request -> Maybe Response
WaiWs.websocketsApp ConnectionOptions
opts PendingConnection -> IO ()
boundTSApp Request
req
IO (f (f (Maybe Response)))
-> Sem
(WithStrategy
IO f (Sem (WithTactics WebServer f (Sem rInitial) r)))
(IO (f (f (Maybe Response))))
forall (m :: * -> *) a. Monad m => a -> m a
return (IO (f (f (Maybe Response)))
-> Sem
(WithStrategy
IO f (Sem (WithTactics WebServer f (Sem rInitial) r)))
(IO (f (f (Maybe Response)))))
-> (f (f (Maybe Response)) -> IO (f (f (Maybe Response))))
-> f (f (Maybe Response))
-> Sem
(WithStrategy
IO f (Sem (WithTactics WebServer f (Sem rInitial) r)))
(IO (f (f (Maybe Response))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (f (Maybe Response)) -> IO (f (f (Maybe Response)))
forall (m :: * -> *) a. Monad m => a -> m a
return (f (f (Maybe Response))
-> Sem
(WithStrategy
IO f (Sem (WithTactics WebServer f (Sem rInitial) r)))
(IO (f (f (Maybe Response)))))
-> f (f (Maybe Response))
-> Sem
(WithStrategy
IO f (Sem (WithTactics WebServer f (Sem rInitial) r)))
(IO (f (f (Maybe Response))))
forall a b. (a -> b) -> a -> b
$ f ()
stS f () -> f (Maybe Response) -> f (f (Maybe Response))
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (f ()
stT f () -> Maybe Response -> f (Maybe Response)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe Response
finalResp)
runAcceptPendingWebSocketConnection ::
(Final IO `Member` r, Functor f) =>
WS.PendingConnection ->
WS.AcceptRequest ->
Sem (WithTactics WebServer f (Sem rInitial) r) (
f (Either (Either WS.HandshakeException WS.ConnectionException)
WS.Connection))
runAcceptPendingWebSocketConnection :: PendingConnection
-> AcceptRequest
-> Sem
(WithTactics WebServer f (Sem rInitial) r)
(f (Either
(Either HandshakeException ConnectionException) Connection))
runAcceptPendingWebSocketConnection PendingConnection
conn AcceptRequest
opts =
IO
(Either (Either HandshakeException ConnectionException) Connection)
-> Sem
(WithTactics WebServer f (Sem rInitial) r)
(f (Either
(Either HandshakeException ConnectionException) Connection))
forall a (rInitial :: [Effect]) (r :: [Effect]) (f :: * -> *).
(Functor f, Member (Final IO) r) =>
IO a -> Sem (WithTactics WebServer f (Sem rInitial) r) (f a)
ioToWebServerTactics IO
(Either (Either HandshakeException ConnectionException) Connection)
inIO
where
inIO :: IO (Either
(Either WS.HandshakeException WS.ConnectionException)
WS.Connection)
inIO :: IO
(Either (Either HandshakeException ConnectionException) Connection)
inIO = IO
(Either (Either HandshakeException ConnectionException) Connection)
-> (HandshakeException
-> IO
(Either
(Either HandshakeException ConnectionException) Connection))
-> IO
(Either (Either HandshakeException ConnectionException) Connection)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (IO
(Either (Either HandshakeException ConnectionException) Connection)
-> (ConnectionException
-> IO
(Either
(Either HandshakeException ConnectionException) Connection))
-> IO
(Either (Either HandshakeException ConnectionException) Connection)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (Connection
-> Either
(Either HandshakeException ConnectionException) Connection
forall a b. b -> Either a b
Right (Connection
-> Either
(Either HandshakeException ConnectionException) Connection)
-> IO Connection
-> IO
(Either (Either HandshakeException ConnectionException) Connection)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PendingConnection -> AcceptRequest -> IO Connection
WS.acceptRequestWith PendingConnection
conn AcceptRequest
opts)
(Either (Either HandshakeException ConnectionException) Connection
-> IO
(Either (Either HandshakeException ConnectionException) Connection)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Either HandshakeException ConnectionException) Connection
-> IO
(Either
(Either HandshakeException ConnectionException) Connection))
-> (ConnectionException
-> Either
(Either HandshakeException ConnectionException) Connection)
-> ConnectionException
-> IO
(Either (Either HandshakeException ConnectionException) Connection)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either HandshakeException ConnectionException
-> Either
(Either HandshakeException ConnectionException) Connection
forall a b. a -> Either a b
Left (Either HandshakeException ConnectionException
-> Either
(Either HandshakeException ConnectionException) Connection)
-> (ConnectionException
-> Either HandshakeException ConnectionException)
-> ConnectionException
-> Either
(Either HandshakeException ConnectionException) Connection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnectionException
-> Either HandshakeException ConnectionException
forall a b. b -> Either a b
Right))
(Either (Either HandshakeException ConnectionException) Connection
-> IO
(Either (Either HandshakeException ConnectionException) Connection)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Either HandshakeException ConnectionException) Connection
-> IO
(Either
(Either HandshakeException ConnectionException) Connection))
-> (HandshakeException
-> Either
(Either HandshakeException ConnectionException) Connection)
-> HandshakeException
-> IO
(Either (Either HandshakeException ConnectionException) Connection)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either HandshakeException ConnectionException
-> Either
(Either HandshakeException ConnectionException) Connection
forall a b. a -> Either a b
Left (Either HandshakeException ConnectionException
-> Either
(Either HandshakeException ConnectionException) Connection)
-> (HandshakeException
-> Either HandshakeException ConnectionException)
-> HandshakeException
-> Either
(Either HandshakeException ConnectionException) Connection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HandshakeException -> Either HandshakeException ConnectionException
forall a b. a -> Either a b
Left)
runWhilePingingWebSocket :: forall rInitial a r f.
(Final IO `Member` r, Functor f) =>
WS.Connection -> Int -> Sem rInitial a ->
Sem (WithTactics WebServer f (Sem rInitial) r) (f (Maybe a))
runWhilePingingWebSocket :: Connection
-> Int
-> Sem rInitial a
-> Sem (WithTactics WebServer f (Sem rInitial) r) (f (Maybe a))
runWhilePingingWebSocket Connection
conn Int
n Sem rInitial a
app = do
f ()
stT <- Sem (WithTactics WebServer f (Sem rInitial) r) (f ())
forall (f :: * -> *) (m :: * -> *) (r :: [Effect]) (e :: Effect).
Sem (WithTactics e f m r) (f ())
getInitialStateT
Sem (WebServer : r) (f a)
appT' <- Sem rInitial a
-> Sem
(WithTactics WebServer f (Sem rInitial) r)
(Sem (WebServer : r) (f a))
forall (m :: * -> *) a (e :: Effect) (f :: * -> *) (r :: [Effect]).
m a -> Sem (WithTactics e f m r) (Sem (e : r) (f a))
runT Sem rInitial a
app
Inspector f
insT <- Sem (WithTactics WebServer f (Sem rInitial) r) (Inspector f)
forall (e :: Effect) (f :: * -> *) (m :: * -> *) (r :: [Effect]).
Sem (WithTactics e f m r) (Inspector f)
getInspectorT
let
appT :: Sem r (Maybe a)
appT :: Sem r (Maybe a)
appT = (Inspector f -> forall x. f x -> Maybe x
forall (f :: * -> *). Inspector f -> forall x. f x -> Maybe x
inspect Inspector f
insT) (f a -> Maybe a) -> Sem r (f a) -> Sem r (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sem (WebServer : r) (f a) -> Sem r (f a)
forall (r :: [Effect]) a.
Member (Final IO) r =>
Sem (WebServer : r) a -> Sem r a
runWebServerFinal Sem (WebServer : r) (f a)
appT'
Strategic
IO (Sem (WithTactics WebServer f (Sem rInitial) r)) (f (Maybe a))
-> Sem (WithTactics WebServer f (Sem rInitial) r) (f (Maybe a))
forall (m :: * -> *) (r :: [Effect]) a.
Member (Final m) r =>
Strategic m (Sem r) a -> Sem r a
withStrategicToFinal (Strategic
IO (Sem (WithTactics WebServer f (Sem rInitial) r)) (f (Maybe a))
-> Sem (WithTactics WebServer f (Sem rInitial) r) (f (Maybe a)))
-> Strategic
IO (Sem (WithTactics WebServer f (Sem rInitial) r)) (f (Maybe a))
-> Sem (WithTactics WebServer f (Sem rInitial) r) (f (Maybe a))
forall a b. (a -> b) -> a -> b
$ do
IO (f (Maybe a))
appTS' <- Sem (WithTactics WebServer f (Sem rInitial) r) (Maybe a)
-> Sem
(WithStrategy
IO f (Sem (WithTactics WebServer f (Sem rInitial) r)))
(IO (f (Maybe a)))
forall (n :: * -> *) a (m :: * -> *) (f :: * -> *).
n a -> Sem (WithStrategy m f n) (m (f a))
runS (Sem r (Maybe a)
-> Sem (WithTactics WebServer f (Sem rInitial) r) (Maybe a)
forall (e :: Effect) (r :: [Effect]) a. Sem r a -> Sem (e : r) a
raise Sem r (Maybe a)
appT)
f ()
stS <- Sem
(WithStrategy
IO f (Sem (WithTactics WebServer f (Sem rInitial) r)))
(f ())
forall (m :: * -> *) (f :: * -> *) (n :: * -> *).
Sem (WithStrategy m f n) (f ())
getInitialStateS
Inspector f
insS <- Sem
(WithStrategy
IO f (Sem (WithTactics WebServer f (Sem rInitial) r)))
(Inspector f)
forall (m :: * -> *) (f :: * -> *) (n :: * -> *).
Sem (WithStrategy m f n) (Inspector f)
getInspectorS
let appTS :: IO (Maybe a)
appTS :: IO (Maybe a)
appTS = (Maybe (Maybe a) -> Maybe a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe a) -> Maybe a)
-> (f (Maybe a) -> Maybe (Maybe a)) -> f (Maybe a) -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inspector f -> forall x. f x -> Maybe x
forall (f :: * -> *). Inspector f -> forall x. f x -> Maybe x
inspect Inspector f
insS) (f (Maybe a) -> Maybe a) -> IO (f (Maybe a)) -> IO (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (f (Maybe a))
appTS'
IO (f (f (Maybe a)))
-> Sem
(WithStrategy
IO f (Sem (WithTactics WebServer f (Sem rInitial) r)))
(IO (f (f (Maybe a))))
forall (m :: * -> *) a. Monad m => a -> m a
return (IO (f (f (Maybe a)))
-> Sem
(WithStrategy
IO f (Sem (WithTactics WebServer f (Sem rInitial) r)))
(IO (f (f (Maybe a)))))
-> IO (f (f (Maybe a)))
-> Sem
(WithStrategy
IO f (Sem (WithTactics WebServer f (Sem rInitial) r)))
(IO (f (f (Maybe a))))
forall a b. (a -> b) -> a -> b
$ ((f ()
stS f () -> f (Maybe a) -> f (f (Maybe a))
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$>) (f (Maybe a) -> f (f (Maybe a)))
-> (Maybe a -> f (Maybe a)) -> Maybe a -> f (f (Maybe a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f ()
stT f () -> Maybe a -> f (Maybe a)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$>)) (Maybe a -> f (f (Maybe a)))
-> IO (Maybe a) -> IO (f (f (Maybe a)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> Int -> IO () -> IO (Maybe a) -> IO (Maybe a)
forall a. Connection -> Int -> IO () -> IO a -> IO a
WS.withPingThread Connection
conn Int
n (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) IO (Maybe a)
appTS
runReceiveWebSocketDataMessage :: forall rInitial r f.
(Final IO `Member` r, Functor f) =>
WS.Connection ->
Sem (WithTactics WebServer f (Sem rInitial) r) (
f (Either WS.ConnectionException WS.DataMessage))
runReceiveWebSocketDataMessage :: Connection
-> Sem
(WithTactics WebServer f (Sem rInitial) r)
(f (Either ConnectionException DataMessage))
runReceiveWebSocketDataMessage Connection
conn =
IO (Either ConnectionException DataMessage)
-> Sem
(WithTactics WebServer f (Sem rInitial) r)
(f (Either ConnectionException DataMessage))
forall a (rInitial :: [Effect]) (r :: [Effect]) (f :: * -> *).
(Functor f, Member (Final IO) r) =>
IO a -> Sem (WithTactics WebServer f (Sem rInitial) r) (f a)
ioToWebServerTactics IO (Either ConnectionException DataMessage)
inIO
where
inIO :: IO (Either WS.ConnectionException WS.DataMessage)
inIO :: IO (Either ConnectionException DataMessage)
inIO = IO (Either ConnectionException DataMessage)
-> (ConnectionException
-> IO (Either ConnectionException DataMessage))
-> IO (Either ConnectionException DataMessage)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (DataMessage -> Either ConnectionException DataMessage
forall a b. b -> Either a b
Right (DataMessage -> Either ConnectionException DataMessage)
-> IO DataMessage -> IO (Either ConnectionException DataMessage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> IO DataMessage
WS.receiveDataMessage Connection
conn)
(Either ConnectionException DataMessage
-> IO (Either ConnectionException DataMessage)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ConnectionException DataMessage
-> IO (Either ConnectionException DataMessage))
-> (ConnectionException -> Either ConnectionException DataMessage)
-> ConnectionException
-> IO (Either ConnectionException DataMessage)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnectionException -> Either ConnectionException DataMessage
forall a b. a -> Either a b
Left)
runWebServerFinal :: ((Final IO) `Member` r) =>
Sem (WebServer ': r) a -> Sem r a
runWebServerFinal :: Sem (WebServer : r) a -> Sem r a
runWebServerFinal =
(forall (rInitial :: [Effect]) x.
WebServer (Sem rInitial) x
-> Tactical WebServer (Sem rInitial) r x)
-> Sem (WebServer : r) a -> Sem r a
forall (e :: Effect) (r :: [Effect]) a.
(forall (rInitial :: [Effect]) x.
e (Sem rInitial) x -> Tactical e (Sem rInitial) r x)
-> Sem (e : r) a -> Sem r a
interpretH (\WebServer (Sem rInitial) x
v -> case WebServer (Sem rInitial) x
v of
StartWebServer port app -> Int
-> (Request -> PendingWebRequest -> Sem rInitial ResponseReceived)
-> Sem (WithTactics WebServer f (Sem rInitial) r) (f ())
forall (rInitial :: [Effect]) (r :: [Effect]) (f :: * -> *).
(Member (Final IO) r, Functor f) =>
Int
-> (Request -> PendingWebRequest -> Sem rInitial ResponseReceived)
-> Sem (WithTactics WebServer f (Sem rInitial) r) (f ())
runStartWebServer Int
port Request -> PendingWebRequest -> Sem rInitial ResponseReceived
app
StartWebServerSettings settings app -> Settings
-> (Request -> PendingWebRequest -> Sem rInitial ResponseReceived)
-> Sem (WithTactics WebServer f (Sem rInitial) r) (f ())
forall (rInitial :: [Effect]) (r :: [Effect]) (f :: * -> *).
(Member (Final IO) r, Functor f) =>
Settings
-> (Request -> PendingWebRequest -> Sem rInitial ResponseReceived)
-> Sem (WithTactics WebServer f (Sem rInitial) r) (f ())
runStartWebServerSettings Settings
settings Request -> PendingWebRequest -> Sem rInitial ResponseReceived
app
RespondWebRequest reqId response -> PendingWebRequest
-> Response
-> Sem
(WithTactics WebServer f (Sem rInitial) r) (f ResponseReceived)
forall (rInitial :: [Effect]) (r :: [Effect]) (f :: * -> *).
(Member (Final IO) r, Functor f) =>
PendingWebRequest
-> Response
-> Sem
(WithTactics WebServer f (Sem rInitial) r) (f ResponseReceived)
runRespondWebRequest PendingWebRequest
reqId Response
response
GetBody maxLen req -> Int
-> Request
-> Sem
(WithTactics WebServer f (Sem rInitial) r) (f (Maybe ByteString))
forall (rInitial :: [Effect]) (r :: [Effect]) (f :: * -> *).
(Member (Final IO) r, Functor f) =>
Int
-> Request
-> Sem
(WithTactics WebServer f (Sem rInitial) r) (f (Maybe ByteString))
runGetBody Int
maxLen Request
req
UpgradeToWebSocketsResponse opts app req ->
ConnectionOptions
-> (PendingConnection -> Sem rInitial ())
-> Request
-> Sem
(WithTactics WebServer f (Sem rInitial) r) (f (Maybe Response))
forall (rInitial :: [Effect]) (r :: [Effect]) (f :: * -> *).
(Member (Final IO) r, Functor f) =>
ConnectionOptions
-> (PendingConnection -> Sem rInitial ())
-> Request
-> Sem
(WithTactics WebServer f (Sem rInitial) r) (f (Maybe Response))
runUpgradeToWebSocketsResponse ConnectionOptions
opts PendingConnection -> Sem rInitial ()
app Request
req
AcceptPendingWebSocketConnection conn opts ->
PendingConnection
-> AcceptRequest
-> Sem
(WithTactics WebServer f (Sem rInitial) r)
(f (Either
(Either HandshakeException ConnectionException) Connection))
forall (r :: [Effect]) (f :: * -> *) (rInitial :: [Effect]).
(Member (Final IO) r, Functor f) =>
PendingConnection
-> AcceptRequest
-> Sem
(WithTactics WebServer f (Sem rInitial) r)
(f (Either
(Either HandshakeException ConnectionException) Connection))
runAcceptPendingWebSocketConnection PendingConnection
conn AcceptRequest
opts
RejectPendingWebSocketConnection conn opts ->
IO () -> Sem (WithTactics WebServer f (Sem rInitial) r) (f ())
forall a (rInitial :: [Effect]) (r :: [Effect]) (f :: * -> *).
(Functor f, Member (Final IO) r) =>
IO a -> Sem (WithTactics WebServer f (Sem rInitial) r) (f a)
ioToWebServerTactics (PendingConnection -> RejectRequest -> IO ()
WS.rejectRequestWith PendingConnection
conn RejectRequest
opts)
WhilePingingWebSocket conn n app ->
Connection
-> Int
-> Sem rInitial a
-> Sem (WithTactics WebServer f (Sem rInitial) r) (f (Maybe a))
forall (rInitial :: [Effect]) a (r :: [Effect]) (f :: * -> *).
(Member (Final IO) r, Functor f) =>
Connection
-> Int
-> Sem rInitial a
-> Sem (WithTactics WebServer f (Sem rInitial) r) (f (Maybe a))
runWhilePingingWebSocket Connection
conn Int
n Sem rInitial a
app
SendWebSocketDataMessages conn msgs ->
IO () -> Sem (WithTactics WebServer f (Sem rInitial) r) (f ())
forall a (rInitial :: [Effect]) (r :: [Effect]) (f :: * -> *).
(Functor f, Member (Final IO) r) =>
IO a -> Sem (WithTactics WebServer f (Sem rInitial) r) (f a)
ioToWebServerTactics (IO () -> Sem (WithTactics WebServer f (Sem rInitial) r) (f ()))
-> IO () -> Sem (WithTactics WebServer f (Sem rInitial) r) (f ())
forall a b. (a -> b) -> a -> b
$ Connection -> [DataMessage] -> IO ()
WS.sendDataMessages Connection
conn [DataMessage]
msgs
ReceiveWebSocketDataMessage conn ->
Connection
-> Sem
(WithTactics WebServer f (Sem rInitial) r)
(f (Either ConnectionException DataMessage))
forall (rInitial :: [Effect]) (r :: [Effect]) (f :: * -> *).
(Member (Final IO) r, Functor f) =>
Connection
-> Sem
(WithTactics WebServer f (Sem rInitial) r)
(f (Either ConnectionException DataMessage))
runReceiveWebSocketDataMessage Connection
conn
SendWebSocketCloseCode conn code msg ->
IO () -> Sem (WithTactics WebServer f (Sem rInitial) r) (f ())
forall a (rInitial :: [Effect]) (r :: [Effect]) (f :: * -> *).
(Functor f, Member (Final IO) r) =>
IO a -> Sem (WithTactics WebServer f (Sem rInitial) r) (f a)
ioToWebServerTactics (IO () -> Sem (WithTactics WebServer f (Sem rInitial) r) (f ()))
-> IO () -> Sem (WithTactics WebServer f (Sem rInitial) r) (f ())
forall a b. (a -> b) -> a -> b
$ Connection -> Word16 -> a -> IO ()
forall a. WebSocketsData a => Connection -> Word16 -> a -> IO ()
WS.sendCloseCode Connection
conn Word16
code a
msg
)