Track downloads

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

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 {..}

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

stackage-server.cabal

@@ -69,6 +69,7 @@ library
                 PatternGuards
                 StandaloneDeriving
                 UndecidableInstances
+                RecordWildCards
 
     build-depends: 
                    base                          >= 4