add more user fields to CreateUser

This commit is contained in:
Jon Schoning 2020-03-30 12:06:21 -05:00
parent b136e59265
commit 6277194dff

View file

@ -14,23 +14,25 @@ import Lens.Micro
import Options.Generic import Options.Generic
data MigrationOpts data MigrationOpts
= CreateDB { conn :: Text} = CreateDB { conn :: Text }
| CreateUser { conn :: Text | CreateUser { conn :: Text
, userName :: Text , userName :: Text
, userPassword :: Text , userPassword :: Text
, userApiToken :: Maybe Text } , privateDefault :: Maybe Bool
, archiveDefault :: Maybe Bool
, privacyLock :: Maybe Bool }
| DeleteUser { conn :: Text | DeleteUser { conn :: Text
, userName :: Text} , userName :: Text }
| ImportBookmarks { conn :: Text | ImportBookmarks { conn :: Text
, userName :: Text , userName :: Text
, bookmarkFile :: FilePath} , bookmarkFile :: FilePath }
| ExportBookmarks { conn :: Text | ExportBookmarks { conn :: Text
, userName :: Text , userName :: Text
, bookmarkFile :: FilePath} , bookmarkFile :: FilePath }
| ImportNotes { conn :: Text | ImportNotes { conn :: Text
, userName :: Text , userName :: Text
, noteDirectory :: FilePath} , noteDirectory :: FilePath }
| PrintMigrateDB { conn :: Text} | PrintMigrateDB { conn :: Text }
deriving (Generic, Show) deriving (Generic, Show)
instance ParseRecord MigrationOpts instance ParseRecord MigrationOpts
@ -39,54 +41,54 @@ main :: IO ()
main = do main = do
args <- getRecord "Migrations" args <- getRecord "Migrations"
case args of case args of
PrintMigrateDB conn -> PrintMigrateDB {..} ->
P.runSqlite conn dumpMigration P.runSqlite conn dumpMigration
CreateDB conn -> do CreateDB {..} -> do
let connInfo = P.mkSqliteConnectionInfo conn let connInfo = P.mkSqliteConnectionInfo conn
& set P.fkEnabled False & set P.fkEnabled False
P.runSqliteInfo connInfo runMigrations P.runSqliteInfo connInfo runMigrations
CreateUser conn uname upass utoken -> CreateUser{..} ->
P.runSqlite conn $ do P.runSqlite conn $ do
hash' <- liftIO (hashPassword upass) hash' <- liftIO (hashPassword userPassword)
void $ P.upsertBy void $ P.upsertBy
(UniqueUserName uname) (UniqueUserName userName)
(User uname hash' utoken False False False) (User userName hash' Nothing False False False)
[ UserPasswordHash P.=. hash' [ UserPasswordHash P.=. hash'
, UserApiToken P.=. utoken , UserApiToken P.=. Nothing
, UserPrivateDefault P.=. False , UserPrivateDefault P.=. fromMaybe False privateDefault
, UserArchiveDefault P.=. False , UserArchiveDefault P.=. fromMaybe False archiveDefault
, UserPrivacyLock P.=. False , UserPrivacyLock P.=. fromMaybe False privacyLock
] ]
pure () :: DB () pure () :: DB ()
DeleteUser conn uname -> DeleteUser {..} ->
P.runSqlite conn $ do P.runSqlite conn $ do
muser <- P.getBy (UniqueUserName uname) muser <- P.getBy (UniqueUserName userName)
case muser of case muser of
Nothing -> liftIO (print (uname ++ "not found")) Nothing -> liftIO (print (userName ++ "not found"))
Just (P.Entity uid _) -> do Just (P.Entity uid _) -> do
P.deleteCascade uid P.deleteCascade uid
pure () :: DB () pure () :: DB ()
ImportBookmarks conn uname file -> ImportBookmarks {..} ->
P.runSqlite conn $ do P.runSqlite conn $ do
muser <- P.getBy (UniqueUserName uname) muser <- P.getBy (UniqueUserName userName)
case muser of case muser of
Just (P.Entity uid _) -> insertFileBookmarks uid file Just (P.Entity uid _) -> insertFileBookmarks uid bookmarkFile
Nothing -> liftIO (print (uname ++ "not found")) Nothing -> liftIO (print (userName ++ "not found"))
ExportBookmarks conn uname file -> ExportBookmarks {..} ->
P.runSqlite conn $ do P.runSqlite conn $ do
muser <- P.getBy (UniqueUserName uname) muser <- P.getBy (UniqueUserName userName)
case muser of case muser of
Just (P.Entity uid _) -> exportFileBookmarks uid file Just (P.Entity uid _) -> exportFileBookmarks uid bookmarkFile
Nothing -> liftIO (print (uname ++ "not found")) Nothing -> liftIO (print (userName ++ "not found"))
ImportNotes conn uname dir -> ImportNotes {..} ->
P.runSqlite conn $ do P.runSqlite conn $ do
muser <- P.getBy (UniqueUserName uname) muser <- P.getBy (UniqueUserName userName)
case muser of case muser of
Just (P.Entity uid _) -> insertDirFileNotes uid dir Just (P.Entity uid _) -> insertDirFileNotes uid noteDirectory
Nothing -> liftIO (print (uname ++ "not found")) Nothing -> liftIO (print (userName ++ "not found"))