Commit 6f88ca23 authored by Alfredo Di Napoli's avatar Alfredo Di Napoli

WIP - try to test protected endpoint

parent cad95a4c
......@@ -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
......
......@@ -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
......
......@@ -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"
......
......@@ -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 {
......
{-# 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
it "allows 'alice' to see the results" $ \((_testEnv, port), _) -> do
let authPayload = AuthRequest "alice" (GargPassword "alice")
Right result <- runClientM (auth_api authPayload) (clientEnv port)
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
let token = _authVal_token $ fromJust (_authRes_valid result)
_nodes <- runClientM admin_user_api_get (clientEnv port)
pendingWith "currently useless"
let ( roots_api :<|> _nodes_api
) = client (Proxy :: Proxy (MkProtectedAPI GargAdminAPI)) (SA.Token $ TE.encodeUtf8 $ token)
let ( admin_user_api_get :<|> _) = roots_api
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| { } |]
_nodes <- runClientM admin_user_api_get (clientEnv port)
pendingWith "currently useless"
......@@ -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)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment