1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module IntegrationTest (
withApp,
integrationSpec
) where
import BasicPrelude
import Data.Aeson (FromJSON, parseJSON, (.:))
import qualified Data.Aeson as JSON
import Network.Wai.Test (simpleBody)
import Test.Hspec (Spec, SpecWith, before,
describe, it)
import qualified Yesod.Test as YT
import TestSite (App, Route(..))
import TestTools
type MyTestApp = YT.TestApp App
withApp :: App -> SpecWith (YT.TestApp App) -> Spec
withApp app = before $ return (app, id)
authUrl :: Text
authUrl = "http://localhost:3000/auth/login"
data AuthUrl = AuthUrl Text deriving (Eq, Show)
instance FromJSON AuthUrl where
parseJSON (JSON.Object v) = AuthUrl <$> v .: "authentication_url"
parseJSON _ = mempty
loginUrl :: Text
loginUrl = "http://localhost:3000/auth/page/hashdb/login"
data LoginUrl = LoginUrl Text deriving (Eq, Show)
instance FromJSON LoginUrl where
parseJSON (JSON.Object v) = LoginUrl <$> v .: "loginUrl"
parseJSON _ = mempty
successMsg :: Text
successMsg = "Login Successful"
data SuccessMsg = SuccessMsg Text deriving (Eq, Show)
instance FromJSON SuccessMsg where
parseJSON (JSON.Object v) = SuccessMsg <$> v .: "message"
parseJSON _ = mempty
getBodyJSON :: FromJSON a => YT.YesodExample site (Maybe a)
getBodyJSON = do
resp <- YT.getResponse
let body = simpleBody <$> resp
result = JSON.decode =<< body
return result
integrationSpec :: SpecWith MyTestApp
integrationSpec = do
describe "The home page" $ do
it "can be accessed" $ do
YT.get HomeR
YT.statusIs 200
describe "The protected page" $ do
it "requires login" $ do
needsLogin GET ("/prot" :: Text)
it "looks right after login by a valid user" $ do
_ <- doLogin "paul" "MyPassword"
YT.get ProtectedR
YT.statusIs 200
YT.bodyContains "OK, you are logged in so you are allowed to see this!"
it "can't be accessed after login then logout" $ do
_ <- doLogin "paul" "MyPassword"
YT.get $ AuthR LogoutR
-- That `get` will get the form from Yesod.Core.Handler.redirectToPost
-- which will not be submitted automatically without javascript
YT.bodyContains "please click on the button below to be redirected"
-- so we do the redirection ourselves:
YT.request $ do
YT.setMethod "POST"
YT.setUrl $ AuthR LogoutR
-- yesod-core-1.4.19 added the CSRF token to the redirectToPost form
YT.addToken
YT.get HomeR
YT.statusIs 200
YT.bodyContains "Your current auth ID: Nothing"
YT.get ProtectedR
YT.statusIs 303
describe "Login" $ do
it "fails when incorrect password given" $ do
loc <- doLoginPart1 "paul" "WrongPassword"
checkFailedLogin loc
it "fails when unknown user name given" $ do
loc <- doLoginPart1 "xyzzy" "WrongPassword"
checkFailedLogin loc
describe "JSON Login" $ do
it "JSON access to protected page gives JSON object with auth URL" $ do
YT.request $ do
YT.setMethod "GET"
YT.setUrl ProtectedR
YT.addRequestHeader ("Accept", "application/json")
YT.statusIs 401
auth <- getBodyJSON
YT.assertEq "Authentication URL" auth (Just $ AuthUrl authUrl)
it "Custom loginHandler using submitRouteHashDB has correct URL in JSON" $ do
YT.request $ do
YT.setMethod "GET"
YT.setUrl authUrl
YT.addRequestHeader ("Accept", "application/json")
YT.statusIs 200
login <- getBodyJSON
YT.assertEq "Login URL" login (Just $ LoginUrl loginUrl)
-- This example needs yesod-test >= 1.5.0.1, since older ones use wrong
-- content type for JSON (https://github.com/yesodweb/yesod/issues/1063).
it "Sending JSON username and password produces JSON success message" $ do
-- This first request is only to get the CSRF token cookie, used below
YT.request $ do
YT.setMethod "GET"
YT.setUrl authUrl
YT.addRequestHeader ("Accept", "application/json")
YT.request $ do
YT.setMethod "POST"
YT.setUrl loginUrl
YT.addRequestHeader ("Accept", "application/json")
YT.addRequestHeader ("Content-Type", "application/json; charset=utf-8")
YT.setRequestBody "{\"username\":\"paul\",\"password\":\"MyPassword\"}"
-- CSRF token is being checked, since yesod-core >= 1.4.14 is forced
YT.addTokenFromCookie
YT.statusIs 200
msg <- getBodyJSON
YT.assertEq "Login success" msg (Just $ SuccessMsg successMsg)
|
