From 25fa854a84b5e106500283118025276c6bb1e8c3 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Tue, 7 Oct 2014 11:52:06 +0300
Subject: [PATCH] Track downloads

---
 Handler/HackageViewSdist.hs |  2 ++
 Handler/StackageSdist.hs    | 11 +++++++++++
 config/models               |  8 ++++++++
 stackage-server.cabal       |  1 +
 4 files changed, 22 insertions(+)

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