[db] db-obfuscation program

Also, refactored NodeStory to use Prelude database.
parent b25500cb
Pipeline #5372 failed with stages
in 18 minutes and 57 seconds
{-|
Module : Main.hs
Description : Gargantext DB obfuscation
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
See issue
https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/282
This script obfuscates the DB. We don't use gargantext.ini on purpose,
so that we don't accidentally break a running DB.
The procedure is that you clone the DB and provide the cloned DB
location to this script.
Copy the DB with this SQL statement:
CREATE DATABASE "gargantext_copy" WITH TEMPLATE "gargandbV5" OWNER gargantua;
https://stackoverflow.com/questions/876522/creating-a-copy-of-a-database-in-postgresql
-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE Strict #-}
module Main where
import Data.Text qualified as T
import Database.PostgreSQL.Simple qualified as PSQL
import Database.PostgreSQL.Simple.SqlQQ (sql)
import Gargantext.Database.Admin.Config (nodeTypeId)
import Gargantext.Database.Admin.Types.Node (NodeType(..))
import Gargantext.Prelude hiding (option)
import Gargantext.Prelude.Database (runPGSExecute, runPGSQuery)
import Options.Applicative.Simple
data Args = Args {
dbHost :: Text
, dbPort :: Int
, dbName :: Text
, dbUser :: Text
, dbPassword :: Text
} deriving (Show, Eq)
args :: Parser Args
args = Args
<$> ( strOption ( long "db-host"
<> metavar "db-host"
<> help "Location of the DB server"
<> value "localhost"
<> showDefault ) )
<*> ( option auto ( long "db-port"
<> metavar "db-port"
<> value 5432 ) )
<*> ( strOption ( long "db-name"
<> metavar "db-name"
<> value "gargantext_copy" ) )
<*> ( strOption ( long "db-user"
<> metavar "db-user"
<> value "gargantua" ) )
<*> ( strOption ( long "db-password"
<> metavar "db-password"
<> value "" ))
main :: IO ()
main = do
(opts, ()) <-
simpleOptions "0.0.1"
"gargantext DB obfuscation"
"Obfuscates a cloned Gargantext DB"
args
empty
putText $ show opts
let ci = PSQL.ConnectInfo { connectHost = T.unpack $ dbHost opts
, connectPort = fromIntegral $ dbPort opts
, connectUser = T.unpack $ dbUser opts
, connectPassword = T.unpack $ dbPassword opts
, connectDatabase = T.unpack $ dbName opts }
putText $ show ci
c <- PSQL.connect ci
obfuscateNotes c
obfuscateNotes :: PSQL.Connection -> IO ()
obfuscateNotes c = do
let nt = nodeTypeId Notes
_ <- runPGSExecute c [sql|UPDATE nodes SET name = concat('notes-', id) WHERE typename = ?;|] (PSQL.Only nt)
nsNew <- runPGSQuery c [sql|SELECT id, name FROM nodes WHERE typename = ?|] (PSQL.Only nt) :: IO [(Int, Text)]
putText $ show nsNew
_ <- runPGSExecute c [sql|UPDATE nodes SET hyperdata = jsonb_set(hyperdata, '{frame_id}', '"xxx"', false) WHERE typename = ?;|] (PSQL.Only nt)
frameIdsNew <- runPGSQuery c [sql|SELECT id, hyperdata ->> 'frame_id' FROM nodes WHERE typename = ?;|] (PSQL.Only nt) :: IO [(Int, Text)]
putText $ show frameIdsNew
pure ()
......@@ -114,7 +114,7 @@ source-repository-package
source-repository-package
type: git
location: https://gitlab.iscpif.fr/gargantext/haskell-gargantext-prelude
tag: 40135d166830690b1101180b79e9fd3663284b2b
tag: fec7427ba8d1047fd68207afb79139f9dea339e0
source-repository-package
type: git
......
......@@ -679,6 +679,38 @@ executable gargantext-cli
, vector ^>= 0.12.3.0
default-language: Haskell2010
executable gargantext-db-obfuscation
main-is: Main.hs
other-modules:
Paths_gargantext
hs-source-dirs:
bin/gargantext-db-obfuscation
default-extensions:
DataKinds
DeriveGeneric
FlexibleContexts
FlexibleInstances
GADTs
GeneralizedNewtypeDeriving
ImportQualifiedPost
MultiParamTypeClasses
NamedFieldPuns
NoImplicitPrelude
OverloadedStrings
RankNTypes
RecordWildCards
StrictData
ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -O2 -Wmissing-signatures
build-depends:
base
, extra
, gargantext
, gargantext-prelude
, optparse-simple
, postgresql-simple ^>= 0.6.4
, text
default-language: Haskell2010
executable gargantext-import
main-is: Main.hs
other-modules:
......
......@@ -93,7 +93,6 @@ module Gargantext.Core.NodeStory
where
import Codec.Serialise.Class
import Control.Exception (throw)
import Control.Lens (makeLenses, Getter, (^.), (.~), (%~), non, _Just, at, view)
import Control.Monad.Except
import Control.Monad.Reader
......@@ -107,7 +106,6 @@ import Data.Pool (Pool, withResource)
import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
import Data.Semigroup
import Data.Set qualified as Set
import Data.Text qualified as Text
import Database.PostgreSQL.Simple qualified as PGS
import Database.PostgreSQL.Simple.FromField (FromField(fromField), fromJSONField)
import Database.PostgreSQL.Simple.SqlQQ (sql)
......@@ -123,6 +121,7 @@ import Gargantext.Database.Query.Table.Ngrams qualified as TableNgrams
import Gargantext.Database.Query.Table.Node.Error (HasNodeError())
import Gargantext.Database.Schema.Ngrams (NgramsType)
import Gargantext.Prelude hiding (to)
import Gargantext.Prelude.Database
import Opaleye (DefaultFromField(..), SqlJsonb, fromPGSFromField)
------------------------------------------------------------------------
......@@ -297,61 +296,6 @@ type ArchiveList = Archive NgramsState' NgramsStatePatch'
-- DB stuff
runPGSExecute :: (PGS.ToRow q)
=> PGS.Connection -> PGS.Query -> q -> IO Int64
runPGSExecute c qs a = catch (PGS.execute c qs a) printError
where
printError (SomeException e) = do
--q' <- PGS.formatQuery c qs a
_ <- panic $ Text.pack $ show e
throw (SomeException e)
runPGSExecuteMany :: (PGS.ToRow q)
=> PGS.Connection -> PGS.Query -> [q] -> IO Int64
runPGSExecuteMany c qs a = catch (PGS.executeMany c qs a) printError
where
printError (SomeException e) = do
--q' <- PGS.formatQuery c qs a
_ <- panic $ Text.pack $ show e
throw (SomeException e)
runPGSReturning :: (PGS.ToRow q, PGS.FromRow r)
=> PGS.Connection -> PGS.Query -> [q] -> IO [r]
runPGSReturning c qs a = catch (PGS.returning c qs a) printError
where
printError (SomeException e) = do
--q' <- PGS.formatQuery c qs a
_ <- panic $ Text.pack $ show e
throw (SomeException e)
runPGSQuery :: (PGS.FromRow r, PGS.ToRow q)
=> PGS.Connection -> PGS.Query -> q -> IO [r]
runPGSQuery c q a = catch (PGS.query c q a) printError
where
printError (SomeException e) = do
q' <- PGS.formatQuery c q a
hPutStrLn stderr q'
throw (SomeException e)
runPGSAdvisoryLock :: PGS.Connection -> Int -> IO ()
runPGSAdvisoryLock c id = do
_ <- runPGSQuery c [sql| SELECT pg_advisory_lock(?) |]
(PGS.Only id) :: IO [PGS.Only ()]
pure ()
runPGSAdvisoryUnlock :: PGS.Connection -> Int -> IO ()
runPGSAdvisoryUnlock c id = do
_ <- runPGSQuery c [sql| SELECT pg_advisory_unlock(?) |]
(PGS.Only id) :: IO [PGS.Only Bool]
pure ()
runPGSAdvisoryXactLock :: PGS.Connection -> Int -> IO ()
runPGSAdvisoryXactLock c id = do
_ <- runPGSQuery c [sql| SELECT pg_advisory_xact_lock(?) |]
(PGS.Only id) :: IO [PGS.Only ()]
pure ()
nodeExists :: PGS.Connection -> NodeId -> IO Bool
nodeExists c nId = (== [PGS.Only True])
<$> runPGSQuery c [sql| SELECT true FROM nodes WHERE id = ? LIMIT 1 |]
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment