Code review, part II

This commit splits the /export (renaming it to just remote) and tuck it
under the /node hierarchy. The import also lives tucked in the /node.

src/Gargantext/API/Node.hs

@@ -28,15 +28,15 @@ Node API
 module Gargantext.API.Node
   where
 
-import Gargantext.API.Admin.Auth (withNamedAccess, withNamedPolicyT, withPolicy, withPolicy)
 import Gargantext.API.Admin.Auth.Types (PathId(..), AuthenticatedUser (..), auth_node_id, auth_user_id)
+import Gargantext.API.Admin.Auth (withNamedAccess, withNamedPolicyT, withPolicy, withPolicy)
 import Gargantext.API.Admin.EnvTypes (Env)
 import Gargantext.API.Auth.PolicyCheck ( nodeReadChecks, nodeWriteChecks, moveChecks, AccessPolicyManager, publishChecks )
 import Gargantext.API.Errors.Types (BackendInternalError)
 import Gargantext.API.Metrics
 import Gargantext.API.Ngrams.Types (TabType(..))
-import Gargantext.API.Node.DocumentUpload qualified as DocumentUpload
 import Gargantext.API.Node.DocumentsFromWriteNodes qualified as DFWN
+import Gargantext.API.Node.DocumentUpload qualified as DocumentUpload
 import Gargantext.API.Node.File ( fileApi, fileAsyncApi )
 import Gargantext.API.Node.FrameCalcUpload qualified as FrameCalcUpload
 import Gargantext.API.Node.New ( postNode, postNodeAsyncAPI )
@@ -49,8 +49,11 @@ import Gargantext.API.Routes.Named.Node qualified as Named
 import Gargantext.API.Routes.Named.Private qualified as Named
 import Gargantext.API.Routes.Named.Publish qualified as Named
 import Gargantext.API.Routes.Named.Share qualified as Named
+import Gargantext.API.Routes.Named.Tree qualified as Named
 import Gargantext.API.Search qualified as Search
 import Gargantext.API.Server.Named.Ngrams (apiNgramsTableCorpus)
+import Gargantext.API.Server.Named.Remote qualified as Named
+import Gargantext.API.Server.Named.Remote qualified as Remote
 import Gargantext.API.Table ( tableApi, getPair )
 import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Core.Viz.Phylo.API (phyloAPI)
@@ -62,17 +65,16 @@ import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Prelude (DBCmdExtra, JSONB)
 import Gargantext.Database.Query.Table.Node
 import Gargantext.Database.Query.Table.Node.Children (getChildren)
-import Gargantext.Database.Query.Table.Node.Update (Update(..), update)
-import Gargantext.Database.Query.Table.Node.Update qualified as U (update, Update(..), publish)
-import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
 import Gargantext.Database.Query.Table.NodeContext (nodeContextsCategory, nodeContextsScore)
+import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Database.Query.Table.NodeNode
+import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
+import Gargantext.Database.Query.Table.Node.Update qualified as U (update, Update(..), publish)
+import Gargantext.Database.Query.Table.Node.Update (Update(..), update)
 import Gargantext.Database.Query.Tree (tree, tree_flat, TreeMode(..))
 import Gargantext.Prelude
 import Servant
 import Servant.Server.Generic (AsServerT)
-import Gargantext.API.Routes.Named.Tree qualified as Named
-import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 
 
 -- | Delete Nodes
@@ -216,8 +218,12 @@ corpusNodeAPI authenticatedUser = Named.CorpusAPIEndpoint $ \targetNode ->
 ------------------------------------------------------------------------
 nodeAPI :: AuthenticatedUser
         -> Named.NodeAPIEndpoint (AsServerT (GargM Env BackendInternalError))
