Introduce data store abstraction layer

hackage-server.cabal

@@ -307,10 +307,13 @@ 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.Backup
-    Distribution.Server.Features.Security
-    Distribution.Server.Features.Security.Backup
+    Distribution.Server.Features.Core.Store
+      Distribution.Server.Features.Core.Backup
+      Distribution.Server.Features.Security
+      Distribution.Server.Features.Security.Acid
+      Distribution.Server.Features.Security.Backup
     Distribution.Server.Features.Security.FileInfo
     Distribution.Server.Features.Security.Layout
     Distribution.Server.Features.Security.MD5
@@ -319,14 +322,25 @@ library
     Distribution.Server.Features.Security.ResponseContentTypes
     Distribution.Server.Features.Security.SHA256
     Distribution.Server.Features.Security.State
+    Distribution.Server.Features.Security.Store
     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.Acid
+    Distribution.Server.Features.Upload.Store
     Distribution.Server.Features.Upload.State
     Distribution.Server.Features.Upload.Backup
     Distribution.Server.Features.Users
+    Distribution.Server.Features.Users.Acid
+    Distribution.Server.Features.Users.Store
     Distribution.Server.Features.UserNotify
     Distribution.Server.Features.UserNotify.Acid
+    Distribution.Server.Features.UserNotify.Acid.Component
     Distribution.Server.Features.UserNotify.Backup
+    Distribution.Server.Features.UserNotify.Store
     Distribution.Server.Features.UserNotify.Types
 
 
@@ -342,35 +356,49 @@ library
       Distribution.Server.Features.AdminLog
       Distribution.Server.Features.AdminLog.Acid
       Distribution.Server.Features.AdminLog.Backup
+      Distribution.Server.Features.AdminLog.State
+      Distribution.Server.Features.AdminLog.Store
       Distribution.Server.Features.AdminLog.Types
       Distribution.Server.Features.BuildReports
       Distribution.Server.Features.BuildReports.BuildReport
       Distribution.Server.Features.BuildReports.BuildReports
+      Distribution.Server.Features.BuildReports.Acid
       Distribution.Server.Features.BuildReports.Backup
+      Distribution.Server.Features.BuildReports.Store
       Distribution.Server.Features.BuildReports.Render
       Distribution.Server.Features.BuildReports.State
       Distribution.Server.Features.PackageCandidates
+      Distribution.Server.Features.PackageCandidates.Acid
       Distribution.Server.Features.PackageCandidates.Types
       Distribution.Server.Features.PackageCandidates.State
       Distribution.Server.Features.PackageCandidates.Backup
+      Distribution.Server.Features.PackageCandidates.Store
       Distribution.Server.Features.PackageFeed
       Distribution.Server.Features.PackageList
       Distribution.Server.Features.Distro
+      Distribution.Server.Features.Distro.Acid
       Distribution.Server.Features.Distro.Distributions
       Distribution.Server.Features.Distro.Backup
       Distribution.Server.Features.Distro.State
+      Distribution.Server.Features.Distro.Store
       Distribution.Server.Features.Distro.Types
       Distribution.Server.Features.Documentation
+      Distribution.Server.Features.Documentation.Acid
       Distribution.Server.Features.Documentation.State
+      Distribution.Server.Features.Documentation.Store
       Distribution.Server.Features.DownloadCount
+      Distribution.Server.Features.DownloadCount.Acid
       Distribution.Server.Features.DownloadCount.State
+      Distribution.Server.Features.DownloadCount.Store
       Distribution.Server.Features.DownloadCount.Backup
       Distribution.Server.Features.EditCabalFiles
       Distribution.Server.Features.Html
       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,33 +413,47 @@ 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.Acid
       Distribution.Server.Features.Vouch.State
+      Distribution.Server.Features.Vouch.Store
       Distribution.Server.Features.Vouch.Types
       Distribution.Server.Features.RecentPackages
       Distribution.Server.Features.PreferredVersions
+      Distribution.Server.Features.PreferredVersions.Acid
       Distribution.Server.Features.PreferredVersions.State
       Distribution.Server.Features.PreferredVersions.Types
       Distribution.Server.Features.PreferredVersions.Backup
