summaryrefslogtreecommitdiff
path: root/lambda-calcul/haskell/src/Minilang/Server.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lambda-calcul/haskell/src/Minilang/Server.hs')
-rw-r--r--lambda-calcul/haskell/src/Minilang/Server.hs33
1 files changed, 23 insertions, 10 deletions
diff --git a/lambda-calcul/haskell/src/Minilang/Server.hs b/lambda-calcul/haskell/src/Minilang/Server.hs
index 5c34db4..8717081 100644
--- a/lambda-calcul/haskell/src/Minilang/Server.hs
+++ b/lambda-calcul/haskell/src/Minilang/Server.hs
@@ -18,19 +18,22 @@ import Data.Text (Text)
import Minilang.Log
import Minilang.REPL.Net
import Network.Wai
-import Network.Wai.Application.Static
import Network.Wai.Handler.Warp as Warp
import Network.Wai.Middleware.RequestLogger
import Network.Wai.Middleware.RequestLogger.JSON
+import Network.Wai.Middleware.Static (addBase, defaultOptions, staticPolicyWithOptions)
+import Servant.Server (serve)
import System.Log.FastLogger (fromLogStr)
-import Control.Concurrent.Async
+import Data.Data (Proxy (..))
+import Minilang.API (LambdaAPI)
+import Minilang.App (lambdaApp)
data Server = Server
- { serverThread :: Maybe (Async ())
- -- ^If the server is running, this will contain the underlying
- , serverPort :: Int
- -- ^The actual port this server is listening on. Useful when
- }
+ { -- | If the server is running, this will contain the underlying
+ serverThread :: Maybe (Async ()),
+ -- | The actual port this server is listening on. Useful when
+ serverPort :: Int
+ }
-- | Starts HTTP server on given port.
-- This server serves static files from public/ directory and also
@@ -40,7 +43,11 @@ startServer serverPort = do
envs <- newTVarIO mempty
logger <- newLog "minilang"
loggerMiddleware <- runHTTPLog logger
- let app = loggerMiddleware $ runNetREPL logger envs staticResources
+ let app =
+ loggerMiddleware $
+ runNetREPL logger envs $
+ staticResources $
+ serveAPI
(port, action) <- startWarp serverPort app
thread <- async action
logInfo logger $ object ["action" .= ("Started" :: Text), "port" .= port]
@@ -58,6 +65,12 @@ startServer serverPort = do
destination = Callback (\str -> logInfo logger (decode @Value $ fromStrict $ fromLogStr str))
}
+serveAPI :: Application
+serveAPI = serve apiProxy lambdaApp
+
+apiProxy :: Proxy LambdaAPI
+apiProxy = Proxy
+
stopServer :: Server -> IO ()
stopServer (Server (Just th) _) = cancel th
stopServer _ = pure ()
@@ -67,5 +80,5 @@ waitServer (Server (Just th) _) = wait th
waitServer _ = pure ()
-- | Serve static resources under `public/` directory
-staticResources :: Application
-staticResources = staticApp (defaultFileServerSettings "public")
+staticResources :: Middleware
+staticResources = staticPolicyWithOptions defaultOptions (addBase "public")