From 4a911b1585868d20b9c5016a30a5c25c7520b211 Mon Sep 17 00:00:00 2001 From: Gershom Date: Sun, 18 Mar 2018 01:31:50 -0400 Subject: [PATCH 1/2] add redirect on package.tar.gz download --- Distribution/Server/Features/Core.hs | 25 ++++++++++++++++--------- 1 file changed, 16 insertions(+), 9 deletions(-) diff --git a/Distribution/Server/Features/Core.hs b/Distribution/Server/Features/Core.hs index 496ae8014..8ec74a15a 100644 --- a/Distribution/Server/Features/Core.hs +++ b/Distribution/Server/Features/Core.hs @@ -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 From ee5ed9ab1bcbe701c1f67ebf2f1784b007ad904a Mon Sep 17 00:00:00 2001 From: Gershom Date: Sun, 18 Mar 2018 02:09:50 -0400 Subject: [PATCH 2/2] fix test --- tests/HighLevelTest.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/tests/HighLevelTest.hs b/tests/HighLevelTest.hs index c1b51a244..f9d9a7e86 100644 --- a/tests/HighLevelTest.hs +++ b/tests/HighLevelTest.hs @@ -28,6 +28,7 @@ import Util import HttpUtils ( isOk , isNoContent , isForbidden + , execRequest' , Authorization(..) ) import HackageClientUtils @@ -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" @@ -222,4 +226,3 @@ runPackageTests = do testpackage :: (FilePath, String, FilePath, String, FilePath, String) testpackage = mkPackage "testpackage" -