-nodeAPI authenticatedUser = Named.NodeAPIEndpoint $ \targetNode ->
-  withNamedAccess authenticatedUser (PathNode targetNode) (concreteAPI targetNode)
+nodeAPI authenticatedUser = Named.NodeAPIEndpoint
+  { nodeEndpointAPI = \targetNode ->
+      withNamedAccess authenticatedUser (PathNode targetNode) (concreteAPI targetNode)
+  , nodeRemoteImportAPI = Named.remoteImportAPI authenticatedUser
+  }
+
   where
     concreteAPI = genericNodeAPI' (Proxy :: Proxy HyperdataAny) authenticatedUser
 
@@ -269,6 +275,7 @@ genericNodeAPI' _ authenticatedUser targetNode =  Named.NodeAPI
   , fileAsyncAPI       = fileAsyncApi authenticatedUser targetNode
   , dfwnAPI            = DFWN.api authenticatedUser targetNode
   , documentUploadAPI  = DocumentUpload.api targetNode
+  , remoteExportAPI    = Remote.remoteExportAPI targetNode authenticatedUser
   }
   where
     userRootId     = RootId $ authenticatedUser ^. auth_node_id

src/Gargantext/API/Routes/Client.hs

@@ -11,7 +11,8 @@ import Data.Text.Encoding qualified as TE
 import Gargantext.API.Admin.Auth.Types qualified as Auth
 import Gargantext.API.Errors (GargErrorScheme(..))
 import Gargantext.API.Routes.Named
-import Gargantext.API.Routes.Named.Private (mkPrivateAPI, remoteAPI)
+import Gargantext.API.Routes.Named.Node
+import Gargantext.API.Routes.Named.Private
 import Gargantext.API.Routes.Named.Remote qualified as Named
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Prelude
@@ -50,15 +51,16 @@ remoteImportClient (S.Token . TE.encodeUtf8 -> token) c =
                & gargPrivateAPI
                & mkPrivateAPI
                & ($ token)
-               & remoteAPI
-               & Named.remoteAPI
+               & nodeEp
+               & nodeRemoteImportAPI
                & Named.remoteImportEp
                & ($ c)
 
 remoteExportClient :: Auth.Token
+                   -> NodeId
                    -> Named.RemoteExportRequest
                    -> ClientM [NodeId]
-remoteExportClient (S.Token . TE.encodeUtf8 -> token) r =
+remoteExportClient (S.Token . TE.encodeUtf8 -> token) nodeId r =
   clientRoutes & apiWithCustomErrorScheme
                & ($ GES_new)
                & backendAPI
@@ -68,7 +70,9 @@ remoteExportClient (S.Token . TE.encodeUtf8 -> token) r =
                & gargPrivateAPI
                & mkPrivateAPI
                & ($ token)
-               & remoteAPI
-               & Named.remoteAPI
+               & nodeEp
+               & nodeEndpointAPI
+               & ($ nodeId)
+               & remoteExportAPI
                & Named.remoteExportEp
                & ($ r)

src/Gargantext/API/Routes/Named/Node.hs

@@ -50,6 +50,7 @@ import Gargantext.Database.Admin.Types.Hyperdata.User ( HyperdataUser )
 import Gargantext.Database.Query.Facet.Types ( FacetDoc, OrderBy(..) )
 import Prelude
 import Servant
+import Gargantext.API.Routes.Named.Remote (RemoteExportAPI)
 
 -------------------------------------------------------------------
 -- | Node API Types management
@@ -99,6 +100,7 @@ data NodeAPI a mode = NodeAPI
   , fileAsyncAPI       :: mode :- "async"     :> NamedRoutes FileAsyncAPI
   , dfwnAPI            :: mode :- "documents-from-write-nodes" :> NamedRoutes DocumentsFromWriteNodesAPI
   , documentUploadAPI  :: mode :- NamedRoutes DocumentUploadAPI
+  , remoteExportAPI    :: mode :- NamedRoutes RemoteExportAPI
   } deriving Generic
 
 

src/Gargantext/API/Routes/Named/Private.hs

@@ -102,7 +102,6 @@ data GargPrivateAPI' mode = GargPrivateAPI'
   , listJsonAPI      :: mode :- NamedRoutes JSONAPI
   , listTsvAPI       :: mode :- NamedRoutes TSVAPI
   , shareUrlAPI      :: mode :- "shareurl" :> NamedRoutes ShareURL
