Bolt-on ownership check for /remote/export

src/Gargantext/API/Auth/PolicyCheck.hs

@@ -33,6 +33,7 @@ module Gargantext.API.Auth.PolicyCheck (
   , nodePublishedEdit
   , moveChecks
   , publishChecks
+  , remoteExportChecks
   , userMe
   , alwaysAllow
   , alwaysDeny
@@ -211,7 +212,7 @@ nodeNotDescendant :: AccessPolicyErrorReason
 nodeNotDescendant = AccessPolicyErrorReason "Node is not a direct descendant."
 
 invalidUserPermissions :: AccessPolicyErrorReason
-invalidUserPermissions = AccessPolicyErrorReason "User not authorized to perform the operation."
+invalidUserPermissions = AccessPolicyErrorReason "User not authorized to perform the operation (typically due to wrong ownership)."
 
 -------------------------------------------------------------------------------
 -- Smart constructors of access checks
@@ -274,6 +275,11 @@ publishChecks :: NodeId -> BoolExpr AccessCheck
 publishChecks nodeId =
   (nodeUser nodeId `BOr` nodeSuper nodeId)
 
+-- | A user can export a node if he/she owns it, or if that's a super.
+remoteExportChecks :: NodeId -> BoolExpr AccessCheck
+remoteExportChecks nodeId =
+  (nodeUser nodeId `BOr` nodeSuper nodeId)
+
 alwaysAllow :: BoolExpr AccessCheck
 alwaysAllow = BConst . Positive $ AC_always_allow
 

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

@@ -16,6 +16,7 @@ import Data.ByteString qualified as BS
 import Data.Proxy
 import Data.Swagger hiding (Http)
 import Gargantext.API.Admin.Auth.Types (Token)
+import Gargantext.API.Auth.PolicyCheck (PolicyChecked)
 import Gargantext.Database.Admin.Types.Node ( NodeId (..) )
 import GHC.Generics
 import Prelude
@@ -76,7 +77,7 @@ instance ToSchema RemoteBinaryData where
   declareNamedSchema _ = pure $ NamedSchema (Just "RemoteExportRequest") binarySchema
 
 data RemoteAPI' mode = RemoteAPI'
-  { remoteExportEp :: mode :- "export" :> ReqBody '[JSON] RemoteExportRequest :> Post '[JSON] ()
+  { remoteExportEp :: mode :- "export" :> ReqBody '[JSON] RemoteExportRequest :> PolicyChecked (Post '[JSON] ())
   , remoteImportEp :: mode :- "import" :> StreamBody NoFraming OctetStream (C.ConduitT () RemoteBinaryData IO ())
                                        :> Post '[JSON] ()
   } deriving Generic

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

@@ -67,5 +67,5 @@ serverPrivateGargAPI' authenticatedUser@(AuthenticatedUser userNodeId userId)
        , listJsonAPI       = List.jsonAPI
        , listTsvAPI        = List.tsvAPI
        , shareUrlAPI       = shareURL
-       , remoteAPI         = Remote.remoteAPI
+       , remoteAPI         = Remote.remoteAPI authenticatedUser
        }

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

@@ -19,6 +19,9 @@ import Data.ByteString.Char8 qualified as C8
 import Data.ByteString.Lazy qualified as BL
 import Data.Conduit.Combinators qualified as C
 import Data.Conduit.List qualified as CL
+import Gargantext.API.Admin.Auth.Types (AuthenticatedUser)
+import Gargantext.API.Admin.Auth
+import Gargantext.API.Auth.PolicyCheck (remoteExportChecks)
 import Gargantext.API.Errors.Types
 import Gargantext.API.Prelude (IsGargServer)
 import Gargantext.API.Routes.Client (remoteImportClient)
@@ -29,10 +32,13 @@ import Prelude
 import Servant.Client.Streaming (mkClientEnv, withClientM, ClientError)
 import Servant.Server.Generic (AsServerT)
 
-remoteAPI :: (MonadIO m, IsGargServer env err m) => Named.RemoteAPI (AsServerT m)
-remoteAPI = Named.RemoteAPI $
+remoteAPI :: (MonadIO m, IsGargServer env BackendInternalError m)
+          => AuthenticatedUser
+          -> Named.RemoteAPI (AsServerT m)
+remoteAPI authenticatedUser = Named.RemoteAPI $
   Named.RemoteAPI'
-    { remoteExportEp = remoteExportHandler
+    { remoteExportEp = \payload@Named.RemoteExportRequest{..} mgr ->
+        withPolicy authenticatedUser (remoteExportChecks _rer_node_id) (remoteExportHandler payload) mgr
     , remoteImportEp = remoteImportHandler
     }
 
@@ -45,7 +51,7 @@ remoteImportHandler c = do
   chunks <- liftIO $ sourceToList $ c .| C.map (B.byteString . Named.getRemoteBinaryData)
   case deserialiseOrFail @ExpectedPayload (B.toLazyByteString $ mconcat chunks) of
     Left err    -> throwError $ _BackendInternalError # InternalUnexpectedError (toException $ userError $ "Deserialization error: " ++ show err)
-    Right value -> liftIO $ putStrLn $ show $ value
+    Right value -> liftIO $ putStrLn $ "Received from outside: " ++ show value
 
 remoteExportHandler :: ( MonadIO m, Safe.MonadCatch m
                        , IsGargServer err env m