+      Distribution.Server.Features.PreferredVersions.Store
       Distribution.Server.Features.ReverseDependencies
       Distribution.Server.Features.ReverseDependencies.State
       Distribution.Server.Features.Tags
+      Distribution.Server.Features.Tags.Acid
       Distribution.Server.Features.Tags.Backup
+      Distribution.Server.Features.Tags.Store
       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
       Distribution.Server.Features.UserDetails.Backup
+      Distribution.Server.Features.UserDetails.State
+      Distribution.Server.Features.UserDetails.Store
       Distribution.Server.Features.UserDetails.Types
       Distribution.Server.Features.UserSignup
       Distribution.Server.Features.UserSignup.Acid
       Distribution.Server.Features.UserSignup.Backup
+      Distribution.Server.Features.UserSignup.State
+      Distribution.Server.Features.UserSignup.Store
       Distribution.Server.Features.UserSignup.Types
       Distribution.Server.Features.StaticFiles
       Distribution.Server.Features.ServerIntrospect

src/Distribution/Server/Features/AdminLog.hs

@@ -4,18 +4,18 @@
 
 module Distribution.Server.Features.AdminLog where
 
-import qualified Distribution.Server.Features.AdminLog.Acid as Acid
-import Distribution.Server.Features.AdminLog.Backup
+import Distribution.Server.Features.AdminLog.Acid (acidStore)
+import qualified Distribution.Server.Features.AdminLog.Store as Store
 import Distribution.Server.Features.AdminLog.Types
 import Distribution.Server.Users.Types (UserId)
 import Distribution.Server.Users.Group
 import Distribution.Server.Framework
-import Distribution.Server.Framework.BackupRestore
 
 import Distribution.Server.Pages.AdminLog
 import Distribution.Server.Features.Users
 
-import Data.Time.Clock (getCurrentTime)
+import Data.Time.Clock (getCurrentTime, UTCTime)
+import qualified Data.ByteString.Lazy.Char8 as BS
 import Distribution.Server.Util.Parse
 
 --TODO Maybe Reason
@@ -29,38 +29,38 @@ mkAdminAction gd isAdd uid = (if isAdd then Admin_GroupAddUser else Admin_GroupD
 
 data AdminLogFeature = AdminLogFeature {
       adminLogFeatureInterface :: HackageFeature
-    , queryGetAdminLog :: forall m. MonadIO m => m Acid.AdminLog
+    , queryGetAdminLog :: forall m. MonadIO m => m [(UTCTime,UserId,AdminAction,BS.ByteString)]
 }
 
 instance IsHackageFeature AdminLogFeature where
     getFeatureInterface = adminLogFeatureInterface
 
 initAdminLogFeature :: ServerEnv -> IO (UserFeature -> IO AdminLogFeature)
 initAdminLogFeature ServerEnv{serverStateDir} = do
-  adminLogState <- adminLogStateComponent serverStateDir
+  adminLogBackend <- acidStore serverStateDir
   return $ \users@UserFeature{groupChangedHook} -> do
 
-    let feature = adminLogFeature users adminLogState
+    let feature = adminLogFeature users adminLogBackend
 
     registerHook groupChangedHook $ \(gd,addOrDel,actorUid,targetUid,reason) -> do
         now <- getCurrentTime
-        updateState adminLogState $ Acid.AddAdminLog
+        Store.addAdminLog (Store.backendStore adminLogBackend)
             (now, actorUid, mkAdminAction gd addOrDel targetUid, packUTF8 reason)
 
     return feature
 
 adminLogFeature :: UserFeature
-                -> StateComponent AcidState Acid.AdminLog
+                -> Store.Backend
                 -> AdminLogFeature
-adminLogFeature UserFeature{..} adminLogState
+adminLogFeature UserFeature{..} Store.Backend{backendStore = adminLogStore, backendState}
   = AdminLogFeature {..}
 
   where
     adminLogFeatureInterface =
       (emptyHackageFeature "admin-actions-log") {
         featureDesc      = "Log of additions and removals of users from groups.",
         featureResources = [adminLogResource],
-        featureState     = [abstractAcidStateComponent adminLogState]
+        featureState     = backendState
       }
 
     adminLogResource :: Resource
@@ -70,13 +70,13 @@ adminLogFeature UserFeature{..} adminLogState
         resourceGet  = [("html", serveAdminLogGet)]
       }
 
