From 1176a24a1f76f551ec32eda731e8d5cdf93ad085 Mon Sep 17 00:00:00 2001
From: Ben Sima <ben@bsima.me>
Date: Wed, 18 Aug 2021 13:25:31 -0400
Subject: Rename Devalloc to Dragons

---
 Biz/Bild/ShellHook.sh        |    2 +-
 Biz/Cloud/Ports.nix          |    2 +-
 Biz/Cloud/Web.nix            |    6 +-
 Biz/Dev.nix                  |   10 +-
 Biz/Devalloc.hs              | 1666 ------------------------------------------
 Biz/Devalloc.nix             |   66 --
 Biz/Devalloc/Analysis.hs     |  252 -------
 Biz/Devalloc/get-examples.sh |   13 -
 Biz/Devalloc/main.py         |  221 ------
 Biz/Devalloc/pitch.md        |   40 -
 Biz/Dragons.hs               | 1666 ++++++++++++++++++++++++++++++++++++++++++
 Biz/Dragons.nix              |   66 ++
 Biz/Dragons/Analysis.hs      |  252 +++++++
 Biz/Dragons/get-examples.sh  |   13 +
 Biz/Dragons/main.py          |  221 ++++++
 Biz/Dragons/pitch.md         |   40 +
 Biz/Log.hs                   |    2 +-
 17 files changed, 2269 insertions(+), 2269 deletions(-)
 delete mode 100644 Biz/Devalloc.hs
 delete mode 100644 Biz/Devalloc.nix
 delete mode 100644 Biz/Devalloc/Analysis.hs
 delete mode 100755 Biz/Devalloc/get-examples.sh
 delete mode 100755 Biz/Devalloc/main.py
 delete mode 100644 Biz/Devalloc/pitch.md
 create mode 100644 Biz/Dragons.hs
 create mode 100644 Biz/Dragons.nix
 create mode 100644 Biz/Dragons/Analysis.hs
 create mode 100755 Biz/Dragons/get-examples.sh
 create mode 100755 Biz/Dragons/main.py
 create mode 100644 Biz/Dragons/pitch.md

(limited to 'Biz')

