Merge branch 'dev' into 275-dev-date-split-fix

CHANGELOG.md

+## Version 0.0.6.9.9.8.3.4
+
+* [FRONT][FIX][Improve global theme (#509)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/509)
+* [FRONT][FIX][[Node options (flower)] Standardise upload and download buttons (order) (#587)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/587)
+
+## Version 0.0.6.9.9.8.3.3
+
+* [BACK][REFACT][`AuthenticatedUser` should store the `NodeId` _and_ `UserId` (#276)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/276)
+* [BACK][REFACT][Extend `gargantext-prelude` with the whole of `Protolude` (#274)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/274)
+* [FRONT][FIX][[Node Terms] On clicking on a term association (+/-) the scroll position is lost (#546)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/546)
+
 ## Version 0.0.6.9.9.8.3.2
 
 * [BACK][CODE] Type Classes improvement

bin/gargantext-admin/Main.hs

@@ -21,7 +21,6 @@ import Gargantext.Database.Action.User.New (newUsers)
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Prelude (Cmd'')
 import Gargantext.Prelude
-import System.Environment (getArgs)
 import Gargantext.API.Admin.EnvTypes (DevEnv)
 
 main :: IO ()

bin/gargantext-cbor2json/Main.hs

 
-import System.Environment (getArgs)
-import Prelude (IO, id, (.), ($))
+import Prelude (IO, id, (.))
 import Data.Aeson (encode)
 import Codec.Serialise (deserialise)
 import qualified Data.ByteString.Lazy as L

bin/gargantext-cli/Main.hs

@@ -60,13 +60,13 @@ filterTermsAndCooc
      -> (Int, [Text])
      -> IO CoocByYear -- (Int, (Map (Text, Text) Coocs))
 filterTermsAndCooc patterns (year, ts) = do
-  log "start"
+  logWork "start"
   r <- coocOnContexts identity <$> mapM (\x -> {-log "work" >>-} terms' patterns x) ts
-  log "stop"
+  logWork "stop"
   pure $ CoocByYear year (length ts) (DM.mapKeys (both DT.unwords) r)
   where
 
-    log m = do
+    logWork m = do
       tid    <- myThreadId
       (p, _) <- threadCapability tid
       putText . unwords $

bin/gargantext-import/Main.hs

@@ -16,10 +16,7 @@ Import a corpus binary.
 module Main where
 
 import Data.Either
-import Data.Text (Text)
-import System.Environment (getArgs)
 import qualified Data.Text as Text
-import Text.Read (readMaybe)
 
 import Gargantext.API.Dev (withDevEnv, runCmdGargDev)
 import Gargantext.API.Admin.EnvTypes (DevEnv(..), DevJobHandle(..))

bin/gargantext-init/Main.hs

@@ -29,7 +29,6 @@ import Gargantext.Database.Query.Table.Node (getOrMkList)
 import Gargantext.Database.Query.Table.User (insertNewUsers, )
 import Gargantext.Prelude
 import Gargantext.Prelude.Config (GargConfig(..), readConfig)
-import System.Environment (getArgs)
 
 
 main :: IO ()

bin/gargantext-invitations/Main.hs

@@ -24,7 +24,6 @@ import Gargantext.Database.Prelude (CmdRandom)
 import Gargantext.Prelude
 import Gargantext.Prelude.Config (readConfig)
 import Prelude (read)
-import System.Environment (getArgs)
 import qualified Gargantext.API.Node.Share as Share
 
 main :: IO ()
@@ -38,7 +37,7 @@ main = do
   _cfg       <- readConfig         iniPath
 
   let invite :: (CmdRandom env GargError m, HasNLPServer env) => m Int
-      invite = Share.api (UserName $ cs user) (NodeId $ (read node_id :: Int)) (Share.ShareTeamParams $ cs email)
+      invite = Share.api (UserName $ cs user) (UnsafeMkNodeId $ (read node_id :: Int)) (Share.ShareTeamParams $ cs email)
 
   withDevEnv iniPath $ \env -> do
     _ <- runCmdDev env invite

bin/gargantext-phylo/Main.hs

@@ -23,10 +23,9 @@ import Data.ByteString.Char8 qualified as C8
 import Data.List  (nub, isSuffixOf, tail)
 import Data.List.Split
 import Data.Maybe (fromJust)
-import Data.Text  (unwords, unpack, replace, pack)
+import Data.Text  (unpack, replace, pack)
 import Data.Text qualified as T
 import Data.Vector qualified as Vector
-import GHC.IO (FilePath)
 import Gargantext.API.Ngrams.Prelude (toTermList)
 import Gargantext.API.Ngrams.Types
 import Gargantext.Core.Text.Context (TermList)
@@ -46,7 +45,6 @@ import Gargantext.Database.Schema.Ngrams (NgramsType(..))
 import Gargantext.Prelude hiding (hash, replace)
 import Prelude qualified
 import System.Directory (listDirectory,doesFileExist)
-import System.Environment
 
 data Backup = BackupPhyloWithoutLink | BackupPhylo deriving (Show)
 
@@ -99,7 +97,7 @@ wosToDocs limit patterns time path = do
 csvToDocs :: CorpusParser -> Patterns -> TimeUnit -> FilePath -> IO [Document]
 csvToDocs parser patterns time path =
   case parser of
-    Wos  _     -> undefined
+    Wos  _     -> Prelude.error "csvToDocs: unimplemented"
     Csv  limit -> Vector.toList
       <$> Vector.take limit
       <$> Vector.map (\row -> Document (toPhyloDate  (Csv.fromMIntOrDec Csv.defaultYear $ csv_publication_year row) (fromMaybe Csv.defaultMonth $ csv_publication_month row) (fromMaybe Csv.defaultDay $ csv_publication_day row) time)
@@ -170,7 +168,7 @@ seaToLabel config = case (seaElevation config) of
 
 sensToLabel :: PhyloConfig -> [Char]
 sensToLabel config = case (similarity config) of
-      Hamming _ _ -> undefined
+      Hamming _ _ -> Prelude.error "sensToLabel: unimplemented"
       WeightedLogJaccard s _ -> ("WeightedLogJaccard_"  <> show s)
       WeightedLogSim s _ -> ( "WeightedLogSim-sens_"  <> show s)
 
@@ -184,7 +182,7 @@ cliqueToLabel config = case (clique config) of
 syncToLabel :: PhyloConfig -> [Char]
 syncToLabel config = case (phyloSynchrony config) of
       ByProximityThreshold scl sync_sens scope _ -> ("scale_" <> (show scope) <> "_" <> (show sync_sens)  <> "_"  <> (show scl))
-      ByProximityDistribution _ _ -> undefined
+      ByProximityDistribution _ _ -> "syncToLabel: unimplemented"
 
 qualToConfig :: PhyloConfig -> [Char]
 qualToConfig config = case (phyloQuality config) of
@@ -234,7 +232,7 @@ readListV4 path = do
   case listJson of
     Left err -> do
       putStrLn err
-      undefined
+      Prelude.error "readListV4 unimplemented"
     Right listV4 -> pure listV4
 
 

gargantext.cabal

@@ -5,7 +5,7 @@ cabal-version: 2.0
 -- see: https://github.com/sol/hpack
 
 name:           gargantext
-version: 0.0.6.9.9.8.3.2
+version: 0.0.6.9.9.8.3.4
 synopsis:       Search, map, share
 description:    Please see README.md
 category:       Data
@@ -884,6 +884,7 @@ test-suite garg-test-tasty
   type: exitcode-stdio-1.0
   main-is: drivers/tasty/Main.hs
   other-modules:
+      Test.API.Setup
       Test.Core.Text
       Test.Core.Text.Corpus.Query
       Test.Core.Text.Examples

src/Gargantext/API/Admin/Auth.hs

@@ -61,6 +61,7 @@ import Gargantext.Database.Action.Flow.Types (FlowCmdM)
 import Gargantext.Database.Action.User.New (guessUserName)
 import Gargantext.Database.Admin.Types.Node (NodeId(..))
 import Gargantext.Database.Prelude (Cmd', CmdCommon, DbCmd')
+import Gargantext.Database.Admin.Types.Node (UserId)
 import Gargantext.Database.Query.Table.User
 import Gargantext.Database.Query.Tree (isDescendantOf, isIn)
 import Gargantext.Database.Query.Tree.Root (getRoot)
@@ -76,12 +77,13 @@ import Servant.Auth.Server
 
 -- | Main functions of authorization
 
-makeTokenForUser :: ( HasSettings env
-                    , HasJoseError err )
-                 => NodeId -> Cmd' env err Token
-makeTokenForUser uid = do
+makeTokenForUser :: (HasSettings env, HasJoseError err)
+                 => NodeId
+                 -> UserId
+                 -> Cmd' env err Token
+makeTokenForUser nodeId userId = do
   jwtS <- view $ settings . jwtSettings
-  e <- liftBase $ makeJWT (AuthenticatedUser uid) jwtS Nothing
+  e <- liftBase $ makeJWT (AuthenticatedUser nodeId userId) jwtS Nothing
   -- TODO-SECURITY here we can implement token expiration ^^.
   either joseError (pure . toStrict . LE.decodeUtf8) e
   -- TODO not sure about the encoding...
@@ -107,9 +109,9 @@ checkAuthRequest couldBeEmail (GargPassword p) = do
           muId <- head <$> getRoot (UserName usrname)
           case _node_id <$> muId of
             Nothing  -> pure InvalidUser
-            Just uid -> do
-              token <- makeTokenForUser uid
-              pure $ Valid token uid userLight_id
+            Just nodeId -> do
+              token <- makeTokenForUser nodeId userLight_id
+              pure $ Valid token nodeId userLight_id
 
 auth :: (HasSettings env, HasJoseError err, DbCmd' env err m)
      => AuthRequest -> m AuthResponse
@@ -138,12 +140,13 @@ withAccessM :: ( DbCmd' env err m )
             -> PathId
             -> m a
             -> m a
-withAccessM (AuthenticatedUser uId) (PathNode id) m = do
-  d <- id `isDescendantOf` uId
+withAccessM (AuthenticatedUser nodeId _userId) (PathNode id) m = do
+  d <- id `isDescendantOf` nodeId
   if d then m else m -- serverError err401
-withAccessM (AuthenticatedUser uId) (PathNodeNode cId docId) m = do
+
+withAccessM (AuthenticatedUser nodeId _userId) (PathNodeNode cId docId) m = do
   _a <- isIn cId docId -- TODO use one query for all ?
-  _d <- cId `isDescendantOf` uId
+  _d <- cId `isDescendantOf` nodeId
   if True -- a && d
      then m
      else m -- serverError err401

src/Gargantext/API/Admin/Auth/Types.hs

@@ -15,10 +15,12 @@ module Gargantext.API.Admin.Auth.Types
 
 import Control.Lens hiding (elements, to)
 import Data.Aeson.TH (deriveJSON)
+import qualified Data.Aeson.TH as JSON
+import Data.List (tail)
 import Data.Swagger
 import Gargantext.Core.Types.Individu (Username, GargPassword(..), arbitraryUsername, arbitraryPassword)
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
-import Gargantext.Database.Admin.Types.Node (NodeId(..), ListId, DocId, UserId)
+import Gargantext.Database.Admin.Types.Node (NodeId(..), ListId, DocId, UserId (..))
 import Gargantext.Prelude hiding (reverse)
 import Servant.Auth.Server
 import Test.QuickCheck (elements, oneof)
@@ -53,11 +55,14 @@ type TreeId = NodeId
 data CheckAuth = InvalidUser | InvalidPassword | Valid Token TreeId UserId
   deriving (Eq)
 
-newtype AuthenticatedUser = AuthenticatedUser
-  { _authUser_id :: NodeId
+data AuthenticatedUser = AuthenticatedUser
+  { _auth_node_id :: NodeId
+  , _auth_user_id :: UserId
   } deriving (Generic)
 
-$(deriveJSON (unPrefix "_authUser_") ''AuthenticatedUser)
+$(deriveJSON (JSON.defaultOptions { JSON.fieldLabelModifier = tail . dropWhile ((/=) '_') . tail }) ''AuthenticatedUser)
+
+makeLenses ''AuthenticatedUser
 
 instance ToSchema AuthenticatedUser where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_authUser_")
@@ -90,7 +95,7 @@ $(deriveJSON (unPrefix "_authInv_") ''AuthInvalid)
 instance ToSchema AuthInvalid where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_authInv_")
 instance Arbitrary AuthInvalid where
-  arbitrary = elements [ AuthInvalid m 
+  arbitrary = elements [ AuthInvalid m
                        | m <- [ "Invalid user", "Invalid password"]
                        ]
 
@@ -100,8 +105,8 @@ instance ToSchema AuthValid where
 instance Arbitrary AuthValid where
   arbitrary = elements [ AuthValid to' tr u
                        | to' <- ["token0", "token1"]
-                       , tr <- [1..3]
-                       , u <-  [1..3]
+                       , tr <- map UnsafeMkNodeId [1..3]
+                       , u <-  map UnsafeMkUserId [1..3]
                        ]
 
 data PathId = PathNode NodeId | PathNodeNode ListId DocId

src/Gargantext/API/Auth/PolicyCheck.hs

@@ -22,7 +22,6 @@ module Gargantext.API.Auth.PolicyCheck (
 import Control.Lens
 import Gargantext.API.Admin.Auth.Types
 import Gargantext.Core.Types
-import Gargantext.Database.Action.User
 import Gargantext.Database.Prelude (DBCmd, HasConfig (..))
 import Gargantext.Prelude.Config (GargConfig(..))
 import Prelude
@@ -38,6 +37,7 @@ import Control.Monad
 import Gargantext.API.Prelude
 import Servant.Auth.Server.Internal.AddSetCookie
 import Gargantext.Database.Query.Tree
+import Gargantext.Database.Query.Tree.Root
 
 -------------------------------------------------------------------------------
 -- Types
@@ -119,7 +119,7 @@ accessPolicyManager = AccessPolicyManager (\ur ac -> interpretPolicy ur ac)
 
 
 check :: HasNodeError err => AuthenticatedUser -> AccessCheck -> DBCmd err AccessResult
-check (AuthenticatedUser loggedUserNodeId) = \case
+check (AuthenticatedUser loggedUserNodeId _loggedUserUserId) = \case
   AC_always_deny
     -> pure $ Deny err500
   AC_always_allow
@@ -129,8 +129,8 @@ check (AuthenticatedUser loggedUserNodeId) = \case
   AC_master_user _requestedNodeId
     -> do
       masterUsername <- _gc_masteruser <$> view hasConfig
-      masterNodeId   <- getUserId (UserName masterUsername)
-      enforce err403 $ (NodeId masterNodeId) == loggedUserNodeId
+      masterNodeId   <- getRootId (UserName masterUsername)
+      enforce err403 $ masterNodeId == loggedUserNodeId
   AC_node_descendant nodeId
     -> enforce err403 =<< nodeId `isDescendantOf` loggedUserNodeId
 

src/Gargantext/API/Context.hs

@@ -18,6 +18,8 @@ Portability : POSIX
 module Gargantext.API.Context
   where
 
+import Prelude
+
 import Data.Aeson (FromJSON, ToJSON)
 import Servant
 
@@ -42,7 +44,7 @@ contextAPI :: forall proxy a.
          -> AuthenticatedUser
          -> ContextId
          -> GargServer (ContextAPI a)
-contextAPI p uId id' = withAccess (Proxy :: Proxy (ContextAPI a)) Proxy uId (PathNode id') contextAPI'
+contextAPI p uId id' = withAccess (Proxy :: Proxy (ContextAPI a)) Proxy uId (PathNode $ contextId2NodeId id') contextAPI'
   where
     contextAPI' :: GargServer (ContextAPI a)
     contextAPI' = getContextWith   id' p

src/Gargantext/API/GraphQL/Annuaire.hs

@@ -12,7 +12,7 @@ import Gargantext.Database.Admin.Types.Hyperdata.Contact
   , cw_firstName
   , cw_lastName
   , hc_who, ContactWhere, hc_where, cw_organization, cw_labTeamDepts, cw_role, cw_office, cw_country, cw_city, cw_touch, ct_mail, ct_phone, ct_url, hc_title, hc_source)
-import Gargantext.Database.Admin.Types.Node (NodeId(..))
+import Gargantext.Database.Admin.Types.Node (ContextId (..))
 import Gargantext.Database.Prelude (CmdCommon)
 import Gargantext.Database.Query.Table.Context (getContextWith)
 import Gargantext.Database.Schema.Node (node_hyperdata)
@@ -58,7 +58,10 @@ dbAnnuaireContacts contact_id = do
 --  user <- getUsersWithId user_id
 --  hyperdata <- getUserHyperdata user_id
 --  lift (map toUser <$> zip user hyperdata)
-  c <- lift $ getContextWith (NodeId contact_id) (Proxy :: Proxy HyperdataContact)
+
+  -- FIXME(adinapoli) This function seems a bit iffy, unless a 'contact_id'
+  -- is just a synonym for a 'ContextId'.
+  c <- lift $ getContextWith (UnsafeMkContextId contact_id) (Proxy :: Proxy HyperdataContact)
   pure [toAnnuaireContact (contact_id, c ^. node_hyperdata)]
 
 toAnnuaireContact :: (Int, HyperdataContact) -> AnnuaireContact

src/Gargantext/API/GraphQL/Context.hs

@@ -28,7 +28,7 @@ import Gargantext.API.Admin.Types (HasSettings)
 import Gargantext.API.Prelude (GargM, GargError)
 import Gargantext.Core.Types.Search (HyperdataRow(..), toHyperdataRow)
 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument)
-import Gargantext.Database.Admin.Types.Node (ContextTitle, NodeId(..), NodeTypeId, UserId, unNodeId)
+import Gargantext.Database.Admin.Types.Node (ContextTitle, NodeId(..), NodeTypeId, UserId, unNodeId, ContextId (..))
 import Gargantext.Database.Prelude (CmdCommon)
 import Gargantext.Database.Query.Table.NodeContext (getNodeContext, getContextsForNgramsTerms, ContextForNgramsTerms(..), {- getContextNgrams, -} getContextNgramsMatchingFTS)
 import Gargantext.Database.Query.Table.NodeContext qualified as DNC
@@ -144,7 +144,7 @@ dbNodeContext context_id node_id = do
 --  user <- getUsersWithId user_id
 --  hyperdata <- getUserHyperdata user_id
 --  lift (map toUser <$> zip user hyperdata)
-  c <- lift $ getNodeContext (NodeId context_id) (NodeId node_id)
+  c <- lift $ getNodeContext (UnsafeMkContextId context_id) (UnsafeMkNodeId node_id)
   pure $ toNodeContextGQL <$> [c]
 
 -- | Returns list of `ContextGQL` for given ngrams in given corpus id.
@@ -152,7 +152,7 @@ dbContextForNgrams
   :: (CmdCommon env)
   => Int -> [Text] -> GqlM e env [ContextGQL]
 dbContextForNgrams node_id ngrams_terms = do
-  contextsForNgramsTerms <- lift $ getContextsForNgramsTerms (NodeId node_id) ngrams_terms
+  contextsForNgramsTerms <- lift $ getContextsForNgramsTerms (UnsafeMkNodeId node_id) ngrams_terms
   --lift $ printDebug "[dbContextForNgrams] contextsForNgramsTerms" contextsForNgramsTerms
   pure $ toContextGQL <$> contextsForNgramsTerms
 
@@ -161,13 +161,13 @@ dbContextNgrams
   :: (CmdCommon env)
   => Int -> Int -> GqlM e env [Text]
 dbContextNgrams context_id list_id = do
-  lift $ getContextNgramsMatchingFTS (NodeId context_id) (NodeId list_id)
+  lift $ getContextNgramsMatchingFTS (UnsafeMkContextId context_id) (UnsafeMkNodeId list_id)
 
 -- Conversion functions
 
 toNodeContextGQL :: NodeContext -> NodeContextGQL
-toNodeContextGQL (NodeContext { _nc_node_id = NodeId nc_node_id
-                              , _nc_context_id = NodeId nc_context_id
+toNodeContextGQL (NodeContext { _nc_node_id = UnsafeMkNodeId nc_node_id
+                              , _nc_context_id = UnsafeMkNodeId nc_context_id
                               , .. }) =
   NodeContextGQL { nc_id = _nc_id
                  , nc_node_id
@@ -223,6 +223,6 @@ toHyperdataRowDocumentGQL hyperdata =
 updateNodeContextCategory :: (CmdCommon env, HasSettings env)
                           => NodeContextCategoryMArgs -> GqlM' e env [Int]
 updateNodeContextCategory NodeContextCategoryMArgs { context_id, node_id, category } = do
-  _ <- lift $ DNC.updateNodeContextCategory (NodeId context_id) (NodeId node_id) category
+  _ <- lift $ DNC.updateNodeContextCategory (UnsafeMkContextId context_id) (UnsafeMkNodeId node_id) category
 
   pure [1]

src/Gargantext/API/GraphQL/Node.hs

@@ -22,7 +22,7 @@ import Gargantext.API.Admin.Auth.Types
 import Gargantext.API.Auth.PolicyCheck
 import Gargantext.API.GraphQL.PolicyCheck (withPolicy)
 import Gargantext.API.GraphQL.Types
-import Gargantext.Database.Admin.Types.Node (NodeId(..), NodeType)
+import Gargantext.Database.Admin.Types.Node (NodeType)
 import Gargantext.Database.Admin.Types.Node qualified as NN
 import Gargantext.Database.Prelude (CmdCommon)  -- , JSONB)
 import Gargantext.Database.Query.Table.Node (getClosestParentIdByType, getNode)
@@ -76,14 +76,14 @@ dbNodes
   :: (CmdCommon env)
   => Int -> GqlM e env [Node]
 dbNodes node_id = do
-  node <- lift $ getNode $ NodeId node_id
+  node <- lift $ getNode $ NN.UnsafeMkNodeId node_id
   pure [toNode node]
 
 dbNodesCorpus
   :: (CmdCommon env)
   => Int -> GqlM e env [Corpus]
 dbNodesCorpus corpus_id = do
-  corpus <- lift $ getNode $ NodeId corpus_id
+  corpus <- lift $ getNode $ NN.UnsafeMkNodeId corpus_id
   pure [toCorpus corpus]
 
 data NodeParentArgs
@@ -107,7 +107,7 @@ dbParentNodes node_id parent_type = do
       lift $ printDebug "[dbParentNodes] error reading parent type" (T.pack err)
       pure []
     Right parentType -> do
-      mNodeId <- lift $ getClosestParentIdByType (NodeId node_id) parentType -- (fromNodeTypeId parent_type_id)
+      mNodeId <- lift $ getClosestParentIdByType (NN.UnsafeMkNodeId node_id) parentType -- (fromNodeTypeId parent_type_id)
       case mNodeId of
         Nothing -> pure []
         Just id -> do

src/Gargantext/API/GraphQL/Team.hs

@@ -57,7 +57,7 @@ resolveTeam TeamArgs { team_node_id } = dbTeam team_node_id
 dbTeam :: (CmdCommon env) =>
           Int -> GqlM e env Team
 dbTeam nodeId = do
-  let nId = NodeId nodeId
+  let nId = UnsafeMkNodeId nodeId
   res <- lift $ membersOf nId
   teamNode <- lift $ getNode nId
   userNodes <- lift $ getUsersWithNodeHyperdata $ Individu.UserDBId $ uId teamNode
@@ -79,7 +79,7 @@ dbTeam nodeId = do
 deleteTeamMembership :: (CmdCommon env, HasSettings env) =>
                         TeamDeleteMArgs -> GqlM' e env [Int]
 deleteTeamMembership TeamDeleteMArgs { token, shared_folder_id, team_node_id } = do
-  teamNode <- lift $ getNode $ NodeId team_node_id
+  teamNode <- lift $ getNode $ UnsafeMkNodeId team_node_id
   userNodes <- lift (getUsersWithNodeHyperdata $ Individu.UserDBId $ uId teamNode)
   case userNodes of
     [] -> panic $ "[deleteTeamMembership] User with id " <> T.pack (show $ uId teamNode) <> " doesn't exist."
@@ -88,7 +88,7 @@ deleteTeamMembership TeamDeleteMArgs { token, shared_folder_id, team_node_id } =
       case testAuthUser of
         Invalid -> panic "[deleteTeamMembership] failed to validate user"
         Valid -> do
-          lift $ deleteMemberShip [(NodeId shared_folder_id, NodeId team_node_id)]
+          lift $ deleteMemberShip [(UnsafeMkNodeId shared_folder_id, UnsafeMkNodeId team_node_id)]
   where
     uId Node { _node_user_id } = _node_user_id
     nId Node { _node_id } = _node_id

src/Gargantext/API/GraphQL/TreeFirstLevel.hs

@@ -22,8 +22,8 @@ import Gargantext.API.GraphQL.Types
 import Gargantext.Core.Types (Tree, NodeTree, NodeType)
 import Gargantext.Core.Types.Main ( Tree(TreeN), _tn_node, _tn_children, NodeTree(NodeTree, _nt_id, _nt_type), _nt_name )
 import Gargantext.Database.Admin.Config (fromNodeTypeId)
-import Gargantext.Database.Admin.Types.Node (allNodeTypes, NodeId (NodeId))
 import Gargantext.Database.Admin.Types.Node qualified as NN
+import Gargantext.Database.Admin.Types.Node (allNodeTypes, NodeId (UnsafeMkNodeId))
 import Gargantext.Database.Prelude (CmdCommon)
 import Gargantext.Database.Query.Table.Node (getNode)
 import Gargantext.Database.Query.Tree qualified as T
@@ -76,9 +76,9 @@ resolveTree autUser mgr TreeArgs { root_id } =
 dbTree :: (CmdCommon env) =>
           Int -> GqlM e env (TreeFirstLevel (GqlM e env))
 dbTree root_id = do
-  let rId = NodeId root_id
+  let rId = UnsafeMkNodeId root_id
   t <- lift $ T.tree T.TreeFirstLevel rId allNodeTypes
-  n <- lift $ getNode $ NodeId root_id
+  n <- lift $ getNode $ UnsafeMkNodeId root_id
   let pId = toParentId n
   pure $ toTree rId pId t
   where
@@ -93,10 +93,7 @@ toTree rId pId TreeN { _tn_node, _tn_children } = TreeFirstLevel
   }
 
 toTreeNode :: ParentId -> NodeTree -> TreeNode
-toTreeNode pId NodeTree { _nt_name, _nt_id, _nt_type } = TreeNode { name = _nt_name, id = id2int _nt_id, node_type = _nt_type, parent_id = id2int <$> pId}
-  where
-    id2int :: NodeId -> Int
-    id2int (NodeId n) = n
+toTreeNode pId NodeTree { _nt_name, _nt_id, _nt_type } = TreeNode { name = _nt_name, id = NN._NodeId _nt_id, node_type = _nt_type, parent_id = NN._NodeId <$> pId}
 
 childrenToTreeNodes :: (Tree NodeTree, NodeId) -> TreeNode
 childrenToTreeNodes (TreeN {_tn_node}, rId) = toTreeNode (Just rId) _tn_node
@@ -132,7 +129,7 @@ convertDbTreeToTreeNode T.DbTreeNode { _dt_name, _dt_nodeId, _dt_typeId, _dt_par
 
 dbRecursiveParents :: (CmdCommon env) => Int -> GqlM e env (BreadcrumbInfo)
 dbRecursiveParents node_id = do
-  let nId = NodeId node_id
+  let nId = UnsafeMkNodeId node_id
   dbParents <- lift $ T.recursiveParents nId allNodeTypes
   let treeNodes = map convertDbTreeToTreeNode dbParents
   let breadcrumbInfo = BreadcrumbInfo { parents = treeNodes }

src/Gargantext/API/GraphQL/User.hs

@@ -22,16 +22,16 @@ import Gargantext.API.GraphQL.PolicyCheck
 import Gargantext.API.GraphQL.Types
 import Gargantext.Core.Types.Individu qualified as Individu
 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataUser(..))
-import Gargantext.Database.Admin.Types.Node (NodeId(..))
 import Gargantext.Database.Prelude (CmdCommon)
 import Gargantext.Database.Query.Table.User qualified as DBUser
 import Gargantext.Database.Schema.User (UserLight(..))
 import Gargantext.Prelude
+import Gargantext.Core.Types
 
 data User m = User
   { u_email     :: Text
   , u_hyperdata :: m (Maybe HyperdataUser)
-  , u_id        :: Int
+  , u_id        :: UserId
   , u_username  :: Text }
   deriving (Generic, GQLType)
 
@@ -61,7 +61,7 @@ resolveUsers autUser mgr UserArgs { user_id } = do
 -- | Inner function to fetch the user from DB.
 dbUsers :: (CmdCommon env)
         => Int -> GqlM e env [User (GqlM e env)]
-dbUsers user_id = lift (map toUser <$> DBUser.getUsersWithId (Individu.RootId $ NodeId user_id))
+dbUsers user_id = lift (map toUser <$> DBUser.getUsersWithId (Individu.RootId $ UnsafeMkNodeId user_id))
 
 toUser
   :: (CmdCommon env)
@@ -73,12 +73,12 @@ toUser (UserLight { .. }) = User { u_email = userLight_email
 
 resolveHyperdata
   :: (CmdCommon env)
-  => Int -> GqlM e env (Maybe HyperdataUser)
+  => UserId -> GqlM e env (Maybe HyperdataUser)
 resolveHyperdata userid = lift (listToMaybe <$> DBUser.getUserHyperdata (Individu.UserDBId userid))
 
 updateUserPubmedAPIKey :: ( CmdCommon env, HasSettings env) =>
                           UserPubmedAPIKeyMArgs -> GqlM' e env Int
 updateUserPubmedAPIKey UserPubmedAPIKeyMArgs { user_id, api_key } = do
-  _ <- lift $ DBUser.updateUserPubmedAPIKey (Individu.RootId $ NodeId user_id) api_key
+  _ <- lift $ DBUser.updateUserPubmedAPIKey (Individu.RootId $ UnsafeMkNodeId user_id) api_key
 
   pure 1

src/Gargantext/API/GraphQL/UserInfo.hs

@@ -53,6 +53,7 @@ import Gargantext.Database.Query.Table.User (getUsersWithHyperdata, getUsersWith
 import Gargantext.Database.Schema.Node (node_id, node_hyperdata, NodePoly (Node, _node_id))
 import Gargantext.Database.Schema.User (UserLight(..))
 import Gargantext.Prelude
+import Gargantext.Core.Types
 
 data UserInfo = UserInfo
   { ui_id             :: Int
@@ -112,7 +113,7 @@ resolveUserInfos
   -> UserInfoArgs -> GqlM e env [UserInfo]
 resolveUserInfos autUser mgr UserInfoArgs { user_id } =
   -- FIXME(adn) we should use a proper policy, not 'alwaysAllow'.
-  withPolicy autUser mgr alwaysAllow $ dbUsers user_id
+  withPolicy autUser mgr alwaysAllow $ dbUsers (UnsafeMkUserId user_id)
 
 -- | Mutation for user info
 updateUserInfo
@@ -121,7 +122,7 @@ updateUserInfo
   => UserInfoMArgs -> GqlM' e env Int
 updateUserInfo (UserInfoMArgs { ui_id, .. }) = do
   -- lift $ printDebug "[updateUserInfo] ui_id" ui_id
-  users <- lift (getUsersWithNodeHyperdata (Individu.UserDBId ui_id))
+  users <- lift (getUsersWithNodeHyperdata (Individu.UserDBId $ UnsafeMkUserId ui_id))
   case users of
     [] -> panic $ "[updateUserInfo] User with id " <> (T.pack $ show ui_id) <> " doesn't exist."
     ((UserLight { .. }, node_u):_) -> do
@@ -166,7 +167,7 @@ updateUserInfo (UserInfoMArgs { ui_id, .. }) = do
 -- | Inner function to fetch the user from DB.
 dbUsers
   :: (CmdCommon env)
-  => Int -> GqlM e env [UserInfo]
+  => UserId -> GqlM e env [UserInfo]
 dbUsers user_id = do
   -- lift $ printDebug "[dbUsers]" user_id
 --  user <- getUsersWithId user_id
@@ -176,7 +177,7 @@ dbUsers user_id = do
 
 toUser :: (UserLight, HyperdataUser) -> UserInfo
 toUser (UserLight { .. }, u_hyperdata) =
-  UserInfo { ui_id             = userLight_id
+  UserInfo { ui_id             = _UserId userLight_id
            , ui_username       = userLight_username
            , ui_email          = userLight_email
            , ui_title          = u_hyperdata ^. ui_titleL

src/Gargantext/API/GraphQL/Utils.hs

@@ -13,13 +13,14 @@ module Gargantext.API.GraphQL.Utils where
 import Control.Lens.Getter (view)
 import Data.Morpheus.Types (GQLTypeOptions, fieldLabelModifier)
 import Data.Text qualified as T
-import Gargantext.API.Admin.Auth.Types (AuthenticatedUser (AuthenticatedUser, _authUser_id))
+import Gargantext.API.Admin.Auth.Types (AuthenticatedUser (..), auth_node_id)
 import Gargantext.API.Admin.Types (jwtSettings, HasSettings (settings))
 import Gargantext.Core.Utils.Prefix (unCapitalize, dropPrefix)
 import Gargantext.Database.Admin.Types.Node (NodeId)
 import Gargantext.Database.Prelude (Cmd')
 import Gargantext.Prelude
 import Servant.Auth.Server (verifyJWT, JWTSettings)
+import Control.Lens ((^.))
 
 unPrefix :: T.Text -> GQLTypeOptions -> GQLTypeOptions
 unPrefix prefix options = options { fieldLabelModifier = nflm }
@@ -36,11 +37,9 @@ authUser ui_id token = do
   case u of
     Nothing -> pure Invalid
     Just au ->
-      if nId au == ui_id
+      if au ^. auth_node_id == ui_id
         then pure Valid
         else pure Invalid
-        where
-          nId AuthenticatedUser {_authUser_id} = _authUser_id
 
 getUserFromToken :: JWTSettings -> ByteString -> IO (Maybe AuthenticatedUser)
 getUserFromToken = verifyJWT

src/Gargantext/API/Members.hs

@@ -12,19 +12,17 @@ module Gargantext.API.Members where
 
 import Gargantext.API.Admin.EnvTypes (Env)
 import Gargantext.API.Prelude
-import Gargantext.Core.Types (UserId)
-import Gargantext.Database.Action.Share (membersOf)
 import Gargantext.Database.Admin.Types.Node (NodeType(NodeTeam))
-import Gargantext.Database.Prelude (CmdCommon)
 import Gargantext.Database.Query.Table.Node (getNodesIdWithType)
+import Gargantext.Database.Action.Share (membersOf)
+import Gargantext.Database.Prelude (CmdCommon)
 import Gargantext.Prelude
 import Servant
 
 type MembersAPI = Get '[JSON] [Text]
 
-members :: UserId -> ServerT MembersAPI (GargM Env GargError)
-members _ = do
-  getMembers
+members :: ServerT MembersAPI (GargM Env GargError)
+members = getMembers
 
 getMembers :: (CmdCommon env) =>
               GargM env GargError [Text]

src/Gargantext/API/Ngrams/List.hs

@@ -93,9 +93,8 @@ getJson :: HasNodeStory env err m =>
        ListId -> m (Headers '[Header "Content-Disposition" Text] NgramsList)
 getJson lId = do
   lst <- getNgramsList lId
-  let (NodeId id') = lId
   pure $ addHeader (concat [ "attachment; filename=GarganText_NgramsList-"
-                             , pack $ show id'
+                             , pack $ show (_NodeId lId)
                              , ".json"
                              ]
                      ) lst
@@ -104,12 +103,11 @@ getCsv :: HasNodeStory env err m =>
        ListId -> m (Headers '[Header "Content-Disposition" Text] NgramsTableMap)
 getCsv lId = do
   lst <- getNgramsList lId
-  let (NodeId id') = lId
   pure $ case Map.lookup TableNgrams.NgramsTerms lst of
     Nothing -> noHeader Map.empty
     Just (Versioned { _v_data }) ->
       addHeader (concat [ "attachment; filename=GarganText_NgramsList-"
-                        , pack $ show id'
+                        , pack $ show (_NodeId lId)
                         , ".csv"
                         ]
                 ) _v_data

src/Gargantext/API/Ngrams/Tools.hs

@@ -150,13 +150,14 @@ filterListWithRoot lt m = snd <$> HM.filter isMapTerm m
         Nothing -> panic $ "[Garg.API.Ngrams.Tools] filterListWithRoot, unknown key: " <> unNgramsTerm r
         Just  (l',_) -> elem l' lt
 
-groupNodesByNgrams :: ( At root_map
+groupNodesByNgrams :: ( Ord a
+                      , At root_map
                       , Index root_map ~ NgramsTerm
                       , IxValue root_map ~ Maybe RootTerm
                       )
                    => root_map
-                   -> HashMap NgramsTerm (Set NodeId)
-                   -> HashMap NgramsTerm (Set NodeId)
+                   -> HashMap NgramsTerm (Set a)
+                   -> HashMap NgramsTerm (Set a)
 groupNodesByNgrams syn occs = HM.fromListWith (<>) occs'
   where
     occs' = map toSyn (HM.toList occs)

src/Gargantext/API/Node.hs

@@ -28,18 +28,18 @@ Node API
 module Gargantext.API.Node
   where
 
+import Control.Lens ((^.))
 import Data.Aeson (FromJSON, ToJSON)
 import Data.Aeson.TH (deriveJSON)
 import Data.Swagger
 import Gargantext.API.Admin.Auth (withAccess, withPolicy)
-import Gargantext.API.Admin.Auth.Types (PathId(..), AuthenticatedUser (..))
+import Gargantext.API.Admin.Auth.Types (PathId(..), AuthenticatedUser (..), auth_node_id)
 import Gargantext.API.Admin.EnvTypes
 import Gargantext.API.Auth.PolicyCheck
 import Gargantext.API.Metrics
 import Gargantext.API.Ngrams (TableNgramsApi, apiNgramsTableCorpus)
 import Gargantext.API.Ngrams.Types (TabType(..))
 import Gargantext.API.Node.DocumentUpload qualified as DocumentUpload
-import Gargantext.API.Node.DocumentsFromWriteNodes qualified as DocumentsFromWriteNodes
 import Gargantext.API.Node.File
 import Gargantext.API.Node.FrameCalcUpload qualified as FrameCalcUpload
 import Gargantext.API.Node.New
@@ -73,6 +73,7 @@ import Gargantext.Prelude
 import Servant
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
+import qualified Gargantext.API.Node.DocumentsFromWriteNodes as DFWN
 
 
 -- | Admin NodesAPI
@@ -153,7 +154,7 @@ type NodeAPI a = PolicyChecked (NodeNodeAPI a)
              :<|> "file"      :> FileApi
              :<|> "async"     :> FileAsyncApi
 
-             :<|> "documents-from-write-nodes" :> DocumentsFromWriteNodes.API
+             :<|> "documents-from-write-nodes" :> DFWN.API
              :<|> DocumentUpload.API
 
 -- TODO-ACCESS: check userId CanRenameNode nodeId
@@ -195,49 +196,52 @@ nodeAPI :: forall proxy a.
          -> AuthenticatedUser
          -> NodeId
          -> ServerT (NodeAPI a) (GargM Env GargError)
-nodeAPI p authenticatedUser@(AuthenticatedUser (NodeId uId)) id' = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy authenticatedUser (PathNode id') nodeAPI'
+nodeAPI p authenticatedUser targetNode =
+  withAccess (Proxy :: Proxy (NodeAPI a)) Proxy authenticatedUser (PathNode targetNode) nodeAPI'
   where
 
+    userRootId = RootId $ authenticatedUser ^. auth_node_id
+
     nodeAPI' :: ServerT (NodeAPI a) (GargM Env GargError)
-    nodeAPI' =  withPolicy authenticatedUser (nodeChecks id') (getNodeWith   id' p)
-           :<|> rename        id'
-           :<|> postNode  uId id'
-           :<|> postNodeAsyncAPI  uId id'
-           :<|> FrameCalcUpload.api uId id'
-           :<|> putNode       id'
-           :<|> Update.api uId id'
-           :<|> Action.deleteNode (RootId $ NodeId uId) id'
-           :<|> getChildren   id' p
+    nodeAPI' =  withPolicy authenticatedUser (nodeChecks targetNode) (getNodeWith targetNode p)
+           :<|> rename                                targetNode
+           :<|> postNode            authenticatedUser targetNode
+           :<|> postNodeAsyncAPI    authenticatedUser targetNode
+           :<|> FrameCalcUpload.api authenticatedUser targetNode
+           :<|> putNode                               targetNode
+           :<|> Update.api                            targetNode
+           :<|> Action.deleteNode   userRootId        targetNode
+           :<|> getChildren                           targetNode p
 
            -- TODO gather it
-           :<|> tableApi             id'
-           :<|> apiNgramsTableCorpus id'
+           :<|> tableApi                              targetNode
+           :<|> apiNgramsTableCorpus                  targetNode
 
-           :<|> catApi      id'
-           :<|> scoreApi    id'
-           :<|> Search.api  id'
-           :<|> Share.api   (RootId $ NodeId uId) id'
+           :<|> catApi                                targetNode
+           :<|> scoreApi                              targetNode
+           :<|> Search.api                            targetNode
+           :<|> Share.api           userRootId        targetNode
            -- Pairing Tools
-           :<|> pairWith    id'
-           :<|> pairs       id'
-           :<|> getPair     id'
+           :<|> pairWith                              targetNode
+           :<|> pairs                                 targetNode
+           :<|> getPair                               targetNode
 
            -- VIZ
-           :<|> scatterApi id'
-           :<|> chartApi   id'
-           :<|> pieApi     id'
-           :<|> treeApi    id'
-           :<|> phyloAPI   id' uId
-           :<|> moveNode   (RootId $ NodeId uId) id'
+           :<|> scatterApi                            targetNode
+           :<|> chartApi                              targetNode
+           :<|> pieApi                                targetNode
+           :<|> treeApi                               targetNode
+           :<|> phyloAPI                              targetNode
+           :<|> moveNode           userRootId         targetNode
            -- :<|> nodeAddAPI id'
            -- :<|> postUpload id'
-           :<|> Share.unPublish id'
+           :<|> Share.unPublish                       targetNode
 
-           :<|> fileApi uId id'
-           :<|> fileAsyncApi uId id'
+           :<|> fileApi                               targetNode
+           :<|> fileAsyncApi       authenticatedUser  targetNode
 
-           :<|> DocumentsFromWriteNodes.api uId id'
-           :<|> DocumentUpload.api uId id'
+           :<|> DFWN.api           authenticatedUser  targetNode
+           :<|> DocumentUpload.api                    targetNode
 
 
 ------------------------------------------------------------------------

src/Gargantext/API/Node/Contact.hs

@@ -59,8 +59,8 @@ type API = "contact" :> Summary "Contact endpoint"
 
 
 api :: AuthenticatedUser -> CorpusId -> ServerT API (GargM Env GargError)
-api authUser@(AuthenticatedUser (NodeId uid)) cid =
-       (api_async   (RootId (NodeId                   uid)) cid)
+api authUser@(AuthenticatedUser userNodeId _userUserId) cid =
+       (api_async   (RootId userNodeId) cid)
   :<|> (nodeNodeAPI (Proxy :: Proxy HyperdataContact) authUser cid)
 
 type API_Async = AsyncJobs JobLog '[JSON] AddContactParams JobLog

src/Gargantext/API/Node/Corpus/Export.hs

@@ -59,8 +59,10 @@ getCorpus cId lId nt' = do
     Nothing -> defaultList cId
     Just l  -> pure l
 
+  -- FIXME(adn) Audit the usage of this, we are converting from a node
+  -- to a context id.
   ns   <- Map.fromList
-       <$> map (\n -> (_context_id n, n))
+       <$> map (\n -> (nodeId2ContextId $ _context_id n, n))
        <$> selectDocNodes cId
 
   repo <- getRepo [listId]

src/Gargantext/API/Node/Document/Export.hs

@@ -11,43 +11,50 @@ Portability : POSIX
 module Gargantext.API.Node.Document.Export
   where
 
-import qualified Data.ByteString.Lazy.Char8 as BSC
+-- import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument(..))
+import Control.Lens (view)
 import Data.Csv (encodeDefaultOrderedByName)
-import qualified Data.Text as T
-import qualified Data.Text.Encoding as TE
 import Data.Version (showVersion)
 import Gargantext.API.Node.Document.Export.Types
 import Gargantext.API.Prelude (GargNoServer, GargServer)
 import Gargantext.Core (toDBid)
 import Gargantext.Core.Types
--- import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument(..))
 import Gargantext.Database.Query.Facet (runViewDocuments, Facet(..))
 import Gargantext.Database.Query.Table.Node (getClosestParentIdByType)
-import Gargantext.Database.Schema.Node (NodePoly(..))
+import Gargantext.Database.Query.Table.Node.User
+import Gargantext.Database.Schema.Node (NodePoly(..), node_user_id)
 import Gargantext.Prelude
-import qualified Paths_gargantext as PG -- cabal magic build module
 import Servant
+import qualified Data.ByteString.Lazy.Char8 as BSC
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as TE
+import qualified Paths_gargantext as PG -- cabal magic build module
 
-api :: UserId -> DocId -> GargServer API
-api uid dId = getDocumentsJSON uid dId
-     :<|> getDocumentsCSV uid dId
+api :: NodeId
+    -- ^ The ID of the target user
+    -> DocId
+    -> GargServer API
+api userNodeId dId = getDocumentsJSON userNodeId dId
+                :<|> getDocumentsCSV userNodeId dId
 
 --------------------------------------------------
 -- | Hashes are ordered by Set
-getDocumentsJSON :: UserId
+getDocumentsJSON :: NodeId
+                 -- ^ The ID of the target user
                  -> DocId
                  -> GargNoServer (Headers '[Header "Content-Disposition" T.Text] DocumentExport)
-getDocumentsJSON uId pId = do
+getDocumentsJSON nodeUserId pId = do
+  uId <- view node_user_id <$> getNodeUser nodeUserId
   mcId <- getClosestParentIdByType pId NodeCorpus
   let cId = maybe (panic "[G.A.N.D.Export] Node has no parent") identity mcId
   docs <- runViewDocuments cId False Nothing Nothing Nothing Nothing Nothing
   pure $ addHeader (T.concat [ "attachment; filename=GarganText_DocsList-"
                              , T.pack $ show pId
                              , ".json"])
-    DocumentExport { _de_documents = mapFacetDoc <$> docs
+    DocumentExport { _de_documents = mapFacetDoc uId <$> docs
                         , _de_garg_version = T.pack $ showVersion PG.version }
   where
-    mapFacetDoc (FacetDoc { .. }) =
+    mapFacetDoc uId (FacetDoc { .. }) =
       Document { _d_document =
                  Node { _node_id = facetDoc_id
                       , _node_hash_id = Nothing
@@ -65,11 +72,12 @@ getDocumentsJSON uId pId = do
                                                 , _ng_hash = "" }
                          , _d_hash     = ""}
 
-getDocumentsCSV :: UserId
+getDocumentsCSV :: NodeId
+                -- ^ The Node ID of the target user
                 -> DocId
                 -> GargNoServer (Headers '[Header "Content-Disposition" T.Text] T.Text) -- [Document]
-getDocumentsCSV uId pId = do
-  dJSON <- getDocumentsJSON uId pId
+getDocumentsCSV userNodeId pId = do
+  dJSON <- getDocumentsJSON userNodeId pId
   let DocumentExport { _de_documents } = getResponse dJSON
   let ret = TE.decodeUtf8 $ BSC.toStrict $ encodeDefaultOrderedByName _de_documents
 

src/Gargantext/API/Node/DocumentUpload.hs

@@ -75,18 +75,17 @@ type API = Summary " Document upload"
            :> "async"
            :> AsyncJobs JobLog '[JSON] DocumentUpload JobLog
 
-api :: UserId -> NodeId -> ServerT API (GargM Env GargError)
-api uId nId =
+api :: NodeId -> ServerT API (GargM Env GargError)
+api nId =
   serveJobsAPI UploadDocumentJob $ \jHandle q -> do
-      documentUploadAsync uId nId q jHandle
+      documentUploadAsync nId q jHandle
 
 documentUploadAsync :: (FlowCmdM env err m, MonadJobStatus m)
-               => UserId
-               -> NodeId
+               => NodeId
                -> DocumentUpload
                -> JobHandle m
                -> m ()
-documentUploadAsync _uId nId doc jobHandle = do
+documentUploadAsync nId doc jobHandle = do
   markStarted 1 jobHandle
   _docIds <- documentUpload nId doc
   -- printDebug "documentUploadAsync" docIds

src/Gargantext/API/Node/DocumentsFromWriteNodes.hs

@@ -44,6 +44,8 @@ import Gargantext.Database.Schema.Node (node_hyperdata, node_name, node_date)
 import Gargantext.Prelude
 import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
 import Servant
+import Gargantext.API.Admin.Auth.Types
+-- import qualified Gargantext.Defaults as Defaults
 
 ------------------------------------------------------------------------
 type API = Summary " Documents from Write nodes."
@@ -62,22 +64,26 @@ instance ToJSON Params where
   toJSON = genericToJSON defaultOptions
 instance ToSchema Params
 ------------------------------------------------------------------------
-api :: UserId -> NodeId -> ServerT API (GargM Env GargError)
-api uId nId =
+api :: AuthenticatedUser
+    -- ^ The logged-in user
+    -> NodeId
+    -> ServerT API (GargM Env GargError)
+api authenticatedUser nId =
   serveJobsAPI DocumentFromWriteNodeJob $ \jHandle p ->
-    documentsFromWriteNodes uId nId p jHandle
+    documentsFromWriteNodes authenticatedUser nId p jHandle
 
 documentsFromWriteNodes :: ( HasSettings env
                            , FlowCmdM env err m
                            , MonadJobStatus m
                            , HasNodeStoryImmediateSaver env
                            , HasNodeArchiveStoryImmediateSaver env )
-                        => UserId
+                        => AuthenticatedUser
+                        -- ^ The logged-in user
                         -> NodeId
                         -> Params
                         -> JobHandle m
                         -> m ()
-documentsFromWriteNodes uId nId Params { selection, lang, paragraphs } jobHandle = do
+documentsFromWriteNodes authenticatedUser nId Params { selection, lang, paragraphs } jobHandle = do
   markStarted 2 jobHandle
   markProgress 1 jobHandle
 
@@ -105,7 +111,7 @@ documentsFromWriteNodes uId nId Params { selection, lang, paragraphs } jobHandle
                   -> hyperdataDocumentFromFrameWrite lang paragraphs' (node, contents)) <$> frameWritesWithContents
   let parsed = List.concat $ rights parsedE
   -- printDebug "DocumentsFromWriteNodes: uId" uId
-  _ <- flowDataText (RootId (NodeId uId))
+  _ <- flowDataText (RootId userNodeId)
                     (DataNew (Just $ fromIntegral $ length parsed, yieldMany parsed))
                     (Multi lang)
                     cId
@@ -113,11 +119,15 @@ documentsFromWriteNodes uId nId Params { selection, lang, paragraphs } jobHandle
                     jobHandle
 
 
-  listId <- getOrMkList cId uId
+  -- FIXME(adn) If we were to store the UserID inside an 'AuthenticatedUser', we won't need this.
+  listId <- getOrMkList cId userId
   v <- currentVersion listId
   _ <- commitStatePatch listId (Versioned v mempty)
 
   markProgress 1 jobHandle
+  where
+    userNodeId = authenticatedUser ^. auth_node_id
+    userId     = authenticatedUser ^. auth_user_id
 
 ------------------------------------------------------------------------
 hyperdataDocumentFromFrameWrite :: Lang -> Int -> (Node HyperdataFrame, T.Text) -> Either T.Text [HyperdataDocument]

src/Gargantext/API/Node/File.hs

@@ -23,6 +23,13 @@ import Data.ByteString.Lazy qualified as BSL
 import Data.MIME.Types qualified as DMT
 import Data.Swagger
 import Data.Text qualified as T
+import Data.Text
+import Servant
+import qualified Gargantext.Database.GargDB as GargDB
+import qualified Network.HTTP.Media as M
+
+import Data.Either
+import Gargantext.API.Admin.Auth.Types
 import Gargantext.API.Admin.EnvTypes (GargJob(..), Env)
 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
 import Gargantext.API.Admin.Types (HasSettings)
@@ -33,14 +40,11 @@ import Gargantext.Database.Action.Flow.Types
 import Gargantext.Database.Action.Node (mkNodeWithParent)
 import Gargantext.Database.Admin.Types.Hyperdata.File
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.GargDB qualified as GargDB
 import Gargantext.Database.Query.Table.Node (getNodeWith)
 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
 import Gargantext.Database.Schema.Node (node_hyperdata)
 import Gargantext.Prelude
 import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
-import Network.HTTP.Media qualified as M
-import Servant
 
 data RESPONSE deriving Typeable
 
@@ -57,8 +61,8 @@ type FileApi = Summary "File download"
 instance MimeUnrender RESPONSE BSResponse where
   mimeUnrender _ lbs = Right $ BSResponse (BSL.toStrict lbs)
 
-fileApi :: UserId -> NodeId -> GargServer FileApi
-fileApi uId nId = fileDownload uId nId
+fileApi :: NodeId -> GargServer FileApi
+fileApi nId = fileDownload nId
 
 newtype Contents = Contents BS.ByteString
 
@@ -74,10 +78,9 @@ instance ToSchema BSResponse  where
   declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy TODO)
 
 fileDownload :: (HasSettings env, FlowCmdM env err m)
-             => UserId
-             -> NodeId
+             => NodeId
              -> m (Headers '[Servant.Header "Content-Type" Text] BSResponse)
-fileDownload uId nId = do
+fileDownload nId = do
   -- printDebug "[fileDownload] uId" uId
   -- printDebug "[fileDownload] nId" nId
 
@@ -108,27 +111,30 @@ type FileAsyncApi = Summary "File Async Api"
                  :> "add"
                  :> AsyncJobs JobLog '[FormUrlEncoded] NewWithFile JobLog
 
-fileAsyncApi :: UserId -> NodeId -> ServerT FileAsyncApi (GargM Env GargError)
-fileAsyncApi uId nId =
+fileAsyncApi :: AuthenticatedUser
+             -- ^ The logged-in user
+             -> NodeId
+             -> ServerT FileAsyncApi (GargM Env GargError)
+fileAsyncApi authenticatedUser nId =
   serveJobsAPI AddFileJob $ \jHandle i ->
-    addWithFile uId nId i jHandle
+    addWithFile authenticatedUser nId i jHandle
 
 
 addWithFile :: (HasSettings env, FlowCmdM env err m, MonadJobStatus m)
-            => UserId
+            => AuthenticatedUser
+            -- ^ The logged-in user
             -> NodeId
             -> NewWithFile
             -> JobHandle m
             -> m ()
-addWithFile uId nId nwf@(NewWithFile _d _l fName) jobHandle = do
+addWithFile authenticatedUser nId nwf@(NewWithFile _d _l fName) jobHandle = do
 
   -- printDebug "[addWithFile] Uploading file: " nId
   markStarted 1 jobHandle
 
   fPath <- GargDB.writeFile nwf
   -- printDebug "[addWithFile] File saved as: " fPath
-
-  nIds <- mkNodeWithParent NodeFile (Just nId) uId fName
+  nIds <- mkNodeWithParent NodeFile (Just nId) userId fName
 
   _ <- case nIds of
     [nId'] -> do
@@ -143,3 +149,5 @@ addWithFile uId nId nwf@(NewWithFile _d _l fName) jobHandle = do
 
   -- printDebug "[addWithFile] File upload finished: " nId
   markComplete jobHandle
+  where
+    userId = authenticatedUser ^. auth_user_id

src/Gargantext/API/Node/FrameCalcUpload.hs

@@ -21,6 +21,12 @@ import Data.ByteString.Lazy qualified as BSL
 import Data.ByteString.UTF8 qualified as BSU8
 import Data.Swagger
 import Data.Text qualified as T
+import Network.HTTP.Client (newManager, httpLbs, parseRequest, responseBody)
+import Network.HTTP.Client.TLS (tlsManagerSettings)
+import Servant
+import Web.FormUrlEncoded (FromForm)
+
+import Gargantext.API.Admin.Auth.Types
 import Gargantext.API.Admin.EnvTypes (GargJob(..), Env)
 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
 import Gargantext.API.Node.Corpus.New (addToCorpusWithForm)
@@ -38,10 +44,6 @@ import Gargantext.Database.Query.Table.Node (getClosestParentIdByType, getNodeWi
 import Gargantext.Database.Schema.Node (node_hyperdata)
 import Gargantext.Prelude
 import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
-import Network.HTTP.Client (newManager, httpLbs, parseRequest, responseBody)
-import Network.HTTP.Client.TLS (tlsManagerSettings)
-import Servant
-import Web.FormUrlEncoded (FromForm)
 
 data FrameCalcUpload = FrameCalcUpload {
   _wf_lang      :: !(Maybe Lang)
@@ -60,20 +62,21 @@ type API = Summary " FrameCalc upload"
            :> "async"
            :> AsyncJobs JobLog '[JSON] FrameCalcUpload JobLog
 
-api :: UserId -> NodeId -> ServerT API (GargM Env GargError)
-api uId nId =
+api :: AuthenticatedUser -> NodeId -> ServerT API (GargM Env GargError)
+api authenticatedUser nId =
   serveJobsAPI UploadFrameCalcJob $ \jHandle p ->
-    frameCalcUploadAsync uId nId p jHandle
+    frameCalcUploadAsync authenticatedUser nId p jHandle
 
 
 
 frameCalcUploadAsync :: (HasConfig env, FlowCmdM env err m, MonadJobStatus m)
-                     => UserId
+                     => AuthenticatedUser
+                     -- ^ The logged-in user
                      -> NodeId
                      -> FrameCalcUpload
                      -> JobHandle m
                      -> m ()
-frameCalcUploadAsync uId nId (FrameCalcUpload _wf_lang _wf_selection) jobHandle = do
+frameCalcUploadAsync authenticatedUser nId (FrameCalcUpload _wf_lang _wf_selection) jobHandle = do
   markStarted 5 jobHandle
 
   -- printDebug "[frameCalcUploadAsync] uId" uId
@@ -99,7 +102,8 @@ frameCalcUploadAsync uId nId (FrameCalcUpload _wf_lang _wf_selection) jobHandle
   case mCId of
     Nothing -> markFailure 1 Nothing jobHandle
     Just cId ->
-      addToCorpusWithForm (RootId (NodeId uId))
+      -- FIXME(adn) Audit this conversion.
+      addToCorpusWithForm (RootId userNodeId)
                           cId
                           (NewWithForm { _wf_filetype = CSV
                                        , _wf_fileformat = Plain
@@ -109,3 +113,5 @@ frameCalcUploadAsync uId nId (FrameCalcUpload _wf_lang _wf_selection) jobHandle
                                        , _wf_selection }) jobHandle
 
   markComplete jobHandle
+  where
+    userNodeId = authenticatedUser ^. auth_node_id

src/Gargantext/API/Node/New.hs

@@ -31,14 +31,13 @@ import Gargantext.Database.Action.Node
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Prelude (Cmd)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
-import Gargantext.Database.Query.Table.Node.User
-import Gargantext.Database.Schema.Node
 import Gargantext.Prelude
 import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
 import Servant
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary
 import Web.FormUrlEncoded (FromForm, ToForm)
+import Gargantext.API.Admin.Auth.Types
 
 ------------------------------------------------------------------------
 data PostNode = PostNode { pn_name     :: Text
@@ -56,14 +55,14 @@ instance Arbitrary PostNode where
 
 ------------------------------------------------------------------------
 postNode :: HasNodeError err
-         => UserId
+         => AuthenticatedUser
+         -- ^ The logged-in user
          -> NodeId
          -> PostNode
          -> Cmd err [NodeId]
-postNode uId pId (PostNode nodeName nt) = do
-  nodeUser <- getNodeUser (NodeId uId)
-  let uId' = nodeUser ^. node_user_id
-  mkNodeWithParent nt (Just pId) uId' nodeName
+postNode authenticatedUser pId (PostNode nodeName nt) = do
+  let userId = authenticatedUser ^. auth_user_id
+  mkNodeWithParent nt (Just pId) userId nodeName
 
 ------------------------------------------------------------------------
 type PostNodeAsync = Summary "Post Node"
@@ -72,29 +71,32 @@ type PostNodeAsync = Summary "Post Node"
 
 
 postNodeAsyncAPI
-  :: UserId -> NodeId -> ServerT PostNodeAsync (GargM Env GargError)
-postNodeAsyncAPI uId nId =
-  serveJobsAPI NewNodeJob $ \jHandle p -> postNodeAsync uId nId p jHandle
+  :: AuthenticatedUser
+  -- ^ The logged-in user
+  -> NodeId
+  -- ^ The target node
+  -> ServerT PostNodeAsync (GargM Env GargError)
+postNodeAsyncAPI authenticatedUser nId =
+  serveJobsAPI NewNodeJob $ \jHandle p -> postNodeAsync authenticatedUser nId p jHandle
 
 ------------------------------------------------------------------------
 postNodeAsync :: (FlowCmdM env err m, MonadJobStatus m)
-    => UserId
+    => AuthenticatedUser
+    -- ^ The logged in user
     -> NodeId
     -> PostNode
     -> JobHandle m
     -> m ()
-postNodeAsync uId nId (PostNode nodeName tn) jobHandle = do
+postNodeAsync authenticatedUser nId (PostNode nodeName tn) jobHandle = do
 
   -- printDebug "postNodeAsync" nId
   markStarted 3 jobHandle
   markProgress 1 jobHandle
 
-  nodeUser <- getNodeUser (NodeId uId)
-
   -- _ <- threadDelay 1000
   markProgress 1 jobHandle
 
-  let uId' = nodeUser ^. node_user_id
-  _ <- mkNodeWithParent tn (Just nId) uId' nodeName
+  let userId = authenticatedUser ^. auth_user_id
+  _ <- mkNodeWithParent tn (Just nId) userId nodeName
 
   markComplete jobHandle

src/Gargantext/API/Node/Share.hs

@@ -49,7 +49,7 @@ instance ToJSON    ShareNodeParams where
 instance ToSchema  ShareNodeParams
 instance Arbitrary ShareNodeParams where
   arbitrary = elements [ ShareTeamParams "user1"
-                       , SharePublicParams (NodeId 1)
+                       , SharePublicParams (UnsafeMkNodeId 1)
                        ]
 ------------------------------------------------------------------------
 -- TODO permission
@@ -86,7 +86,7 @@ api userInviting nId (ShareTeamParams user') = do
               _ <- case List.null children of
                 True -> do
                   -- printDebug "[G.A.N.Share.api]" ("Invitation is enabled if you share a corpus at least" :: Text)
-                  pure 0
+                  pure $ UnsafeMkUserId 0
                 False -> do
                   -- printDebug "[G.A.N.Share.api]" ("Your invitation is sent to: " <> user'')
                   newUser user''

src/Gargantext/API/Node/Update.hs

@@ -88,26 +88,25 @@ data Charts = Sources | Authors | Institutes | Ngrams | All
     deriving (Generic, Eq, Ord, Enum, Bounded)
 
 ------------------------------------------------------------------------
-api :: UserId -> NodeId -> ServerT API (GargM Env GargError)
-api uId nId =
+api :: NodeId -> ServerT API (GargM Env GargError)
+api nId =
   serveJobsAPI UpdateNodeJob $ \jHandle p ->
-    updateNode uId nId p jHandle
+    updateNode nId p jHandle
 
 updateNode :: (HasNodeStory env err m, HasSettings env, MonadJobStatus m)
-           => UserId
-           -> NodeId
+           => NodeId
            -> UpdateNodeParams
            -> JobHandle m
            -> m ()
-updateNode uId nId (UpdateNodeParamsGraph metric partitionMethod bridgeMethod strength nt1 nt2) jobHandle = do
+updateNode nId (UpdateNodeParamsGraph metric partitionMethod bridgeMethod strength nt1 nt2) jobHandle = do
 
   markStarted 2 jobHandle
   -- printDebug "Computing graph: " method
-  _ <- recomputeGraph uId nId partitionMethod bridgeMethod (Just metric) (Just strength) nt1 nt2 True
+  _ <- recomputeGraph nId partitionMethod bridgeMethod (Just metric) (Just strength) nt1 nt2 True
   -- printDebug "Graph computed: " method
   markComplete jobHandle
 
-updateNode _uId nid1 (LinkNodeReq nt nid2) jobHandle = do
+updateNode nid1 (LinkNodeReq nt nid2) jobHandle = do
   markStarted 2 jobHandle
   _ <- case nt of
     NodeAnnuaire -> pairing nid2 nid1 Nothing -- defaultList
@@ -118,7 +117,7 @@ updateNode _uId nid1 (LinkNodeReq nt nid2) jobHandle = do
   markComplete jobHandle
 
 -- | `Advanced` to update graphs
-updateNode _uId lId (UpdateNodeParamsList Advanced) jobHandle = do
+updateNode lId (UpdateNodeParamsList Advanced) jobHandle = do
   markStarted 3 jobHandle
   corpusId <- view node_parent_id <$> getNode lId
 
@@ -134,7 +133,7 @@ updateNode _uId lId (UpdateNodeParamsList Advanced) jobHandle = do
 
   markComplete jobHandle
 
-updateNode _uId lId (UpdateNodeParamsList _mode) jobHandle = do
+updateNode lId (UpdateNodeParamsList _mode) jobHandle = do
   markStarted 3 jobHandle
   corpusId <- view node_parent_id <$> getNode lId
 
@@ -149,7 +148,7 @@ updateNode _uId lId (UpdateNodeParamsList _mode) jobHandle = do
 
   markComplete jobHandle
 
-updateNode _userId phyloId (UpdateNodePhylo config) jobHandle = do
+updateNode phyloId (UpdateNodePhylo config) jobHandle = do
   markStarted 3 jobHandle
   corpusId' <- view node_parent_id <$> getNode phyloId
   markProgress 1 jobHandle
@@ -172,7 +171,7 @@ updateNode _userId phyloId (UpdateNodePhylo config) jobHandle = do
   -- sendMail (UserDBId userId)
   markComplete jobHandle
 
-updateNode _uId tId (UpdateNodeParamsTexts _mode) jobHandle = do
+updateNode tId (UpdateNodeParamsTexts _mode) jobHandle = do
   markStarted 3 jobHandle
   corpusId <- view node_parent_id <$> getNode tId
   markProgress 1 jobHandle
@@ -186,7 +185,7 @@ updateNode _uId tId (UpdateNodeParamsTexts _mode) jobHandle = do
   markComplete jobHandle
 
 
-updateNode _uId _nId _p jobHandle = do
+updateNode _nId _p jobHandle = do
   simuLogs jobHandle 10
 ------------------------------------------------------------------------
 

src/Gargantext/API/Public.hs

@@ -66,7 +66,7 @@ api_node nId = do
   -- TODO optimize with SQL
   case Set.member nId pubNodes of
     False -> panic "Not allowed" -- TODO throwErr
-    True  -> fileApi 0 nId
+    True  -> fileApi nId
 
 -------------------------------------------------------------------------
 
@@ -82,7 +82,7 @@ filterPublicDatas :: [(Node HyperdataFolder, Maybe Int)]
                   -> [(Node HyperdataFolder, [NodeId])]
 filterPublicDatas datas =
   map (\(n,mi) ->
-          let mi' = NodeId <$> mi in
+          let mi' = UnsafeMkNodeId <$> mi in
                   ( _node_id n, (n, maybe [] (:[]) mi' ))
       ) datas
       & Map.fromListWith (\(n1,i1) (_n2,i2) -> (n1, i1 <> i2))

src/Gargantext/API/Routes.hs

@@ -237,7 +237,7 @@ serverGargAdminAPI =  roots
 
 serverPrivateGargAPI'
   :: AuthenticatedUser -> ServerT GargPrivateAPI' (GargM Env GargError)
-serverPrivateGargAPI' authenticatedUser@(AuthenticatedUser (NodeId uid))
+serverPrivateGargAPI' authenticatedUser@(AuthenticatedUser userNodeId userId)
        =  serverGargAdminAPI
      :<|> nodeAPI     (Proxy :: Proxy HyperdataAny)      authenticatedUser
      :<|> contextAPI  (Proxy :: Proxy HyperdataAny)      authenticatedUser
@@ -251,7 +251,7 @@ serverPrivateGargAPI' authenticatedUser@(AuthenticatedUser (NodeId uid))
      :<|> withAccess  (Proxy :: Proxy TableNgramsApi) Proxy authenticatedUser
           <$> PathNode <*> apiNgramsTableDoc
 
-     :<|> DocumentExport.api uid
+     :<|> DocumentExport.api userNodeId
 
      :<|> count -- TODO: undefined
 
@@ -259,18 +259,18 @@ serverPrivateGargAPI' authenticatedUser@(AuthenticatedUser (NodeId uid))
      --     <$> PathNode <*> Search.api -- TODO: move elsewhere
 
      :<|> withAccess (Proxy :: Proxy GraphAPI)       Proxy authenticatedUser
-          <$> PathNode <*> graphAPI uid -- TODO: mock
+          <$> PathNode <*> graphAPI userId -- TODO: mock
 
      :<|> (\nodeId -> withPolicyT (Proxy @TreeAPI) Proxy authenticatedUser (nodeChecks nodeId) (treeAPI nodeId))
 
      :<|> withAccess (Proxy :: Proxy TreeFlatAPI)    Proxy authenticatedUser
           <$> PathNode <*> treeFlatAPI
 
-     :<|> members uid
+     :<|> members
      -- TODO access
-     :<|> addCorpusWithForm  (RootId (NodeId uid))
+     :<|> addCorpusWithForm  (RootId userNodeId)
     -- :<|> addCorpusWithFile  (RootId (NodeId uid))
-     :<|> addCorpusWithQuery (RootId (NodeId uid))
+     :<|> addCorpusWithQuery (RootId userNodeId)
 
      -- :<|> addAnnuaireWithForm
      -- :<|> New.api  uid -- TODO-SECURITY

src/Gargantext/Core/NodeStory.hs

@@ -123,6 +123,7 @@ import Gargantext.Database.Query.Table.Node.Error (HasNodeError())
 import Gargantext.Database.Schema.Ngrams (NgramsType)
 import Gargantext.Prelude
 import Opaleye (DefaultFromField(..), SqlJsonb, fromPGSFromField)
+import qualified Database.PostgreSQL.Simple.ToField     as PGS
 
 ------------------------------------------------------------------------
 data NodeStoryEnv = NodeStoryEnv
@@ -334,7 +335,7 @@ nodeExists c nId = (== [PGS.Only True])
 getNodesIdWithType :: PGS.Connection -> NodeType -> IO [NodeId]
 getNodesIdWithType c nt = do
   ns <- runPGSQuery c query (PGS.Only $ nodeTypeId nt)
-  pure $ map (\(PGS.Only nId) -> NodeId nId) ns
+  pure $ map (\(PGS.Only nId) -> UnsafeMkNodeId nId) ns
   where
     query :: PGS.Query
     query = [sql| SELECT id FROM nodes WHERE typename = ? |]
@@ -352,7 +353,7 @@ getNodesArchiveHistory c nodesId = do
                             :: IO [(Int, TableNgrams.NgramsType, NgramsTerm, NgramsPatch)]
 
   pure $ map (\(nId, ngramsType, terms, patch)
-               -> ( NodeId nId
+               -> ( UnsafeMkNodeId nId
                   , Map.singleton ngramsType [HashMap.singleton terms patch]
                   )
              ) as
@@ -398,9 +399,9 @@ insertNodeArchiveHistory c nodeId version (h:hs) = do
                 )|]
 
 getNodeStory :: PGS.Connection -> NodeId -> IO NodeListStory
-getNodeStory c nId@(NodeId nodeId) = do
+getNodeStory c nId = do
   --res <- withResource pool $ \c -> runSelect c query :: IO [NodeStoryPoly NodeId Version Int Int NgramsRepoElement]
-  res <- runPGSQuery c nodeStoriesQuery (PGS.Only nodeId) :: IO [(Version, TableNgrams.NgramsType, NgramsTerm, NgramsRepoElement)]
+  res <- runPGSQuery c nodeStoriesQuery (PGS.Only $ PGS.toField nId) :: IO [(Version, TableNgrams.NgramsType, NgramsTerm, NgramsRepoElement)]
   -- We have multiple rows with same node_id and different (ngrams_type_id, ngrams_id).
   -- Need to create a map: {<node_id>: {<ngrams_type_id>: {<ngrams_id>: <data>}}}
   let dbData = map (\(version, ngramsType, ngrams, ngrams_repo_element) ->
@@ -453,12 +454,12 @@ archiveStateListFilterFromSet set =
 
 -- | This function inserts whole new node story and archive for given node_id.
 insertNodeStory :: PGS.Connection -> NodeId -> ArchiveList -> IO ()
-insertNodeStory c (NodeId nId) a = do
+insertNodeStory c nId a = do
   mapM_ (\(ngramsType, ngrams, ngramsRepoElement) -> do
             termIdM <- runPGSQuery c ngramsIdQuery (PGS.Only ngrams) :: IO [PGS.Only Int64]
             case headMay termIdM of
               Nothing -> pure 0
-              Just (PGS.Only termId) -> runPGSExecuteMany c query [(nId, a ^. a_version, ngramsType, termId, ngramsRepoElement)]) $ archiveStateToList $ a ^. a_state
+              Just (PGS.Only termId) -> runPGSExecuteMany c query [(PGS.toField nId, a ^. a_version, ngramsType, termId, ngramsRepoElement)]) $ archiveStateToList $ a ^. a_state
              -- runInsert c $ insert ngramsType ngrams ngramsRepoElement) $ archiveStateToList _a_state
 
   where
@@ -514,7 +515,7 @@ updateArchiveStateList c nodeId version as = do
 
 -- | This function updates the node story and archive for given node_id.
 updateNodeStory :: PGS.Connection -> NodeId -> ArchiveList -> ArchiveList -> IO ()
-updateNodeStory c nodeId@(NodeId _nId) currentArchive newArchive = do
+updateNodeStory c nodeId currentArchive newArchive = do
   -- STEPS
 
   -- 0. We assume we're inside an advisory lock
@@ -570,11 +571,11 @@ updateNodeStory c nodeId@(NodeId _nId) currentArchive newArchive = do
 --                     , dReturning = rCount }
 
 upsertNodeStories :: PGS.Connection -> NodeId -> ArchiveList -> IO ()
-upsertNodeStories c nodeId@(NodeId nId) newArchive = do
+upsertNodeStories c nodeId newArchive = do
   -- printDebug "[upsertNodeStories] START nId" nId
   PGS.withTransaction c $ do
     -- printDebug "[upsertNodeStories] locking nId" nId
-    runPGSAdvisoryXactLock c nId
+    runPGSAdvisoryXactLock c (_NodeId nodeId)
 
     (NodeStory m) <- getNodeStory c nodeId
     case Map.lookup nodeId m of

src/Gargantext/Core/Text/List.hs

@@ -35,12 +35,11 @@ import Gargantext.Core.Text.List.Group.WithStem
 import Gargantext.Core.Text.List.Social
 import Gargantext.Core.Text.List.Social.Prelude
 import Gargantext.Core.Text.Metrics (scored', Scored(..), scored_speExc, scored_genInc, normalizeGlobal, normalizeLocal, scored_terms)
-import Gargantext.Core.Types (ListType(..), MasterCorpusId, UserCorpusId)
+import Gargantext.Core.Types (ListType(..), MasterCorpusId, UserCorpusId, ContextId)
 import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Data.HashMap.Strict.Utils qualified as HashMap
 import Gargantext.Database.Action.Metrics.NgramsByContext (getContextsByNgramsUser, getContextsByNgramsOnlyUser)
 import Gargantext.Database.Action.Metrics.TFICF (getTficf_withSample)
-import Gargantext.Database.Admin.Types.Node (NodeId)
 import Gargantext.Database.Prelude (DBCmd)
 import Gargantext.Database.Query.Table.Ngrams (text2ngrams)
 import Gargantext.Database.Query.Table.NgramsPostag (selectLems)
@@ -97,7 +96,7 @@ buildNgramsOthersList :: ( HasNodeError err
                       -> (NgramsType, MapListSize, MaxListSize)
                       -> m (Map NgramsType [NgramsElement])
 buildNgramsOthersList user uCid mfslw _groupParams (nt, MapListSize mapListSize, MaxListSize maxListSize) = do
-  allTerms  :: HashMap NgramsTerm (Set NodeId) <- getContextsByNgramsUser uCid nt
+  allTerms  :: HashMap NgramsTerm (Set ContextId) <- getContextsByNgramsUser uCid nt
 
   -- PrivateFirst for first developments since Public NodeMode is not implemented yet
   socialLists :: FlowCont NgramsTerm FlowListScores
@@ -232,7 +231,7 @@ buildNgramsTermsList user uCid mCid mfslw groupParams (nt, MapListSize mapListSi
   -- printDebug "[buildNgramsTermsList: mapTextDocIds]" mapTextDocIds
 
   let
-    groupedTreeScores_SetNodeId :: HashMap NgramsTerm (GroupedTreeScores (Set NodeId))
+    groupedTreeScores_SetNodeId :: HashMap NgramsTerm (GroupedTreeScores (Set ContextId))
     !groupedTreeScores_SetNodeId = HashMap.filter (\g -> Set.size (view gts'_score g) > 1) -- removing hapax
                                 $ setScoresWithMap mapTextDocIds (groupedMonoHead <> groupedMultHead)
 

src/Gargantext/Core/Text/List/Social.hs

@@ -29,7 +29,7 @@ import Gargantext.Core.Text.List.Social.Find (findListsId)
 import Gargantext.Core.Text.List.Social.Patch (addScorePatches)
 import Gargantext.Core.Text.List.Social.Prelude (FlowCont, FlowListScores)
 import Gargantext.Core.Types.Individu (User)
-import Gargantext.Database.Admin.Types.Node (ListId, NodeId(..))
+import Gargantext.Database.Admin.Types.Node (ListId)
 import Gargantext.Database.Prelude (DBCmd, connPool)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Database.Query.Tree (NodeMode(Private), HasTreeError)
@@ -70,7 +70,7 @@ instance ToJSON FlowSocialListWith where
   toJSON (NoList v) = object [ ("type", String "NoList"), ("makeList", toJSON v) ]
   toJSON (FlowSocialListWithLists { fslw_lists = ids }) =
     object [ ("type", String "SelectedLists")
-           , ("value", Array $ V.fromList (map (\(NodeId id) -> toJSON id) ids)) ]
+           , ("value", Array $ V.fromList (map toJSON ids)) ]
 
 instance Arbitrary FlowSocialListWith where
   arbitrary = oneof [

src/Gargantext/Core/Viz/Chart.hs

@@ -34,6 +34,7 @@ import Gargantext.Database.Query.Table.NodeContext (selectDocsDates)
 import Gargantext.Database.Schema.Ngrams
 import Gargantext.Database.Schema.Node
 import Gargantext.Prelude hiding (toList)
+import qualified Data.Set            as Set
 
 
 histoData :: CorpusId -> DBCmd err Histo
@@ -83,7 +84,8 @@ treeData cId nt lt = do
     dico = filterListWithRoot [lt] ts
     terms = catMaybes $ List.concat $ map (\(a,b) -> [Just a, b]) $ HashMap.toList dico
 
-  cs' <- getContextsByNgramsOnlyUser cId (ls' <> ls) nt terms
+  -- FIXME(adn) Audit the usage, as we are converting between a context id to a node id.
+  cs' <- HashMap.map (Set.map contextId2NodeId) <$> getContextsByNgramsOnlyUser cId (ls' <> ls) nt terms
 
   m  <- getListNgrams ls nt
   pure $ V.fromList $ toTree lt cs' m

src/Gargantext/Core/Viz/Graph/API.hs

@@ -41,9 +41,8 @@ import Gargantext.Database.Query.Table.Node
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Database.Query.Table.Node.Select
 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
-import Gargantext.Database.Query.Table.Node.User (getNodeUser)
-import Gargantext.Database.Schema.Ngrams
 import Gargantext.Database.Schema.Node
+import Gargantext.Database.Schema.Ngrams
 import Gargantext.Prelude
 import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
 import Servant
@@ -72,19 +71,18 @@ instance ToJSON GraphVersions
 instance ToSchema GraphVersions
 
 graphAPI :: UserId -> NodeId -> ServerT GraphAPI (GargM Env GargError)
-graphAPI u n = getGraph         u n
-          :<|> graphAsync       u n
-          :<|> graphClone       u n
-          :<|> getGraphGexf     u n
-          :<|> graphVersionsAPI u n
+graphAPI userId n = getGraph n
+          :<|> graphAsync        n
+          :<|> graphClone        userId n
+          :<|> getGraphGexf      n
+          :<|> graphVersionsAPI  userId n
 
 ------------------------------------------------------------------------
 --getGraph :: UserId -> NodeId -> GargServer HyperdataGraphAPI
 getGraph :: HasNodeStory env err m
-          => UserId
-         -> NodeId
+         => NodeId
          -> m HyperdataGraphAPI
-getGraph _uId nId = do
+getGraph nId = do
   nodeGraph <- getNodeWith nId (Proxy :: Proxy HyperdataGraph)
 
   let
@@ -120,8 +118,7 @@ getGraph _uId nId = do
 
 --recomputeGraph :: UserId -> NodeId -> Maybe GraphMetric -> GargNoServer Graph
 recomputeGraph :: HasNodeStory env err m
-               => UserId
-               -> NodeId
+               => NodeId
                -> PartitionMethod
                -> BridgenessMethod
                -> Maybe GraphMetric
@@ -130,7 +127,7 @@ recomputeGraph :: HasNodeStory env err m
                -> NgramsType
                -> Bool
                -> m Graph
-recomputeGraph _uId nId partitionMethod bridgeMethod maybeSimilarity maybeStrength nt1 nt2 force' = do
+recomputeGraph nId partitionMethod bridgeMethod maybeSimilarity maybeStrength nt1 nt2 force' = do
   nodeGraph <- getNodeWith nId (Proxy :: Proxy HyperdataGraph)
   let
     graph  = nodeGraph ^. node_hyperdata . hyperdataGraph
@@ -251,9 +248,9 @@ type GraphAsyncAPI = Summary "Recompute graph"
                      :> AsyncJobsAPI JobLog () JobLog
 
 
-graphAsync :: UserId -> NodeId -> ServerT GraphAsyncAPI (GargM Env GargError)
-graphAsync u n =
-  serveJobsAPI RecomputeGraphJob $ \jHandle _ -> graphRecompute u n jHandle
+graphAsync :: NodeId -> ServerT GraphAsyncAPI (GargM Env GargError)
+graphAsync n =
+  serveJobsAPI RecomputeGraphJob $ \jHandle _ -> graphRecompute n jHandle
 
 
 --graphRecompute :: UserId
@@ -262,13 +259,12 @@ graphAsync u n =
 --               -> GargNoServer JobLog
 -- TODO get Graph Metadata to recompute
 graphRecompute ::  (HasNodeStory env err m, MonadJobStatus m)
-               => UserId
-               -> NodeId
+               => NodeId
                -> JobHandle m
                -> m ()
-graphRecompute u n jobHandle = do
+graphRecompute n jobHandle = do
   markStarted 1 jobHandle
-  _g <- recomputeGraph u n Spinglass BridgenessMethod_Basic Nothing Nothing NgramsTerms NgramsTerms False
+  _g <- recomputeGraph n Spinglass BridgenessMethod_Basic Nothing Nothing NgramsTerms NgramsTerms False
   markComplete jobHandle
 
 ------------------------------------------------------------
@@ -280,7 +276,7 @@ type GraphVersionsAPI = Summary "Graph versions"
 graphVersionsAPI :: UserId -> NodeId -> GargServer GraphVersionsAPI
 graphVersionsAPI u n =
            graphVersions u n
-      :<|> recomputeVersions u n
+      :<|> recomputeVersions n
 
 graphVersions :: (HasNodeStory env err m)
               => UserId
@@ -312,10 +308,9 @@ graphVersions u nId = do
                        , gv_repo = v }
 
 recomputeVersions :: HasNodeStory env err m
-                  => UserId
-                  -> NodeId
+                  => NodeId
                   -> m Graph
-recomputeVersions uId nId = recomputeGraph uId nId Spinglass BridgenessMethod_Basic Nothing Nothing NgramsTerms NgramsTerms False
+recomputeVersions nId = recomputeGraph nId Spinglass BridgenessMethod_Basic Nothing Nothing NgramsTerms NgramsTerms False
 
 ------------------------------------------------------------
 graphClone :: HasNodeError err
@@ -323,13 +318,11 @@ graphClone :: HasNodeError err
            -> NodeId
            -> HyperdataGraphAPI
            -> DBCmd err NodeId
-graphClone uId pId (HyperdataGraphAPI { _hyperdataAPIGraph = graph
-                                      , _hyperdataAPICamera = camera }) = do
+graphClone userId pId (HyperdataGraphAPI { _hyperdataAPIGraph = graph
+                                         , _hyperdataAPICamera = camera }) = do
   let nodeType = NodeGraph
-  nodeUser <- getNodeUser (NodeId uId)
   nodeParent <- getNodeWith pId (Proxy :: Proxy HyperdataGraph)
-  let uId' = nodeUser ^. node_user_id
-  nIds <- mkNodeWithParent nodeType (Just pId) uId' $ nodeParent ^. node_name
+  nIds <- mkNodeWithParent nodeType (Just pId) userId $ nodeParent ^. node_name
   case nIds of
     [] -> pure pId
     (nId:_) -> do
@@ -345,9 +338,8 @@ graphClone uId pId (HyperdataGraphAPI { _hyperdataAPIGraph = graph
 --             -> NodeId
 --             -> GargNoServer (Headers '[Servant.Header "Content-Disposition" Text] Graph)
 getGraphGexf :: HasNodeStory env err m
-              => UserId
-             -> NodeId
+              => NodeId
              -> m (Headers '[Servant.Header "Content-Disposition" Text] Graph)
-getGraphGexf uId nId = do
-  HyperdataGraphAPI { _hyperdataAPIGraph = graph } <- getGraph uId nId
+getGraphGexf nId = do
+  HyperdataGraphAPI { _hyperdataAPIGraph = graph } <- getGraph nId
   pure $ addHeader "attachment; filename=graph.gexf" graph

src/Gargantext/Core/Viz/Phylo/API.hs

@@ -50,9 +50,9 @@ type PhyloAPI = Summary "Phylo API"
             :<|> PostPhylo
 
 
-phyloAPI :: PhyloId -> UserId -> GargServer PhyloAPI
-phyloAPI n u = getPhylo  n
-        :<|> postPhylo n u
+phyloAPI :: PhyloId -> GargServer PhyloAPI
+phyloAPI n = getPhylo  n
+        :<|> postPhylo n
         -- :<|> putPhylo  n
         -- :<|> deletePhylo  n
 
@@ -163,8 +163,8 @@ type PostPhylo =  QueryParam "listId" ListId
           --     :> ReqBody '[JSON] PhyloQueryBuild
                :> (Post '[JSON] NodeId)
 
-postPhylo :: PhyloId -> UserId -> GargServer PostPhylo
-postPhylo phyloId _userId _lId = do
+postPhylo :: PhyloId -> GargServer PostPhylo
+postPhylo phyloId _lId = do
   -- TODO get Reader settings
   -- s <- ask
   -- let

src/Gargantext/Core/Viz/Phylo/API/Tools.hs

@@ -30,7 +30,7 @@ import Gargantext.API.Ngrams.Types (NgramsTerm(..))
 import Gargantext.Core (withDefaultLanguage, Lang)
 import Gargantext.Core.NodeStory (HasNodeStory)
 import Gargantext.Core.Text.Terms.WithList (Patterns, buildPatterns, termsInText)
-import Gargantext.Core.Types (Context)
+import Gargantext.Core.Types (Context, nodeId2ContextId)
 import Gargantext.Core.Types.Main (ListType(MapTerm))
 import Gargantext.Core.Viz.Phylo (TimeUnit(..), Date, Document(..), PhyloConfig(..), Phylo)
 import Gargantext.Core.Viz.Phylo.PhyloExport (toPhyloExport, dotToFile)
@@ -143,8 +143,8 @@ context2phyloDocument timeUnit context (ngs_terms, ngs_sources) = do
   let
     toText x = Set.toList $ Set.map unNgramsTerm x
 
-    text'    = maybe [] toText $ Map.lookup contextId ngs_terms
-    sources' = maybe [] toText $ Map.lookup contextId ngs_sources
+    text'    = maybe [] toText $ Map.lookup (nodeId2ContextId contextId) ngs_terms
+    sources' = maybe [] toText $ Map.lookup (nodeId2ContextId contextId) ngs_sources
 
   pure $ Document date date' text' Nothing sources' (Year 3 1 5)
 

src/Gargantext/Database/Action/Flow.hs

@@ -120,6 +120,7 @@ import Gargantext.Prelude.Crypto.Hash (Hash)
 import Gargantext.System.Logging
 import Gargantext.Utils.Jobs (JobHandle, MonadJobStatus(..))
 import PUBMED.Types qualified as PUBMED
+import qualified Data.Bifunctor    as B
 
 ------------------------------------------------------------------------
 -- Imports for upgrade function
@@ -205,7 +206,7 @@ flowDataText :: forall env err m.
 flowDataText u (DataOld ids) tt cid mfslw _ = do
   $(logLocM) DEBUG $ T.pack $ "Found " <> show (length ids) <> " old node IDs"
   (_userId, userCorpusId, listId) <- createNodes u (Right [cid]) corpusType
-  _ <- Doc.add userCorpusId ids
+  _ <- Doc.add userCorpusId (map nodeId2ContextId ids)
   flowCorpusUser (_tt_lang tt) u userCorpusId listId corpusType mfslw
   where
     corpusType = (Nothing :: Maybe HyperdataCorpus)
@@ -336,7 +337,7 @@ addDocumentsToHyperCorpus :: ( DbCmd' env err m
                              -> m [DocId]
 addDocumentsToHyperCorpus ncs mb_hyper la corpusId docs = do
   ids <- insertMasterDocs ncs mb_hyper la docs
-  void $ Doc.add corpusId ids
+  void $ Doc.add corpusId (map nodeId2ContextId ids)
   pure ids
 
 ------------------------------------------------------------------------
@@ -434,14 +435,14 @@ insertMasterDocs ncs c lang hs  =  do
                 <- mapNodeIdNgrams
                 <$> documentIdWithNgrams
                       (extractNgramsT ncs $ withLang lang documentsWithId)
-                      documentsWithId
+                      (map (B.first contextId2NodeId) documentsWithId)
 
   lId      <- getOrMkList masterCorpusId masterUserId
   -- _ <- saveDocNgramsWith lId mapNgramsDocs'
   _ <- saveDocNgramsWith lId mapNgramsDocs'
 
   -- _cooc <- insertDefaultNode NodeListCooc lId masterUserId
-  pure ids'
+  pure $ map contextId2NodeId ids'
 
 saveDocNgramsWith :: (DbCmd' env err m)
                   => ListId
@@ -461,7 +462,7 @@ saveDocNgramsWith lId mapNgramsDocs' = do
 
   --printDebug "saveDocNgramsWith" mapCgramsId
   -- insertDocNgrams
-  let ngrams2insert =  catMaybes [ ContextNodeNgrams2 <$> Just nId
+  let ngrams2insert =  catMaybes [ ContextNodeNgrams2 <$> Just (nodeId2ContextId nId)
                                             <*> (getCgramsId mapCgramsId ngrams_type (_ngramsTerms terms''))
                                             <*> Just (fromIntegral w :: Double)
                        | (terms'', mapNgramsTypes)      <- HashMap.toList mapNgramsDocs
@@ -493,10 +494,10 @@ insertDocs uId cId hs = do
   newIds <- insertDb uId Nothing docs
   -- printDebug "newIds" newIds
   let
-    newIds' = map reId newIds
+    newIds' = map (nodeId2ContextId . reId) newIds
     documentsWithId = mergeData (toInserted newIds) (Map.fromList $ map viewUniqId' docs)
   _ <- Doc.add cId newIds'
-  pure (newIds', documentsWithId)
+  pure (newIds', map (B.first nodeId2ContextId) documentsWithId)
 
 
 ------------------------------------------------------------------------

src/Gargantext/Database/Action/Flow/Pairing.hs

@@ -192,7 +192,8 @@ getNgramsDocId cId lId nt = do
   let ngs = filterListWithRoot [MapTerm, CandidateTerm] $ mapTermListRoot (lId:lIds) nt repo
   -- printDebug "getNgramsDocId" ngs
 
-  groupNodesByNgrams ngs <$> getContextsByNgramsOnlyUser cId (lIds <> [lId]) nt (HashMap.keys ngs)
+  -- FIXME(adinapoli) we should audit this, we are converting from 'ContextId' to 'NodeId'.
+  HM.map (Set.map contextId2NodeId) . groupNodesByNgrams ngs <$> getContextsByNgramsOnlyUser cId (lIds <> [lId]) nt (HashMap.keys ngs)
 
 hashmapReverse :: (Ord a, Eq b, Hashable b)
         => HashMap a (Set b) -> HashMap b (Set a)

src/Gargantext/Database/Action/Flow/Utils.hs

@@ -39,13 +39,14 @@ insertDocNgrams lId m = do
   -- printDebug "[insertDocNgrams] ns" ns
   insertContextNodeNgrams ns
   where
-    ns = [ ContextNodeNgrams docId lId (ng^.index)
-                                   (ngramsTypeId t)
-                                   (fromIntegral i)
-                                   cnt
-         | (ng, t2n2i) <- HashMap.toList m
-         , (t,  n2i)   <- DM.toList t2n2i
-         , (docId,  (i, cnt))     <- DM.toList n2i
+    ns = [ ContextNodeNgrams (nodeId2ContextId docId)
+                             lId (ng^.index)
+                             (ngramsTypeId t)
+                             (fromIntegral i)
+                             cnt
+         | (ng, t2n2i)       <- HashMap.toList m
+         , (t,  n2i)         <- DM.toList t2n2i
+         , (docId, (i, cnt)) <- DM.toList n2i
          ]
 
 -- [(NodeId, {Ngrams: ({NgramsType: Int}, TermsCount)})]

src/Gargantext/Database/Action/Metrics.hs

@@ -32,7 +32,7 @@ import Gargantext.API.Ngrams.Types (TabType(..), ngramsTypeFromTabType, NgramsTe
 import Gargantext.Core (HasDBid(toDBid))
 import Gargantext.Core.NodeStory hiding (runPGSQuery)
 import Gargantext.Core.Text.Metrics (scored, Scored(..), {-localMetrics, toScored-})
-import Gargantext.Core.Types (ListType(..), NodeType(..), ContextId)
+import Gargantext.Core.Types (ListType(..), NodeType(..), ContextId, contextId2NodeId)
 import Gargantext.Core.Types.Query (Limit(..))
 import Gargantext.Database.Action.Metrics.NgramsByContext (getContextsByNgramsOnlyUser{-, getTficfWith-})
 import Gargantext.Database.Admin.Config (userMaster)
@@ -61,7 +61,9 @@ getNgramsCooc cId lId tabType maybeLimit = do
 
   lIds <- selectNodesWithUsername NodeList userMaster
 
+  -- FIXME(adn) Audit this, we are converting from a ContextId to a NodeId
   myCooc <- HM.filter (>1) <$> getCoocByNgrams (Diagonal True)
+                           <$> HM.map (Set.map contextId2NodeId)
                            <$> groupNodesByNgrams ngs
                            <$> getContextsByNgramsOnlyUser cId
                                                            (lIds <> [lId])

src/Gargantext/Database/Action/Metrics/NgramsByContext.hs

@@ -16,9 +16,6 @@ Ngrams by node enable contextual metrics.
 module Gargantext.Database.Action.Metrics.NgramsByContext
   where
 
--- import Debug.Trace (trace)
---import Data.Map.Strict.Patch (PatchMap, Replace, diff)
--- import Control.Monad (void)
 import Data.HashMap.Strict (HashMap)
 import Data.HashMap.Strict qualified as HM
 import Data.List qualified as List
@@ -26,13 +23,14 @@ import Data.Map.Strict qualified as Map
 import Data.Set qualified as Set
 import Database.PostgreSQL.Simple qualified as DPS
 import Database.PostgreSQL.Simple.SqlQQ (sql)
+import Database.PostgreSQL.Simple.ToField qualified as DPS
 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
 import Database.PostgreSQL.Simple.Types qualified as DPST
 import Gargantext.API.Ngrams.Types (NgramsTerm(..))
 import Gargantext.Core
 import Gargantext.Data.HashMap.Strict.Utils as HM
-import Gargantext.Database.Admin.Types.Node (ListId, CorpusId, NodeId(..), ContextId, MasterCorpusId, NodeType(NodeDocument), UserCorpusId, DocId)
-import Gargantext.Database.Prelude (DBCmd, runPGSQuery)  -- , execPGSQuery)
+import Gargantext.Database.Admin.Types.Node (ListId, CorpusId, NodeId(..), ContextId (..), MasterCorpusId, NodeType(NodeDocument), UserCorpusId, DocId)
+import Gargantext.Database.Prelude (DBCmd, runPGSQuery)
 import Gargantext.Database.Schema.Ngrams (ngramsTypeId, NgramsType(..))
 import Gargantext.Prelude
 
@@ -50,7 +48,7 @@ countContextsByNgramsWith f m = (total, m')
 
 
     groupContextsByNgramsWith :: (NgramsTerm -> NgramsTerm)
-                              -> HashMap NgramsTerm (Set NodeId)
+                              -> HashMap NgramsTerm (Set ContextId)
                               -> HashMap NgramsTerm (Set NgramsTerm, Set ContextId)
     groupContextsByNgramsWith f' m'' =
       HM.fromListWith (<>) $ map (\(t,ns) -> (f' t, (Set.singleton t, ns)))
@@ -69,7 +67,7 @@ getContextsByNgramsUser cId nt =
       selectNgramsByContextUser :: HasDBid NodeType
                                 => CorpusId
                                 -> NgramsType
-                                -> DBCmd err [(NodeId, Text)]
+                                -> DBCmd err [(ContextId, Text)]
       selectNgramsByContextUser cId' nt' =
         runPGSQuery queryNgramsByContextUser
                     ( cId'
@@ -110,7 +108,7 @@ getOccByNgramsOnlyFast :: CorpusId
                        -> DBCmd err (HashMap NgramsTerm [ContextId])
 getOccByNgramsOnlyFast cId lId nt = do
     --HM.fromList <$> map (\(t,n) -> (NgramsTerm t, round n)) <$> run cId lId nt
-    HM.fromList <$> map (\(t, ns) -> (NgramsTerm t, NodeId <$> DPST.fromPGArray ns)) <$> run cId lId nt
+    HM.fromList <$> map (\(t, ns) -> (NgramsTerm t, UnsafeMkContextId <$> DPST.fromPGArray ns)) <$> run cId lId nt
     where
 
       run :: CorpusId
@@ -249,7 +247,7 @@ getContextsByNgramsOnlyUser :: HasDBid NodeType
                             -> [ListId]
                             -> NgramsType
                             -> [NgramsTerm]
-                            -> DBCmd err (HashMap NgramsTerm (Set NodeId))
+                            -> DBCmd err (HashMap NgramsTerm (Set ContextId))
 getContextsByNgramsOnlyUser cId ls nt ngs =
      HM.unionsWith        (<>)
    . map (HM.fromListWith (<>)
@@ -262,7 +260,7 @@ getNgramsByContextOnlyUser :: HasDBid NodeType
                            -> [ListId]
                            -> NgramsType
                            -> [NgramsTerm]
-                           -> DBCmd err (Map NodeId (Set NgramsTerm))
+                           -> DBCmd err (Map ContextId (Set NgramsTerm))
 getNgramsByContextOnlyUser cId ls nt ngs =
      Map.unionsWith         (<>)
    . map ( Map.fromListWith (<>)
@@ -284,7 +282,7 @@ selectNgramsOnlyByContextUser cId ls nt tms =
   runPGSQuery queryNgramsOnlyByContextUser
                 ( Values fields ((DPS.Only . unNgramsTerm) <$> tms)
                 , Values [QualifiedIdentifier Nothing "int4"]
-                         (DPS.Only <$> (map (\(NodeId n) -> n) ls))
+                         (DPS.Only <$> map DPS.toField ls)
                 , cId
                 , toDBid NodeDocument
                 , ngramsTypeId nt
@@ -330,7 +328,7 @@ selectNgramsOnlyByDocUser dId ls nt tms =
   runPGSQuery queryNgramsOnlyByDocUser
                 ( Values fields ((DPS.Only . unNgramsTerm) <$> tms)
                 , Values [QualifiedIdentifier Nothing "int4"]
-                         (DPS.Only <$> (map (\(NodeId n) -> n) ls))
+                         (DPS.Only <$> (map DPS.toField ls))
                 , dId
                 , ngramsTypeId nt
                 )

src/Gargantext/Database/Action/Share.hs

@@ -10,7 +10,8 @@ Portability : POSIX
 -}
 
 
-{-# LANGUAGE Arrows                 #-}
+{-# LANGUAGE Arrows       #-}
+{-# LANGUAGE ViewPatterns #-}
 
 module Gargantext.Database.Action.Share
   where
@@ -67,7 +68,7 @@ membersOf nId = do
 
 membersOfQuery :: TeamNodeId
                -> SelectArr () (MaybeFields (Field SqlText), MaybeFields (Field SqlInt4))
-membersOfQuery (NodeId teamId) = proc () -> do
+membersOfQuery (_NodeId -> teamId) = proc () -> do
   (nn, n, u) <- nodeNode_node_User -< ()
   restrict -< (nn ^. nn_node2_id) .== sqlInt4 teamId
   returnA -< ( user_username <$> u

src/Gargantext/Database/Admin/Types/Node.hs

@@ -12,6 +12,8 @@ Portability : POSIX
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 {-# LANGUAGE BangPatterns               #-}
+{-# LANGUAGE DerivingStrategies         #-}
+{-# LANGUAGE DerivingVia                #-}
 {-# LANGUAGE TemplateHaskell            #-}
 
 -- {-# LANGUAGE DuplicateRecordFields #-}
@@ -46,9 +48,26 @@ import Test.QuickCheck.Instances.Text ()
 import Test.QuickCheck.Instances.Time ()
 import Text.Read (read)
 
+-- | A class generalising over resource identifiers in gargantext
+class ResourceId a where
+  isPositive :: a -> Bool
 
+-- | A unique identifier for users within gargantext. Note that the 'UserId' for users is
+-- typically /different/ from their 'NodeId', as the latter tracks the resources being created,
+-- whereas this one tracks only users.
+newtype UserId = UnsafeMkUserId { _UserId :: Int }
+  deriving stock (Show, Eq, Ord, Generic)
+  deriving newtype (ToSchema, ToJSON, FromJSON, FromField, ToField)
+
+instance GQLType UserId
+
+instance ResourceId UserId where
+  isPositive = (> 0) . _UserId
+
+instance DefaultFromField SqlInt4 UserId
+  where
+    defaultFromField = fromPGSFromField
 
-type UserId = Int
 type MasterUserId = UserId
 
 type NodeTypeId   = Int
@@ -199,38 +218,56 @@ instance (Arbitrary hyperdata
 
 ------------------------------------------------------------------------
 pgNodeId :: NodeId -> O.Column O.SqlInt4
-pgNodeId = O.sqlInt4 . id2int
-  where
-    id2int :: NodeId -> Int
-    id2int (NodeId n) = n
+pgNodeId = pgResourceId _NodeId
+
+pgResourceId :: (a -> Int) -> a -> O.Column O.SqlInt4
+pgResourceId id2int = O.sqlInt4 . id2int
 
 pgContextId :: ContextId -> O.Column O.SqlInt4
-pgContextId = pgNodeId
+pgContextId = pgResourceId _ContextId
 
 ------------------------------------------------------------------------
-newtype NodeId = NodeId { _NodeId :: Int }
+-- | A unique identifier for a /node/ in the gargantext tree. Every time
+-- we create something in Gargantext (a user, a corpus, etc) we add a node
+-- to a tree, and each node has its unique identifier. Note how nodes might
+-- have also /other/ identifiers, to better qualify them.
+newtype NodeId = UnsafeMkNodeId { _NodeId :: Int }
   deriving (Read, Generic, Num, Eq, Ord, Enum, ToJSONKey, FromJSONKey, ToJSON, FromJSON, Hashable, Csv.ToField)
+
+instance ResourceId NodeId where
+  isPositive = (> 0) . _NodeId
+
 instance GQLType NodeId
 instance Prelude.Show NodeId where
-  show (NodeId n) = "nodeId-" <> show n
+  show (UnsafeMkNodeId n) = "nodeId-" <> show n
 instance Serialise NodeId
 instance ToField NodeId where
-  toField (NodeId n) = toField n
+  toField (UnsafeMkNodeId n) = toField n
 instance ToRow NodeId where
-  toRow (NodeId i) = [toField i]
+  toRow (UnsafeMkNodeId i) = [toField i]
 
 instance FromField NodeId where
   fromField field mdata = do
-    n <- fromField field mdata
-    if (n :: Int) > 0
-       then pure $ NodeId n
+    n <- UnsafeMkNodeId <$> fromField field mdata
+    if isPositive n
+       then pure n
        else mzero
 instance ToSchema NodeId
 
--- TODO make another type
-type ContextId = NodeId
+-- | An identifier for a 'Context' in gargantext.
+newtype ContextId = UnsafeMkContextId { _ContextId :: Int }
+  deriving stock   (Show, Eq, Ord, Generic)
+  deriving newtype (Csv.ToField, ToJSONKey, FromJSONKey, ToJSON, FromJSON, ToField, ToSchema)
+  deriving FromField via NodeId
+
+instance ToParamSchema ContextId
 
-newtype NodeContextId = NodeContextId Int
+instance FromHttpApiData ContextId where
+  parseUrlPiece n = pure $ UnsafeMkContextId $ (read . cs) n
+instance ToHttpApiData ContextId where
+  toUrlPiece (UnsafeMkContextId n) = toUrlPiece n
+
+newtype NodeContextId = UnsafeMkNodeContextId { _NodeContextId :: Int }
   deriving (Read, Generic, Num, Eq, Ord, Enum, ToJSONKey, FromJSONKey, ToJSON, FromJSON, Hashable, Csv.ToField)
 
 
@@ -238,17 +275,27 @@ newtype NodeContextId = NodeContextId Int
 --  toField (NodeId nodeId) = Csv.toField nodeId
 
 unNodeId :: NodeId -> Int
-unNodeId (NodeId n) = n
+unNodeId = _NodeId
+
+-- | Converts a 'NodeId' into a 'ContextId'.
+-- FIXME(adn) We should audit the usage of this function,
+-- to make sure that a ContextId and a NodeId are /really/
+-- conceptually the same thing.
+nodeId2ContextId :: NodeId -> ContextId
+nodeId2ContextId = UnsafeMkContextId . _NodeId
+
+contextId2NodeId :: ContextId -> NodeId
+contextId2NodeId = UnsafeMkNodeId . _ContextId
 
 ------------------------------------------------------------------------
 ------------------------------------------------------------------------
 instance FromHttpApiData NodeId where
-  parseUrlPiece n = pure $ NodeId $ (read . cs) n
+  parseUrlPiece n = pure $ UnsafeMkNodeId $ (read . cs) n
 instance ToHttpApiData NodeId where
-  toUrlPiece (NodeId n) = toUrlPiece n
+  toUrlPiece (UnsafeMkNodeId n) = toUrlPiece n
 instance ToParamSchema NodeId
 instance Arbitrary NodeId where
-  arbitrary = NodeId <$> arbitrary
+  arbitrary = UnsafeMkNodeId <$> arbitrary
 
 type ParentId    = NodeId
 type CorpusId    = NodeId

src/Gargantext/Database/Query/Table/Context.hs

@@ -36,10 +36,10 @@ import Prelude            hiding (null, id, map, sum)
 
 getContextWith :: (HasNodeError err, JSONB a)
             => ContextId -> proxy a -> DBCmd err (Node a)
-getContextWith nId _ = do
-  maybeContext <- headMay <$> runOpaQuery (selectContext (pgNodeId nId))
+getContextWith cId _ = do
+  maybeContext <- headMay <$> runOpaQuery (selectContext (pgContextId cId))
   case maybeContext of
-    Nothing -> nodeError (DoesNotExist nId)
+    Nothing -> nodeError (NoContextFound cId)
     Just  r -> pure $ context2node r
 
 queryContextSearchTable :: Select ContextSearchRead
@@ -117,7 +117,7 @@ getContextsIdWithType :: (HasNodeError err, HasDBid NodeType)
                       => NodeType -> DBCmd err [ContextId]
 getContextsIdWithType nt = do
   ns <- runOpaQuery $ selectContextsIdWithType nt
-  pure (map NodeId ns)
+  pure (map UnsafeMkContextId ns)
 
 selectContextsIdWithType :: HasDBid NodeType
                       => NodeType -> Select (Column SqlInt4)

src/Gargantext/Database/Query/Table/ContextNodeNgrams2.hs

@@ -24,7 +24,7 @@ module Gargantext.Database.Query.Table.ContextNodeNgrams2
 
 import Gargantext.Database.Schema.Prelude
 import Gargantext.Database.Schema.ContextNodeNgrams2
-import Gargantext.Database.Admin.Types.Node (pgNodeId)
+import Gargantext.Database.Admin.Types.Node (pgContextId)
 import Gargantext.Database.Prelude (mkCmd, DBCmd)
 import Prelude
 
@@ -36,7 +36,7 @@ queryContextNodeNgrams2Table = selectTable contextNodeNgrams2Table
 insertContextNodeNgrams2 :: [ContextNodeNgrams2] -> DBCmd err Int
 insertContextNodeNgrams2 = insertContextNodeNgrams2W
                      . map (\(ContextNodeNgrams2 n1 n2 w) ->
-                              ContextNodeNgrams2 (pgNodeId n1)
+                              ContextNodeNgrams2 (pgContextId n1)
                                                  (sqlInt4  n2)
                                                  (sqlDouble w)
                            )

src/Gargantext/Database/Query/Table/Node.hs

@@ -13,9 +13,10 @@ Portability : POSIX
 {-# LANGUAGE Arrows                 #-}
 {-# LANGUAGE ConstraintKinds        #-}
 {-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE QuasiQuotes       #-}
+{-# LANGUAGE QuasiQuotes            #-}
 {-# LANGUAGE TemplateHaskell        #-}
 {-# LANGUAGE TypeFamilies           #-}
+{-# LANGUAGE ViewPatterns           #-}
 
 module Gargantext.Database.Query.Table.Node
   where
@@ -123,11 +124,11 @@ getClosestParentIdByType :: HasDBid NodeType
 getClosestParentIdByType nId nType = do
   result <- runPGSQuery query (PGS.Only nId)
   case result of
-    [(NodeId parentId, pTypename)] -> do
+    [(_NodeId -> parentId, pTypename)] -> do
       if toDBid nType == pTypename then
-        pure $ Just $ NodeId parentId
+        pure $ Just $ UnsafeMkNodeId parentId
       else
-        getClosestParentIdByType (NodeId parentId) nType
+        getClosestParentIdByType (UnsafeMkNodeId parentId) nType
     _ -> pure Nothing
   where
     query :: PGS.Query
@@ -147,9 +148,9 @@ getClosestParentIdByType' :: HasDBid NodeType
 getClosestParentIdByType' nId nType = do
   result <- runPGSQuery query (PGS.Only nId)
   case result of
-    [(NodeId id, pTypename)] -> do
+    [(_NodeId -> id, pTypename)] -> do
       if toDBid nType == pTypename then
-        pure $ Just $ NodeId id
+        pure $ Just $ UnsafeMkNodeId id
       else
         getClosestParentIdByType nId nType
     _ -> pure Nothing
@@ -223,7 +224,7 @@ getNodeWithType nId nt _ = runOpaQuery $ selectNodeWithType nId nt
   where
     selectNodeWithType ::  HasDBid NodeType
                         => NodeId -> NodeType -> Select NodeRead
-    selectNodeWithType (NodeId nId') nt' = proc () -> do
+    selectNodeWithType (_NodeId -> nId') nt' = proc () -> do
         row@(Node ti _ tn _ _ _ _ _) <- queryNodeTable -< ()
         restrict -< ti .== sqlInt4 nId'
         restrict -< tn .== sqlInt4 (toDBid nt')
@@ -232,7 +233,7 @@ getNodeWithType nId nt _ = runOpaQuery $ selectNodeWithType nId nt
 getNodesIdWithType :: (HasNodeError err, HasDBid NodeType) => NodeType -> DBCmd err [NodeId]
 getNodesIdWithType nt = do
   ns <- runOpaQuery $ selectNodesIdWithType nt
-  pure (map NodeId ns)
+  pure (map UnsafeMkNodeId ns)
 
 selectNodesIdWithType :: HasDBid NodeType
                       => NodeType -> Select (Column SqlInt4)
@@ -299,7 +300,7 @@ node :: (ToJSON a, Hyperdata a, HasDBid NodeType)
 node nodeType name hyperData parentId userId =
   Node Nothing Nothing
        (sqlInt4 typeId)
-       (sqlInt4 userId)
+       (sqlInt4 $ _UserId userId)
        (pgNodeId <$> parentId)
        (sqlStrictText name)
        Nothing
@@ -344,7 +345,7 @@ insertNodesWithParentR pid ns = insertNodesR (set node_parent_id (pgNodeId <$> p
 
 node2table :: HasDBid NodeType
            => UserId -> Maybe ParentId -> Node' -> NodeWrite
-node2table uid pid (Node' nt txt v []) = Node Nothing Nothing (sqlInt4 $ toDBid nt) (sqlInt4 uid) (fmap pgNodeId pid) (sqlStrictText txt) Nothing (sqlStrictJSONB $ cs $ encode v)
+node2table uid pid (Node' nt txt v []) = Node Nothing Nothing (sqlInt4 $ toDBid nt) (sqlInt4 $ _UserId uid) (fmap pgNodeId pid) (sqlStrictText txt) Nothing (sqlStrictJSONB $ cs $ encode v)
 node2table _ _ (Node' _ _ _ _) = panic "node2table: should not happen, Tree insert not implemented yet"
 
 

src/Gargantext/Database/Query/Table/Node/Error.hs

@@ -14,7 +14,10 @@ import Control.Lens (Prism', (#), (^?))
 import Data.Aeson
 import Data.Text qualified as T
 import Gargantext.Core.Types.Individu
-import Gargantext.Database.Admin.Types.Node (ListId, NodeId(..))
+
+import Prelude hiding (null, id, map, sum, show)
+
+import Gargantext.Database.Admin.Types.Node (ListId, NodeId(..), ContextId)
 import Gargantext.Prelude hiding (sum, head)
 import Prelude qualified
 
@@ -31,6 +34,7 @@ data NodeError = NoListFound { listId :: ListId }
                | NotImplYet
                | ManyNodeUsers
                | DoesNotExist NodeId
+               | NoContextFound ContextId
                | NeedsConfiguration
                | NodeError Text
                | QueryNoParse Text
@@ -50,14 +54,15 @@ instance Prelude.Show NodeError
     show ManyParents   = "Too many parents"
     show ManyNodeUsers = "Many userNode/user"
     show (DoesNotExist n)   = "Node does not exist (" <> show n <> ")"
+    show (NoContextFound n) = "Context node does not exist (" <> show n <> ")"
     show NeedsConfiguration = "Needs configuration"
     show (NodeError e)      = "NodeError: " <> cs e
     show (QueryNoParse err) = "QueryNoParse: " <> T.unpack err
 
 instance ToJSON NodeError where
-  toJSON (NoListFound { listId = NodeId listId }) =
+  toJSON (NoListFound { listId }) =
     object [ ( "error", "No list found" )
-           , ( "listId", Number $ fromIntegral listId ) ]
+           , ( "listId", toJSON listId ) ]
   toJSON err =
     object [ ( "error", String $ T.pack $ show err ) ]
 

src/Gargantext/Database/Query/Table/NodeContext.hs

@@ -53,8 +53,8 @@ import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
 import Gargantext.Core
 import Gargantext.Core.Types
 import Gargantext.Database.Admin.Types.Hyperdata
-import Gargantext.Database.Prelude (DBCmd, execPGSQuery, mkCmd, restrictMaybe, runCountOpaQuery, runPGSQuery, runOpaQuery)
-import Gargantext.Database.Query.Table.Node.Error (HasNodeError, NodeError(DoesNotExist), nodeError)
+import Gargantext.Database.Query.Table.Node.Error (HasNodeError, NodeError(..), nodeError)
+import Gargantext.Database.Prelude
 import Gargantext.Database.Schema.Context
 import Gargantext.Database.Schema.Node
 import Gargantext.Database.Schema.NodeContext
@@ -84,9 +84,9 @@ getNodeContexts n = runOpaQuery (selectNodeContexts $ pgNodeId n)
 
 getNodeContext :: HasNodeError err => ContextId -> NodeId -> DBCmd err NodeContext
 getNodeContext c n = do
-  maybeNodeContext <- headMay <$> runOpaQuery (selectNodeContext (pgNodeId c) (pgNodeId n))
+  maybeNodeContext <- headMay <$> runOpaQuery (selectNodeContext (pgContextId c) (pgNodeId n))
   case maybeNodeContext of
-    Nothing -> nodeError (DoesNotExist c)
+    Nothing -> nodeError (NoContextFound c)
     Just  r -> pure r
   where
     selectNodeContext :: Field SqlInt4 -> Field SqlInt4 -> Select NodeContextRead
@@ -222,7 +222,7 @@ getContextNgrams contextId listId = do
 -- more permissive (i.e. ignores word ordering). See
 -- https://www.peterullrich.com/complete-guide-to-full-text-search-with-postgres-and-ecto
 getContextNgramsMatchingFTS :: HasNodeError err
-                            => NodeId
+                            => ContextId
                             -> NodeId
                             -> DBCmd err [Text]
 getContextNgramsMatchingFTS contextId listId = do

src/Gargantext/Database/Query/Table/NodeNgrams.hs

@@ -78,7 +78,7 @@ insertNodeNgrams nns = runPGSQuery query (PGS.Only $ Values fields nns')
                                                       ,"int4","int4","int4","int4"
                                                       ,"float8"]
     -- nns' :: [(Int, ListTypeId, NgramsText, NgramsTypeId ,NgramsField, NgramsTag, NgramsClass, Double)]
-    nns' = map (\(NodeNgrams _id (NodeId node_id'') node_subtype ngrams_terms ngrams_type ngrams_field ngrams_tag ngrams_class weight)
+    nns' = map (\(NodeNgrams _id node_id'' node_subtype ngrams_terms ngrams_type ngrams_field ngrams_tag ngrams_class weight)
                               -> [ toField node_id''
                                  , toField $ toDBid node_subtype
                                  , toField $ ngrams_terms

src/Gargantext/Database/Query/Table/User.hs

@@ -57,8 +57,9 @@ import Gargantext.Core.Types.Individu
 import Gargantext.Database.Admin.Config (nodeTypeId)
 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataUser(..), hu_pubmed_api_key)
 import Gargantext.Database.Admin.Types.Node (NodeType(NodeUser), Node, NodeId(..), pgNodeId)
-import Gargantext.Database.Prelude (DBCmd, mkCmd, runOpaQuery)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
+import Gargantext.Database.Admin.Types.Node (UserId(..))
+import Gargantext.Database.Prelude
 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateNodeWithType)
 import Gargantext.Database.Schema.Node (NodeRead, node_hyperdata, queryNodeTable, node_id, node_user_id, node_typename)
 import Gargantext.Database.Schema.User
@@ -146,7 +147,7 @@ selectUsersLightWithForgotPasswordUUID uuid = proc () -> do
 
 ----------------------------------------------------------
 getUsersWithId :: User -> DBCmd err [UserLight]
-getUsersWithId (UserDBId i) = map toUserLight <$> runOpaQuery (selectUsersLightWithId i)
+getUsersWithId (UserDBId i) = map toUserLight <$> runOpaQuery (selectUsersLightWithId $ _UserId i)
   where
     selectUsersLightWithId :: Int -> Select UserRead
     selectUsersLightWithId i' = proc () -> do
@@ -181,7 +182,7 @@ getUserHyperdata (RootId uId) = do
       restrict -< row^.node_id .== pgNodeId i'
       returnA  -< row^.node_hyperdata
 getUserHyperdata (UserDBId uId) = do
-  runOpaQuery (selectUserHyperdataWithId uId)
+  runOpaQuery (selectUserHyperdataWithId $ _UserId uId)
   where
     selectUserHyperdataWithId :: Int -> Select (Field SqlJsonb)
     selectUserHyperdataWithId i' = proc () -> do
@@ -203,7 +204,7 @@ getUserNodeHyperdata (RootId uId) = do
       restrict -< row^.node_id .== pgNodeId i'
       returnA  -< row
 getUserNodeHyperdata (UserDBId uId) = do
-  runOpaQuery (selectUserHyperdataWithId uId)
+  runOpaQuery (selectUserHyperdataWithId $ _UserId uId)
   where
     selectUserHyperdataWithId :: Int -> Select NodeRead
     selectUserHyperdataWithId i' = proc () -> do
@@ -235,7 +236,7 @@ updateUserEmail (UserLight { .. }) = mkCmd $ \c -> runUpdate_ c updateUserQuery
     updateUserQuery = Update
       { uTable      = userTable
       , uUpdateWith = updateEasy (\ (UserDB { .. }) -> UserDB { user_email = sqlStrictText userLight_email, .. } )
-      , uWhere      = (\row -> user_id row .== (sqlInt4 userLight_id))
+      , uWhere      = (\row -> user_id row .== (sqlInt4 $ _UserId userLight_id))
       , uReturning  = rCount }
 
 updateUserPassword :: UserLight -> DBCmd err Int64
@@ -245,7 +246,7 @@ updateUserPassword (UserLight { userLight_password = GargPassword password, .. }
     updateUserQuery = Update
       { uTable      = userTable
       , uUpdateWith = updateEasy (\(UserDB { .. }) -> UserDB { user_password = sqlStrictText password, .. } )
-      , uWhere      = \row -> user_id row .== sqlInt4 userLight_id
+      , uWhere      = \row -> user_id row .== (sqlInt4 $ _UserId userLight_id)
       , uReturning  = rCount }
 
 updateUserForgotPasswordUUID :: UserLight -> DBCmd err Int64
@@ -256,7 +257,7 @@ updateUserForgotPasswordUUID (UserLight { .. }) = mkCmd $ \c -> runUpdate_ c upd
     updateUserQuery = Update
       { uTable      = userTable
       , uUpdateWith = updateEasy (\(UserDB { .. }) -> UserDB { user_forgot_password_uuid = pass', .. })
-      , uWhere      = \row -> user_id row .== sqlInt4 userLight_id
+      , uWhere      = \row -> user_id row .== (sqlInt4 $ _UserId userLight_id)
       , uReturning  = rCount }
 
 getUserPubmedAPIKey :: User -> DBCmd err (Maybe PUBMED.APIKey)
@@ -282,13 +283,13 @@ userWith f t xs = find (\x -> f x == t) xs
 userWithUsername :: Text -> [UserDB] -> Maybe UserDB
 userWithUsername t xs = userWith user_username t xs
 
-userWithId :: Int -> [UserDB] -> Maybe UserDB
+userWithId :: UserId -> [UserDB] -> Maybe UserDB
 userWithId t xs = userWith user_id t xs
 
 userLightWithUsername :: Text -> [UserLight] -> Maybe UserLight
 userLightWithUsername t xs = userWith userLight_username t xs
 
-userLightWithId :: Int -> [UserLight] -> Maybe UserLight
+userLightWithId :: UserId -> [UserLight] -> Maybe UserLight
 userLightWithId t xs = userWith userLight_id t xs
 ----------------------------------------------------------------------
 users :: DBCmd err [UserDB]

src/Gargantext/Database/Query/Tree/Root.hs

@@ -101,7 +101,7 @@ mkRoot user = do
   -- TODO ? Which name for user Node ?
   una <- getUsername user
 
-  case uid > 0 of
+  case isPositive uid of
      False -> nodeError NegativeId
      True  -> do
        rs <- mkNodeWithParent NodeUser Nothing uid una
@@ -126,7 +126,7 @@ selectRoot (UserName username) = proc () -> do
 selectRoot (UserDBId uid) = proc () -> do
     row   <- queryNodeTable -< ()
     restrict -< _node_typename row   .== (sqlInt4 $ toDBid NodeUser)
-    restrict -< _node_user_id   row   .== (sqlInt4 uid)
+    restrict -< _node_user_id   row   .== (sqlInt4 $ _UserId uid)
     returnA  -< row
 
 selectRoot (RootId nid) =

src/Gargantext/Database/Schema/User.hs

@@ -39,8 +39,9 @@ import Control.Lens.TH (makeLensesWith, abbreviatedFields)
 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
 import Opaleye hiding (FromField)
 import Opaleye.Internal.Table (Table(..))
+import Gargantext.Core.Types
 ------------------------------------------------------------------------
-data UserLight = UserLight { userLight_id                   :: !Int
+data UserLight = UserLight { userLight_id                   :: !UserId
                            , userLight_username             :: !Text
                            , userLight_email                :: !Text
                            , userLight_password             :: !GargPassword
@@ -98,7 +99,7 @@ type UserRead  = UserPoly        (Column SqlInt4)         (Column SqlText)
                                  (Column SqlTimestamptz)
                                  (Column SqlText)
 
-type UserDB = UserPoly Int Text (Maybe UTCTime) Bool Text Text Text Text Bool Bool UTCTime (Maybe Text)
+type UserDB = UserPoly UserId Text (Maybe UTCTime) Bool Text Text Text Text Bool Bool UTCTime (Maybe Text)
 
 $(makeAdaptorAndInstance "pUserDB"   ''UserPoly)
 $(makeLensesWith abbreviatedFields   ''UserPoly)

src/Gargantext/Database/Types.hs

@@ -30,6 +30,10 @@ data Indexed i a =
 
 makeLenses ''Indexed
 
+instance Bifunctor Indexed where
+  first  f (Indexed i a) = Indexed (f i) a
+  second g (Indexed i a) = Indexed i (g a)
+
 ----------------------------------------------------------------------
 -- | Main instances
 instance (FromField i, FromField a) => PGS.FromRow (Indexed i a) where

test/Test/API/Authentication.hs

@@ -64,8 +64,8 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
                          _authRes_valid = Just $
                            AuthValid {
                              _authVal_token = cannedToken
-                           , _authVal_tree_id = fromMaybe (NodeId 1) $ listToMaybe $ result0 ^.. _Right . authRes_valid . _Just . authVal_tree_id
-                           , _authVal_user_id = fromMaybe 1          $ listToMaybe $ result0 ^.. _Right . authRes_valid . _Just . authVal_user_id
+                           , _authVal_tree_id = fromMaybe (UnsafeMkNodeId 1) $ listToMaybe $ result0 ^.. _Right . authRes_valid . _Just . authVal_tree_id
+                           , _authVal_user_id = fromMaybe (UnsafeMkUserId 1) $ listToMaybe $ result0 ^.. _Right . authRes_valid . _Just . authVal_user_id
                            }
                          , _authRes_inval = Nothing
                          }

test/Test/Database/Operations.hs

@@ -83,14 +83,14 @@ writeRead01 env = do
     uid1 <- new_user nur1
     uid2 <- new_user nur2
 
-    liftBase $ uid1 `shouldBe` 2
-    liftBase $ uid2 `shouldBe` 3
+    liftBase $ uid1 `shouldBe` UnsafeMkUserId 2
+    liftBase $ uid2 `shouldBe` UnsafeMkUserId 3
 
     -- Getting the users by username returns the expected IDs
     uid1' <- getUserId (UserName "alfredo")
     uid2' <- getUserId (UserName "paul")
-    liftBase $ uid1' `shouldBe` 2
-    liftBase $ uid2' `shouldBe` 3
+    liftBase $ uid1' `shouldBe` UnsafeMkUserId 2
+    liftBase $ uid2' `shouldBe` UnsafeMkUserId 3
 
 mkUserDup :: TestEnv -> Assertion
 mkUserDup env = do
@@ -127,7 +127,7 @@ corpusReadWrite01 env = do
     uid      <- getUserId (UserName "alfredo")
     parentId <- getRootId (UserName "alfredo")
     [corpusId] <- mk (Just "Test_Corpus") (Nothing :: Maybe HyperdataCorpus) parentId uid
-    liftIO $ corpusId `shouldBe` NodeId 416
+    liftIO $ corpusId `shouldBe` UnsafeMkNodeId 416
     -- Retrieve the corpus by Id
     [corpus] <- getCorporaWithParentId parentId
     liftIO $ corpusId `shouldBe` (_node_id corpus)

test/Test/Ngrams/Query/PaginationCorpus.hs

@@ -22,7 +22,7 @@ implementationElem = NgramsElement {
     _ne_ngrams = "implementation"
   , _ne_size = 1
   , _ne_list = MapTerm
-  , _ne_occurrences = Set.fromList [ NodeId 1, NodeId 2, NodeId 3, NodeId 4, NodeId 5 ]
+  , _ne_occurrences = Set.fromList $ map UnsafeMkContextId [ 1, 2, 3, 4, 5 ]
   , _ne_root = Nothing
   , _ne_parent = Nothing
   , _ne_children = mSetFromList [ "code", "functions", "language", "programs" ]
@@ -33,7 +33,7 @@ languagesElem = NgramsElement {
     _ne_ngrams = NgramsTerm {unNgramsTerm = "languages"}
   , _ne_size = 1
   , _ne_list = MapTerm
-  , _ne_occurrences = Set.fromList [ NodeId 1, NodeId 2 , NodeId 3 , NodeId 4 ]
+  , _ne_occurrences = Set.fromList $ map UnsafeMkContextId [ 1, 2 , 3 , 4 ]
   , _ne_root = Nothing
   , _ne_parent = Nothing
   , _ne_children = mSetFromList [ "approach", "use" ]
@@ -44,7 +44,7 @@ termsElem = NgramsElement {
     _ne_ngrams = NgramsTerm {unNgramsTerm = "terms"}
   , _ne_size = 1
   , _ne_list = MapTerm
-  , _ne_occurrences = Set.fromList [ NodeId 1, NodeId 2 , NodeId 3 ]
+  , _ne_occurrences = Set.fromList $ map UnsafeMkContextId [ 1, 2 , 3 ]
   , _ne_root = Nothing
   , _ne_parent = Nothing
   , _ne_children = mSetFromList [ "algorithm", "evaluation", "monad", "programmers" ]
@@ -55,7 +55,7 @@ proofElem = NgramsElement {
     _ne_ngrams = NgramsTerm {unNgramsTerm = "proof"}
   , _ne_size = 1
   , _ne_list = MapTerm
-  , _ne_occurrences = Set.fromList [ NodeId 1, NodeId 2 ]
+  , _ne_occurrences = Set.fromList $ map UnsafeMkContextId [ 1, 2 ]
   , _ne_root = Nothing
   , _ne_parent = Nothing
   , _ne_children = mSetFromList [ "proofs" ]
@@ -66,7 +66,7 @@ sideEffectsElem = NgramsElement {
     _ne_ngrams = NgramsTerm {unNgramsTerm = "side effects"}
   , _ne_size = 1
   , _ne_list = StopTerm
-  , _ne_occurrences = Set.fromList [ NodeId 1, NodeId 2, NodeId 3, NodeId 4, NodeId 5, NodeId 6 ]
+  , _ne_occurrences = Set.fromList $ map UnsafeMkContextId [ 1, 2, 3, 4, 5, 6 ]
   , _ne_root = Nothing
   , _ne_parent = Nothing
   , _ne_children = mSetFromList [ ]
@@ -77,7 +77,7 @@ ooElem = NgramsElement {
     _ne_ngrams = NgramsTerm {unNgramsTerm = "object oriented"}
   , _ne_size = 1
   , _ne_list = StopTerm
-  , _ne_occurrences = Set.fromList [ NodeId 1, NodeId 2, NodeId 3, NodeId 4, NodeId 5 ]
+  , _ne_occurrences = Set.fromList $ map UnsafeMkContextId [ 1, 2, 3, 4, 5 ]
   , _ne_root = Nothing
   , _ne_parent = Nothing
   , _ne_children = mSetFromList [ "null pointer exception" ]
@@ -88,7 +88,7 @@ javaElem = NgramsElement {
     _ne_ngrams = NgramsTerm {unNgramsTerm = "java"}
   , _ne_size = 1
   , _ne_list = StopTerm
-  , _ne_occurrences = Set.fromList [ NodeId 1, NodeId 2, NodeId 3 ]
+  , _ne_occurrences = Set.fromList $ map UnsafeMkContextId [ 1, 2, 3 ]
   , _ne_root = Nothing
   , _ne_parent = Nothing
   , _ne_children = mSetFromList [ "JVM" ]
@@ -99,7 +99,7 @@ pascalElem = NgramsElement {
     _ne_ngrams = NgramsTerm {unNgramsTerm = "pascal"}
   , _ne_size = 1
   , _ne_list = StopTerm
-  , _ne_occurrences = Set.fromList [ NodeId 1, NodeId 2 ]
+  , _ne_occurrences = Set.fromList $ map UnsafeMkContextId [ 1, 2 ]
   , _ne_root = Nothing
   , _ne_parent = Nothing
   , _ne_children = mSetFromList [ "turbo", "borland" ]
@@ -110,7 +110,7 @@ haskellElem = NgramsElement {
     _ne_ngrams = NgramsTerm {unNgramsTerm = "haskell"}
   , _ne_size = 1
   , _ne_list = CandidateTerm
-  , _ne_occurrences = Set.fromList [ NodeId 1, NodeId 2, NodeId 3, NodeId 4, NodeId 5, NodeId 6, NodeId 7, NodeId 8 ]
+  , _ne_occurrences = Set.fromList $ map UnsafeMkContextId [ 1, 2, 3, 4, 5, 6, 7, 8 ]
   , _ne_root = Nothing
   , _ne_parent = Nothing
   , _ne_children = mSetFromList [ ]
@@ -121,7 +121,7 @@ concHaskellElem = NgramsElement {
     _ne_ngrams = NgramsTerm {unNgramsTerm = "concurrent haskell"}
   , _ne_size = 1
   , _ne_list = CandidateTerm
-  , _ne_occurrences = Set.fromList [ NodeId 1, NodeId 2, NodeId 3, NodeId 4, NodeId 5 ]
+  , _ne_occurrences = Set.fromList $ map UnsafeMkContextId [ 1, 2, 3, 4, 5 ]
   , _ne_root = Nothing
   , _ne_parent = Nothing
   , _ne_children = mSetFromList [ "Simon Marlow" ]

test/drivers/hspec/Main.hs

@@ -3,7 +3,6 @@ module Main where
 
 import Gargantext.Prelude
 
-import Control.Exception
 import Shelly hiding (FilePath)
 import System.IO
 import System.Process