-    queryGetAdminLog :: MonadIO m => m Acid.AdminLog
-    queryGetAdminLog = queryState adminLogState Acid.GetAdminLog
+    queryGetAdminLog :: MonadIO m => m [(UTCTime,UserId,AdminAction,BS.ByteString)]
+    queryGetAdminLog = Store.getAdminLog adminLogStore
 
     serveAdminLogGet _ = do
-      aLog  <- queryState adminLogState Acid.GetAdminLog
+      aLog  <- queryGetAdminLog
       users <- queryGetUserDb
-      return . toResponse . adminLogPage users . map mkRow . Acid.adminLog $ aLog
+      return . toResponse . adminLogPage users . map mkRow $ aLog
 
     mkRow (time, actorId, Admin_GroupDelUser targetId group, reason) =
           (time, actorId, "Acid.Delete", targetId, nameIt group, unpackUTF8 reason)
@@ -87,18 +87,3 @@ adminLogFeature UserFeature{..} adminLogState
     nameIt AdminGroup           = "Administrators"
     nameIt TrusteeGroup         = "Trustees"
     nameIt (OtherGroup s)       = unpackUTF8 s
-
-adminLogStateComponent :: FilePath -> IO (StateComponent AcidState Acid.AdminLog)
-adminLogStateComponent stateDir = do
-  st <- openLocalStateFrom (stateDir </> "db" </> "AdminLog") Acid.initialAdminLog
-  return StateComponent {
-      stateDesc    = "AdminLog"
-    , stateHandle  = st
-    , getState     = query st Acid.GetAdminLog
-    , putState     = update st . Acid.ReplaceAdminLog
-    , backupState  = \_ (Acid.AdminLog xs) ->
-                      [BackupByteString ["adminLog.txt"] . backupLogEntries $ xs]
-    , restoreState = restoreAdminLogBackup
-    , resetState   = adminLogStateComponent
-    }
-

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