diff --git a/Biz/Bild/ShellHook.sh b/Biz/Bild/ShellHook.sh
index 59786e4..11954a7 100644
--- a/Biz/Bild/ShellHook.sh
+++ b/Biz/Bild/ShellHook.sh
@@ -44,7 +44,7 @@ function pie() {
 function run-sentry() {
   urls=(
     http://que.run
-    https://devalloc.io
+    https://dragons.dev
     https://simatime.com
     https://tv.simatime.com
     https://bsima.me
diff --git a/Biz/Cloud/Ports.nix b/Biz/Cloud/Ports.nix
index 435a0b6..636c797 100644
--- a/Biz/Cloud/Ports.nix
+++ b/Biz/Cloud/Ports.nix
@@ -3,7 +3,7 @@
   bitcoind = 8333;
   dandel-rovbur = 8080;
   delugeWeb = 8112;
-  devalloc = 8095;
+  dragons = 8095;
   et = 2022;
   gemini = 1965;
   git = 9418;
diff --git a/Biz/Cloud/Web.nix b/Biz/Cloud/Web.nix
index 5a14fb4..853c967 100644
--- a/Biz/Cloud/Web.nix
+++ b/Biz/Cloud/Web.nix
@@ -118,8 +118,8 @@ in
           useACMEHost = rootDomain;
         };
 
-        "devalloc.io" = {
-          locations."/".proxyPass = "http://${ports.bensIp}:${toString ports.devalloc}";
+        "dragons.dev" = {
+          locations."/".proxyPass = "http://${ports.bensIp}:${toString ports.dragons}";
           forceSSL = true;
           useACMEHost = rootDomain;
         };
@@ -166,7 +166,7 @@ in
   # This must contain all of the other domains we host
   security.acme.certs.${rootDomain}.extraDomainNames = [
     "bsima.me" "www.bsima.me"
-    "devalloc.io"
+    "dragons.dev"
   ] ++ map (sub: "${sub}.${rootDomain}") [
     "tv"
     "matrix"
diff --git a/Biz/Dev.nix b/Biz/Dev.nix
index 837ffaf..0f9b07c 100644
--- a/Biz/Dev.nix
+++ b/Biz/Dev.nix
@@ -10,17 +10,17 @@ bild.os {
     ./Dev/Configuration.nix
     ./Dev/Hardware.nix
     ./Dev/Hoogle.nix
-    ./Devalloc.nix
+    ./Dragons.nix
     # ./Dev/Guix.nix # I need to package a bunch of guile libs first
   ];
   networking.hostName = "lithium";
   networking.domain = "dev.simatime.com";
-  services.devalloc = {
+  services.dragons = {
     enable = true;
     port = 8095;
-    package = bild.ghc ./Devalloc.hs;
-    keep = "/var/devalloc/keep";
-    depo = "/var/devalloc/depo";
+    package = bild.ghc ./Dragons.hs;
+    keep = "/var/dragons/keep";
+    depo = "/var/dragons/depo";
   };
 }
 
diff --git a/Biz/Devalloc.hs b/Biz/Devalloc.hs
deleted file mode 100644
index 998260e..0000000
--- a/Biz/Devalloc.hs
+++ /dev/null
@@ -1,1666 +0,0 @@
-{-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE ExtendedDefaultRules #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE Strict #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-
--- Developer allocation
---
--- : out devalloc
--- : sys cmark
-module Biz.Devalloc
-  ( main,
-    test,
-  )
-where
-
-import Alpha hiding (rem, (<.>))
-import qualified Biz.App as App
-import qualified Biz.Auth as Auth
-import qualified Biz.Cli as Cli
-import Biz.Devalloc.Analysis (Analysis (..), Commit (..))
-import qualified Biz.Devalloc.Analysis as Analysis
-import qualified Biz.Id as Id
-import qualified Biz.Log as Log
-import qualified Biz.Look
-import Biz.Test ((@=?), (@?!=), (@?=))
-import qualified Biz.Test as Test
-import qualified CMark as Cmark
-import qualified CMark.Lucid as Cmark
-import Clay (em, pct, px, rem, sec, (?))
-import qualified Clay
-import qualified Clay.Font
-import qualified Clay.Render as Clay
-import qualified Control.Concurrent.Async as Async
-import qualified Control.Exception as Exception
-import Crypto.JOSE.JWK (JWK)
-import Data.Acid (makeAcidic)
-import qualified Data.Acid as Acid
-import qualified Data.Acid.Advanced as Acid
-import qualified Data.Acid.Local as Acid
-import qualified Data.Aeson as Aeson
-import qualified Data.ByteString.Lazy as LBS
-import Data.Data (Data)
-import Data.IxSet (Indexable (..), IxSet, ixFun, ixSet, (&&&), (@=))
-import qualified Data.IxSet as IxSet
-import qualified Data.List as List
-import qualified Data.Map as Map
-import Data.SafeCopy (base, deriveSafeCopy, extension)
-import qualified Data.SafeCopy as SafeCopy
-import qualified Data.Set as Set
-import qualified Data.Text as Text
-import qualified Data.Text.Encoding as Encoding
-import qualified Data.Time.Calendar as Time
-import qualified Data.Time.Clock as Time
-import Data.Vector (Vector)
-import qualified Data.Vector as Vector
--- import qualified Data.Vector.Algorithms.Intro as Vector
-import qualified GitHub
-import qualified Lucid
-import qualified Lucid.Base as Lucid
-import qualified Lucid.Servant as Lucid
-import NeatInterpolation
-import qualified Network.Wai as Wai
-import qualified Network.Wai.Handler.Warp as Warp
-import Servant
-import Servant.API.Generic (ToServantApi, genericApi, toServant, (:-))
-import qualified Servant.Auth as Auth
-import qualified Servant.Auth.Server as Auth
-import qualified Servant.HTML.Lucid as Lucid
-import Servant.Server.Generic (AsServer)
-import qualified System.Directory as Directory
-import qualified System.Envy as Envy
-import System.FilePath ((<.>), (</>))
-import qualified System.Process as Process
-import qualified Web.FormUrlEncoded as Web
-
--- * persistent data
-
--- This must go first because of template haskell splicing.
---
--- When changing a persisted type `T`, first copy the type `T == T0`, then make
--- the `SafeCopy.Migrate T` class compile, then make changes to `T`. If you
--- don't, there will be a runtime exception when you try to start the new
--- service. I'm not sure how to guard against this, except maybe run a test
--- deployment by copying a database backup locally, or something:
---     rm -rf _/var/devalloc
---     rsync -avz /var/devalloc/ _/var
-
-newtype UserEmail = UserEmail {unUserEmail :: Maybe Text}
-  deriving (Eq, Ord, Data, Typeable, Generic, Show)
-
-instance Aeson.ToJSON UserEmail
-
-instance Aeson.FromJSON UserEmail
-
-instance Auth.ToJWT UserEmail
-
-instance Auth.FromJWT UserEmail
-
-instance Lucid.ToHtml UserEmail where
-  toHtmlRaw = Lucid.toHtml
-  toHtml (UserEmail (Just email)) = Lucid.toHtml email
-  toHtml (UserEmail Nothing) = mempty
-
-$(deriveSafeCopy 0 'base ''UserEmail)
-
--- | In 'GitHub.Data.Definitions' this is '(Id User)', but I don't want the
--- extra complexity of 'Id', so just store the underlying Int
-newtype GitHubId = GitHubId {unGitHubId :: Int}
-  deriving (Eq, Ord, Data, Typeable, Generic, Show)
-
-instance Aeson.ToJSON GitHubId
-
-instance Aeson.FromJSON GitHubId
-
-instance Auth.ToJWT GitHubId
-
-instance Auth.FromJWT GitHubId
-
-$(deriveSafeCopy 0 'base ''GitHubId)
-
-newtype GitHubHandle = GitHubHandle {unGitHubHandle :: Text}
-  deriving (Eq, Ord, Data, Typeable, Generic, Show)
-
-instance Aeson.ToJSON GitHubHandle
-
-instance Aeson.FromJSON GitHubHandle
-
-$(deriveSafeCopy 0 'base ''GitHubHandle)
-
-data Subscription = Free | Invoice
-  deriving (Eq, Data, Typeable, Ord, Generic, Show)
-
-instance Web.FromForm Subscription where
-  fromForm f = case Web.parseUnique "user-subscription" f of
-    Right "Free" -> Right Free
-    Right "Invoice" -> Right Invoice
-    Right x -> Left <| "could not parse form value: " <> x
-    Left x -> Left <| "could not parse form value: " <> x
-
-instance Aeson.ToJSON Subscription
-
-instance Aeson.FromJSON Subscription
-
-instance Auth.ToJWT Subscription
-
-instance Auth.FromJWT Subscription
-
-$(deriveSafeCopy 0 'base ''Subscription)
-
-data User0 = User0
-  { userEmail :: UserEmail,
-    userGitHubId :: GitHubId,
-    -- | So we can make GitHub API calls on their behalf.
-    userGitHubToken :: Text,
-    userSubscription :: Subscription,
-    userId :: Id.Id User0
-  }
-  deriving (Eq, Data, Typeable, Ord, Generic, Show)
-
-$(deriveSafeCopy 0 'base ''Id.Id)
-$(deriveSafeCopy 0 'base ''User0)
-
--- | The main representation of a user.
-data User = User
-  { userEmail :: UserEmail,
-    userGitHubId :: GitHubId,
-    userGitHubHandle :: GitHubHandle,
-    -- | So we can make GitHub API calls on their behalf.
-    userGitHubToken :: Text,
-    userSubscription :: Subscription,
-    userId :: Id.Id User
-  }
-  deriving (Eq, Data, Typeable, Ord, Generic, Show)
-
-instance Aeson.ToJSON User
-
-instance Aeson.FromJSON User
-
-instance Auth.ToJWT User
-
-instance Auth.FromJWT User
-
-instance SafeCopy.Migrate User where
-  type MigrateFrom User = User0
-  migrate User0 {..} =
-    User
-      { userId = Id.mk (Proxy :: Proxy User) <| Id.untag userId,
-        userGitHubHandle = GitHubHandle "unknown",
-        ..
-      }
-
-$(deriveSafeCopy 1 'extension ''User)
-
-instance Indexable User where
-  empty =
-    ixSet
-      [ ixFun <| \User {..} -> [userEmail],
-        ixFun <| \User {..} -> [userGitHubId],
-        ixFun <| \User {..} -> [userSubscription]
-      ]
-
-instance Lucid.ToHtml Commit where
-  toHtmlRaw = Lucid.toHtml
-  toHtml (Sha txt) = Lucid.toHtml txt
-
-$(deriveSafeCopy 0 'base ''Commit)
-
-newtype URL = URL Text
-  deriving (Eq, Data, Typeable, Ord, Generic, Show)
-
-instance Envy.Var URL where
-  toVar (URL txt) = str txt
-  fromVar = Just <. URL <. str
-
-instance Lucid.ToHtml URL where
-  toHtmlRaw = Lucid.toHtml
-  toHtml (URL txt) = Lucid.toHtml txt
-
-$(deriveSafeCopy 0 'base ''URL)
-
-data Visibility = Public | Private
-  deriving (Eq, Ord, Generic, Show, Data, Typeable)
-
-$(deriveSafeCopy 0 'base ''Visibility)
-
-instance Indexable Analysis where
-  empty =
-    ixSet
-      [ ixFun <| \Analysis {..} -> [commit]
-      ]
-
-instance App.HasCss AnalysisAction where
-  cssFor _ = do
-    "#analysis > *" ? do
-      Biz.Look.marginAll (rem 2)
-    ".score" ? do
-      Clay.display Clay.grid
-      Biz.Look.gridTemplateAreas
-        [ "title quantity details-collapsed",
-          "preview-chart preview-chart preview-chart",
-          "details details details"
-        ]
-      Clay.alignItems Clay.baseline
-      Clay.gridTemplateColumns [pct 30, 40, 30]
-      Biz.Look.gridTemplateRows ["auto"]
-    ".title" ? do
-      Biz.Look.gridArea "title"
-      Clay.fontSize (rem 1.4)
-      Clay.lineHeight (rem 2.4)
-    ".percentage" ? do
-      Biz.Look.gridArea "quantity"
-      Clay.display Clay.flex
-      Clay.alignItems Clay.baseline
-      ".centum" ? do
-        Clay.fontSize (rem 1.2)
-        Clay.lineHeight (rem 1.2)
-    ".quantity" ? do
-      Biz.Look.gridArea "quantity"
-      Clay.fontSize (rem 3)
-      Clay.lineHeight (rem 3)
-    ".preview-chart" ? do
-      Biz.Look.gridArea "preview-chart"
-    "details" ? do
-      Biz.Look.gridArea "details-collapsed"
-      Biz.Look.justifySelf <| Clay.JustifyContentValue "self-end"
-    "details[open]" ? do
-      Biz.Look.gridArea "details"
-      Biz.Look.justifySelf <| Clay.JustifyContentValue "auto"
-    ".preview-chart" ? do
-      Clay.height (px 2)
-      Clay.maxWidth (pct 100)
-    "table" ? do
-      Biz.Look.marginAll (px 0)
-      Clay.maxWidth (pct 100)
-    "#hotspots" ? do
-      ".preview-chart" ? do
-        Clay.height (rem 1)
-        "table" ? do
-          Clay.height (rem 4)
-          Clay.marginTop (rem (-3))
-          Clay.zIndex (-1)
-      ".bar" ? do
-        Clay.height (px 800)
-
-instance Lucid.ToHtml AnalysisAction where
-  toHtmlRaw = Lucid.toHtml
-  toHtml AnalysisAction {..} =
-    Lucid.div_ [Lucid.id_ "analysis"] <| do
-      let Analysis {..} = analysis
-      Lucid.p_ [Lucid.class_ "analysisFor"] <| do
-        "Analysis for " <> Lucid.toHtml gitDir
-
-      score_ <| do
-        title_ "Total Score"
-        percentage_ <| do
-          quantity_ <| Lucid.toHtml <| tshow score
-          centum_ "/100"
-        previewChart <| simpleBar score 100
-        Lucid.details_ <| do
-          Lucid.summary_ "Details"
-          desc
-            [text|
-            Your score is a weighted composite of the below metrics.
-            What your score means:
-            - 0-30: very high risk, most of your codebase is unknown or ephemeral
-            - 30-60: medium-high risk, tasks that involve working on this
-              codebase will take longer than they should, and we should expect
-              a few unforeseen bugs
-            - 60-80: medium-low risk, tasks in this codebase can be expected to
-              complete in the estimated time, and it probably doesn't have many bugs
-            - 80+: low risk, your codebase is super clean, give your devs a raise
-            |]
-
-      score_ <| do
-        title_ "Total Files"
-        quantity_ <| Lucid.toHtml <| tshow totalFiles
-
-      score_ <| do
-        title_ "Active authors"
-        quantity_ <| Lucid.toHtml <| slen activeAuthors
-        Lucid.details_ <| do
-          Lucid.summary_ "Details"
-          Lucid.ul_ <| forM_ activeAuthors <| \author -> do
-            Lucid.li_ <| Lucid.toHtml author
-
-      score_ <| do
-        title_ "Blackholes"
-        quantity_ <| Lucid.toHtml <| slen blackholes
-        previewChart <| simpleBar (len blackholes) totalFiles
-        Lucid.details_ <| do
-          Lucid.summary_ "Details"
-          desc
-            [text|
-            A blackhole has zero active contributors, so none of your current team
-            members have touched this code. These are very high risk. If there is
-            a problem with this area of the codebase, it will take longer for your
-            team to diagnose and fix the root cause; new features that interact
-            with a blackhole will take longer to deploy.
-
-            **What you can do:** Start a project to ensure these blackholes are
-            well-defined and documented. If anything is completely unknown, write
-            tests against that part of the code as it currently stands, then decide
-            if a rewrite is necessary.
-            |]
-          Lucid.ul_ <| do
-            traverse_ (Lucid.toHtml .> Lucid.li_) blackholes
-
-      score_ <| do
-        title_ "Liabilities"
-        quantity_ <| Lucid.toHtml <| slen liabilities
-        previewChart <| simpleBar (len liabilities) totalFiles
-        Lucid.details_ <| do
-          Lucid.summary_ "Details"
-          desc
-            [text|
-            Files with < 3 active contributors. These are at risk of becoming
-            blackholes if contributors change teams or leave the company.
-
-            **What you can do:** Next time a task involves one of these files,
-            pull in some team members that haven't worked on this area of the
-            codebase.
-
-            In general, when assigning tasks, ensure developers are occasionally
-            working on areas of the codebase that are new to them. Not only will
-            this decrease your liability, it will also improve your developers
-            by helping them learn new areas of the code and share techniques.
-            |]
-          Lucid.ul_ <| do
-            traverse_ (Lucid.toHtml .> Lucid.li_) liabilities
-
-      score_ <| do
-        title_ "Stale files"
-        quantity_ <| Lucid.toHtml <| tshow <| Map.size stale
-        previewChart <| simpleBar (Map.size stale) totalFiles
-        Lucid.details_ <| do
-          Lucid.summary_ "Details"
-          desc
-            [text|
-            Files that haven't been touched in 6 months. These aren't necessarily
-            a risk: unchanging files could just be really well-defined and stable.
-            On the other hand, they could also be places that nobody wants to go
-            because nobody knows how they work.
-
-            **What you can do:** Run this list by your team and find out who has
-            knowledge of this area. If nobody does, start a project to
-            investigate and re-define this part of the codebase, ensuring good
-            documentation practices along the way.
-            |]
-          Lucid.ul_ <| do
-            -- probably Map.mapWithKey is better?
-            forM_ (Map.toList stale) <| \(path, days) ->
-              Lucid.li_ <| Lucid.toHtml <| path <> " (" <> show days <> " days)"
-
-      Lucid.with score_ [Lucid.id_ "hotspots"] <| do
-        title_ "Hotspots"
-        quantity_ "" -- TODO
-        previewChart <| do
-          Lucid.table_ [Lucid.class_ "charts-css column"] <| do
-            Lucid.tr_ <| do
-              forM_ (Map.toList hotspotMap) <| \(_, n) -> do
-                Lucid.td_ [Lucid.style_ <| size n totalCommits] ""
-        Lucid.details_ <| do
-          Lucid.summary_ "Details"
-          desc
-            [text|
-            A hotspot is an over-active code module: developers are continually
-            reworking this part of the code, wasting time redoing work instead
-            of progressing.
-            The flamegraph below plots files by how often they are changed, a
-            longer horizontal line means more changes. Hover over the bars to
-            see filenames and change count.
-
-            **What you can do:** After identifying the hotspots, discuss with your
-            team how to improve the code. Why does the code change so often? Does
-            it need a more well-defined spec? Does it need a deep refactor? Maybe
-            part of it can be abstracted into a more solid module?
-            |]
-          Lucid.table_ [Lucid.class_ "charts-css bar"] <| do
-            Lucid.tr_ <| do
-              forM_ (Map.toList hotspotMap) <| \(path, n) -> do
-                Lucid.td_ [Lucid.style_ <| size n totalCommits] <| do
-                  Lucid.span_ [Lucid.class_ "tooltip"]
-                    <| Lucid.toHtml
-                    <| path <> ": " <> show n <> " commits"
-    where
-      simpleBar :: (Show i, Monad m, Num i) => i -> Integer -> Lucid.HtmlT m ()
-      simpleBar n total = do
-        Lucid.table_ [Lucid.class_ "charts-css bar stacked multiple"] <| do
-          Lucid.tr_ <| do
-            Lucid.td_ [Lucid.style_ <| size n total] ""
-            <> Lucid.td_ [Lucid.style_ <| size total total] ""
-
-      len = toInteger <. length
-      slen = tshow <. length
-      div_ c = Lucid.with Lucid.div_ [Lucid.class_ c]
-      score_ = div_ "score"
-      title_ = div_ "title"
-      quantity_ = div_ "quantity"
-      centum_ = div_ "centum"
-      percentage_ = div_ "percentage"
-      size n total = "--size: calc(" <> show n <> "/" <> show total <> ")"
-      previewChart = div_ "preview-chart"
-      desc :: Monad m => Text -> Lucid.HtmlT m ()
-      desc = Lucid.p_ <. Cmark.renderNode [] <. Cmark.commonmarkToNode []
-
--- | Captures an 'Analysis' with metadata used in the webapp to track who asked
--- it and so on.
-data AnalysisAction = AnalysisAction
-  { -- | Monotonic incrementing integer id
-    analysisId :: Id.Id AnalysisAction,
-    -- | Who asked for this analysis
-    askedBy :: Id.Id User,
-    -- | Where is this coming from?
-    url :: URL,
-    -- | Is the URL publically visible?
-    repoVisibility :: Visibility,
-    -- | The actual analaysis
-    analysis :: Analysis
-  }
-  deriving (Eq, Ord, Generic, Show, Data, Typeable)
-
-$(deriveSafeCopy 0 'base ''Analysis)
-$(deriveSafeCopy 0 'base ''AnalysisAction)
-
-instance Indexable AnalysisAction where
-  empty =
-    ixSet
-      [ ixFun <| \AnalysisAction {..} -> [analysisId],
-        ixFun <| \AnalysisAction {..} -> [askedBy],
-        ixFun <| \AnalysisAction {..} -> [url],
-        ixFun <| \AnalysisAction {..} -> [repoVisibility],
-        ixFun <| \AnalysisAction {..} -> [commit analysis]
-      ]
-
--- | The database.
-data Keep = Keep
-  { users :: IxSet User,
-    nextUserId :: Id.Id User,
-    analyses :: IxSet AnalysisAction,
-    nextAnalysisId :: Id.Id AnalysisAction
-  }
-  deriving (Data, Typeable)
-
-$(deriveSafeCopy 0 'base ''Keep)
-
-createUser :: User -> Acid.Update Keep User
-createUser u = do
-  keep <- get
-  let newUser = u {userId = nextUserId keep} :: User
-  put
-    <| keep
-      { users = IxSet.insert newUser (users keep),
-        nextUserId = succ <| nextUserId keep
-      }
-  pure newUser
-
-updateUser :: User -> Acid.Update Keep User
-updateUser u@User {..} = do
-  keep <- get
-  put <| keep {users = IxSet.updateIx userGitHubId u (users keep)}
-  pure u
-
-getUserByEmail :: UserEmail -> Acid.Query Keep (Maybe User)
-getUserByEmail email = do
-  Keep {..} <- ask
-  pure <| IxSet.getOne <| users @= email
-
-getUserByGitHubId :: GitHubId -> Acid.Query Keep (Maybe User)
-getUserByGitHubId id = do
-  Keep {..} <- ask
-  pure <| IxSet.getOne <| users @= id
-
-getUsers :: Acid.Query Keep [User]
-getUsers = do
-  Keep {..} <- ask
-  pure <| IxSet.toList users
-
-createAnalysis :: AnalysisAction -> Acid.Update Keep AnalysisAction
-createAnalysis a = do
-  keep@Keep {..} <- get
-  let newAnalysis = a {analysisId = nextAnalysisId} :: AnalysisAction
-  put
-    <| keep
-      { analyses = IxSet.insert newAnalysis analyses,
-        nextAnalysisId = succ nextAnalysisId
-      }
-  pure newAnalysis
-
-getAnalysisById :: Id.Id AnalysisAction -> Acid.Query Keep (Maybe AnalysisAction)
-getAnalysisById id = do
-  Keep {..} <- ask
-  pure <| IxSet.getOne <| analyses @= id
-
-getAllAnalyses :: Acid.Query Keep [AnalysisAction]
-getAllAnalyses = do
-  Keep {..} <- ask
-  pure <| IxSet.toList analyses
-
-getAnalysesByAsker :: User -> Acid.Query Keep [AnalysisAction]
-getAnalysesByAsker User {..} = do
-  Keep {..} <- ask
-  pure <| IxSet.toList <| analyses @= userId
-
-getAnalysesByUrl :: URL -> Acid.Query Keep [AnalysisAction]
-getAnalysesByUrl url = do
-  Keep {..} <- ask
-  pure <| IxSet.toList <| analyses @= url
-
-getAnalysisByUrlAndCommit :: URL -> Commit -> Acid.Query Keep (Maybe AnalysisAction)
-getAnalysisByUrlAndCommit url sha = do
-  Keep {..} <- ask
-  pure <| IxSet.getOne <| analyses @= url &&& analyses @= sha
-
-$( makeAcidic
-     ''Keep
-     [ 'createUser,
-       'updateUser,
-       'getUsers,
-       'getUserByEmail,
-       'getUserByGitHubId,
-       'createAnalysis,
-       'getAnalysisById,
-       'getAllAnalyses,
-       'getAnalysesByAsker,
-       'getAnalysesByUrl,
-       'getAnalysisByUrlAndCommit
-     ]
- )
-
-upsertGitHubUser ::
-  Acid.AcidState Keep ->
-  ByteString ->
-  GitHub.User ->
-  IO (Either Text User)
-upsertGitHubUser keep tok ghUser =
-  ghUser
-    |> GitHub.userId
-    |> GitHub.untagId
-    |> GitHubId
-    |> GetUserByGitHubId
-    |> Acid.query keep
-    +> \case
-      Just user ->
-        -- if we already know this user, we need to refresh the token
-        UpdateUser user {userGitHubToken = Encoding.decodeUtf8 tok}
-          |> Acid.update keep
-      Nothing ->
-        CreateUser
-          User
-            { userEmail = UserEmail <| GitHub.userEmail ghUser,
-              userGitHubId = GitHubId <. GitHub.untagId <| GitHub.userId ghUser,
-              userGitHubHandle =
-                GitHubHandle <| GitHub.untagName <| GitHub.userLogin ghUser,
-              userGitHubToken = Encoding.decodeUtf8 tok,
-              userSubscription = Free,
-              userId = mempty
-            }
-          |> Acid.update keep
-    /> Right
-
-test_upsertGitHubUser :: IO (Config, Application, Acid.AcidState Keep) -> Test.Tree
-test_upsertGitHubUser load =
-  Test.group
-    "upsertUser"
-    [ Test.unit "userId is not mempty" <| do
-        (_, _, k) <- load
-        Right User {..} <- upsertGitHubUser k "token" mock_ghUser
-        userId @?!= mempty,
-      Test.unit "creates user when email is empty" <| do
-        (_, _, k) <- load
-        Right User {..} <- upsertGitHubUser k "token" mock_ghUser {GitHub.userEmail = Nothing}
-        userEmail @?!= UserEmail Nothing
-    ]
-
-mock_ghUser :: GitHub.User
-mock_ghUser =
-  GitHub.User
-    { GitHub.userId = GitHub.mkId (Proxy :: Proxy GitHub.User) 123,
-      GitHub.userEmail = Just "user@example.com",
-      GitHub.userLogin = "user",
-      GitHub.userName = Nothing,
-      GitHub.userType = GitHub.OwnerUser,
-      GitHub.userCreatedAt =
-        Time.UTCTime (Time.ModifiedJulianDay 1) (Time.secondsToDiffTime 100),
-      GitHub.userPublicGists = 123,
-      GitHub.userAvatarUrl = GitHub.URL "http://example.com",
-      GitHub.userFollowers = 0,
-      GitHub.userFollowing = 0,
-      GitHub.userHireable = Nothing,
-      GitHub.userBlog = Nothing,
-      GitHub.userBio = Nothing,
-      GitHub.userPublicRepos = 0,
-      GitHub.userLocation = Nothing,
-      GitHub.userCompany = Nothing,
-      GitHub.userUrl = GitHub.URL "http://example.com",
-      GitHub.userHtmlUrl = GitHub.URL "http://example.com"
-    }
-
-init :: Keep
-init =
-  Keep
-    { nextAnalysisId = Id.mk (Proxy :: Proxy AnalysisAction) 1,
-      nextUserId = Id.mk (Proxy :: Proxy User) 1,
-      users = IxSet.empty,
-      analyses = IxSet.empty
-    }
-
--- * main and test
-
-main :: IO ()
-main = Cli.main <| Cli.Plan help move test tidy
-
-help :: Cli.Docopt
-help =
-  [Cli.docopt|
-devalloc
-
-Usage:
-  devalloc [--quiet]
-  devalloc test
-|]
-
-move :: Cli.Arguments -> IO ()
-move args =
-  Exception.bracket
-    (startup <| args `Cli.has` Cli.longOption "quiet")
-    shutdown
-    run
-
-startup :: Bool -> IO (Config, Application, Acid.AcidState Keep)
-startup quiet = do
-  cfg <- Envy.decodeWithDefaults Envy.defConfig
-  oAuthArgs <- Envy.decodeWithDefaults Envy.defConfig
-  kp <- Acid.openLocalStateFrom (keep cfg) init :: IO (Acid.AcidState Keep)
-  jwk <- Auth.generateKey
-  let URL url = homeExample cfg
-  unless quiet <| do
-    Log.info ["boot", "devalloc"] >> Log.br
-    Log.info ["boot", "area", show <| area cfg] >> Log.br
-    Log.info ["boot", "port", show <| port cfg] >> Log.br
-    Log.info ["boot", "depo", Text.pack <| depo cfg] >> Log.br
-    Log.info ["boot", "keep", Text.pack <| keep cfg] >> Log.br
-    Log.info ["boot", "home", "example", url] >> Log.br
-  let jwtCfg = Auth.defaultJWTSettings jwk
-  let cooks = case area cfg of
-        Test -> testCookieSettings
-        Live -> liveCookieSettings
-  let ctx = cooks :. jwtCfg :. EmptyContext
-  let app = serveWithContext paths ctx (toServant <| htmlApp cooks kp cfg jwk oAuthArgs)
-  unless quiet <| do Log.info ["boot", "ready"] >> Log.br
-  pure (cfg, app, kp)
-
-shutdown :: (Config, Application, Acid.AcidState Keep) -> IO ()
-shutdown (_, _, kp) = Acid.createCheckpointAndClose kp
-
-tidy :: Config -> IO ()
-tidy Config {..} = Directory.removeDirectoryRecursive keep
-
-run :: (Config, Wai.Application, Acid.AcidState Keep) -> IO ()
-run (cfg, app, _) = Warp.run (port cfg) (Log.wai app)
-
-liveCookieSettings :: Auth.CookieSettings
-liveCookieSettings =
-  Auth.defaultCookieSettings
-    { Auth.cookieIsSecure = Auth.Secure,
-      -- disable XSRF protection because we don't use any javascript
-      Auth.cookieXsrfSetting = Nothing
-    }
-
-testCookieSettings :: Auth.CookieSettings
-testCookieSettings =
-  Auth.defaultCookieSettings
-    { Auth.cookieIsSecure = Auth.NotSecure,
-      Auth.cookieXsrfSetting = Nothing
-    }
-
-test :: Test.Tree
-test =
-  Test.group
-    "Biz.Devalloc"
-    [ test_spliceCreds,
-      Test.with
-        (startup True)
-        (\t@(c, _, _) -> shutdown t >> tidy c)
-        test_upsertGitHubUser,
-      Test.with
-        (startup True)
-        (\t@(c, _, _) -> shutdown t >> tidy c)
-        test_analyzeGitHub
-    ]
-
--- * app configurations
-
-data Area = Test | Live
-  deriving (Generic, Show)
-
-instance Envy.Var Area where
-  toVar = show
-  fromVar "Test" = Just Test
-  fromVar "Live" = Just Live
-  fromVar _ = Just Test
-
-data Config = Config
-  { port :: Warp.Port,
-    -- | The repo depo! Depository of repositories!
-    depo :: FilePath,
-    keep :: FilePath,
-    area :: Area,
-    -- | A user token for the GitHub API to be used in testing and when getting
-    -- the homepage/example analyses. Get a token with 'repo' scope from GitHub
-    -- and set in .envrc.local
-    -- https://docs.github.com/en/github/authenticating-to-github/creating-a-personal-access-token
-    tokn :: Text,
-    -- | The example shown on the homepage
-    homeExample :: URL
-  }
-  deriving (Generic, Show)
-
-instance Envy.DefConfig Config where
-  defConfig =
-    Config
-      { port = 8005,
-        depo = "_/var/devalloc/depo",
-        keep = "_/var/devalloc/keep",
-        area = Test,
-        tokn = mempty,
-        homeExample = URL "https://github.com/github/training-kit"
-      }
-
-instance Envy.FromEnv Config
-
--- * paths and pages
-
--- | Wraps pages in default HTML
-instance (Lucid.ToHtml a, App.HasCss a) => Lucid.ToHtml (App.Html a) where
-  toHtmlRaw = Lucid.toHtml
-  toHtml (App.Html x) =
-    Lucid.doctypehtml_ <| do
-      Lucid.head_ <| do
-        Lucid.title_ "Devalloc.io :: Know your codebase, know your team."
-        Lucid.meta_
-          [ Lucid.name_ "description",
-            Lucid.content_ "Know your codebase, know your team."
-          ]
-        Lucid.meta_
-          [ Lucid.name_ "viewport",
-            Lucid.content_ "width=device-width, initial-scale=1"
-          ]
-        Lucid.meta_ [Lucid.charset_ "utf-8"]
-        jsRef "//unpkg.com/turbolinks@5.2.0/dist/turbolinks.js"
-        -- base styles
-        style baseStyle
-        cssRef "//unpkg.com/charts.css/dist/charts.min.css"
-        -- page styles
-        style <| App.cssFor x
-      Lucid.body_ (Lucid.toHtml x)
-    where
-      style = Lucid.style_ <. toStrict <. Clay.renderWith Clay.compact []
-      jsRef _href =
-        Lucid.with
-          (Lucid.script_ mempty)
-          [ Lucid.makeAttribute "src" _href,
-            Lucid.makeAttribute "async" mempty,
-            Lucid.makeAttribute "defer" mempty
-          ]
-      cssRef _href =
-        Lucid.with
-          (Lucid.link_ mempty)
-          [ Lucid.makeAttribute "rel" "stylesheet",
-            Lucid.makeAttribute "href" _href
-          ]
-
--- | All of the routes in the app.
-data Paths path = Paths
-  { home ::
-      path
-        :- Get '[Lucid.HTML] (App.Html Home),
-    login ::
-      path
-        :- "login"
-        :> Verb 'GET 301 '[Lucid.HTML] (Headers '[Header "Location" Text] NoContent),
-    githubAuth ::
-      path
-        :- "auth"
-        :> "github"
-        :> "callback"
-        :> QueryParam "code" Text
-        :> Get '[Lucid.HTML] (Auth.SetCookies (App.Html UserAccount)),
-    getAccount ::
-      path
-        :- Auth.Auth '[Auth.Cookie] User
-        :> "account"
-        :> Get '[Lucid.HTML] (App.Html UserAccount),
-    postAccount ::
-      path
-        :- Auth.Auth '[Auth.Cookie] User
-        :> "account"
-        :> ReqBody '[FormUrlEncoded] Subscription
-        :> Post '[Lucid.HTML] (App.Html UserAccount),
-    selectRepo ::
-      path
-        :- Auth.Auth '[Auth.Cookie] User
-        :> "select-repo"
-        :> Get '[Lucid.HTML] (App.Html SelectRepo),
-    getAnalyses ::
-      path
-        :- Auth.Auth '[Auth.Cookie] User
-        :> "analysis"
-        :> Get '[Lucid.HTML] (App.Html Analyses),
-    getAnalysis ::
-      path
-        :- Auth.Auth '[Auth.Cookie] User
-        :> "analysis"
-        :> Capture "analysisId" (Id.Id AnalysisAction)
-        :> Get '[Lucid.HTML] (App.Html AnalysisDisplay),
-    postAnalysis ::
-      path
-        :- Auth.Auth '[Auth.Cookie] User
-        :> "analysis"
-        :> ReqBody '[FormUrlEncoded] SubmitAnalysis
-        :> Post '[Lucid.HTML] (App.Html AnalysisDisplay),
-    admin ::
-      path
-        :- Auth.Auth '[Auth.Cookie] User
-        :> "admin"
-        :> Get '[Lucid.HTML] (App.Html AdminDashboard)
-  }
-  deriving (Generic)
-
-paths :: Proxy (ToServantApi Paths)
-paths = genericApi (Proxy :: Proxy Paths)
-
-guardAuth ::
-  MonadError ServerError m =>
-  Auth.AuthResult a ->
-  m a
-guardAuth = \case
-  Auth.NoSuchUser -> throwError err401 {errBody = "No such user"}
-  Auth.BadPassword -> throwError err401 {errBody = "Bad password"}
-  Auth.Indefinite -> throwError err401 {errBody = "No authentication found"}
-  Auth.Authenticated user -> pure user
-
-guardAdmin ::
-  MonadError ServerError m =>
-  Auth.AuthResult User ->
-  m User
-guardAdmin = \case
-  Auth.NoSuchUser -> throwError err401 {errBody = "No such user"}
-  Auth.BadPassword -> throwError err401 {errBody = "Bad password"}
-  Auth.Indefinite -> throwError err401 {errBody = "No authentication found"}
-  Auth.Authenticated user@User {..}
-    | userGitHubId == GitHubId 200617 -> pure user
-    | otherwise -> throwError err401 {errBody = "You're not admin..."}
-
-requiredScopes :: Set Text
-requiredScopes = Set.fromList ["repo"]
-
-guardScope :: Text -> Servant.Handler ()
-guardScope =
-  Text.split (== ',')
-    .> Set.fromList
-    .> Set.isSubsetOf requiredScopes
-    .> ( \ok ->
-           unless ok
-             <| throwError err503 {errBody = "Scopes are not correct"}
-       )
-
--- | Main HTML handlers for all paths.
-htmlApp ::
-  Auth.CookieSettings ->
-  Acid.AcidState Keep ->
-  Config ->
-  JWK ->
-  Auth.OAuthArgs ->
-  Paths AsServer
-htmlApp cooks kp cfg jwk oAuthArgs =
-  Paths
-    { home =
-        homeExample cfg
-          |> GetAnalysesByUrl
-          |> Acid.query' kp
-          /> head
-          /> Home oAuthArgs
-          /> App.Html,
-      login =
-        pure <| addHeader (githubLoginUrl oAuthArgs) NoContent,
-      githubAuth = \case
-        Nothing -> throwError err503 {errBody = "Bad response from GitHub API"}
-        Just code -> do
-          Auth.OAuthResponse {..} <- Auth.githubOauth oAuthArgs code |> liftIO
-          guardScope scope
-          let warn :: Text -> Servant.Handler a
-              warn msg =
-                Log.warn [msg]
-                  >> Log.br
-                  |> liftIO
-                  >> throwError err502 {errBody = str msg}
-          user <-
-            GitHub.userInfoCurrentR
-              |> GitHub.github (userGitHubAuth access_token)
-              |> liftIO
-              +> either (show .> warn) pure
-              +> upsertGitHubUser kp (Encoding.encodeUtf8 access_token)
-              .> liftIO
-              +> either warn pure
-          Auth.acceptLogin cooks (Auth.defaultJWTSettings jwk) user
-            |> liftIO
-            +> \case
-              Nothing -> throwError err502 {errBody = "login didn't work"}
-              -- I think this should redirect to instead of rendering UserAccount
-              Just applyCookies ->
-                UserAccount user
-                  |> App.Html
-                  |> applyCookies
-                  |> pure,
-      getAccount =
-        guardAuth >=> UserAccount .> App.Html .> pure,
-      postAccount = \a subscription ->
-        guardAuth a
-          +> \user ->
-            UpdateUser user {userSubscription = subscription}
-              |> Acid.update' kp
-              +> UserAccount
-              .> App.Html
-              .> pure,
-      selectRepo =
-        guardAuth
-          >=> \user@User {..} ->
-            GitHub.github
-              (userGitHubAuth userGitHubToken)
-              (GitHub.currentUserReposR GitHub.RepoPublicityAll GitHub.FetchAll)
-              |> liftIO
-              +> \case
-                Left err -> throwError err502 {errBody = str <| (show err :: String)}
-                Right repos -> pure <. App.Html <| SelectRepo user repos,
-      getAnalyses =
-        guardAuth
-          >=> \user@User {..} ->
-            GetAnalysesByAsker user
-              |> Acid.query' kp
-              +> Analyses user
-              .> App.Html
-              .> pure,
-      getAnalysis = \a analysisId ->
-        guardAuth a
-          +> \user ->
-            GetAnalysisById analysisId
-              |> Acid.query' kp
-              +> \case
-                Nothing -> throwError err404
-                Just analysis -> pure <| App.Html <| AnalysisDisplay user analysis,
-      postAnalysis = \a SubmitAnalysis {..} ->
-        guardAuth a
-          +> \user@User {..} -> do
-            -- we just assume github for now
-            analyzeGitHub
-              kp
-              user
-              (userGitHubAuth userGitHubToken)
-              (depo cfg)
-              owner
-              repo
-              |> liftIO
-              +> AnalysisDisplay user
-              .> App.Html
-              .> pure,
-      admin =
-        guardAdmin
-          >=> \user -> do
-            allUsers <- Acid.query' kp GetUsers
-            totalAnalyses <- length </ Acid.query' kp GetAllAnalyses
-            AdminDashboard {..}
-              |> App.Html
-              |> pure
-    }
-
-baseStyle :: Clay.Css
-baseStyle = do
-  Biz.Look.fuckingStyle
-
-  Biz.Look.whenDark <| do
-    "body" ? do
-      Clay.backgroundColor black
-    "a:link" <> "a:visited" ? do
-      Clay.textDecorationColor Clay.white
-      Clay.color Clay.white
-    "a:hover" ? do
-      Clay.textDecorationColor yellow
-    "select" <> "button" <> "input" ? do
-      Clay.backgroundColor black
-      Clay.color Clay.white
-
-  Biz.Look.whenLight <| do
-    "body" ? do
-      Clay.color black
-    "a:link" <> "a:visited" ? do
-      Clay.textDecorationColor black
-      Clay.color black
-    "a:hover" ? do
-      Clay.textDecorationColor yellow
-    "select" <> "button" <> "input" ? do
-      Clay.backgroundColor Clay.white
-      Clay.color black
-
-  "body" ? Biz.Look.fontStack
-  "header" ? do
-    Clay.maxWidth (pct 100)
-  "footer" ? do
-    Clay.fontStyle Clay.italic
-    Clay.fontSize (rem 0.8)
-    Clay.marginTop (em 6)
-    Clay.marginBottom (em 6)
-  "a" <> "input.link" ? do
-    Clay.transition "all" (sec 0.2) Clay.ease 0
-    Clay.transitionProperties
-      [ "text-decoration-color",
-        "text-decoration-thickness",
-        "text-decoration-width"
-      ]
-    Clay.textDecoration Clay.underline
-    Biz.Look.textDecorationThickness (em 0.1)
-    Biz.Look.textDecorationWidth (em 0.1)
-  "a:hover" <> "input.link" ? do
-    Clay.textDecorationColor yellow
-    Clay.textDecoration Clay.underline
-    Biz.Look.textDecorationThickness (em 0.2)
-    Biz.Look.textDecorationWidth (em 0.2)
-
-  "select" <> "button" <> "input" ? do
-    Biz.Look.paddingAll (em 0.5)
-    Biz.Look.marginX (em 0.5)
-    Clay.borderColor yellow
-    Clay.borderStyle Clay.solid
-
-  -- for making POST requests with a form disguised as a link
-  "input.link" ? do
-    Clay.cursor Clay.pointer
-    Clay.borderWidth 0
-    Clay.fontSize (rem 1)
-    Biz.Look.marginAll (px 0)
-    Biz.Look.paddingAll (px 0)
-
-  ".badge" ? do
-    Clay.borderWidth (px 1)
-    Clay.borderColor Clay.grey
-    Clay.borderStyle Clay.solid
-    Biz.Look.borderRadiusAll (rem 2)
-    Clay.fontSize (rem 0.8)
-    Biz.Look.marginAll (rem 1)
-    Biz.Look.paddingX (rem 0.5)
-    Biz.Look.paddingY (rem 0.25)
-
-  "label" ? do
-    Clay.display Clay.inlineBlock
-    Clay.width (px 100)
-
-  "nav" ? do
-    Clay.display Clay.flex
-    Clay.justifyContent Clay.spaceBetween
-    "a" ? do
-      Clay.padding (em 1) (em 1) (em 1) (em 1)
-      Clay.display Clay.block
-    "ul" ? do
-      Clay.display Clay.flex
-      Clay.justifyContent Clay.flexEnd
-      Clay.listStyleType Clay.none
-      Clay.margin (Clay.px 0) 0 0 0
-      "li" ? do
-        Clay.padding 0 (px 5) 0 (px 5)
-
-  "details" ? do
-    Clay.display Clay.inline
-    "summary" ? do
-      Clay.color "#6c757d"
-      Clay.display Clay.listItem
-      Clay.cursor Clay.pointer
-
-yellow, black :: Clay.Color
-yellow = "#ffe000"
-black = "#121212"
-
-data AdminDashboard = AdminDashboard
-  { user :: User,
-    allUsers :: [User],
-    totalAnalyses :: Int
-  }
-
-instance App.HasCss AdminDashboard where
-  cssFor _ = mempty
-
-instance Lucid.ToHtml AdminDashboard where
-  toHtmlRaw = Lucid.toHtml
-  toHtml AdminDashboard {..} = do
-    header <| Just user
-    Lucid.main_ <| do
-      Lucid.section_ <| do
-        Lucid.h2_ <| Lucid.toHtml <| "Total Analyses: " <> tshow totalAnalyses
-      Lucid.section_ <| do
-        Lucid.h2_ "Post analysis"
-        let action = linkAction_ "/" <| fieldLink postAnalysis
-        Lucid.form_ [action, Lucid.method_ "post"] <| do
-          Lucid.input_ [Lucid.type_ "text", Lucid.name_ "owner"]
-          Lucid.input_ [Lucid.type_ "text", Lucid.name_ "repo"]
-          Lucid.input_
-            [ Lucid.type_ "submit"
-            ]
-
-      Lucid.section_ <| do
-        Lucid.h2_ "All Users"
-        Lucid.ul_
-          <| forM_ allUsers
-          <| \User {..} -> do
-            Lucid.li_ <| do
-              Lucid.toHtml <| unGitHubHandle userGitHubHandle
-
-    footer
-
--- | The front page pitch. Eventually I'd like to load the content from markdown
--- files or some other store of data so I can A/B test.
-data Home = Home Auth.OAuthArgs (Maybe AnalysisAction)
-
-instance App.HasCss Home where
-  cssFor (Home _ mAnalysis) = do
-    "p" ? Clay.textAlign Clay.center
-    "h1" ? do
-      Clay.fontSize (Clay.rem 3)
-    "h1" <> "h2" ? do
-      Clay.textAlign Clay.center
-    ".example" ? do
-      Clay.borderStyle Clay.solid
-      Clay.borderWidth (px 2)
-      Clay.borderColor "#aaa"
-      Biz.Look.borderRadiusAll (px 10)
-      Biz.Look.paddingX (em 2)
-      Biz.Look.paddingY (em 1)
-      maybe mempty App.cssFor mAnalysis
-    "section" ? do
-      Clay.padding (rem 3) 0 (rem 3) 0
-    "a#try-button" <> "a#try-button:visited" ? do
-      Clay.transition "all" (sec 0.2) Clay.ease 0
-      Clay.transitionProperties
-        ["color", "background-color", "border-color"]
-      Clay.padding (em 0.5) (em 1) (em 0.5) (em 1)
-      Clay.display Clay.flex
-      Clay.flexDirection Clay.column
-      Clay.margin (em 3) Clay.auto 0 Clay.auto
-      Clay.width (px 250)
-      Clay.borderWidth (px 1)
-      Clay.borderStyle Clay.solid
-      Clay.borderColor black
-      Clay.backgroundColor yellow
-      Clay.color black
-      Clay.textDecoration Clay.none
-      Clay.justifyContent Clay.center
-      Clay.alignItems Clay.center
-      Clay.fontWeight Clay.bold
-      "small" ? do
-        Clay.fontSize (px 10)
-    "a#try-button:hover" ? do
-      Clay.borderColor yellow
-      Clay.color yellow
-      Clay.backgroundColor black
-
-instance Lucid.ToHtml Home where
-  toHtmlRaw = Lucid.toHtml
-  toHtml (Home oAuthArgs analysis) = do
-    header Nothing
-    Lucid.main_ <| do
-      section <| do
-        h1 "Know your codebase."
-        h1 "Know your team."
-        p "Devalloc analyzes your codebase trends, finds patterns in how your developers work, and protects against tech debt."
-        p "Just hook it up to your CI system - Devalloc warns you when it finds a problem."
-        Lucid.toHtml <| tryButton oAuthArgs "Give it a try with GitHub" mempty
-      section <| do
-        h2 "Identify blackholes in your codebase"
-        p
-          "What if none of your active employees have touched some part of the codebase? \
-          \ This happens too often with legacy code, and then it turns into a huge source of tech debt. \
-          \ Devalloc finds these \"blackholes\" and warns you about them so you can be proactive in eliminating tech debt."
-      section <| do
-        h2 "Find developer hotspots"
-        p
-          "Which pieces of code get continually rewritten, taking up valuable dev time? \
-          \ Find these module hotspots before they become a costly time-sink."
-      section <| do
-        h2 "See an example analysis"
-        maybe
-          ( Lucid.toHtml
-              <| tryButton oAuthArgs "Run a free complimentary analysis" mempty
-          )
-          (exampleWrapper <. Lucid.toHtml)
-          analysis
-      section <| do
-        h2 "Protect against lost knowledge"
-        p "Not everyone can know every part of a codebase. By finding pieces of code that only 1 or 2 people have touched, devalloc identifes siloed knowledge. This allows you to protect against the risk of this knowledge leaving the company if an employee leaves."
-      section <| do
-        h2 "Don't just measure code coverage - also know your dev coverage"
-        p "No matter how smart your employees are, if you are under- or over-utilizing your developers then you will never get optimal performance from your team."
-        p "Know how your devs work best: which ones have depth of knowledge, and which ones have breadth?"
-      section <| do
-        h2 "See how your teams *actually* organize themselves with cluster analysis"
-        p "Does your team feel splintered or not cohesive? Which developers work best together? Devalloc analyzes the collaboration patterns between devs and helps you form optimal pairings and teams based on shared code and mindspace."
-      section <| do
-        h1 <| "Ready to get going?"
-        Lucid.toHtml
-          <| tryButton
-            oAuthArgs
-            "Give it a try with GitHub"
-            "It's free for a limited time!"
-    footer
-    where
-      section = Lucid.section_
-      markdown = Cmark.renderNode [] <. Cmark.commonmarkToNode []
-      p = Lucid.p_ <. markdown
-      h1 = Lucid.h1_
-      h2 = Lucid.h2_ <. markdown
-      exampleWrapper = Lucid.div_ [Lucid.class_ "example"]
-
-data Analyses = Analyses User [AnalysisAction]
-
-instance App.HasCss Analyses where
-  cssFor _ = mempty
-
-instance Lucid.ToHtml Analyses where
-  toHtmlRaw = Lucid.toHtml
-  toHtml (Analyses user@User {..} analyses) = do
-    header <| Just user
-    Lucid.main_ <| do
-      Lucid.section_ <| do
-        Lucid.h2_ "Your Analyses"
-        Lucid.p_
-          <| Lucid.a_
-            [Lucid.linkHref_ "/" <| fieldLink selectRepo]
-            "Analyze one of your repos"
-        Lucid.div_ <| do
-          forM_ analyses <| \AnalysisAction {..} ->
-            Lucid.a_
-              [ href analysisId,
-                css <| Biz.Look.marginAll (em 1)
-                  <> Clay.textDecoration Clay.none
-              ]
-              <| do
-                Lucid.div_ <| Lucid.toHtml url
-                Lucid.div_ [css <| Clay.fontSizeCustom Clay.Font.small]
-                  <| Lucid.toHtml (commit analysis)
-    footer
-    where
-      href aid = Lucid.linkHref_ "/" <| fieldLink getAnalysis aid
-
-newtype UserAccount = UserAccount User
-
-instance App.HasCss UserAccount where
-  cssFor (UserAccount _) = mempty
-
-instance Lucid.ToHtml Subscription where
-  toHtmlRaw = Lucid.toHtml
-  toHtml Free = "Free"
-  toHtml Invoice = "Invoice me"
-
-linkAction_ :: ToHttpApiData a => Text -> a -> Lucid.Attribute
-linkAction_ baseUrl = Lucid.action_ <. (baseUrl <>) <. Servant.toUrlPiece
-
-instance Lucid.ToHtml UserAccount where
-  toHtmlRaw = Lucid.toHtml
-  toHtml (UserAccount user@User {..}) = do
-    header <| Just user
-    Lucid.main_ <| do
-      Lucid.h1_ "Welcome!"
-      Lucid.section_ <| do
-        Lucid.h2_ "Subscription"
-        let action = linkAction_ "/" <| fieldLink postAccount
-        Lucid.form_ [action, Lucid.method_ "post"] <| do
-          let name = "user-subscription"
-          Lucid.label_ [Lucid.for_ name] "Your plan:"
-          Lucid.select_ [Lucid.name_ name] <| do
-            Lucid.option_
-              (Lucid.value_ "Free" : isSelected Free)
-              <| Lucid.toHtml Free
-            Lucid.option_
-              (Lucid.value_ "Invoice" : isSelected Invoice)
-              <| Lucid.toHtml Invoice
-          Lucid.input_ [Lucid.type_ "submit", Lucid.value_ "Save"]
-        when (userSubscription == Invoice) <| do
-          Lucid.p_ "Thanks! You will receive an invoice by email every month."
-    footer
-    where
-      isSelected sel =
-        if userSubscription == sel
-          then [Lucid.selected_ <| tshow sel]
-          else mempty
-
-css :: Clay.Css -> Lucid.Attribute
-css = Lucid.style_ <. toStrict <. Clay.renderWith Clay.htmlInline []
-
-userGitHubAuth ::
-  -- | Token from `User.userGitHubToken` or `Config.tokn`
-  Text ->
-  GitHub.Auth
-userGitHubAuth = GitHub.OAuth <. Encoding.encodeUtf8
-
--- GitHub OAuth endpoint. For what the parameters mean, see:
--- https://docs.github.com/en/developers/apps/authorizing-oauth-apps
-githubLoginUrl :: Auth.OAuthArgs -> Text
-githubLoginUrl Auth.OAuthArgs {..} =
-  "https://github.com/login/oauth/authorize?"
-    <> encodeParams
-      [ ("client_id", clientId),
-        ("state", clientState),
-        ("scope", Text.intercalate " " <| Set.toList requiredScopes)
-      ]
-
--- | This view presents a list of repos to select for analysis.
-data SelectRepo = SelectRepo User (Vector GitHub.Repo)
-
-instance App.HasCss SelectRepo where
-  cssFor (SelectRepo _ _) = do
-    "ul" ? do
-      Clay.listStyleType Clay.none
-      Clay.margin (px 0) 0 0 0
-      Clay.padding (px 0) 0 0 0
-      "li" ? do
-        Clay.borderBottomWidth (px 1)
-        Clay.borderBottomColor "#999"
-        Clay.borderBottomStyle Clay.solid
-        Clay.padding (em 1.5) 0 (em 1.5) 0
-        ".link" ? do
-          Clay.fontSize (em 1.17)
-
-instance Lucid.ToHtml SelectRepo where
-  toHtmlRaw = Lucid.toHtml
-  toHtml (SelectRepo user repos) = do
-    header <| Just user
-    Lucid.main_ <| do
-      Lucid.h2_ "Select a repo to analyze"
-      Lucid.ul_ <| Lucid.toHtml <| traverse_ displayRepo (Vector.toList repos)
-    footer
-    where
-      displayRepo :: GitHub.Repo -> Lucid.Html ()
-      displayRepo repo =
-        Lucid.li_ <| do
-          let action = linkAction_ "/" <| fieldLink postAnalysis
-          Lucid.form_ [action, Lucid.method_ "post"] <| do
-            Lucid.input_
-              [ Lucid.type_ "submit",
-                Lucid.class_ "link",
-                Lucid.value_ <| GitHub.untagName
-                  <| GitHub.repoName repo
-              ]
-            Lucid.input_
-              [ Lucid.type_ "hidden",
-                Lucid.name_ "owner",
-                Lucid.value_ <| GitHub.untagName <| GitHub.simpleOwnerLogin <| GitHub.repoOwner repo
-              ]
-            Lucid.input_
-              [ Lucid.type_ "hidden",
-                Lucid.name_ "repo",
-                Lucid.value_ <| GitHub.untagName <| GitHub.repoName repo
-              ]
-            when (GitHub.repoPrivate repo) <| privateBadge
-            maybe mempty (Lucid.p_ <. Lucid.toHtml) (GitHub.repoDescription repo)
-      privateBadge = Lucid.span_ [Lucid.class_ "badge"] "Private"
-
--- * parts
-
--- | Utility for turning a list of tuples into a URL querystring.
-encodeParams :: [(Text, Text)] -> Text
-encodeParams =
-  Encoding.decodeUtf8
-    <. LBS.toStrict
-    <. Web.urlEncodeParams
-
--- | Login button for GitHub.
-tryButton :: Auth.OAuthArgs -> Text -> Text -> Lucid.Html ()
-tryButton oAuthArgs title subtitle =
-  Lucid.a_
-    [Lucid.id_ "try-button", Lucid.href_ <| githubLoginUrl oAuthArgs]
-    <| do
-      Lucid.toHtml title
-      Lucid.small_ <| Lucid.toHtml subtitle
-
--- | Universal header
-header :: Monad m => Maybe User -> Lucid.HtmlT m ()
-header muser =
-  Lucid.header_ <| do
-    Lucid.nav_ <| do
-      a "Devalloc" <| fieldLink home
-      case muser of
-        Nothing ->
-          Lucid.ul_ <| do
-            li "Login" <| fieldLink login
-        Just _ ->
-          Lucid.ul_ <| do
-            li "Analyses" <| fieldLink getAnalyses
-            li "Account" <| fieldLink getAccount
-  where
-    a txt href =
-      Lucid.a_ [Lucid.linkHref_ "/" href] txt
-    li txt href = Lucid.li_ <| a txt href
-
--- | Universal footer
-footer :: Monad m => Lucid.HtmlT m ()
-footer =
-  Lucid.footer_ <| do
-    Lucid.p_ <| Lucid.i_ "Copyright ©2020-2021 Devalloc.io"
-
--- * analysis
-
-data SubmitAnalysis = SubmitAnalysis
-  { owner :: Text,
-    repo :: Text
-  }
-  deriving (Eq, Show, Generic)
-
-instance Web.FromForm SubmitAnalysis
-
--- | I need more information than just 'Analysis' has to render a full, useful
--- web page, hence this type.
-data AnalysisDisplay = AnalysisDisplay User AnalysisAction
-
-instance App.HasCss AnalysisDisplay where
-  cssFor (AnalysisDisplay _ analysis) = App.cssFor analysis
-
-instance Lucid.ToHtml AnalysisDisplay where
-  toHtmlRaw = Lucid.toHtml
-  toHtml (AnalysisDisplay user anal) = do
-    header <| Just user
-    Lucid.main_ <| do
-      Lucid.h1_ "Analysis Results"
-      Lucid.toHtml anal
-    footer
-
--- | Run a full analysis on a git repo
-analyze :: Acid.AcidState Keep -> Id.Id User -> [Text] -> URL -> FilePath -> Bool -> IO AnalysisAction
-analyze keep askedBy activeAuthors url bareRepo repoPrivate = do
-  commit <- Sha </ Text.strip </ Text.pack </ Analysis.git bareRepo ["log", "-n1", "--format=%H"]
-  Acid.query keep (GetAnalysisByUrlAndCommit url commit) +> \case
-    Just analysis -> pure analysis
-    Nothing ->
-      Analysis.run activeAuthors bareRepo
-        /> ( \a ->
-               AnalysisAction
-                 { analysisId = mempty,
-                   analysis = a,
-                   repoVisibility = repoPrivate ?: (Private, Public),
-                   ..
-                 }
-           )
-        /> CreateAnalysis
-        +> Acid.update keep
-
-spliceCreds :: User -> Text -> Text
-spliceCreds User {..} url =
-  scheme <> "//" <> unGitHubHandle userGitHubHandle <> ":" <> userGitHubToken <> "@" <> Text.drop 2 rest
-  where
-    (scheme, rest) = Text.breakOn "//" url
-
-test_spliceCreds :: Test.Tree
-test_spliceCreds =
-  Test.group
-    "spliceCreds"
-    [ Test.unit "simple happy path"
-        <| "https://user:token@github.com/owner/repo"
-        @=? spliceCreds mock_user "https://github.com/owner/repo"
-    ]
-  where
-    mock_user =
-      User
-        { userEmail = UserEmail <| Just "user@example.com",
-          userGitHubHandle = GitHubHandle "user",
-          userGitHubId = GitHubId 0,
-          userGitHubToken = "token",
-          userSubscription = Free,
-          userId = mempty
-        }
-
--- | Clones a repo from GitHub and does the analysis.
-analyzeGitHub ::
-  GitHub.AuthMethod ghAuth =>
-  Acid.AcidState Keep ->
-  -- | The User asking for the analysis, we auth as them
-  User ->
-  -- | How to auth with GitHub API
-  ghAuth ->
-  -- | The repo depo
-  FilePath ->
-  -- | GitHub owner
-  Text ->
-  -- | GitHub repo
-  Text ->
-  IO AnalysisAction
-analyzeGitHub keep user@User {userId} ghAuth depo o r = do
-  activeAuthors <-
-    getPeople
-      /> Vector.map (GitHub.simpleUserLogin .> GitHub.userInfoForR)
-      /> Vector.toList
-      +> Async.mapConcurrently (GitHub.github ghAuth)
-      /> map (either (const Nothing) GitHub.userEmail)
-      /> catMaybes
-      /> List.nub
-  GitHub.github ghAuth (GitHub.repositoryR ghOwner ghRepo) +> \case
-    Left err -> throwIO <| toException err
-    Right repo -> do
-      let canonicalUrl = GitHub.getUrl <| GitHub.repoHtmlUrl repo
-      let cloningUrl = if GitHub.repoPrivate repo then spliceCreds user canonicalUrl else canonicalUrl
-      let worktree = depo </> removeScheme canonicalUrl <.> "git"
-      bareRepo <- fetchBareRepo cloningUrl worktree
-      analyze keep userId activeAuthors (URL canonicalUrl) bareRepo (GitHub.repoPrivate repo)
-  where
-    ghOwner = GitHub.mkName (Proxy :: Proxy GitHub.Owner) o
-    ghRepo = GitHub.mkName (Proxy :: Proxy GitHub.Repo) r
-
-    getPeople :: IO (Vector GitHub.SimpleUser)
-    getPeople =
-      Async.runConcurrently <| (Vector.++)
-        </ Concurrently getCollaborators
-        <*> Concurrently getTopContributors
-
-    getCollaborators :: IO (Vector GitHub.SimpleUser)
-    getCollaborators =
-      GitHub.collaboratorsOnR ghOwner ghRepo GitHub.FetchAll
-        |> GitHub.github ghAuth
-        /> either mempty identity
-
-    getTopContributors :: IO (Vector GitHub.SimpleUser)
-    getTopContributors =
-      -- 'False' means don't include anonymous contributors
-      GitHub.contributorsR ghOwner ghRepo False GitHub.FetchAll
-        |> GitHub.github ghAuth
-        /> either mempty identity
-        -- TODO: return top 10%; I can't figure out how to use this />
-        -- Vector.sortBy
-        --   ( \case
-        --       GitHub.KnownContributor n _ _ _ _ _ -> n
-        --       GitHub.AnonymousContributor n _ -> n
-        --   )
-        /> Vector.take 10
-        /> Vector.mapMaybe GitHub.contributorToSimpleUser
-
-test_analyzeGitHub :: IO (Config, Application, Acid.AcidState Keep) -> Test.Tree
-test_analyzeGitHub load =
-  Test.group
-    "analyzeGitHub"
-    [ Test.unit "can analyze a public repo (octocat/hello-world)" <| do
-        (c, _, k) <- load
-        let user@User {userGitHubToken} = mock_user c
-        AnalysisAction {..} <-
-          analyzeGitHub
-            k
-            user
-            (userGitHubAuth userGitHubToken)
-            (depo c)
-            "octocat"
-            "hello-world"
-        url @?= URL "https://github.com/octocat/Hello-World"
-        -- bareRepo @?= depo c <> "/github.com/octocat/Hello-World.git"
-        let Analysis {..} = analysis
-        length activeAuthors @?= 2
-        activeAuthors @?= ["hire@spacegho.st", "octocat@github.com"]
-        blackholes @?= ["README"]
-        liabilities @?= ["README"]
-        Map.member "README" stale @?= True
-        score @?= 20
-        totalFiles @?= 1
-        commit @?= Sha "7fd1a60b01f91b314f59955a4e4d4e80d8edf11d",
-      Test.unit "can analyze a private repo (bsima/biz)" <| do
-        (c, _, k) <- load
-        let user@User {userGitHubToken} = mock_user c
-        AnalysisAction {..} <-
-          analyzeGitHub
-            k
-            user
-            (userGitHubAuth userGitHubToken)
-            (depo c)
-            "bsima"
-            "biz"
-        url @?= URL "https://github.com/bsima/biz"
-        -- bareRepo @?= depo c <> "/github.com/bsima/biz.git"
-    ]
-  where
-    mock_user c =
-      User
-        { userEmail = UserEmail <| Just "ben@bsima.me",
-          userGitHubHandle = GitHubHandle "bsima",
-          userGitHubId = GitHubId 0,
-          userGitHubToken = tokn c,
-          userSubscription = Free,
-          userId = mempty
-        }
-
--- | Clone the repo to @<Config.depo>/<url>@. If repo already exists, just do a
--- @git fetch@. pures the full path to the local repo.
-fetchBareRepo :: Text -> String -> IO FilePath
-fetchBareRepo url worktree =
-  Directory.doesPathExist worktree
-    +> fetchOrClone
-    >> pure worktree
-  where
-    fetchOrClone True =
-      Log.info ["git", "fetch", url]
-        >> Log.br
-        >> Process.callProcess "git" ["--git-dir", worktree, "fetch", "--quiet", "origin"]
-    fetchOrClone False =
-      Log.info ["git", "clone", url]
-        >> Log.br
-        >> Process.callProcess "git" ["clone", "--bare", "--quiet", "--", Text.unpack url, worktree]
-
-removeScheme :: Text -> FilePath
-removeScheme u = Text.unpack <. Text.dropWhile (== '/') <. snd <| Text.breakOn "//" u
diff --git a/Biz/Devalloc.nix b/Biz/Devalloc.nix
deleted file mode 100644
index a1c9bcf..0000000
--- a/Biz/Devalloc.nix
+++ /dev/null
@@ -1,66 +0,0 @@
-{ options
-, lib
-, config
-, pkgs
-, ...
-}:
-
-let
-  cfg = config.services.devalloc;
-in
-{
-  options.services.devalloc = {
-    enable = lib.mkEnableOption "Enable the devalloc service";
-    port = lib.mkOption {
-      type = lib.types.int;
-      default = 3000;
-      description = ''
-        The port on which devalloc will listen for
-        incoming HTTP traffic.
-      '';
-    };
-    keep = lib.mkOption {
-      type = lib.types.path;
-      default = "/var/devalloc/keep";
-      description = "Keep location";
-    };
-    depo = lib.mkOption {
-      type = lib.types.path;
-      default = "/var/devalloc/depo";
-      description = "depo location";
-    };
-    package = lib.mkOption {
-      type = lib.types.package;
-      description = "devalloc package to use";
-    };
-  };
-  config = lib.mkIf cfg.enable {
-    systemd.services.devalloc = {
-      path = [ cfg.package pkgs.git ];
-      wantedBy = [ "multi-user.target" ];
-      preStart = ''
-        mkdir -p ${cfg.keep}
-        mkdir -p ${cfg.depo}
-      '';
-      script = ''
-        ${cfg.package}/bin/devalloc
-      '';
-      description = ''
-        Devalloc
-      '';
-      serviceConfig = {
-        Environment = [
-          "PORT=${toString cfg.port}"
-          "AREA=Live"
-          "DEPO=${cfg.depo}"
-          "KEEP=${cfg.keep}"
-        ];
-        EnvironmentFile="/run/devalloc/env";
-        KillSignal = "INT";
-        Type = "simple";
-        Restart = "on-abort";
-        RestartSec = "1";
-      };
-    };
-  };
-}
diff --git a/Biz/Devalloc/Analysis.hs b/Biz/Devalloc/Analysis.hs
deleted file mode 100644
index 4b1f297..0000000
--- a/Biz/Devalloc/Analysis.hs
+++ /dev/null
@@ -1,252 +0,0 @@
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-
--- : out devalloc-analyze
-module Biz.Devalloc.Analysis
-  ( Analysis (..),
-    Commit (..),
-    run,
-    main,
-    test,
-    git,
-  )
-where
-
-import Alpha
-import qualified Biz.Cli as Cli
-import Biz.Test ((@=?))
-import qualified Biz.Test as Test
-import qualified Control.Concurrent.Async as Async
-import qualified Data.Aeson as Aeson
-import Data.Data (Data)
-import qualified Data.List as List
-import qualified Data.Map as Map
-import qualified Data.String as String
-import qualified Data.Text as Text
-import qualified Data.Time.Clock as Time
-import qualified Data.Time.Format as Time
-import qualified System.Directory as Directory
-import qualified System.Process as Process
-
-main :: IO ()
-main = Cli.main <| Cli.Plan help move test tidy
-
-move :: Cli.Arguments -> IO ()
-move args = gitDir +> run authors /> Aeson.encode +> putStrLn
-  where
-    gitDir =
-      Cli.argument "git-dir"
-        |> Cli.getArgWithDefault args ".git"
-        |> Directory.makeAbsolute
-    authors =
-      -- i think this is not working? do i need optparse-applicative?
-      Cli.shortOption 'a'
-        |> Cli.getAllArgs args
-        |> map Text.pack
-
-tidy :: cfg -> IO ()
-tidy _ = pure ()
-
-test :: Test.Tree
-test = Test.group "Biz.Devalloc.Analysis" [test_calculateScore]
-
-help :: Cli.Docopt
-help =
-  [Cli.docopt|
-devalloc-analyze
-
-Usage:
-  devalloc-analyze test
-  devalloc-analyze [--author=<email>]... <git-dir>
-
-Options:
-  -a, --author  List of active authors' emails.
-|]
-
-newtype Commit = Sha Text
-  deriving (Eq, Data, Typeable, Ord, Generic, Show)
-
-instance Aeson.ToJSON Commit
-
--- | The result of analyzing a git repo.
-data Analysis = Analysis
-  { -- | Where the repo is stored on the local disk.
-    gitDir :: FilePath,
-    -- | A path with no active contributors
-    blackholes :: [Text],
-    -- | A path with < 3 active contributors
-    liabilities :: [Text],
-    -- | Map of path to number of commits, for detecting paths that continually
-    -- get rewritten.
-    hotspotMap :: Map FilePath Integer,
-    -- | Files that have not been touched in 6 months
-    stale :: Map FilePath Integer,
-    -- | Total score for the repo
-    score :: Integer,
-    -- | Total number of files
-    totalFiles :: Integer,
-    -- | The total number of commits
-    totalCommits :: Integer,
-    -- | List of all the active users we care about
-    activeAuthors :: [Text],
-    -- | Which commit this analysis was run against.
-    commit :: Commit
-  }
-  deriving (Eq, Ord, Generic, Show, Data, Typeable)
-
-instance Aeson.ToJSON Analysis
-
-run :: [Text] -> FilePath -> IO Analysis
-run activeAuthors bareRepo = do
-  commit <- git bareRepo ["rev-parse", "HEAD"] /> Text.pack /> chomp /> Sha
-  tree <-
-    git
-      bareRepo
-      [ "ls-tree",
-        "--full-tree",
-        "--name-only",
-        "-r", -- recurse into subtrees
-        "HEAD"
-      ]
-      /> String.lines
-  authors <- traverse (authorsFor bareRepo) tree :: IO [[(Text, Text, Text)]]
-  let authorMap = zip tree authors :: [(FilePath, [(Text, Text, Text)])]
-  stalenessMap <- traverse (lastTouched bareRepo) tree
-  let blackholes =
-        [ Text.pack path
-          | (path, authors_) <- authorMap,
-            null (map third authors_ `List.intersect` activeAuthors)
-        ]
-  let liabilities =
-        [ Text.pack path
-          | (path, authors_) <- authorMap,
-            length (map third authors_ `List.intersect` activeAuthors) < 3
-        ]
-  let numBlackholes = realToFrac <| length blackholes
-  let numLiabilities = realToFrac <| length liabilities
-  let numTotal = realToFrac <| length tree
-  hotspotMap <-
-    Map.fromList </ Async.mapConcurrently getChangeCount tree
-  totalCommits <-
-    git bareRepo ["rev-list", "--count", "HEAD"]
-      /> filter (/= '\n')
-      /> readMaybe
-      /> fromMaybe 0
-  pure
-    <| Analysis
-      { gitDir = bareRepo,
-        stale =
-          Map.fromList
-            <| [ (path, days)
-                 | (path, Just days) <- stalenessMap,
-                   days > 180
-               ],
-        score = calculateScore numTotal numBlackholes numLiabilities,
-        totalFiles = toInteger <| length tree,
-        ..
-      }
-  where
-    third :: (a, b, c) -> c
-    third (_, _, a) = a
-    getChangeCount :: FilePath -> IO (FilePath, Integer)
-    getChangeCount path =
-      git bareRepo ["rev-list", "--count", "HEAD", "--", path]
-        /> filter (/= '\n')
-        /> readMaybe
-        /> fromMaybe 0
-        /> (path,)
-
--- | Given a git dir and a path inside the git repo, get information about the
--- authors.
-authorsFor ::
-  FilePath ->
-  FilePath ->
-  -- | returns (number of commits, author name, author email)
-  IO [(Text, Text, Text)]
-authorsFor gitDir path =
-  Process.readProcess
-    "git"
-    [ "--git-dir",
-      gitDir,
-      "shortlog",
-      "--numbered",
-      "--summary",
-      "--email",
-      "HEAD",
-      "--",
-      path
-    ]
-    ""
-    /> Text.pack
-    /> Text.lines
-    /> map (Text.break (== '\t'))
-    /> map parseAuthor
-  where
-    parseAuthor (commits, author) =
-      ( Text.strip commits,
-        Text.strip <| Text.takeWhile (/= '<') author,
-        Text.strip <| Text.dropAround (`elem` ['<', '>']) <| Text.dropWhile (/= '<') author
-      )
-
--- | Run a git command on a repo
-git ::
-  -- | path to the git dir (bare repo)
-  String ->
-  -- | args to `git`
-  [String] ->
-  IO String
-git bareRepo args = Process.readProcess "git" (["--git-dir", bareRepo] ++ args) ""
-
-lastTouched :: FilePath -> FilePath -> IO (FilePath, Maybe Integer)
-lastTouched bareRepo path = do
-  now <- Time.getCurrentTime
-  timestamp <-
-    Process.readProcess
-      "git"
-      [ "--git-dir",
-        bareRepo,
-        "log",
-        "-n1",
-        "--pretty=%aI",
-        "--",
-        path
-      ]
-      ""
-      /> filter (/= '\n')
-      /> Time.parseTimeM True Time.defaultTimeLocale "%Y-%m-%dT%H:%M:%S%z"
-  pure (path, calculateAge now </ timestamp)
-  where
-    calculateAge now n = round <| Time.diffUTCTime now n / Time.nominalDay
-
--- | Does the aggregate score calculation given number of files found to be
--- blackholes, liabilities, etc.
-calculateScore :: Double -> Double -> Double -> Integer
-calculateScore 0 _ _ = 0
-calculateScore a 0 0 | a > 0 = 100
-calculateScore a b c | a < 0 || b < 0 || c < 0 = 0
-calculateScore numTotal numBlackholes numLiabilities =
-  max 0 <. round
-    <| maxScore
-    * (weightedBlackholes + weightedLiabilities + numGood)
-    / numTotal
-  where
-    weightedBlackholes = numBlackholes * (5 / 10)
-    weightedLiabilities = numLiabilities * (7 / 10)
-    numGood = numTotal - numBlackholes - numLiabilities
-    maxScore = 100.0
-
-test_calculateScore :: Test.Tree
-test_calculateScore =
-  Test.group
-    "calculateScore"
-    [ Test.unit "perfect score" <| 100 @=? calculateScore 100 0 0,
-      Test.unit "all blackholes" <| 50 @=? calculateScore 100 100 0,
-      Test.unit "all liabilities" <| 70 @=? calculateScore 100 0 100,
-      Test.prop "never > 100" <| \t b l -> calculateScore t b l <= 100,
-      Test.prop "never < 0" <| \t b l -> calculateScore t b l >= 0
-    ]
diff --git a/Biz/Devalloc/get-examples.sh b/Biz/Devalloc/get-examples.sh
deleted file mode 100755
index 2e0647b..0000000
--- a/Biz/Devalloc/get-examples.sh
+++ /dev/null
@@ -1,13 +0,0 @@
-#!/usr/bin/env bash
-if [ "$#" == "0" ]
-then
-    echo "usage: $(basename $0) <cookie>"
-    echo "copy the cookie from the browser dev console"
-    exit 1
-fi
-cookie="$1"
-curl 'https://devalloc.io/analysis?user=github&repo=training-kit' \
-    -X POST \
-    -H 'Content-Type: application/x-www-form-urlencoded' \
-    -H "Cookie: JWT-Cookie=$cookie" \
-    --compressed --insecure
diff --git a/Biz/Devalloc/main.py b/Biz/Devalloc/main.py
deleted file mode 100755
index bb10441..0000000
--- a/Biz/Devalloc/main.py
+++ /dev/null
@@ -1,221 +0,0 @@
-#!/usr/bin/env python
-"""
-Analyze developer allocation across a codebase.
-"""
-
-import argparse
-import datetime
-import logging
-import os
-import re
-import subprocess
-import sys
-
-
-def find_user(line):
-    """Given 'Ben Sima <ben@bsima.me>', finds `Ben Sima'. Returns the first
-    matching string."""
-    return re.findall(r"^[^<]*", line)[0].strip()
-
-
-def authors_for(path, active_users):
-    """Return a dictionary of {author: commits} for given path. Usernames not in
-    the 'active_users' list will be filtered out."""
-    raw = subprocess.check_output(
-        ["git", "shortlog", "--numbered", "--summary", "--email", "--", path]
-    ).decode("utf-8")
-    lines = [s for s in raw.split("\n") if s]
-    data = {}
-    for line in lines:
-        parts = line.strip().split("\t")
-        author = find_user(parts[1])
-        commits = parts[0]
-        if author in active_users:
-            data[author] = commits
-    return data
-
-
-def mailmap_users():
-    """Returns users from the .mailmap file."""
-    users = []
-    with open(".mailmap") as file:
-        lines = file.readlines()
-        for line in lines:
-            users.append(find_user(line))
-    return users
-
-
-MAX_SCORE = 10
-
-
-def score(blackhole, liability, good, total):
-    "Calculate the score."
-    weights = {
-        "blackhole": 0.5,
-        "liability": 0.7,
-    }
-    return (
-        MAX_SCORE
-        * (
-            (blackhole * weights["blackhole"])
-            + (liability * weights["liability"])
-            + good
-        )
-        / total
-    )
-
-
-def get_args():
-    "Parse CLI arguments."
-    cli = argparse.ArgumentParser(description=__doc__)
-    cli.add_argument("repo", default=".", help="the git repo to run on", metavar="REPO")
-    cli.add_argument(
-        "-b",
-        "--blackholes",
-        action="store_true",
-        help="print the blackholes (files with one or zero active contributors)",
-    )
-    cli.add_argument(
-        "-l",
-        "--liabilities",
-        action="store_true",
-        help="print the liabilities (files with < 3 active contributors)",
-    )
-    cli.add_argument(
-        "-s",
-        "--stale",
-        action="store_true",
-        help="print stale files (haven't been touched in 6 months)",
-    )
-    cli.add_argument(
-        "-i", "--ignored", nargs="+", default=[], help="patterns to ignore in paths",
-    )
-    cli.add_argument(
-        "--active-users",
-        nargs="+",
-        default=[],
-        help="list of active user emails. if not provided, this is loaded from .mailmap",
-    )
-    cli.add_argument(
-        "-v",
-        "--verbosity",
-        help="set the log level verbosity",
-        choices=["debug", "warning", "error"],
-        default="error",
-    )
-    return cli.parse_args()
-
-
-def guard_git(repo):
-    "Guard against non-git repos."
-    is_git = subprocess.run(
-        ["git", "rev-parse"],
-        stderr=subprocess.PIPE,
-        stdout=subprocess.PIPE,
-        check=False,
-    ).returncode
-    if is_git != 0:
-        sys.exit(f"error: not a git repository: {repo}")
-
-
-def staleness(path, now):
-    "How long has it been since this file was touched?"
-    timestamp = datetime.datetime.strptime(
-        subprocess.check_output(["git", "log", "-n1", "--pretty=%aI", path])
-        .decode("utf-8")
-        .strip(),
-        "%Y-%m-%dT%H:%M:%S%z",
-    )
-    delta = now - timestamp
-    return delta.days
-
-
-class Repo:
-    "Represents a repo and stats for the repo."
-
-    def __init__(self, ignored_paths, active_users):
-        self.paths = [
-            p
-            for p in subprocess.check_output(["git", "ls-files", "--no-deleted"])
-            .decode("utf-8")
-            .split()
-            if not any(i in p for i in ignored_paths)
-        ]
-        logging.debug("collecting stats")
-        self.stats = {}
-        for path in self.paths:
-            self.stats[path] = authors_for(path, active_users)
-        self.blackholes = [path for path, authors in self.stats.items() if not authors]
-        self.liabilities = {
-            path: list(authors)
-            for path, authors in self.stats.items()
-            if 1 <= len(authors) < 3
-        }
-        now = datetime.datetime.utcnow().astimezone()
-        self.stale = {}
-        for path, _ in self.stats.items():
-            _staleness = staleness(path, now)
-            if _staleness > 180:
-                self.stale[path] = _staleness
-
-    def print_blackholes(self, full):
-        "Print number of blackholes, or list of all blackholes."
-        # note: file renames may result in false positives
-        n_blackhole = len(self.blackholes)
-        print(f"Blackholes: {n_blackhole}")
-        if full:
-            for path in self.blackholes:
-                print(f"  {path}")
-
-    def print_liabilities(self, full):
-        "Print number of liabilities, or list of all liabilities."
-        n_liabilities = len(self.liabilities)
-        print(f"Liabilities: {n_liabilities}")
-        if full:
-            for path, authors in self.liabilities.items():
-                print(f"  {path}  ({', '.join(authors)})")
-
-    def print_score(self):
-        "Print the overall score."
-        n_total = len(self.stats.keys())
-        n_blackhole = len(self.blackholes)
-        n_liabilities = len(self.liabilities)
-        n_good = n_total - n_blackhole - n_liabilities
-        print("Total:", n_total)
-        print(
-            "Score: {:.2f}/{}".format(
-                score(n_blackhole, n_liabilities, n_good, n_total), MAX_SCORE
-            )
-        )
-
-    def print_stale(self, full):
-        "Print stale files"
-        n_stale = len(self.stale)
-        print(f"Stale files: {n_stale}")
-        if full:
-            for path, days in self.stale.items():
-                print(f"  {path}  ({days} days)")
-
-
-if __name__ == "__main__":
-    ARGS = get_args()
-    logging.basicConfig(stream=sys.stderr, level=ARGS.verbosity.upper())
-
-    logging.debug("starting")
-    os.chdir(os.path.abspath(ARGS.repo))
-
-    guard_git(ARGS.repo)
-
-    # if no active users provided, load from .mailmap
-    if ARGS.active_users == []:
-        if os.path.exists(".mailmap"):
-            ARGS.active_users = mailmap_users()
-
-    # collect data
-    REPO = Repo(ARGS.ignored, ARGS.active_users)
-
-    # print data
-    REPO.print_score()
-    REPO.print_blackholes(ARGS.blackholes)
-    REPO.print_liabilities(ARGS.liabilities)
-    REPO.print_stale(ARGS.stale)
diff --git a/Biz/Devalloc/pitch.md b/Biz/Devalloc/pitch.md
deleted file mode 100644
index cfc0b23..0000000
--- a/Biz/Devalloc/pitch.md
+++ /dev/null
@@ -1,40 +0,0 @@
-# Devalloc
-
-Devalloc analyzes your codebase trends, finds patterns in how your developers
-work, and protects against tech debt.
-
-Just hook it up to your CI system - it will warn you when it finds a problem.
-
-## Identify blackholes in your codebase
-
-What if none of your active employees have touched some part of the codebase?
-This happens too often with legacy code, and then it turns into a huge source of
-tech debt. Devalloc finds these "blackholes" and warns you about them so you
-can be proactive in eliminating tech debt.
-
-## Protect against lost knowledge
-
-Not everyone can know every part of a codebase. By finding pieces of code
-that only 1 or 2 people have touched, devalloc identifes siloed knowledge. This
-allows you to protect against the risk of this knowledge leaving the company if
-an employee leaves.
-
-## Don't just measure "code coverage" - also know your "dev coverage"
-
-No matter how smart your employees are, if you are under- or over-utilizing your
-developers then you will never get optimal performance from your team.
-
-- Find developer "hot spots" in your code: which pieces of code get continually
-  rewritten, taking up valuable dev time?
-- Know how your devs work best: which ones have depth of knowledge, and which
-  ones have breadth?
-
-(Paid only)
-
-## See how your teams *actually* organize themselves with cluster analysis
-
-Does your team feel splintered or not cohesive? Which developers work best
-together? Devalloc analyzes the collaboration patterns between devs and helps
-you form optimal pairings and teams based on shared code and mindspace.
-
-(Paid only)
diff --git a/Biz/Dragons.hs b/Biz/Dragons.hs
new file mode 100644
index 0000000..6cb5fed
--- /dev/null
+++ b/Biz/Dragons.hs
@@ -0,0 +1,1666 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE ExtendedDefaultRules #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE Strict #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+-- Developer allocation
+--
+-- : out dragons
+-- : sys cmark
+module Biz.Dragons
+  ( main,
+    test,
+  )
+where
+
+import Alpha hiding (rem, (<.>))
+import qualified Biz.App as App
+import qualified Biz.Auth as Auth
+import qualified Biz.Cli as Cli
+import Biz.Dragons.Analysis (Analysis (..), Commit (..))
+import qualified Biz.Dragons.Analysis as Analysis
+import qualified Biz.Id as Id
+import qualified Biz.Log as Log
+import qualified Biz.Look
+import Biz.Test ((@=?), (@?!=), (@?=))
+import qualified Biz.Test as Test
+import qualified CMark as Cmark
+import qualified CMark.Lucid as Cmark
+import Clay (em, pct, px, rem, sec, (?))
+import qualified Clay
+import qualified Clay.Font
+import qualified Clay.Render as Clay
+import qualified Control.Concurrent.Async as Async
+import qualified Control.Exception as Exception
+import Crypto.JOSE.JWK (JWK)
+import Data.Acid (makeAcidic)
+import qualified Data.Acid as Acid
+import qualified Data.Acid.Advanced as Acid
+import qualified Data.Acid.Local as Acid
+import qualified Data.Aeson as Aeson
+import qualified Data.ByteString.Lazy as LBS
+import Data.Data (Data)
+import Data.IxSet (Indexable (..), IxSet, ixFun, ixSet, (&&&), (@=))
+import qualified Data.IxSet as IxSet
+import qualified Data.List as List
+import qualified Data.Map as Map
+import Data.SafeCopy (base, deriveSafeCopy, extension)
+import qualified Data.SafeCopy as SafeCopy
+import qualified Data.Set as Set
+import qualified Data.Text as Text
+import qualified Data.Text.Encoding as Encoding
+import qualified Data.Time.Calendar as Time
+import qualified Data.Time.Clock as Time
+import Data.Vector (Vector)
+import qualified Data.Vector as Vector
+-- import qualified Data.Vector.Algorithms.Intro as Vector
+import qualified GitHub
+import qualified Lucid
+import qualified Lucid.Base as Lucid
+import qualified Lucid.Servant as Lucid
+import NeatInterpolation
+import qualified Network.Wai as Wai
+import qualified Network.Wai.Handler.Warp as Warp
+import Servant
+import Servant.API.Generic (ToServantApi, genericApi, toServant, (:-))
+import qualified Servant.Auth as Auth
+import qualified Servant.Auth.Server as Auth
+import qualified Servant.HTML.Lucid as Lucid
+import Servant.Server.Generic (AsServer)
+import qualified System.Directory as Directory
+import qualified System.Envy as Envy
+import System.FilePath ((<.>), (</>))
+import qualified System.Process as Process
+import qualified Web.FormUrlEncoded as Web
+
+-- * persistent data
+
+-- This must go first because of template haskell splicing.
+--
+-- When changing a persisted type `T`, first copy the type `T == T0`, then make
+-- the `SafeCopy.Migrate T` class compile, then make changes to `T`. If you
+-- don't, there will be a runtime exception when you try to start the new
+-- service. I'm not sure how to guard against this, except maybe run a test
+-- deployment by copying a database backup locally, or something:
+--     rm -rf _/var/dragons
+--     rsync -avz /var/dragons/ _/var
+
+newtype UserEmail = UserEmail {unUserEmail :: Maybe Text}
+  deriving (Eq, Ord, Data, Typeable, Generic, Show)
+
+instance Aeson.ToJSON UserEmail
+
+instance Aeson.FromJSON UserEmail
+
+instance Auth.ToJWT UserEmail
+
+instance Auth.FromJWT UserEmail
+
+instance Lucid.ToHtml UserEmail where
+  toHtmlRaw = Lucid.toHtml
+  toHtml (UserEmail (Just email)) = Lucid.toHtml email
+  toHtml (UserEmail Nothing) = mempty
+
+$(deriveSafeCopy 0 'base ''UserEmail)
+
+-- | In 'GitHub.Data.Definitions' this is '(Id User)', but I don't want the
+-- extra complexity of 'Id', so just store the underlying Int
+newtype GitHubId = GitHubId {unGitHubId :: Int}
+  deriving (Eq, Ord, Data, Typeable, Generic, Show)
+
+instance Aeson.ToJSON GitHubId
+
+instance Aeson.FromJSON GitHubId
+
+instance Auth.ToJWT GitHubId
+
+instance Auth.FromJWT GitHubId
+
+$(deriveSafeCopy 0 'base ''GitHubId)
+
+newtype GitHubHandle = GitHubHandle {unGitHubHandle :: Text}
+  deriving (Eq, Ord, Data, Typeable, Generic, Show)
+
+instance Aeson.ToJSON GitHubHandle
+
+instance Aeson.FromJSON GitHubHandle
+
+$(deriveSafeCopy 0 'base ''GitHubHandle)
+
+data Subscription = Free | Invoice
+  deriving (Eq, Data, Typeable, Ord, Generic, Show)
+
+instance Web.FromForm Subscription where
+  fromForm f = case Web.parseUnique "user-subscription" f of
+    Right "Free" -> Right Free
+    Right "Invoice" -> Right Invoice
+    Right x -> Left <| "could not parse form value: " <> x
+    Left x -> Left <| "could not parse form value: " <> x
+
+instance Aeson.ToJSON Subscription
+
+instance Aeson.FromJSON Subscription
+
+instance Auth.ToJWT Subscription
+
+instance Auth.FromJWT Subscription
+
+$(deriveSafeCopy 0 'base ''Subscription)
+
+data User0 = User0
+  { userEmail :: UserEmail,
+    userGitHubId :: GitHubId,
+    -- | So we can make GitHub API calls on their behalf.
+    userGitHubToken :: Text,
+    userSubscription :: Subscription,
+    userId :: Id.Id User0
+  }
+  deriving (Eq, Data, Typeable, Ord, Generic, Show)
+
+$(deriveSafeCopy 0 'base ''Id.Id)
+$(deriveSafeCopy 0 'base ''User0)
+
+-- | The main representation of a user.
+data User = User
+  { userEmail :: UserEmail,
+    userGitHubId :: GitHubId,
+    userGitHubHandle :: GitHubHandle,
+    -- | So we can make GitHub API calls on their behalf.
+    userGitHubToken :: Text,
+    userSubscription :: Subscription,
+    userId :: Id.Id User
+  }
+  deriving (Eq, Data, Typeable, Ord, Generic, Show)
+
+instance Aeson.ToJSON User
+
+instance Aeson.FromJSON User
+
+instance Auth.ToJWT User
+
+instance Auth.FromJWT User
+
+instance SafeCopy.Migrate User where
+  type MigrateFrom User = User0
+  migrate User0 {..} =
+    User
+      { userId = Id.mk (Proxy :: Proxy User) <| Id.untag userId,
+        userGitHubHandle = GitHubHandle "unknown",
+        ..
+      }
+
+$(deriveSafeCopy 1 'extension ''User)
+
+instance Indexable User where
+  empty =
+    ixSet
+      [ ixFun <| \User {..} -> [userEmail],
+        ixFun <| \User {..} -> [userGitHubId],
+        ixFun <| \User {..} -> [userSubscription]
+      ]
+
+instance Lucid.ToHtml Commit where
+  toHtmlRaw = Lucid.toHtml
+  toHtml (Sha txt) = Lucid.toHtml txt
+
+$(deriveSafeCopy 0 'base ''Commit)
+
+newtype URL = URL Text
+  deriving (Eq, Data, Typeable, Ord, Generic, Show)
+
+instance Envy.Var URL where
+  toVar (URL txt) = str txt
+  fromVar = Just <. URL <. str
+
+instance Lucid.ToHtml URL where
+  toHtmlRaw = Lucid.toHtml
+  toHtml (URL txt) = Lucid.toHtml txt
+
+$(deriveSafeCopy 0 'base ''URL)
+
+data Visibility = Public | Private
+  deriving (Eq, Ord, Generic, Show, Data, Typeable)
+
+$(deriveSafeCopy 0 'base ''Visibility)
+
+instance Indexable Analysis where
+  empty =
+    ixSet
+      [ ixFun <| \Analysis {..} -> [commit]
+      ]
+
+instance App.HasCss AnalysisAction where
+  cssFor _ = do
+    "#analysis > *" ? do
+      Biz.Look.marginAll (rem 2)
+    ".score" ? do
+      Clay.display Clay.grid
+      Biz.Look.gridTemplateAreas
+        [ "title quantity details-collapsed",
+          "preview-chart preview-chart preview-chart",
+          "details details details"
+        ]
+      Clay.alignItems Clay.baseline
+      Clay.gridTemplateColumns [pct 30, 40, 30]
+      Biz.Look.gridTemplateRows ["auto"]
+    ".title" ? do
+      Biz.Look.gridArea "title"
+      Clay.fontSize (rem 1.4)
+      Clay.lineHeight (rem 2.4)
+    ".percentage" ? do
+      Biz.Look.gridArea "quantity"
+      Clay.display Clay.flex
+      Clay.alignItems Clay.baseline
+      ".centum" ? do
+        Clay.fontSize (rem 1.2)
+        Clay.lineHeight (rem 1.2)
+    ".quantity" ? do
+      Biz.Look.gridArea "quantity"
+      Clay.fontSize (rem 3)
+      Clay.lineHeight (rem 3)
+    ".preview-chart" ? do
+      Biz.Look.gridArea "preview-chart"
+    "details" ? do
+      Biz.Look.gridArea "details-collapsed"
+      Biz.Look.justifySelf <| Clay.JustifyContentValue "self-end"
+    "details[open]" ? do
+      Biz.Look.gridArea "details"
+      Biz.Look.justifySelf <| Clay.JustifyContentValue "auto"
+    ".preview-chart" ? do
+      Clay.height (px 2)
+      Clay.maxWidth (pct 100)
+    "table" ? do
+      Biz.Look.marginAll (px 0)
+      Clay.maxWidth (pct 100)
+    "#hotspots" ? do
+      ".preview-chart" ? do
+        Clay.height (rem 1)
+        "table" ? do
+          Clay.height (rem 4)
+          Clay.marginTop (rem (-3))
+          Clay.zIndex (-1)
+      ".bar" ? do
+        Clay.height (px 800)
+
+instance Lucid.ToHtml AnalysisAction where
+  toHtmlRaw = Lucid.toHtml
+  toHtml AnalysisAction {..} =
+    Lucid.div_ [Lucid.id_ "analysis"] <| do
+      let Analysis {..} = analysis
+      Lucid.p_ [Lucid.class_ "analysisFor"] <| do
+        "Analysis for " <> Lucid.toHtml gitDir
+
+      score_ <| do
+        title_ "Total Score"
+        percentage_ <| do
+          quantity_ <| Lucid.toHtml <| tshow score
+          centum_ "/100"
+        previewChart <| simpleBar score 100
+        Lucid.details_ <| do
+          Lucid.summary_ "Details"
+          desc
+            [text|
+            Your score is a weighted composite of the below metrics.
+            What your score means:
+            - 0-30: very high risk, most of your codebase is unknown or ephemeral
+            - 30-60: medium-high risk, tasks that involve working on this
+              codebase will take longer than they should, and we should expect
+              a few unforeseen bugs
+            - 60-80: medium-low risk, tasks in this codebase can be expected to
+              complete in the estimated time, and it probably doesn't have many bugs
+            - 80+: low risk, your codebase is super clean, give your devs a raise
+            |]
+
+      score_ <| do
+        title_ "Total Files"
+        quantity_ <| Lucid.toHtml <| tshow totalFiles
+
+      score_ <| do
+        title_ "Active authors"
+        quantity_ <| Lucid.toHtml <| slen activeAuthors
+        Lucid.details_ <| do
+          Lucid.summary_ "Details"
+          Lucid.ul_ <| forM_ activeAuthors <| \author -> do
+            Lucid.li_ <| Lucid.toHtml author
+
+      score_ <| do
+        title_ "Blackholes"
+        quantity_ <| Lucid.toHtml <| slen blackholes
+        previewChart <| simpleBar (len blackholes) totalFiles
+        Lucid.details_ <| do
+          Lucid.summary_ "Details"
+          desc
+            [text|
+            A blackhole has zero active contributors, so none of your current team
+            members have touched this code. These are very high risk. If there is
+            a problem with this area of the codebase, it will take longer for your
+            team to diagnose and fix the root cause; new features that interact
+            with a blackhole will take longer to deploy.
+
+            **What you can do:** Start a project to ensure these blackholes are
+            well-defined and documented. If anything is completely unknown, write
+            tests against that part of the code as it currently stands, then decide
+            if a rewrite is necessary.
+            |]
+          Lucid.ul_ <| do
+            traverse_ (Lucid.toHtml .> Lucid.li_) blackholes
+
+      score_ <| do
+        title_ "Liabilities"
+        quantity_ <| Lucid.toHtml <| slen liabilities
+        previewChart <| simpleBar (len liabilities) totalFiles
+        Lucid.details_ <| do
+          Lucid.summary_ "Details"
+          desc
+            [text|
+            Files with < 3 active contributors. These are at risk of becoming
+            blackholes if contributors change teams or leave the company.
+
+            **What you can do:** Next time a task involves one of these files,
+            pull in some team members that haven't worked on this area of the
+            codebase.
+
+            In general, when assigning tasks, ensure developers are occasionally
+            working on areas of the codebase that are new to them. Not only will
+            this decrease your liability, it will also improve your developers
+            by helping them learn new areas of the code and share techniques.
+            |]
+          Lucid.ul_ <| do
+            traverse_ (Lucid.toHtml .> Lucid.li_) liabilities
+
+      score_ <| do
+        title_ "Stale files"
+        quantity_ <| Lucid.toHtml <| tshow <| Map.size stale
+        previewChart <| simpleBar (Map.size stale) totalFiles
+        Lucid.details_ <| do
+          Lucid.summary_ "Details"
+          desc
+            [text|
+            Files that haven't been touched in 6 months. These aren't necessarily
+            a risk: unchanging files could just be really well-defined and stable.
+            On the other hand, they could also be places that nobody wants to go
+            because nobody knows how they work.
+
+            **What you can do:** Run this list by your team and find out who has
+            knowledge of this area. If nobody does, start a project to
+            investigate and re-define this part of the codebase, ensuring good
+            documentation practices along the way.
+            |]
+          Lucid.ul_ <| do
+            -- probably Map.mapWithKey is better?
+            forM_ (Map.toList stale) <| \(path, days) ->
+              Lucid.li_ <| Lucid.toHtml <| path <> " (" <> show days <> " days)"
+
+      Lucid.with score_ [Lucid.id_ "hotspots"] <| do
+        title_ "Hotspots"
+        quantity_ "" -- TODO
+        previewChart <| do
+          Lucid.table_ [Lucid.class_ "charts-css column"] <| do
+            Lucid.tr_ <| do
+              forM_ (Map.toList hotspotMap) <| \(_, n) -> do
+                Lucid.td_ [Lucid.style_ <| size n totalCommits] ""
+        Lucid.details_ <| do
+          Lucid.summary_ "Details"
+          desc
+            [text|
+            A hotspot is an over-active code module: developers are continually
+            reworking this part of the code, wasting time redoing work instead
+            of progressing.
+            The flamegraph below plots files by how often they are changed, a
+            longer horizontal line means more changes. Hover over the bars to
+            see filenames and change count.
+
+            **What you can do:** After identifying the hotspots, discuss with your
+            team how to improve the code. Why does the code change so often? Does
+            it need a more well-defined spec? Does it need a deep refactor? Maybe
+            part of it can be abstracted into a more solid module?
+            |]
+          Lucid.table_ [Lucid.class_ "charts-css bar"] <| do
+            Lucid.tr_ <| do
+              forM_ (Map.toList hotspotMap) <| \(path, n) -> do
+                Lucid.td_ [Lucid.style_ <| size n totalCommits] <| do
+                  Lucid.span_ [Lucid.class_ "tooltip"]
+                    <| Lucid.toHtml
+                    <| path <> ": " <> show n <> " commits"
+    where
+      simpleBar :: (Show i, Monad m, Num i) => i -> Integer -> Lucid.HtmlT m ()
+      simpleBar n total = do
+        Lucid.table_ [Lucid.class_ "charts-css bar stacked multiple"] <| do
+          Lucid.tr_ <| do
+            Lucid.td_ [Lucid.style_ <| size n total] ""
+            <> Lucid.td_ [Lucid.style_ <| size total total] ""
+
+      len = toInteger <. length
+      slen = tshow <. length
+      div_ c = Lucid.with Lucid.div_ [Lucid.class_ c]
+      score_ = div_ "score"
+      title_ = div_ "title"
+      quantity_ = div_ "quantity"
+      centum_ = div_ "centum"
+      percentage_ = div_ "percentage"
+      size n total = "--size: calc(" <> show n <> "/" <> show total <> ")"
+      previewChart = div_ "preview-chart"
+      desc :: Monad m => Text -> Lucid.HtmlT m ()
+      desc = Lucid.p_ <. Cmark.renderNode [] <. Cmark.commonmarkToNode []
+
+-- | Captures an 'Analysis' with metadata used in the webapp to track who asked
+-- it and so on.
+data AnalysisAction = AnalysisAction
+  { -- | Monotonic incrementing integer id
+    analysisId :: Id.Id AnalysisAction,
+    -- | Who asked for this analysis
+    askedBy :: Id.Id User,
+    -- | Where is this coming from?
+    url :: URL,
+    -- | Is the URL publically visible?
+    repoVisibility :: Visibility,
+    -- | The actual analaysis
+    analysis :: Analysis
+  }
+  deriving (Eq, Ord, Generic, Show, Data, Typeable)
+
+$(deriveSafeCopy 0 'base ''Analysis)
+$(deriveSafeCopy 0 'base ''AnalysisAction)
+
+instance Indexable AnalysisAction where
+  empty =
+    ixSet
+      [ ixFun <| \AnalysisAction {..} -> [analysisId],
+        ixFun <| \AnalysisAction {..} -> [askedBy],
+        ixFun <| \AnalysisAction {..} -> [url],
+        ixFun <| \AnalysisAction {..} -> [repoVisibility],
+        ixFun <| \AnalysisAction {..} -> [commit analysis]
+      ]
+
+-- | The database.
+data Keep = Keep
+  { users :: IxSet User,
+    nextUserId :: Id.Id User,
+    analyses :: IxSet AnalysisAction,
+    nextAnalysisId :: Id.Id AnalysisAction
+  }
+  deriving (Data, Typeable)
+
+$(deriveSafeCopy 0 'base ''Keep)
+
+createUser :: User -> Acid.Update Keep User
+createUser u = do
+  keep <- get
+  let newUser = u {userId = nextUserId keep} :: User
+  put
+    <| keep
+      { users = IxSet.insert newUser (users keep),
+        nextUserId = succ <| nextUserId keep
+      }
+  pure newUser
+
+updateUser :: User -> Acid.Update Keep User
+updateUser u@User {..} = do
+  keep <- get
+  put <| keep {users = IxSet.updateIx userGitHubId u (users keep)}
+  pure u
+
+getUserByEmail :: UserEmail -> Acid.Query Keep (Maybe User)
+getUserByEmail email = do
+  Keep {..} <- ask
+  pure <| IxSet.getOne <| users @= email
+
+getUserByGitHubId :: GitHubId -> Acid.Query Keep (Maybe User)
+getUserByGitHubId id = do
+  Keep {..} <- ask
+  pure <| IxSet.getOne <| users @= id
+
+getUsers :: Acid.Query Keep [User]
+getUsers = do
+  Keep {..} <- ask
+  pure <| IxSet.toList users
+
+createAnalysis :: AnalysisAction -> Acid.Update Keep AnalysisAction
+createAnalysis a = do
+  keep@Keep {..} <- get
+  let newAnalysis = a {analysisId = nextAnalysisId} :: AnalysisAction
+  put
+    <| keep
+      { analyses = IxSet.insert newAnalysis analyses,
+        nextAnalysisId = succ nextAnalysisId
+      }
+  pure newAnalysis
+
+getAnalysisById :: Id.Id AnalysisAction -> Acid.Query Keep (Maybe AnalysisAction)
+getAnalysisById id = do
+  Keep {..} <- ask
+  pure <| IxSet.getOne <| analyses @= id
+
+getAllAnalyses :: Acid.Query Keep [AnalysisAction]
+getAllAnalyses = do
+  Keep {..} <- ask
+  pure <| IxSet.toList analyses
+
+getAnalysesByAsker :: User -> Acid.Query Keep [AnalysisAction]
+getAnalysesByAsker User {..} = do
+  Keep {..} <- ask
+  pure <| IxSet.toList <| analyses @= userId
+
+getAnalysesByUrl :: URL -> Acid.Query Keep [AnalysisAction]
+getAnalysesByUrl url = do
+  Keep {..} <- ask
+  pure <| IxSet.toList <| analyses @= url
+
+getAnalysisByUrlAndCommit :: URL -> Commit -> Acid.Query Keep (Maybe AnalysisAction)
+getAnalysisByUrlAndCommit url sha = do
+  Keep {..} <- ask
+  pure <| IxSet.getOne <| analyses @= url &&& analyses @= sha
+
+$( makeAcidic
+     ''Keep
+     [ 'createUser,
+       'updateUser,
+       'getUsers,
+       'getUserByEmail,
+       'getUserByGitHubId,
+       'createAnalysis,
+       'getAnalysisById,
+       'getAllAnalyses,
+       'getAnalysesByAsker,
+       'getAnalysesByUrl,
+       'getAnalysisByUrlAndCommit
+     ]
+ )
+
+upsertGitHubUser ::
+  Acid.AcidState Keep ->
+  ByteString ->
+  GitHub.User ->
+  IO (Either Text User)
+upsertGitHubUser keep tok ghUser =
+  ghUser
+    |> GitHub.userId
+    |> GitHub.untagId
+    |> GitHubId
+    |> GetUserByGitHubId
+    |> Acid.query keep
+    +> \case
+      Just user ->
+        -- if we already know this user, we need to refresh the token
+        UpdateUser user {userGitHubToken = Encoding.decodeUtf8 tok}
+          |> Acid.update keep
+      Nothing ->
+        CreateUser
+          User
+            { userEmail = UserEmail <| GitHub.userEmail ghUser,
+              userGitHubId = GitHubId <. GitHub.untagId <| GitHub.userId ghUser,
+              userGitHubHandle =
+                GitHubHandle <| GitHub.untagName <| GitHub.userLogin ghUser,
+              userGitHubToken = Encoding.decodeUtf8 tok,
+              userSubscription = Free,
+              userId = mempty
+            }
+          |> Acid.update keep
+    /> Right
+
+test_upsertGitHubUser :: IO (Config, Application, Acid.AcidState Keep) -> Test.Tree
+test_upsertGitHubUser load =
+  Test.group
+    "upsertUser"
+    [ Test.unit "userId is not mempty" <| do
+        (_, _, k) <- load
+        Right User {..} <- upsertGitHubUser k "token" mock_ghUser
+        userId @?!= mempty,
+      Test.unit "creates user when email is empty" <| do
+        (_, _, k) <- load
+        Right User {..} <- upsertGitHubUser k "token" mock_ghUser {GitHub.userEmail = Nothing}
+        userEmail @?!= UserEmail Nothing
+    ]
+
+mock_ghUser :: GitHub.User
+mock_ghUser =
+  GitHub.User
+    { GitHub.userId = GitHub.mkId (Proxy :: Proxy GitHub.User) 123,
+      GitHub.userEmail = Just "user@example.com",
+      GitHub.userLogin = "user",
+      GitHub.userName = Nothing,
+      GitHub.userType = GitHub.OwnerUser,
+      GitHub.userCreatedAt =
+        Time.UTCTime (Time.ModifiedJulianDay 1) (Time.secondsToDiffTime 100),
+      GitHub.userPublicGists = 123,
+      GitHub.userAvatarUrl = GitHub.URL "http://example.com",
+      GitHub.userFollowers = 0,
+      GitHub.userFollowing = 0,
+      GitHub.userHireable = Nothing,
+      GitHub.userBlog = Nothing,
+      GitHub.userBio = Nothing,
+      GitHub.userPublicRepos = 0,
+      GitHub.userLocation = Nothing,
+      GitHub.userCompany = Nothing,
+      GitHub.userUrl = GitHub.URL "http://example.com",
+      GitHub.userHtmlUrl = GitHub.URL "http://example.com"
+    }
+
+init :: Keep
+init =
+  Keep
+    { nextAnalysisId = Id.mk (Proxy :: Proxy AnalysisAction) 1,
+      nextUserId = Id.mk (Proxy :: Proxy User) 1,
+      users = IxSet.empty,
+      analyses = IxSet.empty
+    }
+
+-- * main and test
+
+main :: IO ()
+main = Cli.main <| Cli.Plan help move test tidy
+
+help :: Cli.Docopt
+help =
+  [Cli.docopt|
+dragons
+
+Usage:
+  dragons [--quiet]
+  dragons test
+|]
+
+move :: Cli.Arguments -> IO ()
+move args =
+  Exception.bracket
+    (startup <| args `Cli.has` Cli.longOption "quiet")
+    shutdown
+    run
+
+startup :: Bool -> IO (Config, Application, Acid.AcidState Keep)
+startup quiet = do
+  cfg <- Envy.decodeWithDefaults Envy.defConfig
+  oAuthArgs <- Envy.decodeWithDefaults Envy.defConfig
+  kp <- Acid.openLocalStateFrom (keep cfg) init :: IO (Acid.AcidState Keep)
+  jwk <- Auth.generateKey
+  let URL url = homeExample cfg
+  unless quiet <| do
+    Log.info ["boot", "dragons"] >> Log.br
+    Log.info ["boot", "area", show <| area cfg] >> Log.br
+    Log.info ["boot", "port", show <| port cfg] >> Log.br
+    Log.info ["boot", "depo", Text.pack <| depo cfg] >> Log.br
+    Log.info ["boot", "keep", Text.pack <| keep cfg] >> Log.br
+    Log.info ["boot", "home", "example", url] >> Log.br
+  let jwtCfg = Auth.defaultJWTSettings jwk
+  let cooks = case area cfg of
+        Test -> testCookieSettings
+        Live -> liveCookieSettings
+  let ctx = cooks :. jwtCfg :. EmptyContext
+  let app = serveWithContext paths ctx (toServant <| htmlApp cooks kp cfg jwk oAuthArgs)
+  unless quiet <| do Log.info ["boot", "ready"] >> Log.br
+  pure (cfg, app, kp)
+
+shutdown :: (Config, Application, Acid.AcidState Keep) -> IO ()
+shutdown (_, _, kp) = Acid.createCheckpointAndClose kp
+
+tidy :: Config -> IO ()
+tidy Config {..} = Directory.removeDirectoryRecursive keep
+
+run :: (Config, Wai.Application, Acid.AcidState Keep) -> IO ()
+run (cfg, app, _) = Warp.run (port cfg) (Log.wai app)
+
+liveCookieSettings :: Auth.CookieSettings
+liveCookieSettings =
+  Auth.defaultCookieSettings
+    { Auth.cookieIsSecure = Auth.Secure,
+      -- disable XSRF protection because we don't use any javascript
+      Auth.cookieXsrfSetting = Nothing
+    }
+
+testCookieSettings :: Auth.CookieSettings
+testCookieSettings =
+  Auth.defaultCookieSettings
+    { Auth.cookieIsSecure = Auth.NotSecure,
+      Auth.cookieXsrfSetting = Nothing
+    }
+
+test :: Test.Tree
+test =
+  Test.group
+    "Biz.Dragons"
+    [ test_spliceCreds,
+      Test.with
+        (startup True)
+        (\t@(c, _, _) -> shutdown t >> tidy c)
+        test_upsertGitHubUser,
+      Test.with
+        (startup True)
+        (\t@(c, _, _) -> shutdown t >> tidy c)
+        test_analyzeGitHub
+    ]
+
+-- * app configurations
+
+data Area = Test | Live
+  deriving (Generic, Show)
+
+instance Envy.Var Area where
+  toVar = show
+  fromVar "Test" = Just Test
+  fromVar "Live" = Just Live
+  fromVar _ = Just Test
+
+data Config = Config
+  { port :: Warp.Port,
+    -- | The repo depo! Depository of repositories!
+    depo :: FilePath,
+    keep :: FilePath,
+    area :: Area,
+    -- | A user token for the GitHub API to be used in testing and when getting
+    -- the homepage/example analyses. Get a token with 'repo' scope from GitHub
+    -- and set in .envrc.local
+    -- https://docs.github.com/en/github/authenticating-to-github/creating-a-personal-access-token
+    tokn :: Text,
+    -- | The example shown on the homepage
+    homeExample :: URL
+  }
+  deriving (Generic, Show)
+
+instance Envy.DefConfig Config where
+  defConfig =
+    Config
+      { port = 8005,
+        depo = "_/var/dragons/depo",
+        keep = "_/var/dragons/keep",
+        area = Test,
+        tokn = mempty,
+        homeExample = URL "https://github.com/github/training-kit"
+      }
+
+instance Envy.FromEnv Config
+
+-- * paths and pages
+
+-- | Wraps pages in default HTML
+instance (Lucid.ToHtml a, App.HasCss a) => Lucid.ToHtml (App.Html a) where
+  toHtmlRaw = Lucid.toHtml
+  toHtml (App.Html x) =
+    Lucid.doctypehtml_ <| do
+      Lucid.head_ <| do
+        Lucid.title_ "Dragons.dev :: Know your codebase, know your team."
+        Lucid.meta_
+          [ Lucid.name_ "description",
+            Lucid.content_ "Know your codebase, know your team."
+          ]
+        Lucid.meta_
+          [ Lucid.name_ "viewport",
+            Lucid.content_ "width=device-width, initial-scale=1"
+          ]
+        Lucid.meta_ [Lucid.charset_ "utf-8"]
+        jsRef "//unpkg.com/turbolinks@5.2.0/dist/turbolinks.js"
+        -- base styles
+        style baseStyle
+        cssRef "//unpkg.com/charts.css/dist/charts.min.css"
+        -- page styles
+        style <| App.cssFor x
+      Lucid.body_ (Lucid.toHtml x)
+    where
+      style = Lucid.style_ <. toStrict <. Clay.renderWith Clay.compact []
+      jsRef _href =
+        Lucid.with
+          (Lucid.script_ mempty)
+          [ Lucid.makeAttribute "src" _href,
+            Lucid.makeAttribute "async" mempty,
+            Lucid.makeAttribute "defer" mempty
+          ]
+      cssRef _href =
+        Lucid.with
+          (Lucid.link_ mempty)
+          [ Lucid.makeAttribute "rel" "stylesheet",
+            Lucid.makeAttribute "href" _href
+          ]
+
+-- | All of the routes in the app.
+data Paths path = Paths
+  { home ::
+      path
+        :- Get '[Lucid.HTML] (App.Html Home),
+    login ::
+      path
+        :- "login"
+        :> Verb 'GET 301 '[Lucid.HTML] (Headers '[Header "Location" Text] NoContent),
+    githubAuth ::
+      path
+        :- "auth"
+        :> "github"
+        :> "callback"
+        :> QueryParam "code" Text
+        :> Get '[Lucid.HTML] (Auth.SetCookies (App.Html UserAccount)),
+    getAccount ::
+      path
+        :- Auth.Auth '[Auth.Cookie] User
+        :> "account"
+        :> Get '[Lucid.HTML] (App.Html UserAccount),
+    postAccount ::
+      path
+        :- Auth.Auth '[Auth.Cookie] User
+        :> "account"
+        :> ReqBody '[FormUrlEncoded] Subscription
+        :> Post '[Lucid.HTML] (App.Html UserAccount),
+    selectRepo ::
+      path
+        :- Auth.Auth '[Auth.Cookie] User
+        :> "select-repo"
+        :> Get '[Lucid.HTML] (App.Html SelectRepo),
+    getAnalyses ::
+      path
+        :- Auth.Auth '[Auth.Cookie] User
+        :> "analysis"
+        :> Get '[Lucid.HTML] (App.Html Analyses),
+    getAnalysis ::
+      path
+        :- Auth.Auth '[Auth.Cookie] User
+        :> "analysis"
+        :> Capture "analysisId" (Id.Id AnalysisAction)
+        :> Get '[Lucid.HTML] (App.Html AnalysisDisplay),
+    postAnalysis ::
+      path
+        :- Auth.Auth '[Auth.Cookie] User
+        :> "analysis"
+        :> ReqBody '[FormUrlEncoded] SubmitAnalysis
+        :> Post '[Lucid.HTML] (App.Html AnalysisDisplay),
+    admin ::
+      path
+        :- Auth.Auth '[Auth.Cookie] User
+        :> "admin"
+        :> Get '[Lucid.HTML] (App.Html AdminDashboard)
+  }
+  deriving (Generic)
+
+paths :: Proxy (ToServantApi Paths)
+paths = genericApi (Proxy :: Proxy Paths)
+
+guardAuth ::
+  MonadError ServerError m =>
+  Auth.AuthResult a ->
+  m a
+guardAuth = \case
+  Auth.NoSuchUser -> throwError err401 {errBody = "No such user"}
+  Auth.BadPassword -> throwError err401 {errBody = "Bad password"}
+  Auth.Indefinite -> throwError err401 {errBody = "No authentication found"}
+  Auth.Authenticated user -> pure user
+
+guardAdmin ::
+  MonadError ServerError m =>
+  Auth.AuthResult User ->
+  m User
+guardAdmin = \case
+  Auth.NoSuchUser -> throwError err401 {errBody = "No such user"}
+  Auth.BadPassword -> throwError err401 {errBody = "Bad password"}
+  Auth.Indefinite -> throwError err401 {errBody = "No authentication found"}
+  Auth.Authenticated user@User {..}
+    | userGitHubId == GitHubId 200617 -> pure user
+    | otherwise -> throwError err401 {errBody = "You're not admin..."}
+
+requiredScopes :: Set Text
+requiredScopes = Set.fromList ["repo"]
+
+guardScope :: Text -> Servant.Handler ()
+guardScope =
+  Text.split (== ',')
+    .> Set.fromList
+    .> Set.isSubsetOf requiredScopes
+    .> ( \ok ->
+           unless ok
+             <| throwError err503 {errBody = "Scopes are not correct"}
+       )
+
+-- | Main HTML handlers for all paths.
+htmlApp ::
+  Auth.CookieSettings ->
+  Acid.AcidState Keep ->
+  Config ->
+  JWK ->
+  Auth.OAuthArgs ->
+  Paths AsServer
+htmlApp cooks kp cfg jwk oAuthArgs =
+  Paths
+    { home =
+        homeExample cfg
+          |> GetAnalysesByUrl
+          |> Acid.query' kp
+          /> head
+          /> Home oAuthArgs
+          /> App.Html,
+      login =
+        pure <| addHeader (githubLoginUrl oAuthArgs) NoContent,
+      githubAuth = \case
+        Nothing -> throwError err503 {errBody = "Bad response from GitHub API"}
+        Just code -> do
+          Auth.OAuthResponse {..} <- Auth.githubOauth oAuthArgs code |> liftIO
+          guardScope scope
+          let warn :: Text -> Servant.Handler a
+              warn msg =
+                Log.warn [msg]
+                  >> Log.br
+                  |> liftIO
+                  >> throwError err502 {errBody = str msg}
+          user <-
+            GitHub.userInfoCurrentR
+              |> GitHub.github (userGitHubAuth access_token)
+              |> liftIO
+              +> either (show .> warn) pure
+              +> upsertGitHubUser kp (Encoding.encodeUtf8 access_token)
+              .> liftIO
+              +> either warn pure
+          Auth.acceptLogin cooks (Auth.defaultJWTSettings jwk) user
+            |> liftIO
+            +> \case
+              Nothing -> throwError err502 {errBody = "login didn't work"}
+              -- I think this should redirect to instead of rendering UserAccount
+              Just applyCookies ->
+                UserAccount user
+                  |> App.Html
+                  |> applyCookies
+                  |> pure,
+      getAccount =
+        guardAuth >=> UserAccount .> App.Html .> pure,
+      postAccount = \a subscription ->
+        guardAuth a
+          +> \user ->
+            UpdateUser user {userSubscription = subscription}
+              |> Acid.update' kp
+              +> UserAccount
+              .> App.Html
+              .> pure,
+      selectRepo =
+        guardAuth
+          >=> \user@User {..} ->
+            GitHub.github
+              (userGitHubAuth userGitHubToken)
+              (GitHub.currentUserReposR GitHub.RepoPublicityAll GitHub.FetchAll)
+              |> liftIO
+              +> \case
+                Left err -> throwError err502 {errBody = str <| (show err :: String)}
+                Right repos -> pure <. App.Html <| SelectRepo user repos,
+      getAnalyses =
+        guardAuth
+          >=> \user@User {..} ->
+            GetAnalysesByAsker user
+              |> Acid.query' kp
+              +> Analyses user
+              .> App.Html
+              .> pure,
+      getAnalysis = \a analysisId ->
+        guardAuth a
+          +> \user ->
+            GetAnalysisById analysisId
+              |> Acid.query' kp
+              +> \case
+                Nothing -> throwError err404
+                Just analysis -> pure <| App.Html <| AnalysisDisplay user analysis,
+      postAnalysis = \a SubmitAnalysis {..} ->
+        guardAuth a
+          +> \user@User {..} -> do
+            -- we just assume github for now
+            analyzeGitHub
+              kp
+              user
+              (userGitHubAuth userGitHubToken)
+              (depo cfg)
+              owner
+              repo
+              |> liftIO
+              +> AnalysisDisplay user
+              .> App.Html
+              .> pure,
+      admin =
+        guardAdmin
+          >=> \user -> do
+            allUsers <- Acid.query' kp GetUsers
+            totalAnalyses <- length </ Acid.query' kp GetAllAnalyses
+            AdminDashboard {..}
+              |> App.Html
+              |> pure
+    }
+
+baseStyle :: Clay.Css
+baseStyle = do
+  Biz.Look.fuckingStyle
+
+  Biz.Look.whenDark <| do
+    "body" ? do
+      Clay.backgroundColor black
+    "a:link" <> "a:visited" ? do
+      Clay.textDecorationColor Clay.white
+      Clay.color Clay.white
+    "a:hover" ? do
+      Clay.textDecorationColor yellow
+    "select" <> "button" <> "input" ? do
+      Clay.backgroundColor black
+      Clay.color Clay.white
+
+  Biz.Look.whenLight <| do
+    "body" ? do
+      Clay.color black
+    "a:link" <> "a:visited" ? do
+      Clay.textDecorationColor black
+      Clay.color black
+    "a:hover" ? do
+      Clay.textDecorationColor yellow
+    "select" <> "button" <> "input" ? do
+      Clay.backgroundColor Clay.white
+      Clay.color black
+
+  "body" ? Biz.Look.fontStack
+  "header" ? do
+    Clay.maxWidth (pct 100)
+  "footer" ? do
+    Clay.fontStyle Clay.italic
+    Clay.fontSize (rem 0.8)
+    Clay.marginTop (em 6)
+    Clay.marginBottom (em 6)
+  "a" <> "input.link" ? do
+    Clay.transition "all" (sec 0.2) Clay.ease 0
+    Clay.transitionProperties
+      [ "text-decoration-color",
+        "text-decoration-thickness",
+        "text-decoration-width"
+      ]
+    Clay.textDecoration Clay.underline
+    Biz.Look.textDecorationThickness (em 0.1)
+    Biz.Look.textDecorationWidth (em 0.1)
+  "a:hover" <> "input.link" ? do
+    Clay.textDecorationColor yellow
+    Clay.textDecoration Clay.underline
+    Biz.Look.textDecorationThickness (em 0.2)
+    Biz.Look.textDecorationWidth (em 0.2)
+
+  "select" <> "button" <> "input" ? do
+    Biz.Look.paddingAll (em 0.5)
+    Biz.Look.marginX (em 0.5)
+    Clay.borderColor yellow
+    Clay.borderStyle Clay.solid
+
+  -- for making POST requests with a form disguised as a link
+  "input.link" ? do
+    Clay.cursor Clay.pointer
+    Clay.borderWidth 0
+    Clay.fontSize (rem 1)
+    Biz.Look.marginAll (px 0)
+    Biz.Look.paddingAll (px 0)
+
+  ".badge" ? do
+    Clay.borderWidth (px 1)
+    Clay.borderColor Clay.grey
+    Clay.borderStyle Clay.solid
+    Biz.Look.borderRadiusAll (rem 2)
+    Clay.fontSize (rem 0.8)
+    Biz.Look.marginAll (rem 1)
+    Biz.Look.paddingX (rem 0.5)
+    Biz.Look.paddingY (rem 0.25)
+
+  "label" ? do
+    Clay.display Clay.inlineBlock
+    Clay.width (px 100)
+
+  "nav" ? do
+    Clay.display Clay.flex
+    Clay.justifyContent Clay.spaceBetween
+    "a" ? do
+      Clay.padding (em 1) (em 1) (em 1) (em 1)
+      Clay.display Clay.block
+    "ul" ? do
+      Clay.display Clay.flex
+      Clay.justifyContent Clay.flexEnd
+      Clay.listStyleType Clay.none
+      Clay.margin (Clay.px 0) 0 0 0
+      "li" ? do
+        Clay.padding 0 (px 5) 0 (px 5)
+
+  "details" ? do
+    Clay.display Clay.inline
+    "summary" ? do
+      Clay.color "#6c757d"
+      Clay.display Clay.listItem
+      Clay.cursor Clay.pointer
+
+yellow, black :: Clay.Color
+yellow = "#ffe000"
+black = "#121212"
+
+data AdminDashboard = AdminDashboard
+  { user :: User,
+    allUsers :: [User],
+    totalAnalyses :: Int
+  }
+
+instance App.HasCss AdminDashboard where
+  cssFor _ = mempty
+
+instance Lucid.ToHtml AdminDashboard where
+  toHtmlRaw = Lucid.toHtml
+  toHtml AdminDashboard {..} = do
+    header <| Just user
+    Lucid.main_ <| do
+      Lucid.section_ <| do
+        Lucid.h2_ <| Lucid.toHtml <| "Total Analyses: " <> tshow totalAnalyses
+      Lucid.section_ <| do
+        Lucid.h2_ "Post analysis"
+        let action = linkAction_ "/" <| fieldLink postAnalysis
+        Lucid.form_ [action, Lucid.method_ "post"] <| do
+          Lucid.input_ [Lucid.type_ "text", Lucid.name_ "owner"]
+          Lucid.input_ [Lucid.type_ "text", Lucid.name_ "repo"]
+          Lucid.input_
+            [ Lucid.type_ "submit"
+            ]
+
+      Lucid.section_ <| do
+        Lucid.h2_ "All Users"
+        Lucid.ul_
+          <| forM_ allUsers
+          <| \User {..} -> do
+            Lucid.li_ <| do
+              Lucid.toHtml <| unGitHubHandle userGitHubHandle
+
+    footer
+
+-- | The front page pitch. Eventually I'd like to load the content from markdown
+-- files or some other store of data so I can A/B test.
+data Home = Home Auth.OAuthArgs (Maybe AnalysisAction)
+
+instance App.HasCss Home where
+  cssFor (Home _ mAnalysis) = do
+    "p" ? Clay.textAlign Clay.center
+    "h1" ? do
+      Clay.fontSize (Clay.rem 3)
+    "h1" <> "h2" ? do
+      Clay.textAlign Clay.center
+    ".example" ? do
+      Clay.borderStyle Clay.solid
+      Clay.borderWidth (px 2)
+      Clay.borderColor "#aaa"
+      Biz.Look.borderRadiusAll (px 10)
+      Biz.Look.paddingX (em 2)
+      Biz.Look.paddingY (em 1)
+      maybe mempty App.cssFor mAnalysis
+    "section" ? do
+      Clay.padding (rem 3) 0 (rem 3) 0
+    "a#try-button" <> "a#try-button:visited" ? do
+      Clay.transition "all" (sec 0.2) Clay.ease 0
+      Clay.transitionProperties
+        ["color", "background-color", "border-color"]
+      Clay.padding (em 0.5) (em 1) (em 0.5) (em 1)
+      Clay.display Clay.flex
+      Clay.flexDirection Clay.column
+      Clay.margin (em 3) Clay.auto 0 Clay.auto
+      Clay.width (px 250)
+      Clay.borderWidth (px 1)
+      Clay.borderStyle Clay.solid
+      Clay.borderColor black
+      Clay.backgroundColor yellow
+      Clay.color black
+      Clay.textDecoration Clay.none
+      Clay.justifyContent Clay.center
+      Clay.alignItems Clay.center
+      Clay.fontWeight Clay.bold
+      "small" ? do
+        Clay.fontSize (px 10)
+    "a#try-button:hover" ? do
+      Clay.borderColor yellow
+      Clay.color yellow
+      Clay.backgroundColor black
+
+instance Lucid.ToHtml Home where
+  toHtmlRaw = Lucid.toHtml
+  toHtml (Home oAuthArgs analysis) = do
+    header Nothing
+    Lucid.main_ <| do
+      section <| do
+        h1 "Know your codebase."
+        h1 "Know your team."
+        p "Dragons analyzes your codebase trends, finds patterns in how your developers work, and protects against tech debt."
+        p "Just hook it up to your CI system - Dragons warns you when it finds a problem."
+        Lucid.toHtml <| tryButton oAuthArgs "Give it a try with GitHub" mempty
+      section <| do
+        h2 "Identify blackholes in your codebase"
+        p
+          "What if none of your active employees have touched some part of the codebase? \
+          \ This happens too often with legacy code, and then it turns into a huge source of tech debt. \
+          \ Dragons finds these \"blackholes\" and warns you about them so you can be proactive in eliminating tech debt."
+      section <| do
+        h2 "Find developer hotspots"
+        p
+          "Which pieces of code get continually rewritten, taking up valuable dev time? \
+          \ Find these module hotspots before they become a costly time-sink."
+      section <| do
+        h2 "See an example analysis"
+        maybe
+          ( Lucid.toHtml
+              <| tryButton oAuthArgs "Run a free complimentary analysis" mempty
+          )
+          (exampleWrapper <. Lucid.toHtml)
+          analysis
+      section <| do
+        h2 "Protect against lost knowledge"
+        p "Not everyone can know every part of a codebase. By finding pieces of code that only 1 or 2 people have touched, dragons identifes siloed knowledge. This allows you to protect against the risk of this knowledge leaving the company if an employee leaves."
+      section <| do
+        h2 "Don't just measure code coverage - also know your dev coverage"
+        p "No matter how smart your employees are, if you are under- or over-utilizing your developers then you will never get optimal performance from your team."
+        p "Know how your devs work best: which ones have depth of knowledge, and which ones have breadth?"
+      section <| do
+        h2 "See how your teams *actually* organize themselves with cluster analysis"
+        p "Does your team feel splintered or not cohesive? Which developers work best together? Dragons analyzes the collaboration patterns between devs and helps you form optimal pairings and teams based on shared code and mindspace."
+      section <| do
+        h1 <| "Ready to get going?"
+        Lucid.toHtml
+          <| tryButton
+            oAuthArgs
+            "Give it a try with GitHub"
+            "It's free for a limited time!"
+    footer
+    where
+      section = Lucid.section_
+      markdown = Cmark.renderNode [] <. Cmark.commonmarkToNode []
+      p = Lucid.p_ <. markdown
+      h1 = Lucid.h1_
+      h2 = Lucid.h2_ <. markdown
+      exampleWrapper = Lucid.div_ [Lucid.class_ "example"]
+
+data Analyses = Analyses User [AnalysisAction]
+
+instance App.HasCss Analyses where
+  cssFor _ = mempty
+
+instance Lucid.ToHtml Analyses where
+  toHtmlRaw = Lucid.toHtml
+  toHtml (Analyses user@User {..} analyses) = do
+    header <| Just user
+    Lucid.main_ <| do
+      Lucid.section_ <| do
+        Lucid.h2_ "Your Analyses"
+        Lucid.p_
+          <| Lucid.a_
+            [Lucid.linkHref_ "/" <| fieldLink selectRepo]
+            "Analyze one of your repos"
+        Lucid.div_ <| do
+          forM_ analyses <| \AnalysisAction {..} ->
+            Lucid.a_
+              [ href analysisId,
+                css <| Biz.Look.marginAll (em 1)
+                  <> Clay.textDecoration Clay.none
+              ]
+              <| do
+                Lucid.div_ <| Lucid.toHtml url
+                Lucid.div_ [css <| Clay.fontSizeCustom Clay.Font.small]
+                  <| Lucid.toHtml (commit analysis)
+    footer
+    where
+      href aid = Lucid.linkHref_ "/" <| fieldLink getAnalysis aid
+
+newtype UserAccount = UserAccount User
+
+instance App.HasCss UserAccount where
+  cssFor (UserAccount _) = mempty
+
+instance Lucid.ToHtml Subscription where
+  toHtmlRaw = Lucid.toHtml
+  toHtml Free = "Free"
+  toHtml Invoice = "Invoice me"
+
+linkAction_ :: ToHttpApiData a => Text -> a -> Lucid.Attribute
+linkAction_ baseUrl = Lucid.action_ <. (baseUrl <>) <. Servant.toUrlPiece
+
+instance Lucid.ToHtml UserAccount where
+  toHtmlRaw = Lucid.toHtml
+  toHtml (UserAccount user@User {..}) = do
+    header <| Just user
+    Lucid.main_ <| do
+      Lucid.h1_ "Welcome!"
+      Lucid.section_ <| do
+        Lucid.h2_ "Subscription"
+        let action = linkAction_ "/" <| fieldLink postAccount
+        Lucid.form_ [action, Lucid.method_ "post"] <| do
+          let name = "user-subscription"
+          Lucid.label_ [Lucid.for_ name] "Your plan:"
+          Lucid.select_ [Lucid.name_ name] <| do
+            Lucid.option_
+              (Lucid.value_ "Free" : isSelected Free)
+              <| Lucid.toHtml Free
+            Lucid.option_
+              (Lucid.value_ "Invoice" : isSelected Invoice)
+              <| Lucid.toHtml Invoice
+          Lucid.input_ [Lucid.type_ "submit", Lucid.value_ "Save"]
+        when (userSubscription == Invoice) <| do
+          Lucid.p_ "Thanks! You will receive an invoice by email every month."
+    footer
+    where
+      isSelected sel =
+        if userSubscription == sel
+          then [Lucid.selected_ <| tshow sel]
+          else mempty
+
+css :: Clay.Css -> Lucid.Attribute
+css = Lucid.style_ <. toStrict <. Clay.renderWith Clay.htmlInline []
+
+userGitHubAuth ::
+  -- | Token from `User.userGitHubToken` or `Config.tokn`
+  Text ->
+  GitHub.Auth
+userGitHubAuth = GitHub.OAuth <. Encoding.encodeUtf8
+
+-- GitHub OAuth endpoint. For what the parameters mean, see:
+-- https://docs.github.com/en/developers/apps/authorizing-oauth-apps
+githubLoginUrl :: Auth.OAuthArgs -> Text
+githubLoginUrl Auth.OAuthArgs {..} =
+  "https://github.com/login/oauth/authorize?"
+    <> encodeParams
+      [ ("client_id", clientId),
+        ("state", clientState),
+        ("scope", Text.intercalate " " <| Set.toList requiredScopes)
+      ]
+
+-- | This view presents a list of repos to select for analysis.
+data SelectRepo = SelectRepo User (Vector GitHub.Repo)
+
+instance App.HasCss SelectRepo where
+  cssFor (SelectRepo _ _) = do
+    "ul" ? do
+      Clay.listStyleType Clay.none
+      Clay.margin (px 0) 0 0 0
+      Clay.padding (px 0) 0 0 0
+      "li" ? do
+        Clay.borderBottomWidth (px 1)
+        Clay.borderBottomColor "#999"
+        Clay.borderBottomStyle Clay.solid
+        Clay.padding (em 1.5) 0 (em 1.5) 0
+        ".link" ? do
+          Clay.fontSize (em 1.17)
+
+instance Lucid.ToHtml SelectRepo where
+  toHtmlRaw = Lucid.toHtml
+  toHtml (SelectRepo user repos) = do
+    header <| Just user
+    Lucid.main_ <| do
+      Lucid.h2_ "Select a repo to analyze"
+      Lucid.ul_ <| Lucid.toHtml <| traverse_ displayRepo (Vector.toList repos)
+    footer
+    where
+      displayRepo :: GitHub.Repo -> Lucid.Html ()
+      displayRepo repo =
+        Lucid.li_ <| do
+          let action = linkAction_ "/" <| fieldLink postAnalysis
+          Lucid.form_ [action, Lucid.method_ "post"] <| do
+            Lucid.input_
+              [ Lucid.type_ "submit",
+                Lucid.class_ "link",
+                Lucid.value_ <| GitHub.untagName
+                  <| GitHub.repoName repo
+              ]
+            Lucid.input_
+              [ Lucid.type_ "hidden",
+                Lucid.name_ "owner",
+                Lucid.value_ <| GitHub.untagName <| GitHub.simpleOwnerLogin <| GitHub.repoOwner repo
+              ]
+            Lucid.input_
+              [ Lucid.type_ "hidden",
+                Lucid.name_ "repo",
+                Lucid.value_ <| GitHub.untagName <| GitHub.repoName repo
+              ]
+            when (GitHub.repoPrivate repo) <| privateBadge
+            maybe mempty (Lucid.p_ <. Lucid.toHtml) (GitHub.repoDescription repo)
+      privateBadge = Lucid.span_ [Lucid.class_ "badge"] "Private"
+
+-- * parts
+
+-- | Utility for turning a list of tuples into a URL querystring.
+encodeParams :: [(Text, Text)] -> Text
+encodeParams =
+  Encoding.decodeUtf8
+    <. LBS.toStrict
+    <. Web.urlEncodeParams
+
+-- | Login button for GitHub.
+tryButton :: Auth.OAuthArgs -> Text -> Text -> Lucid.Html ()
+tryButton oAuthArgs title subtitle =
+  Lucid.a_
+    [Lucid.id_ "try-button", Lucid.href_ <| githubLoginUrl oAuthArgs]
+    <| do
+      Lucid.toHtml title
+      Lucid.small_ <| Lucid.toHtml subtitle
+
+-- | Universal header
+header :: Monad m => Maybe User -> Lucid.HtmlT m ()
+header muser =
+  Lucid.header_ <| do
+    Lucid.nav_ <| do
+      a "Dragons" <| fieldLink home
+      case muser of
+        Nothing ->
+          Lucid.ul_ <| do
+            li "Login" <| fieldLink login
+        Just _ ->
+          Lucid.ul_ <| do
+            li "Analyses" <| fieldLink getAnalyses
+            li "Account" <| fieldLink getAccount
+  where
+    a txt href =
+      Lucid.a_ [Lucid.linkHref_ "/" href] txt
+    li txt href = Lucid.li_ <| a txt href
+
+-- | Universal footer
+footer :: Monad m => Lucid.HtmlT m ()
+footer =
+  Lucid.footer_ <| do
+    Lucid.p_ <| Lucid.i_ "Copyright ©2020-2021 Dragons.dev"
+
+-- * analysis
+
+data SubmitAnalysis = SubmitAnalysis
+  { owner :: Text,
+    repo :: Text
+  }
+  deriving (Eq, Show, Generic)
+
+instance Web.FromForm SubmitAnalysis
+
+-- | I need more information than just 'Analysis' has to render a full, useful
+-- web page, hence this type.
+data AnalysisDisplay = AnalysisDisplay User AnalysisAction
+
+instance App.HasCss AnalysisDisplay where
+  cssFor (AnalysisDisplay _ analysis) = App.cssFor analysis
+
+instance Lucid.ToHtml AnalysisDisplay where
+  toHtmlRaw = Lucid.toHtml
+  toHtml (AnalysisDisplay user anal) = do
+    header <| Just user
+    Lucid.main_ <| do
+      Lucid.h1_ "Analysis Results"
+      Lucid.toHtml anal
+    footer
+
+-- | Run a full analysis on a git repo
+analyze :: Acid.AcidState Keep -> Id.Id User -> [Text] -> URL -> FilePath -> Bool -> IO AnalysisAction
+analyze keep askedBy activeAuthors url bareRepo repoPrivate = do
+  commit <- Sha </ Text.strip </ Text.pack </ Analysis.git bareRepo ["log", "-n1", "--format=%H"]
+  Acid.query keep (GetAnalysisByUrlAndCommit url commit) +> \case
+    Just analysis -> pure analysis
+    Nothing ->
+      Analysis.run activeAuthors bareRepo
+        /> ( \a ->
+               AnalysisAction
+                 { analysisId = mempty,
+                   analysis = a,
+                   repoVisibility = repoPrivate ?: (Private, Public),
+                   ..
+                 }
+           )
+        /> CreateAnalysis
+        +> Acid.update keep
+
+spliceCreds :: User -> Text -> Text
+spliceCreds User {..} url =
+  scheme <> "//" <> unGitHubHandle userGitHubHandle <> ":" <> userGitHubToken <> "@" <> Text.drop 2 rest
+  where
+    (scheme, rest) = Text.breakOn "//" url
+
+test_spliceCreds :: Test.Tree
+test_spliceCreds =
+  Test.group
+    "spliceCreds"
+    [ Test.unit "simple happy path"
+        <| "https://user:token@github.com/owner/repo"
+        @=? spliceCreds mock_user "https://github.com/owner/repo"
+    ]
+  where
+    mock_user =
+      User
+        { userEmail = UserEmail <| Just "user@example.com",
+          userGitHubHandle = GitHubHandle "user",
+          userGitHubId = GitHubId 0,
+          userGitHubToken = "token",
+          userSubscription = Free,
+          userId = mempty
+        }
+
+-- | Clones a repo from GitHub and does the analysis.
+analyzeGitHub ::
+  GitHub.AuthMethod ghAuth =>
+  Acid.AcidState Keep ->
+  -- | The User asking for the analysis, we auth as them
+  User ->
+  -- | How to auth with GitHub API
+  ghAuth ->
+  -- | The repo depo
+  FilePath ->
+  -- | GitHub owner
+  Text ->
+  -- | GitHub repo
+  Text ->
+  IO AnalysisAction
+analyzeGitHub keep user@User {userId} ghAuth depo o r = do
+  activeAuthors <-
+    getPeople
+      /> Vector.map (GitHub.simpleUserLogin .> GitHub.userInfoForR)
+      /> Vector.toList
+      +> Async.mapConcurrently (GitHub.github ghAuth)
+      /> map (either (const Nothing) GitHub.userEmail)
+      /> catMaybes
+      /> List.nub
+  GitHub.github ghAuth (GitHub.repositoryR ghOwner ghRepo) +> \case
+    Left err -> throwIO <| toException err
+    Right repo -> do
+      let canonicalUrl = GitHub.getUrl <| GitHub.repoHtmlUrl repo
+      let cloningUrl = if GitHub.repoPrivate repo then spliceCreds user canonicalUrl else canonicalUrl
+      let worktree = depo </> removeScheme canonicalUrl <.> "git"
+      bareRepo <- fetchBareRepo cloningUrl worktree
+      analyze keep userId activeAuthors (URL canonicalUrl) bareRepo (GitHub.repoPrivate repo)
+  where
+    ghOwner = GitHub.mkName (Proxy :: Proxy GitHub.Owner) o
+    ghRepo = GitHub.mkName (Proxy :: Proxy GitHub.Repo) r
+
+    getPeople :: IO (Vector GitHub.SimpleUser)
+    getPeople =
+      Async.runConcurrently <| (Vector.++)
+        </ Concurrently getCollaborators
+        <*> Concurrently getTopContributors
+
+    getCollaborators :: IO (Vector GitHub.SimpleUser)
+    getCollaborators =
+      GitHub.collaboratorsOnR ghOwner ghRepo GitHub.FetchAll
+        |> GitHub.github ghAuth
+        /> either mempty identity
+
+    getTopContributors :: IO (Vector GitHub.SimpleUser)
+    getTopContributors =
+      -- 'False' means don't include anonymous contributors
+      GitHub.contributorsR ghOwner ghRepo False GitHub.FetchAll
+        |> GitHub.github ghAuth
+        /> either mempty identity
+        -- TODO: return top 10%; I can't figure out how to use this />
+        -- Vector.sortBy
+        --   ( \case
+        --       GitHub.KnownContributor n _ _ _ _ _ -> n
+        --       GitHub.AnonymousContributor n _ -> n
+        --   )
+        /> Vector.take 10
+        /> Vector.mapMaybe GitHub.contributorToSimpleUser
+
+test_analyzeGitHub :: IO (Config, Application, Acid.AcidState Keep) -> Test.Tree
+test_analyzeGitHub load =
+  Test.group
+    "analyzeGitHub"
+    [ Test.unit "can analyze a public repo (octocat/hello-world)" <| do
+        (c, _, k) <- load
+        let user@User {userGitHubToken} = mock_user c
+        AnalysisAction {..} <-
+          analyzeGitHub
+            k
+            user
+            (userGitHubAuth userGitHubToken)
+            (depo c)
+            "octocat"
+            "hello-world"
+        url @?= URL "https://github.com/octocat/Hello-World"
+        -- bareRepo @?= depo c <> "/github.com/octocat/Hello-World.git"
+        let Analysis {..} = analysis
+        length activeAuthors @?= 2
+        activeAuthors @?= ["hire@spacegho.st", "octocat@github.com"]
+        blackholes @?= ["README"]
+        liabilities @?= ["README"]
+        Map.member "README" stale @?= True
+        score @?= 20
+        totalFiles @?= 1
+        commit @?= Sha "7fd1a60b01f91b314f59955a4e4d4e80d8edf11d",
+      Test.unit "can analyze a private repo (bsima/biz)" <| do
+        (c, _, k) <- load
+        let user@User {userGitHubToken} = mock_user c
+        AnalysisAction {..} <-
+          analyzeGitHub
+            k
+            user
+            (userGitHubAuth userGitHubToken)
+            (depo c)
+            "bsima"
+            "biz"
+        url @?= URL "https://github.com/bsima/biz"
+        -- bareRepo @?= depo c <> "/github.com/bsima/biz.git"
+    ]
+  where
+    mock_user c =
+      User
+        { userEmail = UserEmail <| Just "ben@bsima.me",
+          userGitHubHandle = GitHubHandle "bsima",
+          userGitHubId = GitHubId 0,
+          userGitHubToken = tokn c,
+          userSubscription = Free,
+          userId = mempty
+        }
+
+-- | Clone the repo to @<Config.depo>/<url>@. If repo already exists, just do a
+-- @git fetch@. pures the full path to the local repo.
+fetchBareRepo :: Text -> String -> IO FilePath
+fetchBareRepo url worktree =
+  Directory.doesPathExist worktree
+    +> fetchOrClone
+    >> pure worktree
+  where
+    fetchOrClone True =
+      Log.info ["git", "fetch", url]
+        >> Log.br
+        >> Process.callProcess "git" ["--git-dir", worktree, "fetch", "--quiet", "origin"]
+    fetchOrClone False =
+      Log.info ["git", "clone", url]
+        >> Log.br
+        >> Process.callProcess "git" ["clone", "--bare", "--quiet", "--", Text.unpack url, worktree]
+
+removeScheme :: Text -> FilePath
+removeScheme u = Text.unpack <. Text.dropWhile (== '/') <. snd <| Text.breakOn "//" u
diff --git a/Biz/Dragons.nix b/Biz/Dragons.nix
new file mode 100644
index 0000000..6473232
--- /dev/null
+++ b/Biz/Dragons.nix
@@ -0,0 +1,66 @@
+{ options
+, lib
+, config
+, pkgs
+, ...
+}:
+
+let
+  cfg = config.services.dragons;
+in
+{
+  options.services.dragons = {
+    enable = lib.mkEnableOption "Enable the dragons service";
+    port = lib.mkOption {
+      type = lib.types.int;
+      default = 3000;
+      description = ''
+        The port on which dragons will listen for
+        incoming HTTP traffic.
+      '';
+    };
+    keep = lib.mkOption {
+      type = lib.types.path;
+      default = "/var/dragons/keep";
+      description = "Keep location";
+    };
+    depo = lib.mkOption {
+      type = lib.types.path;
+      default = "/var/dragons/depo";
+      description = "depo location";
+    };
+    package = lib.mkOption {
+      type = lib.types.package;
+      description = "dragons package to use";
+    };
+  };
+  config = lib.mkIf cfg.enable {
+    systemd.services.dragons = {
+      path = [ cfg.package pkgs.git ];
+      wantedBy = [ "multi-user.target" ];
+      preStart = ''
+        mkdir -p ${cfg.keep}
+        mkdir -p ${cfg.depo}
+      '';
+      script = ''
+        ${cfg.package}/bin/dragons
+      '';
+      description = ''
+        Dragons
+      '';
+      serviceConfig = {
+        Environment = [
+          "PORT=${toString cfg.port}"
+          "AREA=Live"
+          "DEPO=${cfg.depo}"
+          "KEEP=${cfg.keep}"
+        ];
+        EnvironmentFile="/run/dragons/env";
+        KillSignal = "INT";
+        Type = "simple";
+        Restart = "on-abort";
+        RestartSec = "1";
+      };
+    };
+  };
+}
diff --git a/Biz/Dragons/Analysis.hs b/Biz/Dragons/Analysis.hs
new file mode 100644
index 0000000..4a1421c
--- /dev/null
+++ b/Biz/Dragons/Analysis.hs
@@ -0,0 +1,252 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-- : out dragons-analyze
+module Biz.Dragons.Analysis
+  ( Analysis (..),
+    Commit (..),
+    run,
+    main,
+    test,
+    git,
+  )
+where
+
+import Alpha
+import qualified Biz.Cli as Cli
+import Biz.Test ((@=?))
+import qualified Biz.Test as Test
+import qualified Control.Concurrent.Async as Async
+import qualified Data.Aeson as Aeson
+import Data.Data (Data)
+import qualified Data.List as List
+import qualified Data.Map as Map
+import qualified Data.String as String
+import qualified Data.Text as Text
+import qualified Data.Time.Clock as Time
+import qualified Data.Time.Format as Time
+import qualified System.Directory as Directory
+import qualified System.Process as Process
+
+main :: IO ()
+main = Cli.main <| Cli.Plan help move test tidy
+
+move :: Cli.Arguments -> IO ()
+move args = gitDir +> run authors /> Aeson.encode +> putStrLn
+  where
+    gitDir =
+      Cli.argument "git-dir"
+        |> Cli.getArgWithDefault args ".git"
+        |> Directory.makeAbsolute
+    authors =
+      -- i think this is not working? do i need optparse-applicative?
+      Cli.shortOption 'a'
+        |> Cli.getAllArgs args
+        |> map Text.pack
+
+tidy :: cfg -> IO ()
+tidy _ = pure ()
+
+test :: Test.Tree
+test = Test.group "Biz.Dragons.Analysis" [test_calculateScore]
+
+help :: Cli.Docopt
+help =
+  [Cli.docopt|
+dragons-analyze
+
+Usage:
+  dragons-analyze test
+  dragons-analyze [--author=<email>]... <git-dir>
+
+Options:
+  -a, --author  List of active authors' emails.
+|]
+
+newtype Commit = Sha Text
+  deriving (Eq, Data, Typeable, Ord, Generic, Show)
+
+instance Aeson.ToJSON Commit
+
+-- | The result of analyzing a git repo.
+data Analysis = Analysis
+  { -- | Where the repo is stored on the local disk.
+    gitDir :: FilePath,
+    -- | A path with no active contributors
+    blackholes :: [Text],
+    -- | A path with < 3 active contributors
+    liabilities :: [Text],
+    -- | Map of path to number of commits, for detecting paths that continually
+    -- get rewritten.
+    hotspotMap :: Map FilePath Integer,
+    -- | Files that have not been touched in 6 months
+    stale :: Map FilePath Integer,
+    -- | Total score for the repo
+    score :: Integer,
+    -- | Total number of files
+    totalFiles :: Integer,
+    -- | The total number of commits
+    totalCommits :: Integer,
+    -- | List of all the active users we care about
+    activeAuthors :: [Text],
+    -- | Which commit this analysis was run against.
+    commit :: Commit
+  }
+  deriving (Eq, Ord, Generic, Show, Data, Typeable)
+
+instance Aeson.ToJSON Analysis
+
+run :: [Text] -> FilePath -> IO Analysis
+run activeAuthors bareRepo = do
+  commit <- git bareRepo ["rev-parse", "HEAD"] /> Text.pack /> chomp /> Sha
+  tree <-
+    git
+      bareRepo
+      [ "ls-tree",
+        "--full-tree",
+        "--name-only",
+        "-r", -- recurse into subtrees
+        "HEAD"
+      ]
+      /> String.lines
+  authors <- traverse (authorsFor bareRepo) tree :: IO [[(Text, Text, Text)]]
+  let authorMap = zip tree authors :: [(FilePath, [(Text, Text, Text)])]
+  stalenessMap <- traverse (lastTouched bareRepo) tree
+  let blackholes =
+        [ Text.pack path
+          | (path, authors_) <- authorMap,
+            null (map third authors_ `List.intersect` activeAuthors)
+        ]
+  let liabilities =
+        [ Text.pack path
+          | (path, authors_) <- authorMap,
+            length (map third authors_ `List.intersect` activeAuthors) < 3
+        ]
+  let numBlackholes = realToFrac <| length blackholes
+  let numLiabilities = realToFrac <| length liabilities
+  let numTotal = realToFrac <| length tree
+  hotspotMap <-
+    Map.fromList </ Async.mapConcurrently getChangeCount tree
+  totalCommits <-
+    git bareRepo ["rev-list", "--count", "HEAD"]
+      /> filter (/= '\n')
+      /> readMaybe
+      /> fromMaybe 0
+  pure
+    <| Analysis
+      { gitDir = bareRepo,
+        stale =
+          Map.fromList
+            <| [ (path, days)
+                 | (path, Just days) <- stalenessMap,
+                   days > 180
+               ],
+        score = calculateScore numTotal numBlackholes numLiabilities,
+        totalFiles = toInteger <| length tree,
+        ..
+      }
+  where
+    third :: (a, b, c) -> c
+    third (_, _, a) = a
+    getChangeCount :: FilePath -> IO (FilePath, Integer)
+    getChangeCount path =
+      git bareRepo ["rev-list", "--count", "HEAD", "--", path]
+        /> filter (/= '\n')
+        /> readMaybe
+        /> fromMaybe 0
+        /> (path,)
+
+-- | Given a git dir and a path inside the git repo, get information about the
+-- authors.
+authorsFor ::
+  FilePath ->
+  FilePath ->
+  -- | returns (number of commits, author name, author email)
+  IO [(Text, Text, Text)]
+authorsFor gitDir path =
+  Process.readProcess
+    "git"
+    [ "--git-dir",
+      gitDir,
+      "shortlog",
+      "--numbered",
+      "--summary",
+      "--email",
+      "HEAD",
+      "--",
+      path
+    ]
+    ""
+    /> Text.pack
+    /> Text.lines
+    /> map (Text.break (== '\t'))
+    /> map parseAuthor
+  where
+    parseAuthor (commits, author) =
+      ( Text.strip commits,
+        Text.strip <| Text.takeWhile (/= '<') author,
+        Text.strip <| Text.dropAround (`elem` ['<', '>']) <| Text.dropWhile (/= '<') author
+      )
+
+-- | Run a git command on a repo
+git ::
+  -- | path to the git dir (bare repo)
+  String ->
+  -- | args to `git`
+  [String] ->
+  IO String
+git bareRepo args = Process.readProcess "git" (["--git-dir", bareRepo] ++ args) ""
+
+lastTouched :: FilePath -> FilePath -> IO (FilePath, Maybe Integer)
+lastTouched bareRepo path = do
+  now <- Time.getCurrentTime
+  timestamp <-
+    Process.readProcess
+      "git"
+      [ "--git-dir",
+        bareRepo,
+        "log",
+        "-n1",
+        "--pretty=%aI",
+        "--",
+        path
+      ]
+      ""
+      /> filter (/= '\n')
+      /> Time.parseTimeM True Time.defaultTimeLocale "%Y-%m-%dT%H:%M:%S%z"
+  pure (path, calculateAge now </ timestamp)
+  where
+    calculateAge now n = round <| Time.diffUTCTime now n / Time.nominalDay
+
+-- | Does the aggregate score calculation given number of files found to be
+-- blackholes, liabilities, etc.
+calculateScore :: Double -> Double -> Double -> Integer
+calculateScore 0 _ _ = 0
+calculateScore a 0 0 | a > 0 = 100
+calculateScore a b c | a < 0 || b < 0 || c < 0 = 0
+calculateScore numTotal numBlackholes numLiabilities =
+  max 0 <. round
+    <| maxScore
+    * (weightedBlackholes + weightedLiabilities + numGood)
+    / numTotal
+  where
+    weightedBlackholes = numBlackholes * (5 / 10)
+    weightedLiabilities = numLiabilities * (7 / 10)
+    numGood = numTotal - numBlackholes - numLiabilities
+    maxScore = 100.0
+
+test_calculateScore :: Test.Tree
+test_calculateScore =
+  Test.group
+    "calculateScore"
+    [ Test.unit "perfect score" <| 100 @=? calculateScore 100 0 0,
+      Test.unit "all blackholes" <| 50 @=? calculateScore 100 100 0,
+      Test.unit "all liabilities" <| 70 @=? calculateScore 100 0 100,
+      Test.prop "never > 100" <| \t b l -> calculateScore t b l <= 100,
+      Test.prop "never < 0" <| \t b l -> calculateScore t b l >= 0
+    ]
diff --git a/Biz/Dragons/get-examples.sh b/Biz/Dragons/get-examples.sh
new file mode 100755
index 0000000..a35a282
--- /dev/null
+++ b/Biz/Dragons/get-examples.sh
@@ -0,0 +1,13 @@
+#!/usr/bin/env bash
+if [ "$#" == "0" ]
+then
+    echo "usage: $(basename $0) <cookie>"
+    echo "copy the cookie from the browser dev console"
+    exit 1
+fi
+cookie="$1"
+curl 'https://dragons.dev/analysis?user=github&repo=training-kit' \
+    -X POST \
+    -H 'Content-Type: application/x-www-form-urlencoded' \
+    -H "Cookie: JWT-Cookie=$cookie" \
+    --compressed --insecure
diff --git a/Biz/Dragons/main.py b/Biz/Dragons/main.py
new file mode 100755
index 0000000..bb10441
--- /dev/null
+++ b/Biz/Dragons/main.py
@@ -0,0 +1,221 @@
+#!/usr/bin/env python
+"""
+Analyze developer allocation across a codebase.
+"""
+
+import argparse
+import datetime
+import logging
+import os
+import re
+import subprocess
+import sys
+
+
+def find_user(line):
+    """Given 'Ben Sima <ben@bsima.me>', finds `Ben Sima'. Returns the first
+    matching string."""
+    return re.findall(r"^[^<]*", line)[0].strip()
+
+
+def authors_for(path, active_users):
+    """Return a dictionary of {author: commits} for given path. Usernames not in
+    the 'active_users' list will be filtered out."""
+    raw = subprocess.check_output(
+        ["git", "shortlog", "--numbered", "--summary", "--email", "--", path]
+    ).decode("utf-8")
+    lines = [s for s in raw.split("\n") if s]
+    data = {}
+    for line in lines:
+        parts = line.strip().split("\t")
+        author = find_user(parts[1])
+        commits = parts[0]
+        if author in active_users:
+            data[author] = commits
+    return data
+
+
+def mailmap_users():
+    """Returns users from the .mailmap file."""
+    users = []
+    with open(".mailmap") as file:
+        lines = file.readlines()
+        for line in lines:
+            users.append(find_user(line))
+    return users
+
+
+MAX_SCORE = 10
+
+
+def score(blackhole, liability, good, total):
+    "Calculate the score."
+    weights = {
+        "blackhole": 0.5,
+        "liability": 0.7,
+    }
+    return (
+        MAX_SCORE
+        * (
+            (blackhole * weights["blackhole"])
+            + (liability * weights["liability"])
+            + good
+        )
+        / total
+    )
+
+
+def get_args():
+    "Parse CLI arguments."
+    cli = argparse.ArgumentParser(description=__doc__)
+    cli.add_argument("repo", default=".", help="the git repo to run on", metavar="REPO")
+    cli.add_argument(
+        "-b",
+        "--blackholes",
+        action="store_true",
+        help="print the blackholes (files with one or zero active contributors)",
+    )
+    cli.add_argument(
+        "-l",
+        "--liabilities",
+        action="store_true",
+        help="print the liabilities (files with < 3 active contributors)",
+    )
+    cli.add_argument(
+        "-s",
+        "--stale",
+        action="store_true",
+        help="print stale files (haven't been touched in 6 months)",
+    )
+    cli.add_argument(
+        "-i", "--ignored", nargs="+", default=[], help="patterns to ignore in paths",
+    )
+    cli.add_argument(
+        "--active-users",
+        nargs="+",
+        default=[],
+        help="list of active user emails. if not provided, this is loaded from .mailmap",
+    )
+    cli.add_argument(
+        "-v",
+        "--verbosity",
+        help="set the log level verbosity",
+        choices=["debug", "warning", "error"],
+        default="error",
+    )
+    return cli.parse_args()
+
+
+def guard_git(repo):
+    "Guard against non-git repos."
+    is_git = subprocess.run(
+        ["git", "rev-parse"],
+        stderr=subprocess.PIPE,
+        stdout=subprocess.PIPE,
+        check=False,
+    ).returncode
+    if is_git != 0:
+        sys.exit(f"error: not a git repository: {repo}")
+
+
+def staleness(path, now):
+    "How long has it been since this file was touched?"
+    timestamp = datetime.datetime.strptime(
+        subprocess.check_output(["git", "log", "-n1", "--pretty=%aI", path])
+        .decode("utf-8")
+        .strip(),
+        "%Y-%m-%dT%H:%M:%S%z",
+    )
+    delta = now - timestamp
+    return delta.days
+
+
+class Repo:
+    "Represents a repo and stats for the repo."
+
+    def __init__(self, ignored_paths, active_users):
+        self.paths = [
+            p
+            for p in subprocess.check_output(["git", "ls-files", "--no-deleted"])
+            .decode("utf-8")
+            .split()
+            if not any(i in p for i in ignored_paths)
+        ]
+        logging.debug("collecting stats")
+        self.stats = {}
+        for path in self.paths:
+            self.stats[path] = authors_for(path, active_users)
+        self.blackholes = [path for path, authors in self.stats.items() if not authors]
+        self.liabilities = {
+            path: list(authors)
+            for path, authors in self.stats.items()
+            if 1 <= len(authors) < 3
+        }
+        now = datetime.datetime.utcnow().astimezone()
+        self.stale = {}
+        for path, _ in self.stats.items():
+            _staleness = staleness(path, now)
+            if _staleness > 180:
+                self.stale[path] = _staleness
+
+    def print_blackholes(self, full):
+        "Print number of blackholes, or list of all blackholes."
+        # note: file renames may result in false positives
+        n_blackhole = len(self.blackholes)
+        print(f"Blackholes: {n_blackhole}")
+        if full:
+            for path in self.blackholes:
+                print(f"  {path}")
+
+    def print_liabilities(self, full):
+        "Print number of liabilities, or list of all liabilities."
+        n_liabilities = len(self.liabilities)
+        print(f"Liabilities: {n_liabilities}")
+        if full:
+            for path, authors in self.liabilities.items():
+                print(f"  {path}  ({', '.join(authors)})")
+
+    def print_score(self):
+        "Print the overall score."
+        n_total = len(self.stats.keys())
+        n_blackhole = len(self.blackholes)
+        n_liabilities = len(self.liabilities)
+        n_good = n_total - n_blackhole - n_liabilities
+        print("Total:", n_total)
+        print(
+            "Score: {:.2f}/{}".format(
+                score(n_blackhole, n_liabilities, n_good, n_total), MAX_SCORE
+            )
+        )
+
+    def print_stale(self, full):
+        "Print stale files"
+        n_stale = len(self.stale)
+        print(f"Stale files: {n_stale}")
+        if full:
+            for path, days in self.stale.items():
+                print(f"  {path}  ({days} days)")
+
+
+if __name__ == "__main__":
+    ARGS = get_args()
+    logging.basicConfig(stream=sys.stderr, level=ARGS.verbosity.upper())
+
+    logging.debug("starting")
+    os.chdir(os.path.abspath(ARGS.repo))
+
+    guard_git(ARGS.repo)
+
+    # if no active users provided, load from .mailmap
+    if ARGS.active_users == []:
+        if os.path.exists(".mailmap"):
+            ARGS.active_users = mailmap_users()
+
+    # collect data
+    REPO = Repo(ARGS.ignored, ARGS.active_users)
+
+    # print data
+    REPO.print_score()
+    REPO.print_blackholes(ARGS.blackholes)
+    REPO.print_liabilities(ARGS.liabilities)
+    REPO.print_stale(ARGS.stale)
diff --git a/Biz/Dragons/pitch.md b/Biz/Dragons/pitch.md
new file mode 100644
index 0000000..a4d4ffa
--- /dev/null
+++ b/Biz/Dragons/pitch.md
@@ -0,0 +1,40 @@
+# Dragons
+
+Dragons analyzes your codebase trends, finds patterns in how your developers
+work, and protects against tech debt.
+
+Just hook it up to your CI system - it will warn you when it finds a problem.
+
+## Identify blackholes in your codebase
+
+What if none of your active employees have touched some part of the codebase?
+This happens too often with legacy code, and then it turns into a huge source of
+tech debt. Dragons finds these "blackholes" and warns you about them so you
+can be proactive in eliminating tech debt.
+
+## Protect against lost knowledge
+
+Not everyone can know every part of a codebase. By finding pieces of code
+that only 1 or 2 people have touched, dragons identifes siloed knowledge. This
+allows you to protect against the risk of this knowledge leaving the company if
+an employee leaves.
+
+## Don't just measure "code coverage" - also know your "dev coverage"
+
+No matter how smart your employees are, if you are under- or over-utilizing your
+developers then you will never get optimal performance from your team.
+
+- Find developer "hot spots" in your code: which pieces of code get continually
+  rewritten, taking up valuable dev time?
+- Know how your devs work best: which ones have depth of knowledge, and which
+  ones have breadth?
+
+(Paid only)
+
+## See how your teams *actually* organize themselves with cluster analysis
+
+Does your team feel splintered or not cohesive? Which developers work best
+together? Dragons analyzes the collaboration patterns between devs and helps
+you form optimal pairings and teams based on shared code and mindspace.
+
+(Paid only)
diff --git a/Biz/Log.hs b/Biz/Log.hs
index 9304cf7..c74d297 100644
--- a/Biz/Log.hs
+++ b/Biz/Log.hs
@@ -32,7 +32,7 @@ import System.IO.Unsafe (unsafePerformIO)
 
 data Lvl = Good | Pass | Info | Warn | Fail | Mark
 
--- | Get the environment. This should probably return 'Biz.Devalloc.Area'
+-- | Get the environment. This should probably return 'Biz.Dragons.Area'
 -- instead of 'String'.
 area :: String
 area =
-- 
cgit v1.2.3