Start9/registry
2
0
Fork 0
mirror of https://github.com/Start9Labs/registry.git synced 2026-04-04 21:59:43 +00:00
Code Issues Packages Projects Releases Wiki Activity

merge

Browse Source
This commit is contained in:
Aaron Greenspan
2020-01-08 00:09:13 -07:00
parent 2bd7472ddd 078381c6dc
commit 66a645804f
2 changed files with 19 additions and 12 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
src/Application.hs
View File

@@ -38,7 +38,10 @@ import Network.Wai
import Network.Wai.Handler.Warp (Settings, defaultSettings, defaultShouldDisplayException, import Network.Wai.Handler.Warp (Settings, defaultSettings, defaultShouldDisplayException,
getPort, setHost, setOnException, setPort) getPort, setHost, setOnException, setPort)
import Network.Wai.Handler.WarpTLS import Network.Wai.Handler.WarpTLS
import Network.Wai.Middleware.AcceptOverride
import Network.Wai.Middleware.Autohead
import Network.Wai.Middleware.Cors (CorsResourcePolicy (..), cors, simpleCorsResourcePolicy) import Network.Wai.Middleware.Cors (CorsResourcePolicy (..), cors, simpleCorsResourcePolicy)
import Network.Wai.Middleware.MethodOverride
import Network.Wai.Middleware.RequestLogger (Destination (Logger), IPAddrSource (..), OutputFormat (..), import Network.Wai.Middleware.RequestLogger (Destination (Logger), IPAddrSource (..), OutputFormat (..),
destination, mkRequestLogger, outputFormat) destination, mkRequestLogger, outputFormat)
import System.Log.FastLogger (defaultBufSize, newStdoutLoggerSet, toLogStr) import System.Log.FastLogger (defaultBufSize, newStdoutLoggerSet, toLogStr)
@@ -109,7 +112,7 @@ makeApplication foundation = do
let authWare = makeAuthWare foundation let authWare = makeAuthWare foundation
-- Create the WAI application and apply middlewares -- Create the WAI application and apply middlewares
appPlain <- toWaiAppPlain foundation appPlain <- toWaiAppPlain foundation
pure . logWare . cors (const . Just $ policy) . authWare . defaultMiddlewaresNoLogging $ appPlain pure . logWare . cors (const . Just $ policy) . authWare . acceptOverride . autohead . methodOverride $ appPlain
where where
policy = simpleCorsResourcePolicy { corsMethods = ["GET", "HEAD", "OPTIONS", "POST", "PATCH", "PUT", "DELETE"], corsRequestHeaders = ["app-version", "Content-Type", "Authorization"] } policy = simpleCorsResourcePolicy { corsMethods = ["GET", "HEAD", "OPTIONS", "POST", "PATCH", "PUT", "DELETE"], corsRequestHeaders = ["app-version", "Content-Type", "Authorization"] }

6
src/Handler/Apps.hs
View File

@@ -24,6 +24,7 @@ import Lib.Registry
import Lib.Semver import Lib.Semver
import Lib.Types.Semver import Lib.Types.Semver
import System.FilePath ((<.>)) import System.FilePath ((<.>))
import System.Posix.Files (fileSize, getFileStatus)
pureLog :: Show a => a -> Handler a pureLog :: Show a => a -> Handler a
pureLog = liftA2 (*>) ($logInfo . show) pure pureLog = liftA2 (*>) ($logInfo . show) pure
@@ -55,7 +56,10 @@ getApp rootDir ext = do
Just (RegisteredAppVersion (_, filePath)) -> do Just (RegisteredAppVersion (_, filePath)) -> do
exists <- liftIO $ doesFileExist filePath exists <- liftIO $ doesFileExist filePath
if exists if exists
then respondSource typePlain $ CB.sourceFile filePath .| awaitForever sendChunkBS then do
sz <- liftIO $ fileSize <$> getFileStatus filePath
addHeader "Content-Length" (show sz)
respondSource typePlain $ CB.sourceFile filePath .| awaitForever sendChunkBS
else notFound else notFound