Add _env_remote_transfer_keys field

This adds a new randomly-generated pair of (PublicKey, PrivateKey) to be
later used to send messages between instances.

It also:

* Returns a remote transfer pub key inside an AuthResponse
* Adds pubKey roundtrip test

gargantext.cabal

@@ -486,6 +486,8 @@ library
     , aeson ^>= 2.1.2.1
     , ansi-terminal
     , array ^>= 0.5.4.0
+    , asn1-encoding >= 0.9.6
+    , asn1-types
     , async ^>= 2.2.4
     , attoparsec ^>= 0.14.4
     , base64-bytestring ^>= 1.2.1.0
@@ -505,6 +507,8 @@ library
     , crawlerIsidore
     , crawlerPubMed
     , cron ^>= 0.7.0
+    , crypton
+    , crypton-x509
     , data-time-segment ^>= 0.1.0.0
     , deferred-folds >= 0.9.18 && < 0.10
     , directory ^>= 1.3.7.1
@@ -732,6 +736,7 @@ common testDependencies
     , containers ^>= 0.6.7
     , crawlerArxiv
     , cryptohash
+    , crypton
     , directory ^>= 1.3.7.1
     , epo-api-client
     , extra ^>= 1.7.9
@@ -822,7 +827,6 @@ test-suite garg-test-tasty
       Test.API.Setup
       Test.API.Prelude
       Test.API.UpdateList
-      Test.Core.AsyncUpdates
       Test.Core.Notifications
       Test.Core.Similarity
       Test.Core.Text
@@ -852,6 +856,7 @@ test-suite garg-test-tasty
       Test.Offline.Errors
       Test.Offline.JSON
       Test.Offline.Phylo
+      Test.Offline.RemoteTransfer
       Test.Offline.Stemming.Lancaster
       Test.Parsers.Date
       Test.Parsers.Types

src/Gargantext/API/Admin/Auth.hs

@@ -54,7 +54,7 @@ import Gargantext.API.Auth.PolicyCheck
 import Gargantext.API.Errors
 import Gargantext.API.Prelude (authenticationError, HasServerError, GargServerC, _ServerError, GargM, IsGargServer)
 import Gargantext.API.Worker (serveWorkerAPI)
-import Gargantext.Core.Config (HasJWTSettings(..))
+import Gargantext.Core.Config (HasJWTSettings(..), HasRemoteTransferKeys(..))
 import Gargantext.Core.Mail (MailModel(..), mail)
 import Gargantext.Core.Mail.Types (mailSettings)
 import Gargantext.Core.Types.Individu (User(..), Username, GargPassword(..))
@@ -115,7 +115,11 @@ checkAuthRequest couldBeEmail (GargPassword p) = do
               token <- makeTokenForUser nodeId userLight_id
               pure $ Valid token nodeId userLight_id
 
-auth :: (HasJWTSettings env, HasAuthenticationError err, DbCmd' env err m)
+auth :: ( HasJWTSettings env
+        , HasRemoteTransferKeys env
+        , HasAuthenticationError err
+        , DbCmd' env err m
+        )
      => AuthRequest -> m AuthResponse
 auth (AuthRequest u p) = do
   checkAuthRequest' <- checkAuthRequest u p
@@ -124,7 +128,9 @@ auth (AuthRequest u p) = do
       throwError $ _AuthenticationError # InvalidUsernameOrPassword
     InvalidPassword -> do
       throwError $ _AuthenticationError # InvalidUsernameOrPassword
-    Valid to trId uId   -> pure $ AuthResponse to trId uId
+    Valid to trId uId   -> do
+      (pk, _) <- view remoteTransferKeys
+      pure $ AuthResponse to trId uId (pubKeyToRemotePubKey pk)
 
 --type instance BasicAuthCfg = BasicAuthData -> IO (AuthResult AuthenticatedUser)
 

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

@@ -8,7 +8,9 @@ Stability   : experimental
 Portability : POSIX
 -}
 
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TemplateHaskell    #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE DeriveAnyClass     #-}
 
 module Gargantext.API.Admin.Auth.Types
   ( -- * Types
@@ -27,6 +29,7 @@ module Gargantext.API.Admin.Auth.Types
   , ForgotPasswordResponse(..)
   , ForgotPasswordAsyncParams(..)
   , ForgotPasswordGet(..)
+  , RemoteTransferPublicKey(..)
 
   -- * Lenses
   , auth_node_id
@@ -34,22 +37,34 @@ module Gargantext.API.Admin.Auth.Types
   , authRes_token
   , authRes_tree_id
   , authRes_user_id
+  , authRes_remote_transfer_pub_key
 
   -- * Combinators
+  , pubKeyToRemotePubKey
+  , remotePubKeyToPubKey
   ) where
 
 import Crypto.JWT qualified as Jose