@@ -1,96 +1,34 @@
-{-# LANGUAGE DeriveDataTypeable, TypeFamilies, TemplateHaskell, BangPatterns,
-             GeneralizedNewtypeDeriving, NamedFieldPuns, RecordWildCards,
-             PatternGuards, RankNTypes #-}
+module Distribution.Server.Features.AdminLog.Acid
+  ( acidStore
+  ) where
 
-module Distribution.Server.Features.AdminLog.Acid where
-
-import Distribution.Server.Features.AdminLog.Types
-import Distribution.Server.Users.Types (UserId)
+import Distribution.Server.Features.AdminLog.Backup
+import qualified Distribution.Server.Features.AdminLog.State as State
+import Distribution.Server.Features.AdminLog.Store
 import Distribution.Server.Framework
-
-import Control.Monad.Reader
-import qualified Control.Monad.State as State
-import Data.Time (UTCTime)
-import qualified Data.ByteString.Lazy.Char8 as BS
-import Data.Acid.Compat
-
-newtype AdminLog = AdminLog {
-      adminLog :: [(UTCTime,UserId,AdminAction,BS.ByteString)]
-} deriving (Show, MemSize)
-
-deriveSafeCopy 0 'base ''AdminLog
-
-initialAdminLog :: AdminLog
-initialAdminLog = AdminLog []
-
-getAdminLog :: Query AdminLog AdminLog
-getAdminLog = ask
-
-addAdminLog :: (UTCTime, UserId, AdminAction, BS.ByteString) -> Update AdminLog ()
-addAdminLog x = State.modify (\(AdminLog xs) -> AdminLog (x : xs))
-
-instance Eq AdminLog where
-    (AdminLog (x:_)) == (AdminLog (y:_)) = x == y
-    (AdminLog []) == (AdminLog []) = True
-    _ == _ = False
-
-replaceAdminLog :: AdminLog -> Update AdminLog ()
-replaceAdminLog = State.put
-
-------------------------------
--- IsAcidic machinery
---
--- See Note [Acid Migration] in "Data.Acid.Compat"
--- original module name was Distribution.Server.Features.AdminLog"
-
--- makeAcidic ''AdminLog ['getAdminLog
---                       ,'replaceAdminLog
---                       ,'addAdminLog]
-
-instance IsAcidic AdminLog where
-  acidEvents
-    = [QueryEvent
-         (\ GetAdminLog -> getAdminLog) safeCopyMethodSerialiser,
-       UpdateEvent
-         (\ (ReplaceAdminLog arg_aDn6) -> replaceAdminLog arg_aDn6)
-         safeCopyMethodSerialiser,
-       UpdateEvent
-         (\ (AddAdminLog arg_aDn7) -> addAdminLog arg_aDn7)
-         safeCopyMethodSerialiser]
-data GetAdminLog = GetAdminLog
-instance SafeCopy GetAdminLog where
-  putCopy GetAdminLog = contain (do return ())
-  getCopy = contain (return GetAdminLog)
-  errorTypeName _ = "Data.SafeCopy.SafeCopy.SafeCopy GetAdminLog"
-instance Data.Acid.Compat.Method GetAdminLog where
-  type MethodResult GetAdminLog = AdminLog
-  type MethodState GetAdminLog = AdminLog
-  methodTag = movedMethodTag "Distribution.Server.Features.AdminLog"
-instance QueryEvent GetAdminLog
-newtype ReplaceAdminLog = ReplaceAdminLog AdminLog
-instance SafeCopy ReplaceAdminLog where
-  putCopy (ReplaceAdminLog arg_aDmO)
-    = contain
-        (do safePut arg_aDmO
-            return ())
-  getCopy = contain (return ReplaceAdminLog <*> safeGet)
-  errorTypeName _ = "Data.SafeCopy.SafeCopy.SafeCopy ReplaceAdminLog"
-instance Data.Acid.Compat.Method ReplaceAdminLog where
-  type MethodResult ReplaceAdminLog = ()
-  type MethodState ReplaceAdminLog = AdminLog
-  methodTag = movedMethodTag "Distribution.Server.Features.AdminLog"
-instance UpdateEvent ReplaceAdminLog
-newtype AddAdminLog
-  = AddAdminLog (UTCTime, UserId, AdminAction, BS.ByteString)
-instance SafeCopy AddAdminLog where
-  putCopy (AddAdminLog arg_aDmT)
-    = contain
-        (do safePut arg_aDmT
-            return ())
-  getCopy = contain (return AddAdminLog <*> safeGet)
-  errorTypeName _ = "Data.SafeCopy.SafeCopy.SafeCopy AddAdminLog"
-instance Data.Acid.Compat.Method AddAdminLog where
-  type MethodResult AddAdminLog = ()
-  type MethodState AddAdminLog = AdminLog
-  methodTag = movedMethodTag "Distribution.Server.Features.AdminLog"
-instance UpdateEvent AddAdminLog
+import Distribution.Server.Framework.BackupRestore
+
+acidStore :: FilePath -> IO Backend
+acidStore stateDir = do
+  adminLogState <- adminLogStateComponent stateDir
+  pure Backend {
+      backendStore = Store {
+          getAdminLog = State.adminLog <$> queryState adminLogState State.GetAdminLog
+        , addAdminLog = \entry -> updateState adminLogState (State.AddAdminLog entry)
+        }
+    , backendState = [abstractAcidStateComponent adminLogState]
+    }
+
+adminLogStateComponent :: FilePath -> IO (StateComponent AcidState State.AdminLog)
+adminLogStateComponent stateDir = do
+  st <- openLocalStateFrom (stateDir </> "db" </> "AdminLog") State.initialAdminLog
+  return StateComponent {
+      stateDesc    = "AdminLog"
+    , stateHandle  = st
+    , getState     = query st State.GetAdminLog
+    , putState     = update st . State.ReplaceAdminLog
+    , backupState  = \_ (State.AdminLog xs) ->
+                      [BackupByteString ["adminLog.txt"] . backupLogEntries $ xs]
+    , restoreState = restoreAdminLogBackup
+    , resetState   = adminLogStateComponent
+    }