Introduce data store abstraction layer

hackage-server.cabal

@@ -307,7 +307,9 @@ library
     Distribution.Server.Features.Browse.Options
     Distribution.Server.Features.Browse.Parsers
     Distribution.Server.Features.Core
+    Distribution.Server.Features.Core.Acid
     Distribution.Server.Features.Core.State
+    Distribution.Server.Features.Core.Store
     Distribution.Server.Features.Core.Backup
     Distribution.Server.Features.Security
     Distribution.Server.Features.Security.Backup
@@ -320,6 +322,10 @@ library
     Distribution.Server.Features.Security.SHA256
     Distribution.Server.Features.Security.State
     Distribution.Server.Features.Mirror
+    Distribution.Server.Features.Mirror.Acid
+    Distribution.Server.Features.Mirror.Store
+    Distribution.Server.Features.TarIndexCache.Acid
+    Distribution.Server.Features.TarIndexCache.Store
     Distribution.Server.Features.Upload
     Distribution.Server.Features.Upload.State
     Distribution.Server.Features.Upload.Backup
@@ -370,7 +376,9 @@ library
       Distribution.Server.Features.Html.HtmlUtilities
       Distribution.Server.Features.HoogleData
       Distribution.Server.Features.HaskellPlatform
+      Distribution.Server.Features.HaskellPlatform.Acid
       Distribution.Server.Features.HaskellPlatform.State
+      Distribution.Server.Features.HaskellPlatform.Store
       Distribution.Server.Features.PackageInfoJSON
       Distribution.Server.Features.Search
       Distribution.Server.Features.Search.BM25F
@@ -385,8 +393,10 @@ library
       Distribution.Server.Features.Search.TermBag
       Distribution.Server.Features.Sitemap.Functions
       Distribution.Server.Features.Votes
+      Distribution.Server.Features.Votes.Acid
       Distribution.Server.Features.Votes.Render
       Distribution.Server.Features.Votes.State
+      Distribution.Server.Features.Votes.Store
       Distribution.Server.Features.Votes.Types
       Distribution.Server.Features.Vouch
       Distribution.Server.Features.Vouch.State
@@ -403,7 +413,9 @@ library
       Distribution.Server.Features.Tags.State
       Distribution.Server.Features.Tags.Types
       Distribution.Server.Features.AnalyticsPixels
+      Distribution.Server.Features.AnalyticsPixels.Acid
       Distribution.Server.Features.AnalyticsPixels.State
+      Distribution.Server.Features.AnalyticsPixels.Store
       Distribution.Server.Features.AnalyticsPixels.Types
       Distribution.Server.Features.UserDetails
       Distribution.Server.Features.UserDetails.Acid

src/Distribution/Server/Features/AnalyticsPixels.hs

@@ -10,11 +10,11 @@ module Distribution.Server.Features.AnalyticsPixels
 
 import Data.Set (Set)
 
+import Distribution.Server.Features.AnalyticsPixels.Acid (acidStore)
+import qualified Distribution.Server.Features.AnalyticsPixels.Store as Store
 import Distribution.Server.Features.AnalyticsPixels.Types
-import qualified Distribution.Server.Features.AnalyticsPixels.State as Acid
 
 import Distribution.Server.Framework
-import Distribution.Server.Framework.BackupRestore
 
 import Distribution.Server.Features.Core
 import Distribution.Server.Features.Upload
@@ -53,7 +53,7 @@ initAnalyticsPixelsFeature :: ServerEnv
                             -> UploadFeature
                             -> IO AnalyticsPixelsFeature)
 initAnalyticsPixelsFeature env@ServerEnv{serverStateDir} = do
-  dbAnalyticsPixelsState <- analyticsPixelsStateComponent serverStateDir
+  dbAnalyticsPixelsState <- acidStore serverStateDir
   analyticsPixelAdded    <- newHook
   analyticsPixelRemoved  <- newHook
 
@@ -64,27 +64,9 @@ initAnalyticsPixelsFeature env@ServerEnv{serverStateDir} = do
 
     return feature
 
--- | Define the backing store (i.e. database component)
-analyticsPixelsStateComponent :: FilePath -> IO (StateComponent AcidState Acid.AnalyticsPixelsState)
-analyticsPixelsStateComponent stateDir = do
-  st <- openLocalStateFrom (stateDir </> "db" </> "AnalyticsPixels") Acid.initialAnalyticsPixelsState
-  return StateComponent {
-      stateDesc    = "Backing store for AnalyticsPixels feature"
-    , stateHandle  = st
-    , getState     = query st Acid.GetAnalyticsPixelsState
-    , putState     = update st . Acid.ReplaceAnalyticsPixelsState
-    , resetState   = analyticsPixelsStateComponent
-    , backupState  = \_ _ -> []
-    , restoreState = RestoreBackup {
-                         restoreEntry    = error "Unexpected backup entry"
-                       , restoreFinalize = return Acid.initialAnalyticsPixelsState
-                       }
-   }
-
-
 -- | Default constructor for building this feature.
 analyticsPixelsFeature :: ServerEnv
-                      -> StateComponent AcidState Acid.AnalyticsPixelsState
+                      -> Store.Backend
                       -> CoreFeature                          -- To get site package list
                       -> UserFeature                          -- To authenticate users
                       -> UploadFeature                        -- For accessing package maintainers and trustees
@@ -93,7 +75,7 @@ analyticsPixelsFeature :: ServerEnv
                       -> AnalyticsPixelsFeature
 
 analyticsPixelsFeature  ServerEnv{..}
