Don't use acid-state for PublicDB

src/Guide/Main.hs

@@ -24,6 +24,10 @@ import Imports
 
 -- Containers
 import qualified Data.Map as M
+-- ByteString
+import qualified Data.ByteString as BS
+-- Lists
+import Safe (headDef)
 -- Monads and monad transformers
 import Control.Monad.Morph
 -- Text
@@ -46,6 +50,8 @@ import qualified Network.Wai.Metrics      as EKG
 import qualified System.Metrics.Gauge     as EKG.Gauge
 -- acid-state
 import Data.Acid as Acid
+import Data.SafeCopy as SafeCopy
+import Data.Serialize.Get as Cereal
 -- IO
 import System.IO
 import qualified SlaveThread as Slave
@@ -55,8 +61,6 @@ import System.Posix.Signals
 import qualified System.FSNotify as FSNotify
 -- HVect
 import Data.HVect hiding (length)
--- safe
-import Safe (headDef)
 
 import Guide.App
 import Guide.ServerStuff
@@ -159,19 +163,19 @@ mainWith config = do
        closeAcidState db
        exitSuccess
      -- USAGE: --load-public <filename>
-     -- loads PublicDB from <filename>, converts it to GlobalState, uses that state
+     -- loads PublicDB from <filename>, converts it to GlobalState, saves & exits
      when (option == "--load-public") $ do
-       let path = headDef "state/public/" $ drop 1 args
-       publicDB :: AcidState PublicDB <- openLocalStateFrom path emptyPublicDB
-       publicState <- Acid.query publicDB GetPublicDB
-       closeAcidState publicDB
-
-       let globalState = fromPublicDB publicState
-       globalDB :: DB <- openLocalStateFrom "state/" globalState
-       Acid.update globalDB (SetGlobalState globalState)
-       createCheckpointAndClose' globalDB
-       putStrLn "PublicDB imported to GlobalState"
-       exitSuccess
+       let path = fromMaybe
+             (error "you haven't provided public DB file name")
+             (args ^? ix 1)
+       (Cereal.runGet SafeCopy.safeGet <$> BS.readFile path) >>= \case
+         Left err -> error err
+         Right publicDB -> do
+           db <- openLocalStateFrom "state/" emptyState
+           Acid.update db (ImportPublicDB publicDB)
+           createCheckpointAndClose' db
+           putStrLn "PublicDB imported to GlobalState"
+           exitSuccess
   -- When we run in GHCi and we exit the main thread, the EKG thread (that
   -- runs the localhost:5050 server which provides statistics) may keep
   -- running. This makes running this in GHCi annoying, because you have to

src/Guide/State.hs

@@ -24,7 +24,6 @@ module Guide.State
   -- * acid-state methods
   -- ** query
   GetGlobalState(..),
-  GetPublicDB(..),
   GetCategories(..),
   GetCategory(..), GetCategoryMaybe(..),
   GetCategoryByItem(..),
@@ -85,11 +84,13 @@ module Guide.State
 
   GetAdminUsers(..),
 
-  -- * public db
+  -- * PublicDB
   PublicDB(..),
   toPublicDB,
   fromPublicDB,
-  emptyPublicDB
+  -- ** queries
+  ImportPublicDB(..),
+  ExportPublicDB(..),
 )
 where
 
@@ -256,24 +257,12 @@ data PublicDB = PublicDB {
   publicUsers             :: Map (Uid User) PublicUser}
   deriving (Show)
 
--- NOTE: you don't need to write migrations for 'PublicDB' but you still 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.
+-- NOTE: you don't need to write migrations for 'PublicDB' but you still
+-- 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
 
--- | Initial state of 'PublicDB'.
-emptyPublicDB :: PublicDB
-emptyPublicDB =
-  PublicDB {
-    publicCategories        = mempty,
-    publicCategoriesDeleted = mempty,
-    publicActions           = mempty,
-    publicPendingEdits      = mempty,
-    publicEditIdCounter     = 0,
-    publicUsers             = mempty
-  }
-
 -- | Converts 'GlobalState' to 'PublicDB' type stripping private data.
 toPublicDB :: GlobalState -> PublicDB
 toPublicDB GlobalState{..} =
@@ -283,7 +272,7 @@ toPublicDB GlobalState{..} =
     publicActions           = _actions,
     publicPendingEdits      = _pendingEdits,
     publicEditIdCounter     = _editIdCounter,
-    publicUsers             = M.map userToPublic _users
+    publicUsers             = fmap userToPublic _users
   }
 
 -- | Converts 'PublicDB' to 'GlobalState' type filling in non-existing data with
@@ -297,7 +286,7 @@ fromPublicDB PublicDB{..} =
     _pendingEdits      = publicPendingEdits,
     _editIdCounter     = publicEditIdCounter,
     _sessionStore      = M.empty,
-    _users             = M.map publicUserToUser publicUsers,
+    _users             = fmap publicUserToUser publicUsers,
     _dirty             = True
   }
 
@@ -306,9 +295,6 @@ fromPublicDB PublicDB{..} =
 getGlobalState :: Acid.Query GlobalState GlobalState
 getGlobalState = view id
 
-getPublicDB :: Acid.Query PublicDB PublicDB
-getPublicDB = view id
-
 getCategories :: Acid.Query GlobalState [Category]
 getCategories = view categories
 
@@ -843,6 +829,14 @@ logoutUserGlobally key = do
 getAdminUsers :: Acid.Query GlobalState [User]
 getAdminUsers = filter (^. userIsAdmin) . toList <$> view users
 
+-- | Populate the database with info from the public DB.
+importPublicDB :: PublicDB -> Acid.Update GlobalState ()
+importPublicDB = put . fromPublicDB
+
+-- | Strip the database from sensitive data and create a 'PublicDB' from it.
+exportPublicDB :: Acid.Query GlobalState PublicDB
+exportPublicDB = toPublicDB <$> ask
+
 makeAcidic ''GlobalState [
   -- queries
   'getGlobalState,
@@ -884,10 +878,9 @@ makeAcidic ''GlobalState [
   'getUser, 'createUser, 'deleteUser, 
   'loginUser,
 
-  'getAdminUsers
-  ]
+  'getAdminUsers,
 
-makeAcidic ''PublicDB [
-  -- query
-  'getPublicDB
+  -- PublicDB
+  'importPublicDB,
+  'exportPublicDB
   ]