Skip to content

Add support for embedding of analytics pixels on package pages #1042

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
May 14, 2022
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
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, 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, 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 @@ -347,6 +347,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 @@ -372,6 +381,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