Don't store user actions (#304)

back/guide.cabal

@@ -69,7 +69,7 @@ library
       Guide.Types.Hue
       Guide.Types.Core
       Guide.Types.Edit
-      Guide.Types.Action
+      Guide.Types.Analytics
       Guide.Types.User
       Guide.Types.Session
     Guide.Handlers

back/src/Guide/Api/Methods.hs

@@ -268,7 +268,6 @@ addEdit edit = push "addEdit" $ attr "edit" edit $ do
         time <- liftIO getCurrentTime
         Context Config{..} _ RequestDetails{..} <- ask
         dbUpdate $ RegisterEdit edit rdIp time
-        dbUpdate $ RegisterAction (Action'Edit edit) rdIp time _baseUrl rdReferer rdUserAgent
         postMatomo $ Matomo rdIp rdUserAgent rdReferer edit
 
 -- | Helper. Get a category from database and throw error 404 when it doesn't exist.

back/src/Guide/Main.hs

@@ -304,12 +304,6 @@ guideApp waiMetrics = do
       Spock.get (haskellRoute <//> root) $ do
         s <- dbQuery GetGlobalState
         q <- param "q"
-        (time, mbIP, mbReferrer, mbUA) <- getRequestDetails
-        let act = case q of
-              Nothing -> Action'MainPageVisit
-              Just x  -> Action'Search x
-        baseUrl <- _baseUrl <$> getConfig
-        dbUpdate (RegisterAction act mbIP time baseUrl mbReferrer mbUA)
         lucidWithConfig $ renderHaskellRoot s q
       -- Category pages
       Spock.get (haskellRoute <//> var) $ \path -> do
@@ -322,10 +316,6 @@ guideApp waiMetrics = do
         case mbCategory of
           Nothing -> Spock.jumpNext
           Just category -> do
-            (time, mbIP, mbReferrer, mbUA) <- getRequestDetails
-            baseUrl <- _baseUrl <$> getConfig
-            dbUpdate $ RegisterAction (Action'CategoryVisit (Uid catId))
-                         mbIP time baseUrl mbReferrer mbUA
             -- If the slug in the url is old (i.e. if it doesn't match the
             -- one we would've generated now), let's do a redirect
             when (categorySlug category /= path) $

back/src/Guide/ServerStuff.hs

@@ -89,12 +89,9 @@ addEdit :: (MonadIO m, HasSpock (ActionCtxT ctx m),
             SpockState (ActionCtxT ctx m) ~ ServerState)
         => Edit -> ActionCtxT ctx m ()
 addEdit ed = do
-  (time, mbIP, mbReferrer, mbUA) <- getRequestDetails
+  (time, mbIP, _mbReferrer, _mbUA) <- getRequestDetails
   unless (isVacuousEdit ed) $ do
     dbUpdate (RegisterEdit ed mbIP time)
-    baseUrl <- _baseUrl <$> getConfig
-    dbUpdate (RegisterAction (Action'Edit ed)
-                mbIP time baseUrl mbReferrer mbUA)
 
 -- | Do an action that would undo an edit. 'Left' signifies failure.
 --

back/src/Guide/State.hs

@@ -20,7 +20,6 @@ module Guide.State
   GlobalState(..),
     categories,
     categoriesDeleted,
-    actions,
     pendingEdits,
     editIdCounter,
     findCategoryByItem,
@@ -70,9 +69,6 @@ module Guide.State
   RegisterEdit(..),
   RemovePendingEdit(..), RemovePendingEdits(..),
 
-  -- ** actions
-  RegisterAction(..),
-
   -- ** other
   MoveItem(..),
   MoveTrait(..),
@@ -113,7 +109,7 @@ import Data.SafeCopy.Migrate
 import Web.Spock.Internal.SessionManager (SessionId)
 
 import Guide.Markdown
-import Guide.Types.Action
+import Guide.Types.Analytics
 import Guide.Types.Core
 import Guide.Types.Edit
 import Guide.Types.Session
@@ -122,7 +118,6 @@ import Guide.Utils
 
 import qualified Data.Map as M
 import qualified Data.Set as S
-import qualified Data.Text as T
 
 
 {- Note [extending types]
@@ -187,7 +182,6 @@ emptyState :: GlobalState
 emptyState = GlobalState {
   _categories = [],
   _categoriesDeleted = [],
-  _actions = [],
   _pendingEdits = [],
   _editIdCounter = 0,
   _sessionStore = M.empty,
@@ -197,7 +191,6 @@ emptyState = GlobalState {
 data GlobalState = GlobalState {
   _categories        :: [Category],
   _categoriesDeleted :: [Category],
-  _actions           :: [(Action, ActionDetails)],
   -- | Pending edits, newest first
   _pendingEdits      :: [(Edit, EditDetails)],
   -- | ID of next edit that will be made
@@ -210,10 +203,17 @@ data GlobalState = GlobalState {
   _dirty             :: Bool }
   deriving (Show)
 
-deriveSafeCopySorted 8 'extension ''GlobalState
+deriveSafeCopySorted 9 'extension ''GlobalState
 makeLenses ''GlobalState
 
-changelog ''GlobalState (Current 8, Past 7) [
+changelog ''GlobalState (Current 9, Past 8) [
+  -- TODO: it's silly that we have to reference 'Action' and keep it in the
+  -- codebase even though we have no use for 'Action' anymore
+  Removed "_actions" [t|[(Action, ActionDetails)]|]
+  ]
+deriveSafeCopySorted 8 'extension ''GlobalState_v8
+
+changelog ''GlobalState (Past 8, Past 7) [
   Added "_sessionStore" [hs|M.empty|],
   Added "_users" [hs|M.empty|]
   ]
@@ -271,7 +271,6 @@ findCategoryByItem itemId s =
 data PublicDB = PublicDB {
   publicCategories        :: [Category],
   publicCategoriesDeleted :: [Category],
-  publicActions           :: [(Action, ActionDetails)],
   publicPendingEdits      :: [(Edit, EditDetails)],
   publicEditIdCounter     :: Int,
   publicUsers             :: Map (Uid User) PublicUser}
@@ -281,7 +280,7 @@ data PublicDB = PublicDB {
 -- need to increase the version when the type changes, so that old clients
 -- wouldn't get cryptic error messages like “not enough bytes” when trying
 -- to deserialize a new version of 'PublicDB' that they can't handle.
-deriveSafeCopySorted 0 'base ''PublicDB
+deriveSafeCopySorted 1 'base ''PublicDB
 
 -- | Converts 'GlobalState' to 'PublicDB' type stripping private data.
 toPublicDB :: GlobalState -> PublicDB
@@ -289,7 +288,6 @@ toPublicDB GlobalState{..} =
   PublicDB {
     publicCategories        = _categories,
     publicCategoriesDeleted = _categoriesDeleted,
-    publicActions           = _actions,
     publicPendingEdits      = _pendingEdits,
     publicEditIdCounter     = _editIdCounter,
     publicUsers             = fmap userToPublic _users
@@ -302,7 +300,6 @@ fromPublicDB PublicDB{..} =
   GlobalState {
     _categories        = publicCategories,
     _categoriesDeleted = publicCategoriesDeleted,
-    _actions           = publicActions,
     _pendingEdits      = publicPendingEdits,
     _editIdCounter     = publicEditIdCounter,
     _sessionStore      = M.empty,
@@ -758,25 +755,6 @@ removePendingEdits
 removePendingEdits m n = do
   pendingEdits %= filter (\(_, d) -> editId d < n || m < editId d)
 
-registerAction
-  :: Action
-  -> Maybe IP
-  -> UTCTime
-  -> Url                          -- ^ Base URL
-  -> Maybe Url                    -- ^ Referrer
-  -> Maybe Text                   -- ^ User-agent
-  -> Acid.Update GlobalState ()
-registerAction act ip date baseUrl ref ua = do
-  let details = ActionDetails {
-        actionIP        = ip,
-        actionDate      = date,
-        actionReferrer  = case T.stripPrefix baseUrl <$> ref of
-                            Nothing       -> Nothing
-                            Just Nothing  -> ExternalReferrer <$> ref
-                            Just (Just s) -> Just (InternalReferrer s),
-        actionUserAgent = ua }
-  actions %= ((act, details) :)
-
 setDirty :: Acid.Update GlobalState ()
 setDirty = dirty .= True
 
@@ -896,8 +874,6 @@ makeAcidic ''GlobalState [
   'getEdit, 'getEdits,
   'registerEdit,
   'removePendingEdit, 'removePendingEdits,
-  -- actions
-  'registerAction,
   -- other
   'moveItem, 'moveTrait,
   'restoreCategory, 'restoreItem, 'restoreTrait,
@@ -948,8 +924,7 @@ deriving instance Show GetTraitMaybe
 deriving instance Show SetTraitContent
 deriving instance Show AddPro
 deriving instance Show AddCon
--- action
-deriving instance Show RegisterAction
+-- edit
 deriving instance Show RegisterEdit
 
 ----------------------------------------------------------------------------

back/src/Guide/Types.hs

@@ -5,13 +5,13 @@ module Guide.Types
   module Guide.Types.Hue,
   module Guide.Types.Core,
   module Guide.Types.Edit,
-  module Guide.Types.Action,
+  module Guide.Types.Analytics,
   module Guide.Types.User,
   module Guide.Types.Session,
 )
 where
 
-import Guide.Types.Action
+import Guide.Types.Analytics
 import Guide.Types.Core
 import Guide.Types.Edit
 import Guide.Types.Hue

back/src/Guide/Types/Analytics.hs

@@ -11,11 +11,15 @@
 --
 --  * We also collect additional information about users performing actions,
 --    such as date and time when the action was performed.
-module Guide.Types.Action
+module Guide.Types.Analytics
 (
-  Action(..),
+  Action(..),            -- TODO: this is only needed for a 'GlobalState'
+                         -- migration, and should be removed after the
+                         -- migration is done.
   Referrer(..),
-  ActionDetails(..),
+  ActionDetails(..),     -- TODO: this is only needed for a 'GlobalState'
+                         -- migration, and should be removed after the
+                         -- migration is done.
 )
 where
 

back/src/Guide/Views.hs

@@ -37,7 +37,6 @@ import NeatInterpolation
 -- Web
 import Lucid hiding (for_)
 -- Network
-import Data.IP
 import Network.HTTP.Client
 import Network.HTTP.Client.TLS
 import Network.HTTP.Types.Status (Status (..))
@@ -212,111 +211,9 @@ renderAdmin globalState = do
     buttonUid <- randomLongUid
     button "Create checkpoint" [uid_ buttonUid] $
       JS.createCheckpoint [JS.selectUid buttonUid]
-    div_ [id_ "stats"] $
-      renderStats globalState (globalState ^. actions)
     div_ [id_ "edits"] $
       renderEdits globalState (map (,Nothing) (globalState ^. pendingEdits))
 
--- | Render statistics on the admin page.
-renderStats
-  :: (MonadIO m)
-  => GlobalState
-  -> [(Action, ActionDetails)]
-  -> HtmlT m ()
-renderStats globalState acts = do
-  h1_ "Statistics"
-  p_ "All information is for last 31 days."
-  now <- liftIO getCurrentTime
-  let thisMonth (_, d) = diffUTCTime now (actionDate d) <= 31*86400
-      acts' = takeWhile thisMonth acts
-  p_ $ do
-    "Main page visits: "
-    strong_ $ toHtml $ show $ length [() | (Action'MainPageVisit, _) <- acts']
-    ". "
-    "Edits: "
-    strong_ $ toHtml $ show $ length [() | (Action'Edit _, _) <- acts']
-    ". "
-    "Unique visitors: "
-    strong_ $ toHtml $ show $ length $ ordNub $ map (actionIP.snd) acts'
-    "."
-  let allCategories = globalState^.categories ++
-                      globalState^.categoriesDeleted
-  -- TODO: move this somewhere else (it's also used in renderEdit)
-  let findCategory catId = fromMaybe err (find (hasUid catId) allCategories)
-        where
-          err = error ("renderStats: couldn't find category with uid = " ++
-                       toString (uidToText catId))
-  table_ [class_ "sortable"] $ do
-    thead_ $ tr_ $ do
-      th_ [class_ "sorttable_nosort"] "Category"
-      th_ "Visits"
-      th_ "Unique visitors"
-    tbody_ $ do
-      let rawVisits :: [(Uid Category, Maybe IP)]
-          rawVisits = [(catId, actionIP d) |
-                       (Action'CategoryVisit catId, d) <- acts']
-      let visits :: [(Uid Category, (Int, Int))]
-          visits = map (over _2 (length &&& length.ordNub) .
-                        (fst.head &&& map snd)) .
-                   groupWith fst
-                     $ rawVisits
-      for_ (reverse $ sortWith (fst.snd) visits) $ \(catId, (n, u)) -> do
-        tr_ $ do
-          td_ (toHtml (findCategory catId ^. title))
-          td_ (toHtml (show n))
-          td_ (toHtml (show u))
-  table_ [class_ "sortable"] $ do
-    thead_ $ tr_ $ do
-      th_ [class_ "sorttable_nosort"] "Search"
-      th_ "Repetitions"
-    tbody_ $ do
-      let searches = map (head &&& length) . group $
-            [s | (Action'Search s, _) <- acts']
-      for_ (reverse $ sortWith snd searches) $ \(s, n) -> do
-        tr_ $ do
-          td_ (toHtml s)
-          td_ (toHtml (show n))
-  table_ [class_ "sortable"] $ do
-    thead_ $ tr_ $ do
-      th_ [class_ "sorttable_nosort"] "Referrer"
-      th_ "Visitors"
-      th_ "Unique visitors"
-    tbody_ $ do
-      let rawVisits :: [(Url, Maybe IP)]
-          rawVisits = [(r, actionIP d)
-                         | d <- map snd acts'
-                         , Just (ExternalReferrer r) <- [actionReferrer d]]
-      let sortRefs :: [(Url, Maybe IP)] -> [(ReferrerView, [Maybe IP])]
-          sortRefs = map (fst.head &&& map snd)
-                   . groupWith fst
-                   . map (over _1 toReferrerView)
-      let visits :: [(ReferrerView, (Int, Int))]
-          visits = map (over _2 (length &&& length.ordNub))
-                       (sortRefs rawVisits)
-      for_ (reverse $ sortWith (fst.snd) visits) $ \(r, (n, u)) -> do
-        tr_ $ do
-          td_ (toHtml (show r))  -- referrer
-          td_ (toHtml (show n))  -- visitors
-          td_ (toHtml (show u))  -- unique visitors
-  table_ $ do
-    thead_ $ tr_ $ do
-      th_ "Action"
-      th_ "Date"
-      th_ "IP"
-    tbody_ $ do
-      -- acts, not acts' (what if there were less than 10 actions in the last
-      -- month?)
-      for_ (take 10 acts) $ \(a, d) -> tr_ $ do
-        td_ $ case a of
-          Action'Edit _          -> "Edit"
-          Action'MainPageVisit   -> "Main page visit"
-          Action'CategoryVisit _ -> "Category visit"
-          Action'Search _        -> "Search"
-        td_ $ toHtml =<< liftIO (humanReadableTime (actionDate d))
-        td_ $ case actionIP d of
-          Nothing -> "<unknown IP>"
-          Just ip -> toHtml (show ip)
-
 -- | Group edits by IP and render them.
 renderEdits
   :: (MonadIO m)