diff --git a/src/Guide/Main.hs b/src/Guide/Main.hs index 954d6ac..0f813d4 100644 --- a/src/Guide/Main.hs +++ b/src/Guide/Main.hs @@ -448,6 +448,7 @@ installTerminationCatcher thread = void $ do -- The user won't be added if it exists already. createAdminUser :: GuideApp () createAdminUser = do + dbUpdate DeleteAllUsers pass <- T.toByteString . _adminPassword <$> getConfig user <- makeUser "admin" "admin@guide.aelve.com" pass void $ dbUpdate $ CreateUser (user & userIsAdmin .~ True) diff --git a/src/Guide/State.hs b/src/Guide/State.hs index 8c4ee56..99d10d4 100644 --- a/src/Guide/State.hs +++ b/src/Guide/State.hs @@ -79,7 +79,7 @@ module Guide.State LoadSession(..), StoreSession(..), DeleteSession(..), GetSessions(..), - GetUser(..), CreateUser(..), DeleteUser(..), + GetUser(..), CreateUser(..), DeleteUser(..), DeleteAllUsers(..), LoginUser(..), GetAdminUsers(..) @@ -750,6 +750,12 @@ deleteUser key = do logoutUserGlobally key setDirty +deleteAllUsers :: Acid.Update GlobalState () +deleteAllUsers = do + mapM_ logoutUserGlobally . M.keys =<< use users + users .= mempty + setDirty + -- | Given an email address and a password, return the user if it exists -- and the password is correct. loginUser :: Text -> ByteString -> Acid.Query GlobalState (Either String User) @@ -813,7 +819,7 @@ makeAcidic ''GlobalState [ 'loadSession, 'storeSession, 'deleteSession, 'getSessions, -- users - 'getUser, 'createUser, 'deleteUser, + 'getUser, 'createUser, 'deleteUser, 'deleteAllUsers, 'loginUser, 'getAdminUsers