+import Crypto.PubKey.RSA qualified as RSA
 import Data.Aeson.TH qualified as JSON
 import Data.Aeson.Types (genericParseJSON, defaultOptions, genericToJSON)
+import Data.ASN1.BinaryEncoding
+import Data.ASN1.Encoding qualified as ASN1
+import Data.ASN1.Types (toASN1, fromASN1)
+import Data.ByteString.Base64 qualified as Base64
 import Data.List (tail)
 import Data.Swagger ( ToSchema(..), genericDeclareNamedSchema )
+import Data.Text.Encoding qualified as TE
+import Data.Text qualified as T
+import Data.X509 qualified as X509
 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.Prelude hiding (reverse)
+import Prelude (String)
 import Servant.Auth.Server
-import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
+import Test.QuickCheck (elements)
 
 ---------------------------------------------------
 
@@ -59,9 +74,36 @@ data AuthRequest = AuthRequest { _authReq_username :: Username
                                }
   deriving (Generic)
 
+newtype RemoteTransferPublicKey =
+  RemoteTransferPublicKey { _RemoteTransferPublicKey :: T.Text }
+  deriving stock (Generic, Eq, Show)
+  deriving newtype (ToJSON, FromJSON)
+  deriving anyclass (ToSchema)
+
+pubKeyToRemotePubKey :: RSA.PublicKey -> RemoteTransferPublicKey
+pubKeyToRemotePubKey pubKey =
+  let x509pubKey = X509.PubKeyRSA pubKey
+      ans1Enc    = ASN1.encodeASN1' DER ((toASN1 x509pubKey) [])
+      in RemoteTransferPublicKey $ TE.decodeUtf8 (Base64.encode ans1Enc)
+
+remotePubKeyToPubKey :: RemoteTransferPublicKey -> Either String RSA.PublicKey
+remotePubKeyToPubKey (RemoteTransferPublicKey pkeyTxt) = do
+  unwrappedB64 <- Base64.decode (TE.encodeUtf8 pkeyTxt)
+  case ASN1.decodeASN1' DER unwrappedB64 of
+    Left asn1Err  -> Left $ show asn1Err
+    Right asn1Obj -> do
+      (x509Ty, _) <- fromASN1 asn1Obj
+      case x509Ty of
+        X509.PubKeyRSA pk -> pure (pk { RSA.public_size = 256 })
+        _                 -> Left "remotePubKeyToPubKey: x509 incompatible type found."
+
 data AuthResponse = AuthResponse { _authRes_token   :: Token
                                  , _authRes_tree_id :: TreeId
                                  , _authRes_user_id :: UserId
+                                 -- | The remote transfer public key which the
+                                 -- browser can save and later use in transfer
+                                 -- requests.
+                                 , _authRes_remote_transfer_pub_key :: RemoteTransferPublicKey
                                  }
   deriving (Generic, Eq, Show)
 
@@ -103,10 +145,11 @@ instance Arbitrary AuthRequest where
 instance ToSchema AuthResponse where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_authRes_")
 instance Arbitrary AuthResponse where
