Start9/registry
2
0
Fork 0
mirror of https://github.com/Start9Labs/registry.git synced 2026-03-26 10:21:51 +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 03c385993e d6a5d980cc
commit 0b4710032c
2 changed files with 19 additions and 12 deletions
Download Patch File Download Diff File Expand all files Collapse all files

25
src/Application.hs
View File

@@ -28,22 +28,25 @@ module Application
import Startlude
import Control.Monad.Logger (liftLoc, runLoggingT)
import Control.Monad.Logger (liftLoc, runLoggingT)
import Data.Default
import Data.IORef
import Database.Persist.Sql
import Database.Persist.Sqlite (createSqlitePool, runSqlPool, sqlDatabase, sqlPoolSize)
import Language.Haskell.TH.Syntax (qLocation)
import Database.Persist.Sqlite (createSqlitePool, runSqlPool, sqlDatabase, sqlPoolSize)
import Language.Haskell.TH.Syntax (qLocation)
import Network.Wai
import Network.Wai.Handler.Warp (Settings, defaultSettings, defaultShouldDisplayException,
getPort, setHost, setOnException, setPort)
import Network.Wai.Handler.Warp (Settings, defaultSettings, defaultShouldDisplayException,
getPort, setHost, setOnException, setPort)
import Network.Wai.Handler.WarpTLS
import Network.Wai.Middleware.Cors (CorsResourcePolicy (..), cors, simpleCorsResourcePolicy)
import Network.Wai.Middleware.RequestLogger (Destination (Logger), IPAddrSource (..), OutputFormat (..),
destination, mkRequestLogger, outputFormat)
import System.Log.FastLogger (defaultBufSize, newStdoutLoggerSet, toLogStr)
import Network.Wai.Middleware.AcceptOverride
import Network.Wai.Middleware.Autohead
import Network.Wai.Middleware.Cors (CorsResourcePolicy (..), cors, simpleCorsResourcePolicy)
import Network.Wai.Middleware.MethodOverride
import Network.Wai.Middleware.RequestLogger (Destination (Logger), IPAddrSource (..), OutputFormat (..),
destination, mkRequestLogger, outputFormat)
import System.Log.FastLogger (defaultBufSize, newStdoutLoggerSet, toLogStr)
import Yesod.Core
import Yesod.Core.Types hiding (Logger)
import Yesod.Core.Types hiding (Logger)
import Yesod.Default.Config2
import Yesod.Persist.Core
@@ -109,7 +112,7 @@ makeApplication foundation = do
let authWare = makeAuthWare foundation
-- Create the WAI application and apply middlewares
appPlain <- toWaiAppPlain foundation
pure . logWare . cors (const . Just $ policy) . authWare . defaultMiddlewaresNoLogging $ appPlain
pure . logWare . cors (const . Just $ policy) . authWare . acceptOverride . autohead . methodOverride $ appPlain
where
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.Types.Semver
import System.FilePath ((<.>))
import System.Posix.Files (fileSize, getFileStatus)
pureLog :: Show a => a -> Handler a
pureLog = liftA2 (*>) ($logInfo . show) pure
@@ -55,7 +56,10 @@ getApp rootDir ext = do
Just (RegisteredAppVersion (_, filePath)) -> do
exists <- liftIO $ doesFileExist filePath
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