diff --git a/Handler/HackageViewSdist.hs b/Handler/HackageViewSdist.hs index 610fe67..0351d99 100644 --- a/Handler/HackageViewSdist.hs +++ b/Handler/HackageViewSdist.hs @@ -2,9 +2,11 @@ module Handler.HackageViewSdist where import Import import Data.Hackage +import Handler.StackageSdist (addDownload) getHackageViewSdistR :: HackageView -> PackageNameVersion -> Handler TypedContent getHackageViewSdistR viewName (PackageNameVersion name version) = do + addDownload Nothing (Just viewName) name version msrc <- sourceHackageViewSdist viewName name version case msrc of Nothing -> notFound diff --git a/Handler/StackageSdist.hs b/Handler/StackageSdist.hs index 48833e8..c690c54 100644 --- a/Handler/StackageSdist.hs +++ b/Handler/StackageSdist.hs @@ -6,6 +6,7 @@ import Data.Hackage getStackageSdistR :: PackageSetIdent -> PackageNameVersion -> Handler TypedContent getStackageSdistR ident (PackageNameVersion name version) = do + addDownload (Just ident) Nothing name version msrc1 <- storeRead (CustomSdist ident name version) msrc <- case msrc1 of @@ -22,3 +23,13 @@ getStackageSdistR ident (PackageNameVersion name version) = do , ".tar.gz" ] respondSource "application/x-gzip" $ mapOutput (Chunk . toBuilder) src + +addDownload :: Maybe PackageSetIdent + -> Maybe HackageView + -> PackageName + -> Version + -> Handler () +addDownload downloadIdent downloadView downloadPackage downloadVersion = do + downloadUserAgent <- fmap decodeUtf8 <$> lookupHeader "user-agent" + downloadTimestamp <- liftIO getCurrentTime + runDB $ insert_ Download {..} diff --git a/config/models b/config/models index f6d2f10..7181535 100644 --- a/config/models +++ b/config/models @@ -39,3 +39,11 @@ Package name' PackageName sql=name version Version overwrite Bool + +Download + ident PackageSetIdent Maybe + view HackageView Maybe + timestamp UTCTime + package PackageName + version Version + userAgent Text Maybe diff --git a/stackage-server.cabal b/stackage-server.cabal index 1f9f451..66d7579 100644 --- a/stackage-server.cabal +++ b/stackage-server.cabal @@ -69,6 +69,7 @@ library PatternGuards StandaloneDeriving UndecidableInstances + RecordWildCards build-depends: base >= 4