-              analyticsPixelsState
+              Store.Backend{backendStore = analyticsPixelsState, backendState}
               CoreFeature { coreResource = CoreResource{..} }
               UserFeature{..}
               UploadFeature{..}
@@ -104,7 +86,7 @@ analyticsPixelsFeature  ServerEnv{..}
     analyticsPixelsFeatureInterface  = (emptyHackageFeature "AnalyticsPixels") {
         featureDesc      = "Allow users to attach analytics pixels to their packages",
         featureResources = [analyticsPixelsResource, userAnalyticsPixelsResource]
-      , featureState     = [abstractAcidStateComponent analyticsPixelsState]
+      , featureState     = backendState
       }
 
     analyticsPixelsResource :: Resource
@@ -114,16 +96,16 @@ analyticsPixelsFeature  ServerEnv{..}
     userAnalyticsPixelsResource = resourceAt "/user/:username/analytics-pixels.:format"
 
     getPackageAnalyticsPixels :: MonadIO m => PackageName -> m (Set AnalyticsPixel)
-    getPackageAnalyticsPixels name =
-        queryState analyticsPixelsState (Acid.AnalyticsPixelsForPackage name)
+    getPackageAnalyticsPixels =
+        Store.getPackageAnalyticsPixels analyticsPixelsState
 
     addPackageAnalyticsPixel :: MonadIO m => PackageName -> AnalyticsPixel -> m Bool
     addPackageAnalyticsPixel name pixel = do
-        added <- updateState analyticsPixelsState (Acid.AddPackageAnalyticsPixel name pixel)
+        added <- Store.addPackageAnalyticsPixel analyticsPixelsState name pixel
         when added $ runHook_ analyticsPixelAdded (name, pixel)
         pure added
 
     removePackageAnalyticsPixel :: MonadIO m => PackageName -> AnalyticsPixel -> m ()
     removePackageAnalyticsPixel name pixel = do
-        updateState analyticsPixelsState (Acid.RemovePackageAnalyticsPixel name pixel)
+        Store.removePackageAnalyticsPixel analyticsPixelsState name pixel
         runHook_ analyticsPixelRemoved (name, pixel)

src/Distribution/Server/Features/AnalyticsPixels/Acid.hs

@@ -0,0 +1,37 @@
+module Distribution.Server.Features.AnalyticsPixels.Acid
+  ( acidStore
+  ) where
+
+import qualified Distribution.Server.Features.AnalyticsPixels.State as Acid
+import Distribution.Server.Features.AnalyticsPixels.Store
+import Distribution.Server.Framework
+import Distribution.Server.Framework.BackupRestore
+
+acidStore :: FilePath -> IO Backend
+acidStore stateDir = do
+  analyticsPixelsState <- analyticsPixelsStateComponent stateDir
+  return Backend {
+      backendStore = Store {
+        getPackageAnalyticsPixels = \name -> queryState analyticsPixelsState (Acid.AnalyticsPixelsForPackage name)
+      , addPackageAnalyticsPixel = \name pixel -> updateState analyticsPixelsState (Acid.AddPackageAnalyticsPixel name pixel)
+      , removePackageAnalyticsPixel = \name pixel -> updateState analyticsPixelsState (Acid.RemovePackageAnalyticsPixel name pixel)
+      }
+    , backendState = [abstractAcidStateComponent analyticsPixelsState]
+    }
+
+-- | Define the backing store (i.e. database component)
+analyticsPixelsStateComponent :: FilePath -> IO (StateComponent AcidState Acid.AnalyticsPixelsState)
+analyticsPixelsStateComponent stateDir = do
+  st <- openLocalStateFrom (stateDir </> "db" </> "AnalyticsPixels") Acid.initialAnalyticsPixelsState
+  return StateComponent {
+      stateDesc    = "Backing store for AnalyticsPixels feature"
+    , stateHandle  = st
+    , getState     = query st Acid.GetAnalyticsPixelsState
+    , putState     = update st . Acid.ReplaceAnalyticsPixelsState
+    , resetState   = analyticsPixelsStateComponent
+    , backupState  = \_ _ -> []
+    , restoreState = RestoreBackup {
+                         restoreEntry    = error "Unexpected backup entry"
+                       , restoreFinalize = return Acid.initialAnalyticsPixelsState
+                       }
+   }

src/Distribution/Server/Features/AnalyticsPixels/Store.hs

@@ -0,0 +1,25 @@
+{-# LANGUAGE RankNTypes #-}
+
+module Distribution.Server.Features.AnalyticsPixels.Store
+  ( Backend(..)
+  , Store(..)
+  ) where
+
+import Distribution.Server.Features.AnalyticsPixels.Types
+import Distribution.Server.Framework (AbstractStateComponent)
+
+import Distribution.Package (PackageName)
+
+import Control.Monad.Trans (MonadIO)
+import Data.Set (Set)
+
+data Backend = Backend {
+    backendStore :: Store
+  , backendState :: [AbstractStateComponent]
+  }
+
+data Store = Store {
+    getPackageAnalyticsPixels   :: forall m. MonadIO m => PackageName -> m (Set AnalyticsPixel)
+  , addPackageAnalyticsPixel    :: forall m. MonadIO m => PackageName -> AnalyticsPixel -> m Bool
+  , removePackageAnalyticsPixel :: forall m. MonadIO m => PackageName -> AnalyticsPixel -> m ()
+  }