diff --git a/guide.cabal b/guide.cabal index 704837e..a4a3809 100644 --- a/guide.cabal +++ b/guide.cabal @@ -128,6 +128,7 @@ library , patches-vector , random >= 1.1 , reroute + , safe , safecopy , safecopy-migrate , scrypt diff --git a/src/Guide/Main.hs b/src/Guide/Main.hs index 0f813d4..0fda2a0 100644 --- a/src/Guide/Main.hs +++ b/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 @@ -150,11 +156,26 @@ mainWith config = do _users = M.empty, _dirty = True } do args <- getArgs - when (args == ["--dry-run"]) $ do + let option = headDef "" args + when (option == "--dry-run") $ do db :: DB <- openLocalStateFrom "state/" (error "couldn't load state") putStrLn "loaded the database successfully" closeAcidState db exitSuccess + -- USAGE: --load-public + -- loads PublicDB from , converts it to GlobalState, saves & exits + when (option == "--load-public") $ do + 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 diff --git a/src/Guide/State.hs b/src/Guide/State.hs index 99d10d4..1ac8288 100644 --- a/src/Guide/State.hs +++ b/src/Guide/State.hs @@ -82,7 +82,15 @@ module Guide.State GetUser(..), CreateUser(..), DeleteUser(..), DeleteAllUsers(..), LoginUser(..), - GetAdminUsers(..) + GetAdminUsers(..), + + -- * PublicDB + PublicDB(..), + toPublicDB, + fromPublicDB, + -- ** queries + ImportPublicDB(..), + ExportPublicDB(..), ) where @@ -235,6 +243,53 @@ findCategoryByItem itemId s = T.unpack (uidToText itemId) hasItem category = itemId `elem` (category^..items.each.uid) +-- | 'PublicDB' contains all safe data from 'GlobalState'. +-- Difference from 'GlobalState': +-- * 'User' replaced with 'PublicUser' +-- * Sessions information removed +-- * Dirty flag removed +data PublicDB = PublicDB { + publicCategories :: [Category], + publicCategoriesDeleted :: [Category], + publicActions :: [(Action, ActionDetails)], + publicPendingEdits :: [(Edit, EditDetails)], + publicEditIdCounter :: Int, + 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. +deriveSafeCopySorted 0 'base ''PublicDB + +-- | Converts 'GlobalState' to 'PublicDB' type stripping private data. +toPublicDB :: GlobalState -> PublicDB +toPublicDB GlobalState{..} = + PublicDB { + publicCategories = _categories, + publicCategoriesDeleted = _categoriesDeleted, + publicActions = _actions, + publicPendingEdits = _pendingEdits, + publicEditIdCounter = _editIdCounter, + publicUsers = fmap userToPublic _users + } + +-- | Converts 'PublicDB' to 'GlobalState' type filling in non-existing data with +-- default values. +fromPublicDB :: PublicDB -> GlobalState +fromPublicDB PublicDB{..} = + GlobalState { + _categories = publicCategories, + _categoriesDeleted = publicCategoriesDeleted, + _actions = publicActions, + _pendingEdits = publicPendingEdits, + _editIdCounter = publicEditIdCounter, + _sessionStore = M.empty, + _users = fmap publicUserToUser publicUsers, + _dirty = True + } + -- get getGlobalState :: Acid.Query GlobalState GlobalState @@ -781,6 +836,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, @@ -822,5 +885,9 @@ makeAcidic ''GlobalState [ 'getUser, 'createUser, 'deleteUser, 'deleteAllUsers, 'loginUser, - 'getAdminUsers + 'getAdminUsers, + + -- PublicDB + 'importPublicDB, + 'exportPublicDB ] diff --git a/src/Guide/Types/User.hs b/src/Guide/Types/User.hs index 11723ee..5bfd39c 100644 --- a/src/Guide/Types/User.hs +++ b/src/Guide/Types/User.hs @@ -15,6 +15,9 @@ module Guide.Types.User makeUser, verifyUser, canCreateUser, + PublicUser, + userToPublic, + publicUserToUser ) where @@ -76,3 +79,36 @@ canCreateUser userFoo userBar = fieldNotEq userID, fieldNotEq userName, fieldNotEq userEmail ] + +-- | 'PublicUser' contains all safe User data. +-- Removed from 'User': +-- * Password +data PublicUser = PublicUser { + publicUserID :: Uid User, + publicUserName :: Text, + publicUserEmail :: Text, + publicUserIsAdmin :: Bool} + deriving (Show) + +deriveSafeCopySorted 0 'base ''PublicUser + +-- | Converts 'User' to 'PublicUser' type. +userToPublic :: User -> PublicUser +userToPublic User{..} = + PublicUser { + publicUserID = _userID, + publicUserName = _userName, + publicUserEmail = _userEmail, + publicUserIsAdmin = _userIsAdmin + } + +-- | Converts 'PublicUser' to 'User' filling password with Nothing. +publicUserToUser :: PublicUser -> User +publicUserToUser PublicUser{..} = + User { + _userID = publicUserID, + _userName = publicUserName, + _userEmail = publicUserEmail, + _userPassword = Nothing, + _userIsAdmin = publicUserIsAdmin + }