WIP - try to test protected endpoint

cabal.project

@@ -79,7 +79,7 @@ source-repository-package
 source-repository-package
     type: git
     location: https://gitlab.iscpif.fr/gargantext/crawlers/arxiv-api.git
-    tag: 2d7e5753cbbce248b860b571a0e9885415c846f7
+    tag: eb130c71fa17adaceed6ff66beefbccb13df51ba
 
 source-repository-package
     type: git

gargantext.cabal

@@ -935,13 +935,17 @@ test-suite garg-test-tasty
     , crawlerArxiv
     , duckling ^>= 0.2.0.0
     , extra ^>= 1.7.9
+    , fmt
     , gargantext
     , gargantext-prelude
     , hspec ^>= 2.7.10
     , hspec-core
     , hspec-expectations >= 0.8 && < 0.9
+    , hspec-wai
+    , hspec-wai-json
     , http-client ^>= 0.6.4.1
     , http-client-tls ^>= 0.3.5.3
+    , http-types
     , lens >= 5.2.2 && < 5.3
     , monad-control >= 1.0.3 && < 1.1
     , mtl ^>= 2.2.2
@@ -973,6 +977,8 @@ test-suite garg-test-tasty
     , tmp-postgres >= 1.34.1 && < 1.35
     , unordered-containers ^>= 0.2.16.0
     , validity ^>= 0.11.0.1
+    , wai
+    , wai-extra
     , warp
   default-language: Haskell2010
 
@@ -1029,11 +1035,15 @@ test-suite garg-test-hspec
     , crawlerArxiv
     , duckling ^>= 0.2.0.0
     , extra ^>= 1.7.9
+    , fmt
     , gargantext
     , gargantext-prelude
     , hspec ^>= 2.7.10
     , hspec-core
     , hspec-expectations >= 0.8 && < 0.9
+    , hspec-wai
+    , hspec-wai-json
+    , http-types
     , http-client ^>= 0.6.4.1
     , http-client-tls ^>= 0.3.5.3
     , lens >= 5.2.2 && < 5.3
@@ -1067,6 +1077,8 @@ test-suite garg-test-hspec
     , tmp-postgres >= 1.34.1 && < 1.35
     , unordered-containers ^>= 0.2.16.0
     , validity ^>= 0.11.0.1
+    , wai
+    , wai-extra
     , warp
   default-language: Haskell2010
 

src/Gargantext/API/Routes.hs

@@ -87,7 +87,7 @@ type GargAPI' =
           :<|> "public"      :> Public.API
 
 
-type MkProtectedAPI sub = SA.Auth '[SA.JWT, SA.Cookie] AuthenticatedUser :> sub
+type MkProtectedAPI private = SA.Auth '[SA.JWT, SA.Cookie] AuthenticatedUser :> private
 
 type GargPrivateAPI = MkProtectedAPI GargPrivateAPI'
 
@@ -98,13 +98,16 @@ type GargAdminAPI
            :<|> "nodes" :> Summary "Nodes endpoint"
                         :> ReqBody '[JSON] [NodeId] :> NodesAPI
 
+-- Node endpoint
+type NodeEndpoint =
+  "node"     :> Summary "Node endpoint"
+             :> Capture "node_id" NodeId
+             :> NodeAPI HyperdataAny
+
 type GargPrivateAPI' =
                 GargAdminAPI
 
-           -- Node endpoint
-           :<|> "node"     :> Summary "Node endpoint"
-                           :> Capture "node_id" NodeId
-                           :> NodeAPI HyperdataAny
+           :<|> NodeEndpoint
 
            -- Context endpoint
            :<|> "context"  :> Summary "Node endpoint"

test/Test/API/Authentication.hs

@@ -42,13 +42,13 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
     -- testing scenarios start here
     describe "GET /api/v1.0/version" $ do
       let version_api = client (Proxy :: Proxy (MkGargAPI (GargAPIVersion GargVersion)))
-      it "requires no auth and returns the current version" $ \(_testEnv, port) -> do
+      it "requires no auth and returns the current version" $ \((_testEnv, port), _) -> do
         result <- runClientM version_api (clientEnv port)
         result `shouldBe` (Right "0.0.6.9.9.7.7")
 
     describe "POST /api/v1.0/auth" $ do
 
-      it "requires no auth and authenticates the user 'alice'" $ \(testEnv, port) -> do
+      it "requires no auth and authenticates the user 'alice'" $ \((testEnv, port), _) -> do
 
         -- Let's create the Alice user.
         void $ flip runReaderT testEnv $ runTestMonad $ do
