Commit caafe0e7 authored by Alfredo Di Napoli's avatar Alfredo Di Napoli

More progress

parent d02d3d8a
...@@ -115,8 +115,8 @@ auth :: (HasSettings env, CmdCommon env, HasJoseError err) ...@@ -115,8 +115,8 @@ auth :: (HasSettings env, CmdCommon env, HasJoseError err)
auth (AuthRequest u p) = do auth (AuthRequest u p) = do
checkAuthRequest' <- checkAuthRequest u p checkAuthRequest' <- checkAuthRequest u p
case checkAuthRequest' of case checkAuthRequest' of
InvalidUser -> pure $ AuthResponse Nothing (Just $ AuthInvalid "Invalid user") InvalidUser -> pure $ AuthResponse Nothing (Just $ AuthInvalid "Invalid username or password")
InvalidPassword -> pure $ AuthResponse Nothing (Just $ AuthInvalid "Invalid password") InvalidPassword -> pure $ AuthResponse Nothing (Just $ AuthInvalid "Invalid username or password")
Valid to trId uId -> pure $ AuthResponse (Just $ AuthValid to trId uId) Nothing Valid to trId uId -> pure $ AuthResponse (Just $ AuthValid to trId uId) Nothing
--type instance BasicAuthCfg = BasicAuthData -> IO (AuthResult AuthenticatedUser) --type instance BasicAuthCfg = BasicAuthData -> IO (AuthResult AuthenticatedUser)
......
...@@ -26,7 +26,6 @@ import Test.Database.Types ...@@ -26,7 +26,6 @@ import Test.Database.Types
import Test.Hspec import Test.Hspec
import Test.Hspec.Wai hiding (pendingWith) import Test.Hspec.Wai hiding (pendingWith)
import Test.Hspec.Wai.Internal (withApplication) import Test.Hspec.Wai.Internal (withApplication)
import Test.Hspec.Wai.JSON
import qualified Data.Text.Encoding as TE import qualified Data.Text.Encoding as TE
import qualified Network.Wai.Handler.Warp as Wai import qualified Network.Wai.Handler.Warp as Wai
import qualified Servant.Auth.Client as SA import qualified Servant.Auth.Client as SA
...@@ -121,3 +120,9 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -121,3 +120,9 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
withValidLogin port "alice" (GargPassword "alice") $ \token -> do withValidLogin port "alice" (GargPassword "alice") $ \token -> do
protected token "GET" (mkUrl port "/node/8") "" protected token "GET" (mkUrl port "/node/8") ""
`shouldRespondWith'` [jsonFragment| {"id":8,"user_id":2,"name":"alice" } |] `shouldRespondWith'` [jsonFragment| {"id":8,"user_id":2,"name":"alice" } |]
it "forbids 'alice' to see others node private info" $ \((_testEnv, port), app) -> do
withApplication app $ do
withValidLogin port "alice" (GargPassword "alice") $ \token -> do
protected token "GET" (mkUrl port "/node/1") ""
`shouldRespondWith` 403
...@@ -27,6 +27,8 @@ pending reason act = act `catch` (\(e :: SomeException) -> do ...@@ -27,6 +27,8 @@ pending reason act = act `catch` (\(e :: SomeException) -> do
putStrLn $ "PENDING: " <> reason putStrLn $ "PENDING: " <> reason
putStrLn (displayException e)) putStrLn (displayException e))
-- | Similar to 'json' from the 'Test.Hspec.Wai.JSON' package,
-- but allows matching on a /fragment/ of the body.
jsonFragment :: QuasiQuoter jsonFragment :: QuasiQuoter
jsonFragment = QuasiQuoter { jsonFragment = QuasiQuoter {
quoteExp = \input -> [|fromValue $(quoteExp aesonQQ input)|] quoteExp = \input -> [|fromValue $(quoteExp aesonQQ input)|]
......
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