Skip to content

Commit

Permalink
Introduce analytics pixels infrastructure
Browse files Browse the repository at this point in the history
  • Loading branch information
alexbiehl committed Apr 12, 2022
1 parent e88e25a commit 9ac62d3
Show file tree
Hide file tree
Showing 14 changed files with 572 additions and 24 deletions.
45 changes: 45 additions & 0 deletions datafiles/templates/Html/analytics-pixels-page.html.st
Original file line number Diff line number Diff line change
@@ -0,0 +1,45 @@
<!DOCTYPE html>
<html>
<head>
$hackageCssTheme()$
<title>Analytics pixels for $pkgname$ | Hackage</title>
</head>

<body>
$hackagePageHeader()$

<div id="content">

<h2>Adding a analytics pixel to <a href="/package/$pkgname$">$pkgname$</a></h2>

<p>
Configure an analytics pixel to be automatically loaded on your package’s page on Hackage.
You’ll need an image URL from any external analytics provider, e.g. <a href="about.scarf.sh">Scarf</a>, which is provided
for free and can surface information about web traffic to your package including geographic
distribution, version distribution, and companies.
</p>

<form method="POST" class="box" action="/package/$pkgname$/analytics-pixels">
<label for="analytics-pixel">Analytics Image URL</label>
<input name="analytics-pixel" type="text" />
<input type="submit" />
</form>

<h2>Existing analytics pixels for <a href="/package/$pkgname$">$pkgname$</a></h2>

<ul>
$analyticsPixels:{analyticsPixel|
<li>
<form method="POST" action="/package/$pkgname$/analytics-pixels">
<label for="analytics-pixel">$analyticsPixel$</label>
<input type="hidden" name="analytics-pixel" value="$analyticsPixel$"/>
<input type="hidden" name="_method" value="DELETE" />
<input type="submit" value="Delete" />
</form>
</li>
}; separator=""$
</ul>

</div>
</body>
</html>
10 changes: 10 additions & 0 deletions datafiles/templates/Html/package-page.html.st
Original file line number Diff line number Diff line change
Expand Up @@ -95,6 +95,11 @@
edit package information
</a>
</li>
<li>
<a href="$baseurl$/package/$package.name$/analytics-pixels">
edit package analytics pixels
</a>
</li>
</ul>
<p>Candidates</p>
<ul>
Expand Down Expand Up @@ -272,5 +277,10 @@
<script src="$doc.baseUrl$/quick-jump.min.js" type="text/javascript"></script>
<script type="text/javascript"> quickNav.init("$doc.baseUrl$", function(toggle) {var t = document.getElementById('quickjump-trigger');if (t) {t.onclick = function(e) { e.preventDefault(); toggle(); };}}); </script>
$endif$

$analyticsPixels:{analyticsPixelUrl|
<img referrerpolicy="no-referrer-when-downgrade" src="$analyticsPixelUrl$" />
}; separator=""$

</body>
</html>
59 changes: 59 additions & 0 deletions datafiles/templates/Html/user-analytics-pixels-page.html.st
Original file line number Diff line number Diff line change
@@ -0,0 +1,59 @@
<!DOCTYPE html>
<html>
<head>
$hackageCssTheme()$
<title>Analytics pixels for all of $username$'s packages | Hackage</title>
</head>

<body>
$hackagePageHeader()$

<div id="content">

<h2>Create a analytics pixel</h2>

<p>
Configure an analytics pixel to be automatically loaded on your package’s page on Hackage.
You’ll need an image URL from any external analytics provider, e.g. <a href="about.scarf.sh">Scarf</a>, which is provided
for free and can surface information about web traffic to your package including geographic
distribution, version distribution, and companies.
</p>

<form method="POST" class="box" action="/user/$username$/analytics-pixels">
<p>
<label for="package">Package</label>
<select name="package">
$pkgs:{pkg|
<option value="$pkg$">$pkg$</option>
}; separator=""$
</select>
</p>
<p>
<label for="analytics-pixel">Analytics pixel URL</label>
<input name="analytics-pixel" type="text" />
</p>
<input type="submit" />
</form>

<h2>Existing analytics pixels</h2>

$pkgpixels:{pkgpixel|
<h3><a href="/package/$pkgpixel.0$">$pkgpixel.0$</a></h3>
<ul>
$pkgpixel.1:{analyticsPixel|
<li>
<form method="POST" action="/user/$username$/analytics-pixels">
<label for="analytics-pixel">$analyticsPixel$</label>
<input type="hidden" name="package" value="$pkgpixel.0$" />
<input type="hidden" name="analytics-pixel" value="$analyticsPixel$"/>
<input type="hidden" name="_method" value="DELETE" />
<input type="submit" value="Delete" />
<form>
</li>
}; separator=""$
</ul>
}; separator=""$