@@ -69,7 +69,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
         let result = over (_Right . authRes_valid . _Just . authVal_token) (const cannedToken) result0
         result `shouldBe` (Right expected)
 
-      it "denies login for user 'alice' if password is invalid" $ \(_testEnv, port) -> do
+      it "denies login for user 'alice' if password is invalid" $ \((_testEnv, port), _) -> do
         let authPayload = AuthRequest "alice" (GargPassword "wrong")
         result <- runClientM (auth_api authPayload) (clientEnv port)
         let expected = AuthResponse {

test/Test/API/Private.hs

+{-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 module Test.API.Private where
 
+import Control.Exception
 import Control.Monad
 import Control.Monad.Reader
 import Data.Maybe
 import Data.Proxy
+import Fmt
 import Gargantext.API.Admin.Auth.Types
 import Gargantext.API.Routes
 import Gargantext.Core.Types.Individu
@@ -20,8 +24,49 @@ import Test.API.Authentication (auth_api)
 import Test.API.Setup (withTestDBAndPort)
 import Test.Database.Types
 import Test.Hspec
+import Test.Hspec.Wai hiding (pendingWith)
+import Test.Hspec.Wai.Internal (withApplication)
+import Test.Hspec.Wai.JSON
 import qualified Data.Text.Encoding as TE
+import qualified Network.Wai.Handler.Warp as Wai
 import qualified Servant.Auth.Client as SA
+import Data.ByteString (ByteString)
+import Network.Wai.Test (SResponse)
+import Network.HTTP.Types
+import qualified Data.ByteString.Lazy as L
+
+type Env = ((TestEnv, Wai.Port), Application)
+
+curApi :: Builder
+curApi = "v1.0"
+
+mkUrl :: Wai.Port -> Builder -> ByteString
+mkUrl _port urlPiece =
+  "/api/" +| curApi |+ urlPiece
+
+-- | Issue a request with a valid 'Authorization: Bearer' inside.
+protected :: Token -> Method -> ByteString -> L.ByteString -> WaiSession () SResponse
+protected tkn mth url payload =
+  request mth url [ (hAccept, "application/json;charset=utf-8")
+                  , (hContentType, "application/json")
+                  , (hAuthorization, TE.encodeUtf8 tkn)
+                  ] payload
+
+getJSON :: ByteString -> WaiSession () SResponse
+getJSON url =
+  request "GET" url [(hContentType, "application/json")] ""
+
+withValidLogin :: MonadIO m => Wai.Port -> Username -> GargPassword -> (Token -> m a) -> m a
+withValidLogin port ur pwd act = do
+  baseUrl <- liftIO $ parseBaseUrl "http://localhost"
+  manager <- liftIO $ newManager defaultManagerSettings
+  let clientEnv = mkClientEnv manager (baseUrl { baseUrlPort = port })
+  let authPayload = AuthRequest ur pwd
+  result <- liftIO $ runClientM (auth_api authPayload) clientEnv
+  case result of
+    Left err  -> liftIO $ throwIO $ userError (show err)
+    Right res -> let token = _authVal_token $ fromJust (_authRes_valid res) in act token
+
 
 tests :: Spec
 tests = sequential $ aroundAll withTestDBAndPort $ do
@@ -33,7 +78,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
     describe "GET /api/v1.0/user" $ do
 
       -- FIXME(adn): unclear if this is useful at all. Doesn't do permission checking.
-      it "doesn't allow someone with an invalid token to show the results" $ \(testEnv, port) -> do
+      it "doesn't allow someone with an invalid token to show the results" $ \((testEnv, port), _) -> do
 
         -- Let's create two users, Alice & Bob. Alice shouldn't be able to see
         -- Bob's private data and vice-versa.
@@ -52,16 +97,24 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
         length result `shouldBe` 0
 
       -- FIXME(adn): unclear if this is useful at all. Doesn't do permission checking.
-      it "allows 'alice' to see the results" $ \(_testEnv, port) -> do
-
-        let authPayload = AuthRequest "alice" (GargPassword "alice")
-        Right result <- runClientM (auth_api authPayload) (clientEnv port)
-
-        let token = _authVal_token $ fromJust (_authRes_valid result)
+      it "allows 'alice' to see the results" $ \((_testEnv, port), _) -> do
 
+        withValidLogin port "alice" (GargPassword "alice") $ \token -> do
           let ( roots_api :<|> _nodes_api
                 ) = client (Proxy :: Proxy (MkProtectedAPI GargAdminAPI)) (SA.Token $ TE.encodeUtf8 $ token)
           let ( admin_user_api_get :<|> _) = roots_api
 
           _nodes <- runClientM admin_user_api_get (clientEnv port)
           pendingWith "currently useless"
+
+    describe "GET /api/v1.0/node" $ do
+
+      it "unauthorised users shouldn't see anything" $ \((_testEnv, port), app) -> do
+        withApplication app $ do
+          get (mkUrl port "/node/1") `shouldRespondWith` 401
+
+      it "allows 'alice' to see her own node info" $ \((_testEnv, port), app) -> do
+        withApplication app $ do
+          withValidLogin port "alice" (GargPassword "alice") $ \token -> do
+            protected token "GET" (mkUrl port "/node/1") "" `shouldRespondWith` [json| { } |]
+

test/Test/API/Setup.hs

@@ -2,31 +2,32 @@
 
 module Test.API.Setup where
 
-import Prelude
+import Control.Lens
 import Gargantext.API (makeApp)
 import Gargantext.API.Admin.EnvTypes (Mode(Mock), Env (..))
 import Gargantext.API.Admin.Settings
+import Gargantext.API.Admin.Types
+import Gargantext.API.Prelude
+import Gargantext.Core.NLP
+import Gargantext.Core.NodeStory
+import Gargantext.Database.Prelude
+import Gargantext.Prelude.Config
 import Gargantext.System.Logging
+import Network.HTTP.Client.TLS (newTlsManager)
+import Network.Wai (Application)
+import Prelude
+import Servant.Auth.Client ()
 import Servant.Client
 import Test.Database.Setup (withTestDB, fakeIniPath, testEnvToPgConnectionInfo)
-import qualified Network.Wai.Handler.Warp         as Warp
 import Test.Database.Types
-import Gargantext.API.Prelude
+import qualified Gargantext.Prelude.Mail as Mail
+import qualified Gargantext.Prelude.NLP as NLP
 import qualified Gargantext.Utils.Jobs as Jobs
+import qualified Gargantext.Utils.Jobs.Monad as Jobs
 import qualified Gargantext.Utils.Jobs.Queue as Jobs
 import qualified Gargantext.Utils.Jobs.Settings as Jobs
-import qualified Gargantext.Utils.Jobs.Monad as Jobs
-import qualified Gargantext.Prelude.Mail as Mail
-import qualified Gargantext.Prelude.NLP as NLP
-import Network.HTTP.Client.TLS (newTlsManager)
-import Control.Lens
-import Gargantext.API.Admin.Types
-import Gargantext.Prelude.Config
-import Gargantext.Core.NodeStory
-import Gargantext.Database.Prelude
-import Gargantext.Core.NLP
+import qualified Network.Wai.Handler.Warp         as Warp
 import qualified Servant.Job.Async as ServantAsync
-import Servant.Auth.Client ()
 
 
 newTestEnv :: TestEnv -> Logger (GargM Env GargError) -> Warp.Port -> IO Env
@@ -67,17 +68,15 @@ newTestEnv testEnv logger port = do
     , _env_nlp       = nlp_env
     }
 
-withGargApp :: TestEnv -> (Warp.Port -> IO ()) -> IO ()
-withGargApp testEnv action = do
-  let createApp = do
-        withLoggerHoisted Mock $ \ioLogger -> do
-          env <- newTestEnv testEnv ioLogger 8080
-          makeApp env
-  Warp.testWithApplication createApp action
+withGargApp :: Application -> (Warp.Port -> IO ()) -> IO ()
+withGargApp app action = do
+  Warp.testWithApplication (pure app) action
 
-withTestDBAndPort :: ((TestEnv, Warp.Port) -> IO ()) -> IO ()
+withTestDBAndPort :: (((TestEnv, Warp.Port), Application) -> IO ()) -> IO ()
 withTestDBAndPort action =
-  withTestDB $ \testEnv ->
-    withGargApp testEnv $ \port ->
-      action (testEnv, port)
-
+  withTestDB $ \testEnv -> do
+    app <- withLoggerHoisted Mock $ \ioLogger -> do
+             env <- newTestEnv testEnv ioLogger 8080
+             makeApp env
+    withGargApp app $ \port ->
+      action ((testEnv, port), app)