[FIX] merge

bin/gargantext-db-obfuscation/Main.hs

+{-|
+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 ()

cabal.project

@@ -124,7 +124,7 @@ source-repository-package
 source-repository-package
     type: git
     location: https://gitlab.iscpif.fr/gargantext/haskell-gargantext-prelude
-    tag: 9b33568da92f92bfa89c8bd8f05b07b70fd021f9
+    tag: fec7427ba8d1047fd68207afb79139f9dea339e0
 
 source-repository-package
     type: git

gargantext.cabal

@@ -682,6 +682,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:

src/Gargantext/Core/NodeStory.hs

@@ -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 |]