{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} {-# OPTIONS_GHC -Wno-orphans #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} module Test.API.Authentication ( tests , auth_api ) where import Control.Lens import Data.Aeson qualified as Aeson import Data.Aeson.QQ import Data.Text as T import Gargantext.API.Admin.Auth.Types import Gargantext.API.Routes.Named import Gargantext.Core.Types import Gargantext.Core.Types.Individu import Gargantext.Database.Action.User.New import Gargantext.Prelude import Network.HTTP.Client hiding (Proxy) import Network.HTTP.Types.Status (status403) import Prelude qualified import Servant.Auth.Client () import Servant.Client.Streaming import Servant.Client.Core.Response qualified as SR import Servant.Client.Generic (genericClient) import Test.API.Routes (auth_api) import Test.API.Setup (withTestDBAndPort, setupEnvironment, SpecContext (..)) import Test.Database.Types import Test.Hspec cannedToken :: T.Text cannedToken = "eyJhbGciOiJIUzUxMiJ9.eyJkYXQiOnsiaWQiOjF9fQ.t49zZSqkPAulEkYEh4pW17H2uwrkyPTdZKwHyG3KUJ0hzU2UUoPBNj8vdv087RCVBJ4tXgxNbP4j0RBv3gxdqg" tests :: Spec tests = sequential $ aroundAll withTestDBAndPort $ beforeAllWith (\ctx -> setupEnvironment (_sctx_env ctx) >>= (const $ pure ctx)) $ do describe "Authentication" $ do baseUrl <- runIO $ parseBaseUrl "http://localhost" manager <- runIO $ newManager defaultManagerSettings let clientEnv port = mkClientEnv manager (baseUrl { baseUrlPort = port }) -- testing scenarios start here describe "GET /api/v1.0/version" $ do let version_api = gargVersionEp . gargAPIVersion . mkBackEndAPI $ genericClient it "requires no auth and returns the current version" $ \SpecContext{..} -> do result <- runClientM version_api (clientEnv _sctx_port) case result of Left err -> Prelude.fail (show err) Right r -> r `shouldSatisfy` ((>= 1) . T.length) -- we got something back describe "POST /api/v1.0/auth" $ do it "requires no auth and authenticates the user 'alice'" $ \(SpecContext testEnv port _app _) -> do -- Let's create the Alice user. void $ flip runReaderT testEnv $ runTestMonad $ do void $ new_user $ mkNewUser "alice@gargan.text" (GargPassword "alice") let authPayload = AuthRequest "alice" (GargPassword "alice") result0 <- runClientM (auth_api authPayload) (clientEnv port) let result = over (_Right . authRes_token) (const cannedToken) result0 let expected = AuthResponse { _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 } result `shouldBe` Right expected it "denies login for user 'alice' if password is invalid" $ \(SpecContext _testEnv port _app _) -> do let authPayload = AuthRequest "alice" (GargPassword "wrong") result <- runClientM (auth_api authPayload) (clientEnv port) -- putText $ "result: " <> show result -- result `shouldBe` (Left $ InvalidUsernameOrPassword) result `shouldSatisfy` isLeft {- Left (FailureResponse (Request {requestPath = (BaseUrl {baseUrlScheme = Http, baseUrlHost = "localhost", baseUrlPort = 43009, baseUrlPath = ""},"/api/v1.0/auth"), requestQueryString = fromList [], requestBody = Just ((),application/json;charset=utf-8), requestAccept = fromList [application/json;charset=utf-8,application/json], requestHeaders = fromList [("X-Garg-Error-Scheme","new")], requestHttpVersion = HTTP/1.1, requestMethod = "POST"}) (Response {responseStatusCode = Status {statusCode = 403, statusMessage = "Invalid username or password."}, responseHeaders = fromList [("Transfer-Encoding","chunked"),("Date","Tue, 05 Nov 2024 09:40:35 GMT"),("Server","Warp/3.3.31")], responseHttpVersion = HTTP/1.1, responseBody = "{\"data\":{},\"diagnostic\":\"Invalid username or password.\",\"type\":\"EC_403__login_failed_invalid_username_or_password\"}"})) -} let (Left result') = result result' `shouldSatisfy` isFailureResponse let (FailureResponse _ res) = result' SR.responseStatusCode res `shouldBe` status403 SR.responseBody res `shouldBe` (Aeson.encode [aesonQQ| { "data": {} , "diagnostic": "Invalid username or password." , "type": "EC_403__login_failed_invalid_username_or_password" } |]) isFailureResponse :: ClientError -> Bool isFailureResponse (FailureResponse _ _) = True isFailureResponse _ = False