mirror of
https://github.com/Start9Labs/registry.git
synced 2026-03-30 03:41:57 +00:00
switch from conduit responses to file responses
This commit is contained in:
@@ -18,9 +18,11 @@ import Network.HTTP.Types ( status404 )
|
|||||||
import System.FilePath ( (<.>)
|
import System.FilePath ( (<.>)
|
||||||
, takeBaseName
|
, takeBaseName
|
||||||
)
|
)
|
||||||
import Yesod.Core ( TypedContent
|
import Yesod.Core ( Content(ContentFile)
|
||||||
|
, TypedContent
|
||||||
, addHeader
|
, addHeader
|
||||||
, notFound
|
, notFound
|
||||||
|
, respond
|
||||||
, respondSource
|
, respondSource
|
||||||
, sendChunkBS
|
, sendChunkBS
|
||||||
, sendResponseStatus
|
, sendResponseStatus
|
||||||
@@ -78,11 +80,10 @@ getAppR file = do
|
|||||||
`orThrow` sendResponseStatus status404 (NotFoundE [i|#{pkg} satisfying #{versionSpec}|])
|
`orThrow` sendResponseStatus status404 (NotFoundE [i|#{pkg} satisfying #{versionSpec}|])
|
||||||
addPackageHeader pkg version
|
addPackageHeader pkg version
|
||||||
void $ recordMetrics pkg version
|
void $ recordMetrics pkg version
|
||||||
(len, src) <- getPackage pkg version >>= \case
|
pkgPath <- getPackage pkg version >>= \case
|
||||||
Nothing -> sendResponseStatus status404 (NotFoundE [i|#{pkg}@#{version}|])
|
Nothing -> sendResponseStatus status404 (NotFoundE [i|#{pkg}@#{version}|])
|
||||||
Just a -> pure a
|
Just a -> pure a
|
||||||
addHeader "Content-Length" (show len)
|
respond typeOctet $ ContentFile pkgPath Nothing
|
||||||
respondSource typeOctet $ src .| awaitForever sendChunkBS
|
|
||||||
|
|
||||||
|
|
||||||
recordMetrics :: PkgId -> Version -> Handler ()
|
recordMetrics :: PkgId -> Version -> Handler ()
|
||||||
|
|||||||
@@ -1,10 +1,10 @@
|
|||||||
{-# LANGUAGE RecordWildCards #-}
|
|
||||||
{-# LANGUAGE TypeApplications #-}
|
|
||||||
{-# LANGUAGE TemplateHaskell #-}
|
|
||||||
{-# LANGUAGE DeriveGeneric #-}
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
{-# LANGUAGE QuasiQuotes #-}
|
|
||||||
{-# LANGUAGE TupleSections #-}
|
|
||||||
{-# LANGUAGE FlexibleContexts #-}
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
|
{-# LANGUAGE QuasiQuotes #-}
|
||||||
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
|
{-# LANGUAGE TupleSections #-}
|
||||||
|
{-# LANGUAGE TypeApplications #-}
|
||||||
|
|
||||||
module Handler.Marketplace where
|
module Handler.Marketplace where
|
||||||
|
|
||||||
@@ -18,11 +18,9 @@ import Startlude hiding ( Any
|
|||||||
)
|
)
|
||||||
|
|
||||||
import Conduit ( (.|)
|
import Conduit ( (.|)
|
||||||
, awaitForever
|
|
||||||
, dropC
|
, dropC
|
||||||
, runConduit
|
, runConduit
|
||||||
, sinkList
|
, sinkList
|
||||||
, sourceFile
|
|
||||||
, takeC
|
, takeC
|
||||||
)
|
)
|
||||||
import Control.Monad.Logger ( MonadLogger
|
import Control.Monad.Logger ( MonadLogger
|
||||||
@@ -109,11 +107,8 @@ import Network.HTTP.Types ( status400
|
|||||||
)
|
)
|
||||||
import Protolude.Unsafe ( unsafeFromJust )
|
import Protolude.Unsafe ( unsafeFromJust )
|
||||||
import Settings
|
import Settings
|
||||||
import System.Directory ( getFileSize )
|
|
||||||
import System.FilePath ( (</>) )
|
import System.FilePath ( (</>) )
|
||||||
import UnliftIO.Async ( concurrently
|
import UnliftIO.Async ( mapConcurrently )
|
||||||
, mapConcurrently
|
|
||||||
)
|
|
||||||
import UnliftIO.Directory ( listDirectory )
|
import UnliftIO.Directory ( listDirectory )
|
||||||
import Util.Shared ( filterDependencyBestVersion
|
import Util.Shared ( filterDependencyBestVersion
|
||||||
, filterDependencyOsCompatible
|
, filterDependencyOsCompatible
|
||||||
@@ -121,7 +116,8 @@ import Util.Shared ( filterDependencyBestVersion
|
|||||||
, filterPkgOsCompatible
|
, filterPkgOsCompatible
|
||||||
, getVersionSpecFromQuery
|
, getVersionSpecFromQuery
|
||||||
)
|
)
|
||||||
import Yesod.Core ( MonadResource
|
import Yesod.Core ( Content(ContentFile)
|
||||||
|
, MonadResource
|
||||||
, RenderRoute(renderRoute)
|
, RenderRoute(renderRoute)
|
||||||
, TypedContent
|
, TypedContent
|
||||||
, YesodRequest(..)
|
, YesodRequest(..)
|
||||||
@@ -130,8 +126,7 @@ import Yesod.Core ( MonadResource
|
|||||||
, getYesod
|
, getYesod
|
||||||
, getsYesod
|
, getsYesod
|
||||||
, lookupGetParam
|
, lookupGetParam
|
||||||
, respondSource
|
, respond
|
||||||
, sendChunkBS
|
|
||||||
, sendResponseStatus
|
, sendResponseStatus
|
||||||
, typeOctet
|
, typeOctet
|
||||||
)
|
)
|
||||||
@@ -192,10 +187,9 @@ getEosR = do
|
|||||||
Nothing -> sendResponseStatus status404 (NotFoundE [i|EOS version satisfying #{spec}|])
|
Nothing -> sendResponseStatus status404 (NotFoundE [i|EOS version satisfying #{spec}|])
|
||||||
Just version -> do
|
Just version -> do
|
||||||
let imgPath = root </> show version </> "eos.img"
|
let imgPath = root </> show version </> "eos.img"
|
||||||
(sz, h) <- runDB $ concurrently (liftIO $ getFileSize imgPath) (retrieveHash version imgPath)
|
h <- runDB $ retrieveHash version imgPath
|
||||||
addHeader "Content-Length" $ show sz
|
|
||||||
addHeader "x-eos-hash" h
|
addHeader "x-eos-hash" h
|
||||||
respondSource typeOctet (sourceFile imgPath .| awaitForever sendChunkBS)
|
respond typeOctet $ ContentFile imgPath Nothing
|
||||||
where
|
where
|
||||||
retrieveHash :: Version -> FilePath -> YesodDB RegistryCtx Text
|
retrieveHash :: Version -> FilePath -> YesodDB RegistryCtx Text
|
||||||
retrieveHash v fp = do
|
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
|
-- 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
|
pkgsWithDependencies <- runDB $ mapConcurrently (getPackageDependencies osPredicate) filteredPackages
|
||||||
PackageListRes <$> mapConcurrently constructPackageListApiRes pkgsWithDependencies
|
PackageListRes <$> mapConcurrently constructPackageListApiRes pkgsWithDependencies
|
||||||
|
|
||||||
where
|
where
|
||||||
defaults = PackageListDefaults { packageListOrder = DESC
|
defaults = PackageListDefaults { packageListOrder = DESC
|
||||||
, packageListPageLimit = 20
|
, packageListPageLimit = 20
|
||||||
|
|||||||
@@ -298,16 +298,9 @@ getHash pkg version = do
|
|||||||
let hashPath = root </> show pkg </> show version </> "hash.bin"
|
let hashPath = root </> show pkg </> show version </> "hash.bin"
|
||||||
liftIO $ readFile hashPath
|
liftIO $ readFile hashPath
|
||||||
|
|
||||||
getPackage :: (MonadResource m, MonadReader r m, Has PkgRepo r)
|
getPackage :: (MonadResource m, MonadReader r m, Has PkgRepo r) => PkgId -> Version -> m (Maybe FilePath)
|
||||||
=> PkgId
|
|
||||||
-> Version
|
|
||||||
-> m (Maybe (Integer, ConduitT () ByteString m ()))
|
|
||||||
getPackage pkg version = do
|
getPackage pkg version = do
|
||||||
root <- asks pkgRepoFileRoot
|
root <- asks pkgRepoFileRoot
|
||||||
let pkgPath = root </> show pkg </> show version </> show pkg <.> "s9pk"
|
let pkgPath = root </> show pkg </> show version </> show pkg <.> "s9pk"
|
||||||
found <- doesPathExist pkgPath
|
found <- doesPathExist pkgPath
|
||||||
if found
|
pure $ if found then Just pkgPath else Nothing
|
||||||
then do
|
|
||||||
n <- getFileSize pkgPath
|
|
||||||
pure . Just $ (n, sourceFile pkgPath)
|
|
||||||
else pure Nothing
|
|
||||||
|
|||||||
Reference in New Issue
Block a user