</div>
</body>
</html>
3 changes: 3 additions & 0 deletions datafiles/templates/Users/manage.html.st
Original file line number Diff line number Diff line change
Expand Up @@ -64,6 +64,9 @@ $tokens:{token|
<li>
<a href="/user/$username$/password">Change your password</a>
</li>
<li>
<a href="/user/$username$/analytics-pixels">Analytics pixels</a>
</li>
</ul>

</div>
Expand Down
2 changes: 2 additions & 0 deletions hackage-server.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -343,6 +343,8 @@ library lib-server
Distribution.Server.Features.Tags
Distribution.Server.Features.Tags.Backup
Distribution.Server.Features.Tags.State
Distribution.Server.Features.AnalyticsPixels
Distribution.Server.Features.AnalyticsPixels.State
Distribution.Server.Features.UserDetails
Distribution.Server.Features.UserSignup
Distribution.Server.Features.StaticFiles
Expand Down
10 changes: 10 additions & 0 deletions src/Distribution/Server/Features.hs
Original file line number Diff line number Diff line change
Expand Up @@ -36,6 +36,7 @@ import Distribution.Server.Features.PreferredVersions (initVersionsFeature)
-- [reverse index disabled] import Distribution.Server.Features.ReverseDependencies (initReverseFeature)
import Distribution.Server.Features.DownloadCount (initDownloadFeature)
import Distribution.Server.Features.Tags (initTagsFeature)
import Distribution.Server.Features.AnalyticsPixels (initAnalyticsPixelsFeature)
import Distribution.Server.Features.Search (initSearchFeature)
import Distribution.Server.Features.PackageList (initListFeature)
import Distribution.Server.Features.HaskellPlatform (initPlatformFeature)
Expand Down Expand Up @@ -127,6 +128,8 @@ initHackageFeatures env@ServerEnv{serverVerbosity = verbosity} = do
initDownloadFeature env
mkTagsFeature <- logStartup "tags" $
initTagsFeature env
mkAnalyticsPixelsFeature <- logStartup "analytics pixels" $
initAnalyticsPixelsFeature env
mkVersionsFeature <- logStartup "versions" $
initVersionsFeature env
-- mkReverseFeature <- logStartup "reverse deps" $
Expand Down Expand Up @@ -255,6 +258,11 @@ initHackageFeatures env@ServerEnv{serverVerbosity = verbosity} = do
uploadFeature
usersFeature

analyticsPixelsFeature <- mkAnalyticsPixelsFeature
coreFeature
usersFeature
uploadFeature

versionsFeature <- mkVersionsFeature
coreFeature
uploadFeature
Expand Down Expand Up @@ -292,6 +300,7 @@ initHackageFeatures env@ServerEnv{serverVerbosity = verbosity} = do
versionsFeature
-- [reverse index disabled] reverseFeature
tagsFeature
analyticsPixelsFeature
downloadFeature
votesFeature
listFeature
Expand Down Expand Up @@ -371,6 +380,7 @@ initHackageFeatures env@ServerEnv{serverVerbosity = verbosity} = do
, getFeatureInterface documentationCandidatesFeature
, getFeatureInterface downloadFeature
, getFeatureInterface tagsFeature
, getFeatureInterface analyticsPixelsFeature
, getFeatureInterface versionsFeature
-- [reverse index disabled] , getFeatureInterface reverseFeature
, getFeatureInterface searchFeature
Expand Down
128 changes: 128 additions & 0 deletions src/Distribution/Server/Features/AnalyticsPixels.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,128 @@
{-# LANGUAGE RankNTypes, NamedFieldPuns, RecordWildCards #-}

-- | Implements a system to allow users to upvote packages.
--
module Distribution.Server.Features.AnalyticsPixels
( AnalyticsPixelsFeature(..)
, AnalyticsPixel(..)
, initAnalyticsPixelsFeature
) where

import Data.Set (Set)

import Distribution.Server.Features.AnalyticsPixels.State

import Distribution.Server.Framework
import Distribution.Server.Framework.BackupRestore

import Distribution.Server.Features.Core
import Distribution.Server.Features.Upload
import Distribution.Server.Features.Users

import Distribution.Package

-- | Define the prototype for this feature
data AnalyticsPixelsFeature = AnalyticsPixelsFeature {
analyticsPixelsFeatureInterface :: HackageFeature,
analyticsPixelsResource :: Resource,
userAnalyticsPixelsResource :: Resource,

analyticsPixelAdded :: Hook (PackageName, AnalyticsPixel) (),
analyticsPixelRemoved :: Hook (PackageName, AnalyticsPixel) (),

-- | Returns all 'AnalyticsPixel's associated with a 'Package'.
getPackageAnalyticsPixels :: forall m. MonadIO m => PackageName -> m (Set AnalyticsPixel),

-- | Adds a new 'AnalyticsPixel' to a 'Package'. Returns True in case it was added. False in case
-- it's already existing.
addPackageAnalyticsPixel :: forall m. MonadIO m => PackageName -> AnalyticsPixel -> m Bool,

-- | Remove a 'AnalyticsPixel' from a 'Package'.
removePackageAnalyticsPixel :: forall m. MonadIO m => PackageName -> AnalyticsPixel -> m ()
}

-- | Implement the isHackageFeature 'interface'
instance IsHackageFeature AnalyticsPixelsFeature where
getFeatureInterface = analyticsPixelsFeatureInterface

-- | Called from Features.hs to initialize this feature
initAnalyticsPixelsFeature :: ServerEnv
-> IO ( CoreFeature
-> UserFeature
-> UploadFeature
-> IO AnalyticsPixelsFeature)
initAnalyticsPixelsFeature env@ServerEnv{serverStateDir} = do
dbAnalyticsPixelsState <- analyticsPixelsStateComponent serverStateDir
analyticsPixelAdded <- newHook
analyticsPixelRemoved <- newHook

return $ \coref@CoreFeature{..} userf@UserFeature{..} uploadf -> do
let feature = analyticsPixelsFeature env
dbAnalyticsPixelsState
coref userf uploadf analyticsPixelAdded analyticsPixelRemoved

return feature

-- | Define the backing store (i.e. database component)
analyticsPixelsStateComponent :: FilePath -> IO (StateComponent AcidState AnalyticsPixelsState)
analyticsPixelsStateComponent stateDir = do
st <- openLocalStateFrom (stateDir </> "db" </> "AnalyticsPixels") initialAnalyticsPixelsState
return StateComponent {
stateDesc = "Backing store for AnalyticsPixels feature"
, stateHandle = st
, getState = query st GetAnalyticsPixelsState
, putState = update st . ReplaceAnalyticsPixelsState
, resetState = analyticsPixelsStateComponent
, backupState = \_ _ -> []
, restoreState = RestoreBackup {
restoreEntry = error "Unexpected backup entry"
, restoreFinalize = return initialAnalyticsPixelsState
}
}


-- | Default constructor for building this feature.
analyticsPixelsFeature :: ServerEnv
-> StateComponent AcidState AnalyticsPixelsState
-> CoreFeature -- To get site package list
-> UserFeature -- To authenticate users
-> UploadFeature -- For accessing package maintainers and trustees
-> Hook (PackageName, AnalyticsPixel) () -- Signals addition of a new AnalyticsPixel
-> Hook (PackageName, AnalyticsPixel) () -- Signals removeal of a AnalyticsPixel
-> AnalyticsPixelsFeature

analyticsPixelsFeature ServerEnv{..}
analyticsPixelsState
CoreFeature { coreResource = CoreResource{..} }
UserFeature{..}
UploadFeature{..}
analyticsPixelAdded
analyticsPixelRemoved
= AnalyticsPixelsFeature {..}
where
analyticsPixelsFeatureInterface = (emptyHackageFeature "AnalyticsPixels") {
featureDesc = "Allow users to attach analytics pixels to their packages",
featureResources = [analyticsPixelsResource, userAnalyticsPixelsResource]
, featureState = [abstractAcidStateComponent analyticsPixelsState]
}

analyticsPixelsResource :: Resource
analyticsPixelsResource = resourceAt "/package/:package/analytics-pixels.:format"

userAnalyticsPixelsResource :: Resource
userAnalyticsPixelsResource = resourceAt "/user/:username/analytics-pixels.:format"

getPackageAnalyticsPixels :: MonadIO m => PackageName -> m (Set AnalyticsPixel)
getPackageAnalyticsPixels name =
queryState analyticsPixelsState (AnalyticsPixelsForPackage name)

addPackageAnalyticsPixel :: MonadIO m => PackageName -> AnalyticsPixel -> m Bool
addPackageAnalyticsPixel name pixel = do
added <- updateState analyticsPixelsState (AddPackageAnalyticsPixel name pixel)
when added $ runHook_ analyticsPixelAdded (name, pixel)
pure added

removePackageAnalyticsPixel :: MonadIO m => PackageName -> AnalyticsPixel -> m ()
removePackageAnalyticsPixel name pixel = do
updateState analyticsPixelsState (RemovePackageAnalyticsPixel name pixel)
runHook_ analyticsPixelRemoved (name, pixel)
Loading

0 comments on commit 9ac62d3

Please sign in to comment.