-  , remoteAPI        :: mode :- NamedRoutes RemoteAPI
   } deriving Generic
 
 
@@ -122,6 +121,7 @@ data NodeAPIEndpoint mode = NodeAPIEndpoint
                             :> Summary "Node endpoint"
                             :> Capture "node_id" NodeId
                             :> NamedRoutes (NodeAPI HyperdataAny)
+  , nodeRemoteImportAPI :: mode :- "node" :> "remote" :> NamedRoutes RemoteImportAPI
   } deriving Generic
 
 newtype AnnuaireAPIEndpoint mode = AnnuaireAPIEndpoint

src/Gargantext/API/Routes/Named/Remote.hs

@@ -3,8 +3,8 @@
 {-# LANGUAGE DerivingStrategies #-}
 module Gargantext.API.Routes.Named.Remote (
   -- * Routes types
-    RemoteAPI(..)
-  , RemoteAPI'(..)
+    RemoteExportAPI(..)
+  , RemoteImportAPI(..)
   , RemoteExportRequest(..)
   , RemoteBinaryData(..)
   ) where
@@ -25,40 +25,41 @@ import Servant.Client.Core.BaseUrl
 import Test.QuickCheck
 
 
-data RemoteAPI mode = RemoteAPI
-  { remoteAPI     :: mode :- "remote" :> NamedRoutes RemoteAPI'
+data RemoteExportAPI mode = RemoteExportAPI
+  { remoteExportEp :: mode :- "remote" :> ReqBody '[JSON] RemoteExportRequest :> PolicyChecked (Post '[JSON] [NodeId])
+  } deriving Generic
+
+data RemoteImportAPI mode = RemoteImportAPI
+  { remoteImportEp :: mode :- "import" :> StreamBody NoFraming OctetStream (C.ConduitT () RemoteBinaryData IO ())
+                                       :> Post '[JSON] [NodeId]
   } deriving Generic
 
 data RemoteExportRequest =
   RemoteExportRequest
-  { -- | The ID of the node we wish to export
-    _rer_node_id        :: NodeId
-    -- | The URL of the instance we want to copy data to.
-  , _rer_instance_url  :: BaseUrl
+  { -- | The URL of the instance we want to copy data to.
+    _rer_instance_url  :: BaseUrl
     -- | The JWT token to use for authentication purposes.
   , _rer_instance_auth :: Token
   } deriving (Show, Eq, Generic)
 
 instance Arbitrary RemoteExportRequest where
-  arbitrary = RemoteExportRequest <$> arbitrary <*> (pure (BaseUrl Http "dev.sub.gargantext.org" 8008 "")) <*> arbitrary
+  arbitrary = RemoteExportRequest <$> (pure (BaseUrl Http "dev.sub.gargantext.org" 8008 "")) <*> arbitrary
 
 instance ToJSON RemoteExportRequest where
   toJSON RemoteExportRequest{..}
-    = JSON.object [ "node_id" .= toJSON _rer_node_id
-                  , "instance_url"  .= toJSON _rer_instance_url
+    = JSON.object [ "instance_url"  .= toJSON _rer_instance_url
                   , "instance_auth" .= toJSON _rer_instance_auth
                   ]
 
 instance FromJSON RemoteExportRequest where
   parseJSON = withObject "RemoteExportRequest" $ \o -> do
-    _rer_node_id       <- o .: "node_id"
     _rer_instance_url  <- maybe (fail "RemoteExportRequest invalid URL") pure =<< (parseBaseUrl <$> o .: "instance_url")
     _rer_instance_auth <- o .: "instance_auth"
     pure RemoteExportRequest{..}
 
 instance ToSchema RemoteExportRequest where
   declareNamedSchema _ =
-    let exampleSchema = RemoteExportRequest (UnsafeMkNodeId 42) (BaseUrl Http "dev.sub.gargantext.org" 8008 "") ("abcdef")
+    let exampleSchema = RemoteExportRequest (BaseUrl Http "dev.sub.gargantext.org" 8008 "") ("abcdef")
     in pure $ NamedSchema (Just "RemoteExportRequest") $ sketchStrictSchema exampleSchema
 
 newtype RemoteBinaryData = RemoteBinaryData { getRemoteBinaryData :: BS.ByteString }
@@ -75,9 +76,3 @@ instance MimeUnrender OctetStream RemoteBinaryData where
 
 instance ToSchema RemoteBinaryData where
   declareNamedSchema _ = pure $ NamedSchema (Just "RemoteExportRequest") binarySchema
-
-data RemoteAPI' mode = RemoteAPI'
-  { remoteExportEp :: mode :- "export" :> ReqBody '[JSON] RemoteExportRequest :> PolicyChecked (Post '[JSON] [NodeId])
-  , remoteImportEp :: mode :- "import" :> StreamBody NoFraming OctetStream (C.ConduitT () RemoteBinaryData IO ())
-                                       :> Post '[JSON] [NodeId]
-  } deriving Generic

src/Gargantext/API/Server/Named/Private.hs

@@ -21,7 +21,6 @@ import Gargantext.API.Prelude (GargM)
 import Gargantext.API.Routes (addCorpusWithForm, addCorpusWithQuery)
 import Gargantext.API.Routes.Named.Private qualified as Named
 import Gargantext.API.Server.Named.Ngrams
-import Gargantext.API.Server.Named.Remote qualified as Remote
 import Gargantext.API.Server.Named.Viz qualified as Viz
 import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataAny)
@@ -67,5 +66,4 @@ serverPrivateGargAPI' authenticatedUser@(AuthenticatedUser userNodeId userId)
        , listJsonAPI       = List.jsonAPI
        , listTsvAPI        = List.tsvAPI
        , shareUrlAPI       = shareURL
-       , remoteAPI         = Remote.remoteAPI authenticatedUser
        }

