diff --git a/Data/Hackage.hs b/Data/Hackage.hs index c773e64..8fcd240 100644 --- a/Data/Hackage.hs +++ b/Data/Hackage.hs @@ -2,6 +2,7 @@ module Data.Hackage ( loadCabalFiles , sourceHackageSdist , createView + , sourceHackageViewSdist ) where import ClassyPrelude.Yesod hiding (get) @@ -153,6 +154,21 @@ sourceHackageSdist name version = do then storeRead key else return Nothing +sourceHackageViewSdist :: ( MonadIO m + , MonadThrow m + , MonadBaseControl IO m + , MonadResource m + , MonadReader env m + , HasHttpManager env + , HasHackageRoot env + , HasBlobStore env StoreKey + , MonadLogger m + , MonadActive m + ) + => HackageView + -> PackageName + -> Version + -> m (Maybe (Source m ByteString)) sourceHackageViewSdist viewName name version = do let key = HackageViewSdist viewName name version msrc1 <- storeRead key @@ -164,13 +180,13 @@ sourceHackageViewSdist viewName name version = do Nothing -> return Nothing Just cabalSrc -> do cabalLBS <- cabalSrc $$ sinkLazy - msrc <- storeRead $ HackageSdist name version + msrc <- sourceHackageSdist name version case msrc of Nothing -> return Nothing Just src -> do - lbs <- fromChunks <$> lazyConsume src + lbs <- fromChunks <$> lazyConsume (src $= ungzip) let lbs' = Tar.write $ replaceCabal cabalLBS $ Tar.read lbs - sourceLazy lbs' $$ storeWrite key + sourceLazy lbs' $$ gzip =$ storeWrite key storeRead key where cabalName = unpack $ concat diff --git a/Handler/StackageSdist.hs b/Handler/StackageSdist.hs index 5fb94ca..48833e8 100644 --- a/Handler/StackageSdist.hs +++ b/Handler/StackageSdist.hs @@ -2,6 +2,7 @@ module Handler.StackageSdist where import Import import Data.BlobStore +import Data.Hackage getStackageSdistR :: PackageSetIdent -> PackageNameVersion -> Handler TypedContent getStackageSdistR ident (PackageNameVersion name version) = do @@ -9,7 +10,7 @@ getStackageSdistR ident (PackageNameVersion name version) = do msrc <- case msrc1 of Just src -> return $ Just src - Nothing -> storeRead $ HackageSdist name version + Nothing -> sourceHackageSdist name version case msrc of Nothing -> notFound Just src -> do