Start9/registry
2
0
Fork 0
mirror of https://github.com/Start9Labs/registry.git synced 2026-03-26 02:11:53 +00:00
Code Issues Packages Projects Releases Wiki Activity

switch from conduit responses to file responses

Browse Source
This commit is contained in:
Keagan McClelland
2022-02-15 17:08:34 -07:00
parent 667f425643
commit f8c5697961
3 changed files with 18 additions and 31 deletions
Download Patch File Download Diff File Expand all files Collapse all files

9
src/Handler/Apps.hs
View File

@@ -18,9 +18,11 @@ import Network.HTTP.Types ( status404 )
import System.FilePath ( (<.>)
, takeBaseName
)
import Yesod.Core ( TypedContent
import Yesod.Core ( Content(ContentFile)
, TypedContent
, addHeader
, notFound
, respond
, respondSource
, sendChunkBS
, sendResponseStatus
@@ -78,11 +80,10 @@ getAppR file = do
`orThrow` sendResponseStatus status404 (NotFoundE [i|#{pkg} satisfying #{versionSpec}|])
addPackageHeader pkg version
void $ recordMetrics pkg version
(len, src) <- getPackage pkg version >>= \case
pkgPath <- getPackage pkg version >>= \case
Nothing -> sendResponseStatus status404 (NotFoundE [i|#{pkg}@#{version}|])
Just a -> pure a
addHeader "Content-Length" (show len)
respondSource typeOctet $ src .| awaitForever sendChunkBS
respond typeOctet $ ContentFile pkgPath Nothing
recordMetrics :: PkgId -> Version -> Handler ()

29
src/Handler/Marketplace.hs
View File

@@ -1,10 +1,10 @@
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
module Handler.Marketplace where
@@ -18,11 +18,9 @@ import Startlude hiding ( Any
)
import Conduit ( (.|)
, awaitForever
, dropC
, runConduit
, sinkList
, sourceFile
, takeC
)
import Control.Monad.Logger ( MonadLogger
@@ -109,11 +107,8 @@ import Network.HTTP.Types ( status400
)
import Protolude.Unsafe ( unsafeFromJust )
import Settings
import System.Directory ( getFileSize )
import System.FilePath ( (</>) )
import UnliftIO.Async ( concurrently
, mapConcurrently
)
import UnliftIO.Async ( mapConcurrently )
import UnliftIO.Directory ( listDirectory )
import Util.Shared ( filterDependencyBestVersion
, filterDependencyOsCompatible
@@ -121,7 +116,8 @@ import Util.Shared ( filterDependencyBestVersion
, filterPkgOsCompatible
, getVersionSpecFromQuery
)
import Yesod.Core ( MonadResource
import Yesod.Core ( Content(ContentFile)
, MonadResource
, RenderRoute(renderRoute)
, TypedContent
, YesodRequest(..)
@@ -130,8 +126,7 @@ import Yesod.Core ( MonadResource
, getYesod
, getsYesod
, lookupGetParam
, respondSource
, sendChunkBS
, respond
, sendResponseStatus
, typeOctet
)
@@ -192,10 +187,9 @@ getEosR = do
Nothing -> sendResponseStatus status404 (NotFoundE [i|EOS version satisfying #{spec}|])
Just version -> do
let imgPath = root </> show version </> "eos.img"
(sz, h) <- runDB $ concurrently (liftIO $ getFileSize imgPath) (retrieveHash version imgPath)
addHeader "Content-Length" $ show sz
h <- runDB $ retrieveHash version imgPath
addHeader "x-eos-hash" h
respondSource typeOctet (sourceFile imgPath .| awaitForever sendChunkBS)
respond typeOctet $ ContentFile imgPath Nothing
where
retrieveHash :: Version -> FilePath -> YesodDB RegistryCtx Text
retrieveHash v fp = do
@@ -269,7 +263,6 @@ getPackageListR = do
-- NOTE: if a package's dependencies do not meet the system requirements, it is currently omitted from the list
pkgsWithDependencies <- runDB $ mapConcurrently (getPackageDependencies osPredicate) filteredPackages
PackageListRes <$> mapConcurrently constructPackageListApiRes pkgsWithDependencies
where
defaults = PackageListDefaults { packageListOrder = DESC
, packageListPageLimit = 20

11
src/Lib/PkgRepository.hs
View File

@@ -298,16 +298,9 @@ getHash pkg version = do
let hashPath = root </> show pkg </> show version </> "hash.bin"
liftIO $ readFile hashPath
getPackage :: (MonadResource m, MonadReader r m, Has PkgRepo r)
=> PkgId
-> Version
-> m (Maybe (Integer, ConduitT () ByteString m ()))
getPackage :: (MonadResource m, MonadReader r m, Has PkgRepo r) => PkgId -> Version -> m (Maybe FilePath)
getPackage pkg version = do
root <- asks pkgRepoFileRoot
let pkgPath = root </> show pkg </> show version </> show pkg <.> "s9pk"
found <- doesPathExist pkgPath
if found
then do
n <- getFileSize pkgPath
pure . Just $ (n, sourceFile pkgPath)
else pure Nothing
pure $ if found then Just pkgPath else Nothing