diff --git a/src/Handler/Apps.hs b/src/Handler/Apps.hs index 2028110..0f38c51 100644 --- a/src/Handler/Apps.hs +++ b/src/Handler/Apps.hs @@ -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 () diff --git a/src/Handler/Marketplace.hs b/src/Handler/Marketplace.hs index 8ea06a5..6657f5c 100644 --- a/src/Handler/Marketplace.hs +++ b/src/Handler/Marketplace.hs @@ -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 diff --git a/src/Lib/PkgRepository.hs b/src/Lib/PkgRepository.hs index 4897703..f366c4d 100644 --- a/src/Lib/PkgRepository.hs +++ b/src/Lib/PkgRepository.hs @@ -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