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
132
133
134
135
136
137
138
139
140
141
142
143
144
145
|
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}
module TestTools (
assertFailure,
urlPath,
needsLogin,
doLogin,
doLoginPart1,
doLoginPart2,
checkFailedLogin,
StdMethod(..)
) where
import TestSite (App(..))
import BasicPrelude
import qualified Prelude (show)
import Data.Text (pack, unpack)
import Data.ByteString.Lazy (toStrict)
import Yesod.Core (RedirectUrl)
import Yesod.Test
import qualified Data.ByteString.Char8 as BC
import Network.URI (URI(uriPath), parseURI)
import Network.HTTP.Types (StdMethod(..), renderStdMethod, Status(..))
import Network.Wai.Test (SResponse(..))
-- Adjust as necessary to the url prefix in the Testing configuration
testRoot :: ByteString
testRoot = "http://localhost:3000"
-- Adjust as necessary for the path part of the url for a page to force login
forceLogin :: ByteString
forceLogin = "/prot"
-- Adjust as necessary for the expected path part of the URL after login
afterLogin :: ByteString
afterLogin = "/prot"
-- Force failure by swearing that black is white, and pigs can fly...
assertFailure :: String -> YesodExample App ()
assertFailure msg = assertEq msg True False
-- Convert an absolute URL (eg extracted from responses) to just the path
-- for use in test requests.
urlPath :: Text -> Text
urlPath = pack . maybe "" uriPath . parseURI . unpack
-- Internal use only - actual urls are ascii, so exact encoding is irrelevant
urlPathB :: ByteString -> Text
urlPathB = urlPath . decodeUtf8
-- Stages in login process, used below
firstRedirect :: RedirectUrl App url =>
StdMethod -> url -> YesodExample App (Maybe ByteString)
firstRedirect method url = do
request $ do
setMethod $ renderStdMethod method
setUrl url
extractLocation -- We should get redirected to the login page
assertLoginPage :: ByteString -> YesodExample App ()
assertLoginPage loc = do
assertEq "correct login redirection location"
(testRoot ++ "/auth/login") loc
get $ urlPathB loc
statusIs 200
bodyContains "Login"
submitLogin :: Text -> Text -> YesodExample App (Maybe ByteString)
submitLogin user pass = do
-- Ideally we would extract this url from the login form on the current page
request $ do
setMethod "POST"
setUrl $ urlPathB $ testRoot ++ "/auth/page/hashdb/login"
addPostParam "username" user
addPostParam "password" pass
addToken
extractLocation -- Successful login should redirect to the home page
extractLocation :: YesodExample App (Maybe ByteString)
extractLocation = do
withResponse ( \ SResponse { simpleStatus = s, simpleHeaders = h } -> do
let code = statusCode s
assertEq ("Expected a 302 or 303 redirection status "
++ "but received " ++ Prelude.show code)
(code `elem` [302,303])
True
return $ lookup "Location" h
)
-- Check that accessing the url with the given method requires login, and
-- that it redirects us to what looks like the login page. Note that this is
-- *not* an ajax request, whatever the method, so the redirection *should*
-- result in the HTML login page.
--
needsLogin :: RedirectUrl App url => StdMethod -> url -> YesodExample App ()
needsLogin method url = do
mbloc <- firstRedirect method url
maybe (assertFailure "Should have location header") assertLoginPage mbloc
-- Do a login (using hashdb auth). This just attempts to go to the home
-- url, and follows through the login process. It should probably be the
-- first thing in each "it" spec.
--
-- To allow testing of the login process itself, doLogin is split into two
-- parts.
--
doLogin :: Text -> Text -> YesodExample App (Maybe ByteString)
doLogin user pass = do
redir <- doLoginPart1 user pass
doLoginPart2 redir
doLoginPart1 :: Text -> Text -> YesodExample App (Maybe ByteString)
doLoginPart1 user pass = do
mbloc <- firstRedirect GET $ urlPathB $ testRoot ++ forceLogin
maybe (assertFailure "Should have location header") assertLoginPage mbloc
submitLogin user pass
doLoginPart2 :: Maybe ByteString -> YesodExample App (Maybe ByteString)
doLoginPart2 mbloc2 = do
maybe (assertFailure "Should have second location header")
(assertEq "Check after-login redirection" $ testRoot ++ afterLogin)
mbloc2
-- Now get the home page to obtain the sessAuth value
get ("/" :: Text)
statusIs 200
resp <- getResponse
let sessAuth = (fmap simpleBody resp) >>= findSessAuth
return sessAuth
where
findSessAuth body =
let stmt = snd $ BC.breakSubstring "var sessAuth =" $ toStrict body
parts = BC.split '"' stmt
in case parts of
(_:sa:_) -> Just sa
_ -> Nothing
-- Use this instead of doLoginPart2 if the login is expected to fail
--
checkFailedLogin :: Maybe ByteString -> YesodExample App ()
checkFailedLogin mbloc2 = do
maybe (assertFailure "Should have second location header")
assertLoginPage
mbloc2
bodyContains "Invalid username/password combination"
|