src/Gargantext/API/Server/Named/Remote.hs

@@ -7,7 +7,8 @@
 {-# LANGUAGE ViewPatterns        #-}
 
 module Gargantext.API.Server.Named.Remote (
-  remoteAPI
+    remoteExportAPI
+  , remoteImportAPI
   ) where
 
 import Codec.Serialise
@@ -94,16 +95,23 @@ renderExportableNode = \case
 
 instance Serialise ExportableNode where
 
-remoteAPI :: (MonadIO m, IsGargServer env BackendInternalError m, HasNodeArchiveStoryImmediateSaver env)
-          => AuthenticatedUser
-          -> Named.RemoteAPI (AsServerT m)
-remoteAPI authenticatedUser = Named.RemoteAPI $
-  Named.RemoteAPI'
-    { remoteExportEp = \payload@Named.RemoteExportRequest{..} mgr ->
-        withPolicy authenticatedUser (remoteExportChecks _rer_node_id) (remoteExportHandler authenticatedUser payload) mgr
-    , remoteImportEp = remoteImportHandler authenticatedUser
+remoteExportAPI :: (MonadIO m, IsGargServer env BackendInternalError m, HasNodeArchiveStoryImmediateSaver env)
+                => NodeId
+                -> AuthenticatedUser
+                -> Named.RemoteExportAPI (AsServerT m)
+remoteExportAPI nodeId authenticatedUser =
+  Named.RemoteExportAPI
+    { remoteExportEp = \payload mgr ->
+        withPolicy authenticatedUser (remoteExportChecks nodeId) (remoteExportHandler nodeId authenticatedUser payload) mgr
     }
 
+remoteImportAPI :: (MonadIO m, IsGargServer env BackendInternalError m, HasNodeArchiveStoryImmediateSaver env)
+                => AuthenticatedUser
+                -> Named.RemoteImportAPI (AsServerT m)
+remoteImportAPI authenticatedUser =
+  Named.RemoteImportAPI
+    { remoteImportEp = remoteImportHandler authenticatedUser }
+
 type ExpectedPayload = Tree ExportableNode
 
 remoteImportHandler :: forall err env m.
@@ -206,10 +214,11 @@ remoteImportHandler loggedInUser c = do
 remoteExportHandler :: ( MonadIO m, Safe.MonadCatch m
                        , IsGargServer err env m
                        )
-                    => AuthenticatedUser
+                    => NodeId
+                    -> AuthenticatedUser
                     -> Named.RemoteExportRequest
                     -> m [NodeId]
-remoteExportHandler loggedInUser Named.RemoteExportRequest{..} = do
+remoteExportHandler _rer_node_id loggedInUser Named.RemoteExportRequest{..} = do
   mgr  <- view gargHttpManager
   nodes <- getNodes _rer_node_id
   checkNodesTypeAllowed nodes

test/Test/API/Private/Remote.hs

@@ -62,11 +62,10 @@ tests = sequential $ aroundAll withTwoServerInstances $ do
             withValidLogin server2Port "bob" (GargPassword "bob") $ \_bobClientEnv bobToken -> do
               liftIO $ do
                 bobPublicFolderId <- getRootPublicFolderIdForUser testEnv1 (UserName "bob")
-                let rq = RemoteExportRequest { _rer_node_id = bobPublicFolderId
-                                             , _rer_instance_url  = fromMaybe (panicTrace "impossible") $ parseBaseUrl "http://localhost:9008"
+                let rq = RemoteExportRequest { _rer_instance_url  = fromMaybe (panicTrace "impossible") $ parseBaseUrl "http://localhost:9008"
                                              , _rer_instance_auth = bobToken
                                              }
-                res <- runClientM (remoteExportClient aliceToken rq) aliceClientEnv
+                res <- runClientM (remoteExportClient aliceToken bobPublicFolderId rq) aliceClientEnv
                 res `shouldFailWith` EC_403__policy_check_error
 
       it "supports trivial transfer between instances" $ \(SpecContext testEnv1 server1Port app1 (_testEnv2, _app2, server2Port)) -> do
@@ -75,11 +74,10 @@ tests = sequential $ aroundAll withTwoServerInstances $ do
             corpusId <- liftIO $ newCorpusForUser testEnv1 "alice"
             withValidLogin server2Port "bob" (GargPassword "bob") $ \_bobClientEnv bobToken -> do
               liftIO $ do
-                let rq = RemoteExportRequest { _rer_node_id = corpusId
-                                             , _rer_instance_url  = fromMaybe (panicTrace "impossible") $ parseBaseUrl "http://localhost:9008"
+                let rq = RemoteExportRequest { _rer_instance_url  = fromMaybe (panicTrace "impossible") $ parseBaseUrl "http://localhost:9008"
                                              , _rer_instance_auth = bobToken
                                              }
-                res <- checkEither $ runClientM (remoteExportClient aliceToken rq) aliceClientEnv
+                res <- checkEither $ runClientM (remoteExportClient aliceToken corpusId rq) aliceClientEnv
                 res `shouldBe` [ UnsafeMkNodeId 16 ]
 
       -- Certain node types (like private, share, etc) shouldn't be transferred.
@@ -89,9 +87,8 @@ tests = sequential $ aroundAll withTwoServerInstances $ do
             folderId <- liftIO $ newPrivateFolderForUser testEnv1 "alice"
             withValidLogin server2Port "bob" (GargPassword "bob") $ \_bobClientEnv bobToken -> do
               liftIO $ do
-                let rq = RemoteExportRequest { _rer_node_id = folderId
-                                             , _rer_instance_url  = fromMaybe (panicTrace "impossible") $ parseBaseUrl "http://localhost:9008"
+                let rq = RemoteExportRequest { _rer_instance_url  = fromMaybe (panicTrace "impossible") $ parseBaseUrl "http://localhost:9008"
                                              , _rer_instance_auth = bobToken
                                              }
-                res <- runClientM (remoteExportClient aliceToken rq) aliceClientEnv
+                res <- runClientM (remoteExportClient aliceToken folderId rq) aliceClientEnv
                 res `shouldFailWith` EC_403__node_export_error