Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

add redirect on package.tar.gz download #698

Open
wants to merge 2 commits into
base: master
Choose a base branch
from
Open

add redirect on package.tar.gz download #698

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
4a911b1
add redirect on package.tar.gz download
gbaz Mar 18, 2018
ee5ed9a
fix test
gbaz Mar 18, 2018
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
25 changes: 16 additions & 9 deletions Distribution/Server/Features/Core.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -677,21 +677,28 @@ coreFeature ServerEnv{serverBlobStore = store} UserFeature{..}
return . toResponse $ Array (Vec.fromList json)

-- result: tarball or not-found error
-- note: this has a redirect gimmick so that we can cache the real
-- tarball in the CDN and also hit the redirect to trigger the download hook
servePackageTarball :: DynamicPath -> ServerPartE Response
servePackageTarball dpath = do
pkgid <- packageTarballInPath dpath
guard (pkgVersion pkgid /= nullVersion)
pkg <- lookupPackageId pkgid
rq <- askRq
case pkgLatestTarball pkg of
Nothing -> errNotFound "Tarball not found"
[MText "No tarball exists for this package version."]
Just (tarball, (uploadtime, _uid), _revNo) -> do
let blobId = blobInfoId $ pkgTarballGz tarball
cacheControl [Public, NoTransform, maxAgeDays 30]
(BlobStorage.blobETag blobId)
file <- liftIO $ BlobStorage.fetch store blobId
runHook_ packageDownloadHook pkgid
return $ toResponse $ Resource.PackageTarball file blobId uploadtime
Nothing -> errNotFound "Tarball not found"
[MText "No tarball exists for this package version."]
Just (tarball, (uploadtime, _uid), _revNo) ->
if not (isJust . lookup "real" . rqInputsQuery $ rq)
then do
runHook_ packageDownloadHook pkgid
seeOther (rqUri rq ++ "?real=true") $ toResponse ()
else do
let blobId = blobInfoId $ pkgTarballGz tarball
cacheControl [Public, NoTransform, maxAgeDays 30]
(BlobStorage.blobETag blobId)
file <- liftIO $ BlobStorage.fetch store blobId
return $ toResponse $ Resource.PackageTarball file blobId uploadtime

-- result: cabal file or not-found error
serveCabalFile :: DynamicPath -> ServerPartE Response
Expand Down
7 changes: 5 additions & 2 deletions tests/HighLevelTest.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -28,6 +28,7 @@ import Util
import HttpUtils ( isOk
, isNoContent
, isForbidden
, execRequest'
, Authorization(..)
)
import HackageClientUtils
Expand Down Expand Up @@ -200,8 +201,11 @@ runPackageTests = do
cabalFile <- getUrl NoAuth "/package/testpackage-1.0.0.0/testpackage.cabal"
unless (cabalFile == testpackageCabalFile) $
die "Bad Cabal file"
do info "Testing tar redirect"
_ <- execRequest' NoAuth (mkGetReq "/package/testpackage/testpackage-1.0.0.0.tar.gz") (==(3,0,3))
return ()
do info "Getting testpackage tar file"
tarFile <- getUrl NoAuth "/package/testpackage/testpackage-1.0.0.0.tar.gz"
tarFile <- getUrl NoAuth "/package/testpackage/testpackage-1.0.0.0.tar.gz?real=1"
unless (tarFile == testpackageTarFileContent) $
die "Bad tar file"
do info "Getting testpackage source"
Expand All @@ -222,4 +226,3 @@ runPackageTests = do

testpackage :: (FilePath, String, FilePath, String, FilePath, String)
testpackage = mkPackage "testpackage"