2019-01-31 02:54:47 +00:00
|
|
|
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
|
|
|
|
|
|
|
|
module Main where
|
|
|
|
|
|
|
|
import Types
|
|
|
|
import Model
|
|
|
|
import ModelCustom
|
|
|
|
|
|
|
|
import qualified Database.Persist as P
|
|
|
|
import qualified Database.Persist.Sqlite as P
|
|
|
|
import ClassyPrelude
|
|
|
|
import Lens.Micro
|
|
|
|
|
|
|
|
import Options.Generic
|
2022-04-01 21:17:25 +00:00
|
|
|
import qualified Options.Applicative as OA
|
|
|
|
import qualified Data.Text as T
|
|
|
|
|
|
|
|
data Password
|
|
|
|
= PasswordText Text
|
|
|
|
| PasswordFile FilePath
|
|
|
|
deriving (Show, Read)
|
|
|
|
|
|
|
|
parsePassword :: OA.Parser Password
|
|
|
|
parsePassword = passwordText <|> passwordFile
|
|
|
|
where
|
|
|
|
passwordText = PasswordText <$> OA.strOption
|
|
|
|
( OA.long "userPassword"
|
|
|
|
<> OA.metavar "PASSWORD"
|
|
|
|
<> OA.help "Password in plain-text"
|
|
|
|
)
|
|
|
|
|
|
|
|
passwordFile = PasswordFile <$> OA.strOption
|
|
|
|
( OA.long "userPasswordFile"
|
|
|
|
<> OA.metavar "FILE"
|
|
|
|
<> OA.help "Password file"
|
|
|
|
)
|
|
|
|
|
|
|
|
instance ParseFields Password
|
|
|
|
|
|
|
|
instance ParseRecord Password where
|
|
|
|
parseRecord = fmap getOnly parseRecord
|
|
|
|
|
|
|
|
instance ParseField Password where
|
|
|
|
parseField _ _ _ _ = parsePassword
|
2019-01-31 02:54:47 +00:00
|
|
|
|
|
|
|
data MigrationOpts
|
2020-03-30 17:06:21 +00:00
|
|
|
= CreateDB { conn :: Text }
|
2019-01-31 02:54:47 +00:00
|
|
|
| CreateUser { conn :: Text
|
|
|
|
, userName :: Text
|
2022-04-01 21:17:25 +00:00
|
|
|
, userPassword :: Password
|
2020-03-30 17:06:21 +00:00
|
|
|
, privateDefault :: Maybe Bool
|
|
|
|
, archiveDefault :: Maybe Bool
|
|
|
|
, privacyLock :: Maybe Bool }
|
2019-01-31 02:54:47 +00:00
|
|
|
| DeleteUser { conn :: Text
|
2020-03-30 17:06:21 +00:00
|
|
|
, userName :: Text }
|
2019-01-31 02:54:47 +00:00
|
|
|
| ImportBookmarks { conn :: Text
|
|
|
|
, userName :: Text
|
2020-03-30 17:06:21 +00:00
|
|
|
, bookmarkFile :: FilePath }
|
2020-06-14 08:04:11 +00:00
|
|
|
| ImportFirefoxBookmarks { conn :: Text
|
|
|
|
, userName :: Text
|
|
|
|
, bookmarkFile :: FilePath }
|
2019-03-09 06:21:41 +00:00
|
|
|
| ExportBookmarks { conn :: Text
|
|
|
|
, userName :: Text
|
2020-03-30 17:06:21 +00:00
|
|
|
, bookmarkFile :: FilePath }
|
2019-01-31 02:54:47 +00:00
|
|
|
| ImportNotes { conn :: Text
|
|
|
|
, userName :: Text
|
2020-03-30 17:06:21 +00:00
|
|
|
, noteDirectory :: FilePath }
|
|
|
|
| PrintMigrateDB { conn :: Text }
|
2019-01-31 02:54:47 +00:00
|
|
|
deriving (Generic, Show)
|
|
|
|
|
|
|
|
instance ParseRecord MigrationOpts
|
|
|
|
|
|
|
|
main :: IO ()
|
|
|
|
main = do
|
|
|
|
args <- getRecord "Migrations"
|
|
|
|
case args of
|
2020-03-30 17:06:21 +00:00
|
|
|
PrintMigrateDB {..} ->
|
2019-01-31 02:54:47 +00:00
|
|
|
P.runSqlite conn dumpMigration
|
|
|
|
|
2020-03-30 17:06:21 +00:00
|
|
|
CreateDB {..} -> do
|
2019-01-31 02:54:47 +00:00
|
|
|
let connInfo = P.mkSqliteConnectionInfo conn
|
|
|
|
& set P.fkEnabled False
|
|
|
|
P.runSqliteInfo connInfo runMigrations
|
|
|
|
|
2020-03-30 17:06:21 +00:00
|
|
|
CreateUser{..} ->
|
2019-01-31 02:54:47 +00:00
|
|
|
P.runSqlite conn $ do
|
2022-04-01 21:17:25 +00:00
|
|
|
passwordText <- liftIO . fmap T.strip $ case userPassword of
|
|
|
|
PasswordText s -> pure s
|
|
|
|
PasswordFile f -> readFileUtf8 f
|
|
|
|
hash' <- liftIO (hashPassword passwordText)
|
2019-01-31 02:54:47 +00:00
|
|
|
void $ P.upsertBy
|
2020-03-30 17:06:21 +00:00
|
|
|
(UniqueUserName userName)
|
|
|
|
(User userName hash' Nothing False False False)
|
2019-01-31 02:54:47 +00:00
|
|
|
[ UserPasswordHash P.=. hash'
|
2020-03-30 17:06:21 +00:00
|
|
|
, UserApiToken P.=. Nothing
|
|
|
|
, UserPrivateDefault P.=. fromMaybe False privateDefault
|
|
|
|
, UserArchiveDefault P.=. fromMaybe False archiveDefault
|
|
|
|
, UserPrivacyLock P.=. fromMaybe False privacyLock
|
2019-01-31 02:54:47 +00:00
|
|
|
]
|
|
|
|
pure () :: DB ()
|
|
|
|
|
2020-03-30 17:06:21 +00:00
|
|
|
DeleteUser {..} ->
|
2019-01-31 02:54:47 +00:00
|
|
|
P.runSqlite conn $ do
|
2020-03-30 17:06:21 +00:00
|
|
|
muser <- P.getBy (UniqueUserName userName)
|
2019-01-31 02:54:47 +00:00
|
|
|
case muser of
|
2020-03-30 17:06:21 +00:00
|
|
|
Nothing -> liftIO (print (userName ++ "not found"))
|
2019-01-31 02:54:47 +00:00
|
|
|
Just (P.Entity uid _) -> do
|
2021-07-23 03:52:02 +00:00
|
|
|
P.delete uid
|
2019-01-31 02:54:47 +00:00
|
|
|
pure () :: DB ()
|
|
|
|
|
2020-06-14 08:04:11 +00:00
|
|
|
ExportBookmarks {..} ->
|
|
|
|
P.runSqlite conn $ do
|
|
|
|
muser <- P.getBy (UniqueUserName userName)
|
|
|
|
case muser of
|
|
|
|
Just (P.Entity uid _) -> exportFileBookmarks uid bookmarkFile
|
|
|
|
Nothing -> liftIO (print (userName ++ "not found"))
|
|
|
|
|
2020-03-30 17:06:21 +00:00
|
|
|
ImportBookmarks {..} ->
|
2019-01-31 02:54:47 +00:00
|
|
|
P.runSqlite conn $ do
|
2020-03-30 17:06:21 +00:00
|
|
|
muser <- P.getBy (UniqueUserName userName)
|
2019-01-31 02:54:47 +00:00
|
|
|
case muser of
|
2020-06-14 08:04:11 +00:00
|
|
|
Just (P.Entity uid _) -> do
|
|
|
|
result <- insertFileBookmarks uid bookmarkFile
|
|
|
|
case result of
|
|
|
|
Left e -> liftIO (print e)
|
|
|
|
Right n -> liftIO (print (show n ++ " bookmarks imported."))
|
2020-03-30 17:06:21 +00:00
|
|
|
Nothing -> liftIO (print (userName ++ "not found"))
|
2019-01-31 02:54:47 +00:00
|
|
|
|
2020-06-14 08:04:11 +00:00
|
|
|
|
|
|
|
ImportFirefoxBookmarks {..} ->
|
2019-03-09 06:21:41 +00:00
|
|
|
P.runSqlite conn $ do
|
2020-03-30 17:06:21 +00:00
|
|
|
muser <- P.getBy (UniqueUserName userName)
|
2019-03-09 06:21:41 +00:00
|
|
|
case muser of
|
2020-06-14 08:04:11 +00:00
|
|
|
Just (P.Entity uid _) -> do
|
|
|
|
result <- insertFFBookmarks uid bookmarkFile
|
|
|
|
case result of
|
|
|
|
Left e -> liftIO (print e)
|
|
|
|
Right n -> liftIO (print (show n ++ " bookmarks imported."))
|
2020-03-30 17:06:21 +00:00
|
|
|
Nothing -> liftIO (print (userName ++ "not found"))
|
2019-03-09 06:21:41 +00:00
|
|
|
|
2020-03-30 17:06:21 +00:00
|
|
|
ImportNotes {..} ->
|
2019-01-31 02:54:47 +00:00
|
|
|
P.runSqlite conn $ do
|
2020-03-30 17:06:21 +00:00
|
|
|
muser <- P.getBy (UniqueUserName userName)
|
2019-01-31 02:54:47 +00:00
|
|
|
case muser of
|
2020-06-14 08:04:11 +00:00
|
|
|
Just (P.Entity uid _) -> do
|
|
|
|
result <- insertDirFileNotes uid noteDirectory
|
|
|
|
case result of
|
|
|
|
Left e -> liftIO (print e)
|
|
|
|
Right n -> liftIO (print (show n ++ " notes imported."))
|
2020-03-30 17:06:21 +00:00
|
|
|
Nothing -> liftIO (print (userName ++ "not found"))
|