From 513399ec324b690fc4ed99c199b4edac8b026966 Mon Sep 17 00:00:00 2001 From: vrom911 Date: Thu, 24 Aug 2017 19:38:17 +0300 Subject: [PATCH 1/4] Add PublicDB type --- src/Guide/State.hs | 47 ++++++++++++++++++++++++++++++++++++++++- src/Guide/Types/User.hs | 41 +++++++++++++++++++++++++++++++++++ 2 files changed, 87 insertions(+), 1 deletion(-) diff --git a/src/Guide/State.hs b/src/Guide/State.hs index 34b771d..2480395 100644 --- a/src/Guide/State.hs +++ b/src/Guide/State.hs @@ -82,7 +82,11 @@ module Guide.State GetUser(..), CreateUser(..), DeleteUser(..), LoginUser(..), - GetAdminUsers(..) + GetAdminUsers(..), + + PublicDB(..), + toPublicDB, + fromPublicDB ) where @@ -817,3 +821,44 @@ makeAcidic ''GlobalState [ 'getAdminUsers ] + +data PublicDB = PublicDB { + publicCategories :: [Category], + publicCategoriesDeleted :: [Category], + publicActions :: [(Action, ActionDetails)], + -- | Pending edits, newest first + publicPendingEdits :: [(Edit, EditDetails)], + -- | ID of next edit that will be made + publicEditIdCounter :: Int, + -- | Users + publicUsers :: Map (Uid User) PublicUser, + -- | The dirty bit (needed to choose whether to make a checkpoint or not) + publicDirty :: Bool } + deriving (Show) + +deriveSafeCopySorted 0 'base ''PublicDB + +toPublicDB :: GlobalState -> PublicDB +toPublicDB GlobalState{..} = + PublicDB { + publicCategories = _categories, + publicCategoriesDeleted = _categoriesDeleted, + publicActions = _actions, + publicPendingEdits = _pendingEdits, + publicEditIdCounter = _editIdCounter, + publicUsers = M.map userToPublic _users, + publicDirty = _dirty + } + +fromPublicDB :: PublicDB -> GlobalState +fromPublicDB PublicDB{..} = + GlobalState { + _categories = publicCategories, + _categoriesDeleted = publicCategoriesDeleted, + _actions = publicActions, + _pendingEdits = publicPendingEdits, + _editIdCounter = publicEditIdCounter, + _sessionStore = M.empty, + _users = M.map publicUserToUser publicUsers, + _dirty = publicDirty + } diff --git a/src/Guide/Types/User.hs b/src/Guide/Types/User.hs index 11723ee..483a3ef 100644 --- a/src/Guide/Types/User.hs +++ b/src/Guide/Types/User.hs @@ -15,6 +15,13 @@ module Guide.Types.User makeUser, verifyUser, canCreateUser, + PublicUser, + publicUserID, + publicUserName, + publicUserEmail, + publicUserIsAdmin, + userToPublic, + publicUserToUser ) where @@ -76,3 +83,37 @@ canCreateUser userFoo userBar = fieldNotEq userID, fieldNotEq userName, fieldNotEq userEmail ] + +data PublicUser = PublicUser { + -- | Unique, pseudorandom identifier for user. + _publicUserID :: Uid User, + -- | Unique username for user. + _publicUserName :: Text, + -- | Unique email address for user. + _publicUserEmail :: Text, + -- | Flag set if user is an administrator. + _publicUserIsAdmin :: Bool + } + deriving (Show) + +deriveSafeCopySorted 0 'base ''PublicUser +makeLenses ''PublicUser + +userToPublic :: User -> PublicUser +userToPublic User{..} = + PublicUser { + _publicUserID = _userID, + _publicUserName = _userName, + _publicUserEmail = _userEmail, + _publicUserIsAdmin = _userIsAdmin + } + +publicUserToUser :: PublicUser -> User +publicUserToUser PublicUser{..} = + User { + _userID = _publicUserID, + _userName = _publicUserName, + _userEmail = _publicUserEmail, + _userPassword = Nothing, + _userIsAdmin = _publicUserIsAdmin + } From ef74f81092b6cd0ae2314540523db73d30e65d46 Mon Sep 17 00:00:00 2001 From: vrom911 Date: Thu, 24 Aug 2017 19:39:16 +0300 Subject: [PATCH 2/4] Add argument --from-publicDB --- src/Guide/Main.hs | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/src/Guide/Main.hs b/src/Guide/Main.hs index afd16b9..213a2fa 100644 --- a/src/Guide/Main.hs +++ b/src/Guide/Main.hs @@ -155,6 +155,14 @@ mainWith config = do putStrLn "loaded the database successfully" closeAcidState db exitSuccess + when (args == ["--from-publicDB"]) $ do + db :: DB <- openLocalStateFrom "state/" (error "couldn't load state") + gs <- query db GetGlobalState + putStrLn "loaded the database" + let publicdb = fromPublicDB $ toPublicDB gs + print publicdb + closeAcidState db + 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 From 8d9d428446b7330f4b7924b092b6c853d191f442 Mon Sep 17 00:00:00 2001 From: vrom911 Date: Sat, 26 Aug 2017 15:00:23 +0300 Subject: [PATCH 3/4] Add loading from PublicDB --- guide.cabal | 1 + src/Guide/Main.hs | 25 ++++++--- src/Guide/State.hs | 113 +++++++++++++++++++++++++--------------- src/Guide/Types/User.hs | 39 ++++++-------- 4 files changed, 106 insertions(+), 72 deletions(-) diff --git a/guide.cabal b/guide.cabal index 0ee176a..4f0a3fc 100644 --- a/guide.cabal +++ b/guide.cabal @@ -127,6 +127,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 213a2fa..572d9e5 100644 --- a/src/Guide/Main.hs +++ b/src/Guide/Main.hs @@ -55,6 +55,8 @@ 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 @@ -150,18 +152,25 @@ 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 - when (args == ["--from-publicDB"]) $ do - db :: DB <- openLocalStateFrom "state/" (error "couldn't load state") - gs <- query db GetGlobalState - putStrLn "loaded the database" - let publicdb = fromPublicDB $ toPublicDB gs - print publicdb - closeAcidState db + -- USAGE: --load-public + -- loads PublicDB from , converts it to GlobalState, uses that state + 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 -- 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 diff --git a/src/Guide/State.hs b/src/Guide/State.hs index 2480395..2514324 100644 --- a/src/Guide/State.hs +++ b/src/Guide/State.hs @@ -24,6 +24,7 @@ module Guide.State -- * acid-state methods -- ** query GetGlobalState(..), + GetPublicDB(..), GetCategories(..), GetCategory(..), GetCategoryMaybe(..), GetCategoryByItem(..), @@ -83,10 +84,12 @@ module Guide.State LoginUser(..), GetAdminUsers(..), - + + -- * public db PublicDB(..), toPublicDB, - fromPublicDB + fromPublicDB, + emptyPublicDB ) where @@ -239,11 +242,73 @@ 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 + +-- | 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{..} = + PublicDB { + publicCategories = _categories, + publicCategoriesDeleted = _categoriesDeleted, + publicActions = _actions, + publicPendingEdits = _pendingEdits, + publicEditIdCounter = _editIdCounter, + publicUsers = M.map 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 = M.map publicUserToUser publicUsers, + _dirty = True + } + -- get getGlobalState :: Acid.Query GlobalState GlobalState getGlobalState = view id +getPublicDB :: Acid.Query PublicDB PublicDB +getPublicDB = view id + getCategories :: Acid.Query GlobalState [Category] getCategories = view categories @@ -822,43 +887,7 @@ makeAcidic ''GlobalState [ 'getAdminUsers ] -data PublicDB = PublicDB { - publicCategories :: [Category], - publicCategoriesDeleted :: [Category], - publicActions :: [(Action, ActionDetails)], - -- | Pending edits, newest first - publicPendingEdits :: [(Edit, EditDetails)], - -- | ID of next edit that will be made - publicEditIdCounter :: Int, - -- | Users - publicUsers :: Map (Uid User) PublicUser, - -- | The dirty bit (needed to choose whether to make a checkpoint or not) - publicDirty :: Bool } - deriving (Show) - -deriveSafeCopySorted 0 'base ''PublicDB - -toPublicDB :: GlobalState -> PublicDB -toPublicDB GlobalState{..} = - PublicDB { - publicCategories = _categories, - publicCategoriesDeleted = _categoriesDeleted, - publicActions = _actions, - publicPendingEdits = _pendingEdits, - publicEditIdCounter = _editIdCounter, - publicUsers = M.map userToPublic _users, - publicDirty = _dirty - } - -fromPublicDB :: PublicDB -> GlobalState -fromPublicDB PublicDB{..} = - GlobalState { - _categories = publicCategories, - _categoriesDeleted = publicCategoriesDeleted, - _actions = publicActions, - _pendingEdits = publicPendingEdits, - _editIdCounter = publicEditIdCounter, - _sessionStore = M.empty, - _users = M.map publicUserToUser publicUsers, - _dirty = publicDirty - } +makeAcidic ''PublicDB [ + -- query + 'getPublicDB + ] diff --git a/src/Guide/Types/User.hs b/src/Guide/Types/User.hs index 483a3ef..5bfd39c 100644 --- a/src/Guide/Types/User.hs +++ b/src/Guide/Types/User.hs @@ -16,10 +16,6 @@ module Guide.Types.User verifyUser, canCreateUser, PublicUser, - publicUserID, - publicUserName, - publicUserEmail, - publicUserIsAdmin, userToPublic, publicUserToUser ) @@ -84,36 +80,35 @@ canCreateUser userFoo userBar = fieldNotEq userName, fieldNotEq userEmail ] +-- | 'PublicUser' contains all safe User data. +-- Removed from 'User': +-- * Password data PublicUser = PublicUser { - -- | Unique, pseudorandom identifier for user. - _publicUserID :: Uid User, - -- | Unique username for user. - _publicUserName :: Text, - -- | Unique email address for user. - _publicUserEmail :: Text, - -- | Flag set if user is an administrator. - _publicUserIsAdmin :: Bool - } + publicUserID :: Uid User, + publicUserName :: Text, + publicUserEmail :: Text, + publicUserIsAdmin :: Bool} deriving (Show) deriveSafeCopySorted 0 'base ''PublicUser -makeLenses ''PublicUser +-- | Converts 'User' to 'PublicUser' type. userToPublic :: User -> PublicUser userToPublic User{..} = PublicUser { - _publicUserID = _userID, - _publicUserName = _userName, - _publicUserEmail = _userEmail, - _publicUserIsAdmin = _userIsAdmin + 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, + _userID = publicUserID, + _userName = publicUserName, + _userEmail = publicUserEmail, _userPassword = Nothing, - _userIsAdmin = _publicUserIsAdmin + _userIsAdmin = publicUserIsAdmin } From 5f42eef59dffd7c9027e58418b1b68d79441338b Mon Sep 17 00:00:00 2001 From: Artyom Date: Tue, 29 Aug 2017 01:03:21 +0300 Subject: [PATCH 4/4] Don't use acid-state for PublicDB --- src/Guide/Main.hs | 32 ++++++++++++++++------------- src/Guide/State.hs | 51 ++++++++++++++++++++-------------------------- 2 files changed, 40 insertions(+), 43 deletions(-) diff --git a/src/Guide/Main.hs b/src/Guide/Main.hs index 572d9e5..378451f 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 @@ -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 - -- loads PublicDB from , converts it to GlobalState, uses that state + -- loads PublicDB from , 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 diff --git a/src/Guide/State.hs b/src/Guide/State.hs index 2514324..f280039 100644 --- a/src/Guide/State.hs +++ b/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 ]