-  arbitrary = elements [ AuthResponse to' tr u
+  arbitrary = elements [ AuthResponse to' tr u k
                        | to' <- ["token0", "token1"]
                        , tr <- map UnsafeMkNodeId [1..3]
                        , u <-  map UnsafeMkUserId [1..3]
+                       , k <-  pure $ RemoteTransferPublicKey "dummy-pubkey"
                        ]
 
 data PathId = PathNode NodeId | PathNodeNode ListId DocId

src/Gargantext/API/Admin/EnvTypes.hs

@@ -15,7 +15,8 @@ module Gargantext.API.Admin.EnvTypes (
   , env_jwt_settings
   , env_pool
   , env_nodeStory
-  
+  , env_remote_transfer_keys
+
   , menv_firewall
   , dev_env_logger
 
@@ -28,21 +29,22 @@ module Gargantext.API.Admin.EnvTypes (
 import Control.Lens hiding (Level, (:<), (.=))
 import Control.Monad.Except
 import Control.Monad.Reader
+import Crypto.PubKey.RSA.Types qualified as RSA
+import Database.PostgreSQL.Simple (Connection)
 import Data.List ((\\))
 import Data.Pool (Pool)
 import Data.Text qualified as T
-import Database.PostgreSQL.Simple (Connection)
 import Gargantext.API.Admin.Orchestrator.Types
 import Gargantext.API.Errors.Types
 import Gargantext.API.Prelude (GargM, IsGargServer)
+import Gargantext.Core.Config (GargConfig(..), gc_mail_config, gc_nlp_config, HasJWTSettings(..), HasConfig(..), HasRemoteTransferKeys(..))
+import Gargantext.Core.Mail.Types (HasMail, mailSettings)
+import Gargantext.Core.NLP (HasNLPServer(..), nlpServerMap)
+import Gargantext.Core.NodeStory
 import Gargantext.Core.Notifications.CentralExchange qualified as CE
 import Gargantext.Core.Notifications.CentralExchange.Types qualified as CET
 import Gargantext.Core.Notifications.Dispatcher (Dispatcher)
 import Gargantext.Core.Notifications.Dispatcher.Types (HasDispatcher(..))
-import Gargantext.Core.Config (GargConfig(..), gc_mail_config, gc_nlp_config, HasJWTSettings(..), HasConfig(..))
-import Gargantext.Core.Mail.Types (HasMail, mailSettings)
-import Gargantext.Core.NLP (HasNLPServer(..), nlpServerMap)
-import Gargantext.Core.NodeStory
 import Gargantext.Database.Prelude (HasConnectionPool(..))
 import Gargantext.Prelude hiding (to)
 import Gargantext.System.Logging
@@ -91,13 +93,14 @@ instance HasLogger (GargM Env BackendInternalError) where
 -- having to specify /everything/. This means that when we /construct/ an 'Env',
 -- we need to remember to force the fields to WHNF at that point.
 data Env = Env
-  { _env_logger           :: ~(Logger (GargM Env BackendInternalError))
-  , _env_pool             :: ~(Pool Connection)
-  , _env_nodeStory        :: ~NodeStoryEnv
-  , _env_manager          :: ~Manager
-  , _env_config           :: ~GargConfig
-  , _env_dispatcher       :: ~Dispatcher
-  , _env_jwt_settings     :: ~JWTSettings
+  { _env_logger               :: ~(Logger (GargM Env BackendInternalError))
+  , _env_pool                 :: ~(Pool Connection)
+  , _env_nodeStory            :: ~NodeStoryEnv
+  , _env_manager              :: ~Manager
+  , _env_config               :: ~GargConfig
+  , _env_dispatcher           :: ~Dispatcher
+  , _env_jwt_settings         :: ~JWTSettings
+  , _env_remote_transfer_keys :: ~(RSA.PublicKey, RSA.PrivateKey)
   }
   deriving (Generic)
 
@@ -135,6 +138,9 @@ instance CET.HasCentralExchangeNotification Env where
     c <- asks (view env_config)
     liftBase $ CE.notify (_gc_notifications_config c) m
 
+instance HasRemoteTransferKeys Env where
+  remoteTransferKeys = env_remote_transfer_keys
+
 data FireWall = FireWall { unFireWall :: Bool }
 
 data MockEnv = MockEnv

src/Gargantext/API/Admin/Settings.hs

@@ -20,17 +20,18 @@ module Gargantext.API.Admin.Settings
 
 
 import Codec.Serialise (Serialise(), serialise)
+import Crypto.PubKey.RSA qualified as RSA
+import Database.PostgreSQL.Simple (Connection, connect, close, ConnectInfo)
 import Data.ByteString.Lazy qualified as L
 import Data.Pool (Pool)
 import Data.Pool qualified as Pool
-import Database.PostgreSQL.Simple (Connection, connect, close, ConnectInfo)
 import Gargantext.API.Admin.EnvTypes
 import Gargantext.API.Errors.Types
 import Gargantext.API.Prelude
-import Gargantext.Core.Notifications.Dispatcher qualified as D
 import Gargantext.Core.Config (GargConfig(..))
 import Gargantext.Core.Config.Types (jwtSettings)
 import Gargantext.Core.NodeStory
+import Gargantext.Core.Notifications.Dispatcher qualified as D
 import Gargantext.Prelude
 import Gargantext.System.Logging
 import Network.HTTP.Client.TLS (newTlsManager)
@@ -159,6 +160,7 @@ newEnv logger config dispatcher = do
 
   !_env_jwt_settings <- jwtSettings (_gc_secrets config)
 
+  _env_remote_transfer_keys <- RSA.generate 256 65537
 
   --_central_exchange <- forkIO $ CE.gServer (_gc_notifications_config config_env)
 
@@ -174,6 +176,7 @@ newEnv logger config dispatcher = do
     , _env_config    = config
     , _env_dispatcher = dispatcher
     , _env_jwt_settings
+    , _env_remote_transfer_keys
     }
 
 newPool :: ConnectInfo -> IO (Pool Connection)

src/Gargantext/Core/Config.hs

@@ -35,16 +35,18 @@ module Gargantext.Core.Config (
 
   , HasJWTSettings(..)
   , HasConfig(..)
+  , HasRemoteTransferKeys(..)
   ) where
 
 import Control.Lens (Getter)
 import Control.Monad.Logger (LogLevel(LevelDebug))
-import Data.Text as T
+import Crypto.PubKey.RSA qualified as RSA
 import Database.PostgreSQL.Simple qualified as PSQL
+import Data.Text as T
 import Gargantext.Core.Config.Mail (MailConfig)
 import Gargantext.Core.Config.NLP (NLPConfig)
-import Gargantext.Core.Config.Worker (WorkerSettings)
 import Gargantext.Core.Config.Types
+import Gargantext.Core.Config.Worker (WorkerSettings)
 import Gargantext.Prelude
 import Servant.Auth.Server (JWTSettings)
 import Servant.Client (BaseUrl(..), Scheme(Http), parseBaseUrl)
@@ -134,3 +136,6 @@ instance HasConfig GargConfig where
 
 class HasJWTSettings env where
   jwtSettings :: Getter env JWTSettings
+
+class HasRemoteTransferKeys env where
+  remoteTransferKeys :: Getter env (RSA.PublicKey, RSA.PrivateKey)

test/Test/API/Authentication.hs

@@ -65,9 +65,12 @@ tests = parallel $ aroundAll withTestDBAndPort $ beforeAllWith (\ctx -> setupEnv
                 _authRes_token = cannedToken
               , _authRes_tree_id = fromMaybe (UnsafeMkNodeId 1) $ listToMaybe $ result0 ^.. _Right . authRes_tree_id
               , _authRes_user_id = fromMaybe (UnsafeMkUserId 1) $ listToMaybe $ result0 ^.. _Right . authRes_user_id
+              -- We can't compare the pub key as it's randomly-generate upon each server restart
+              , _authRes_remote_transfer_pub_key = RemoteTransferPublicKey "uncomparable"
               }
 
-        result `shouldBe` Right expected
+        (result <&> \r -> r { _authRes_remote_transfer_pub_key = RemoteTransferPublicKey "uncomparable" })
+          `shouldBe` Right expected
 
       it "denies login for user 'alice' if password is invalid" $ \(SpecContext _testEnv port _app _) -> do
         let authPayload = AuthRequest "alice" (GargPassword "wrong")

test/Test/API/Setup.hs

@@ -16,16 +16,17 @@ import Control.Concurrent.MVar
 import Control.Exception.Safe
 import Control.Lens
 import Control.Monad.Reader
+import Crypto.PubKey.RSA qualified as RSA
 import Data.ByteString.Lazy.Char8 qualified as C8L
 import Data.Cache qualified as InMemory
 import Data.Streaming.Network (bindPortTCP)
-import Gargantext.API (makeApp)
 import Gargantext.API.Admin.EnvTypes (Mode(Mock), Env (..), env_dispatcher)
 import Gargantext.API.Errors.Types
+import Gargantext.API (makeApp)
 import Gargantext.API.Prelude
-import Gargantext.Core.Notifications (withNotifications)
 import Gargantext.Core.Config (_gc_secrets, gc_frontend_config)
 import Gargantext.Core.Config.Types (NotificationsConfig(..), fc_appPort, jwtSettings)
+import Gargantext.Core.Notifications (withNotifications)
 import Gargantext.Core.Types.Individu
 import Gargantext.Database.Action.Flow
 import Gargantext.Database.Action.User.New
@@ -43,10 +44,10 @@ import Network.HTTP.Client.TLS (newTlsManager)
 import Network.HTTP.Types
 import Network.Wai (Application, responseLBS)
 import Network.Wai.Handler.Warp.Internal
-import Network.WebSockets qualified as WS
 import Network.Wai.Handler.Warp qualified as Warp
 import Network.Wai.Handler.Warp (runSettingsSocket)
 import Network.Wai qualified as Wai
+import Network.WebSockets qualified as WS
 import Prelude hiding (show)
 import Servant.Auth.Client ()
 import Test.Database.Setup (withTestDB)
@@ -81,6 +82,7 @@ newTestEnv testEnv logger port = do
   -- !nodeStory_env <- fromDBNodeStoryEnv pool
 
   !_env_jwt_settings <- jwtSettings (_gc_secrets config_env)
+  _env_remote_transfer_keys <- RSA.generate 256 65537
 
   pure $ Env
     { _env_logger    = logger
@@ -94,6 +96,7 @@ newTestEnv testEnv logger port = do
     -- , _env_central_exchange = central_exchange
     , _env_dispatcher = errorTrace "[Test.API.Setup.newTestEnv] dispatcher not needed, but forced somewhere"
     , _env_jwt_settings
+    , _env_remote_transfer_keys
     }
 
 

test/Test/Core/AsyncUpdates.hs

-{-|
-Module      : Core.Notifications
-Description :
-Copyright   : (c) CNRS, 2017-Present
-License     : AGPL + CECILL v3
-Maintainer  : team@gargantext.org
-Stability   : experimental
-Portability : POSIX
-
--}
-
-module Test.Core.AsyncUpdates
-  ( test
-  , qcTests )
-where
-
-import Data.Aeson qualified as A
-import Gargantext.Core.Notifications.CentralExchange.Types
-import Gargantext.Core.Notifications.Dispatcher.Types
-import Gargantext.Prelude
-import Test.Hspec
-import Test.Instances ()
-import Test.Tasty
-import Test.Tasty.QuickCheck qualified as QC
-
-
-test :: Spec
-test = do
-  describe "check if json serialization of CEMessage works" $ do
-    it "UpdateTreeFirstLevel serialization" $ do
-      let ce = UpdateTreeFirstLevel 15
-      A.decode (A.encode ce) `shouldBe` (Just ce)
-
-qcTests :: TestTree
-qcTests =
-  testGroup "Notifications QuickCheck tests" $ do
-    [ QC.testProperty "CEMessage aeson encoding" $ \m -> A.decode (A.encode (m :: CEMessage)) == Just m
-      , QC.testProperty "Topic aeson encoding" $ \t -> A.decode (A.encode (t :: Topic)) == Just t
-      , QC.testProperty "Message aeson encoding" $ \m -> A.decode (A.encode (m :: Message)) == Just m
-      , QC.testProperty "WSRequest aeson encoding" $ \ws -> A.decode (A.encode (ws :: WSRequest)) == Just ws ]

test/Test/Offline/RemoteTransfer.hs

+{-# LANGUAGE ViewPatterns #-}
+module Test.Offline.RemoteTransfer where
+
+import Crypto.PubKey.RSA as RSA
+import Gargantext.API.Admin.Auth.Types
+import Prelude
+import Test.Tasty
+import Test.Tasty.QuickCheck
+
+tests :: TestTree
+tests = testGroup "RemoteTransfer" [
+  testProperty "PubKey serialisation roundtrip" pubKeySerializeRoundtrip
+  ]
+
+pubKeySerializeRoundtrip :: (Positive Integer, Positive Integer) -> Property
+pubKeySerializeRoundtrip (getPositive -> n, getPositive -> e) =
+  let pk = RSA.PublicKey 256 n e
+  in remotePubKeyToPubKey (pubKeyToRemotePubKey pk) === Right pk

test/drivers/tasty/Main.hs

@@ -29,6 +29,7 @@ import qualified Test.Utils.Crypto               as Crypto
 import qualified Test.Utils.Jobs                 as Jobs
 import qualified Test.Core.Similarity            as Similarity
 import qualified Test.Core.Notifications          as Notifications
+import qualified Test.Offline.RemoteTransfer     as RemoteTransfer
 
 import Test.Tasty
 import Test.Tasty.Hspec
@@ -65,4 +66,5 @@ main = do
     , Worker.tests
     , asyncUpdatesSpec
     , Notifications.qcTests
+    , RemoteTransfer.tests
     ]