diff --git a/models b/models index d682b5020..32dba863f 100644 --- a/models +++ b/models @@ -139,7 +139,7 @@ File title FilePath content ByteString Maybe -- Nothing iff this is a directory modified UTCTime - deriving Show Eq + deriving Show Eq Generic Submission sheet SheetId ratingPoints Points Maybe -- "Just" does not mean done diff --git a/templates/widgets/campus-login-form.hamlet b/templates/widgets/campus-login-form.hamlet index 634991289..fee3691a2 100644 --- a/templates/widgets/campus-login-form.hamlet +++ b/templates/widgets/campus-login-form.hamlet @@ -1,2 +1,2 @@ -
+ ^{login} diff --git a/templates/widgets/dummy-login-form.hamlet b/templates/widgets/dummy-login-form.hamlet index f44f82d91..c1c11574d 100644 --- a/templates/widgets/dummy-login-form.hamlet +++ b/templates/widgets/dummy-login-form.hamlet @@ -1,2 +1,2 @@ - + ^{login} diff --git a/templates/widgets/hash-login-form.hamlet b/templates/widgets/hash-login-form.hamlet index 203a02f2e..d097216bd 100644 --- a/templates/widgets/hash-login-form.hamlet +++ b/templates/widgets/hash-login-form.hamlet @@ -1,2 +1,2 @@ - + ^{login} diff --git a/test/Handler/ProfileSpec.hs b/test/Handler/ProfileSpec.hs index b14e59868..aaf7a0da5 100644 --- a/test/Handler/ProfileSpec.hs +++ b/test/Handler/ProfileSpec.hs @@ -4,20 +4,42 @@ module Handler.ProfileSpec (spec) where import TestImport +import qualified Data.CaseInsensitive as CI + +import Yesod.Core.Handler (toTextUrl) +import Yesod.Core.Unsafe (fakeHandlerGetLogger) + spec :: Spec spec = withApp $ do + describe "Profile page" $ do + it "asserts no access to my-account for anonymous users" $ do + get ProfileR - describe "Profile page" $ do - it "asserts no access to my-account for anonymous users" $ do - get ProfileR - loc <- getLocation - assertEq "Redirect is to Login" loc - either (fail . unpack) (\_ -> return ()) =<< followRedirect - statusIs 200 + app <- getTestYesod + loginText <- fakeHandlerGetLogger appLogger app (toTextUrl $ AuthR LoginR) - it "asserts access to my-account for authenticated users" $ do - userEntity <- createUser "foo" - authenticateAs userEntity + assertHeader "Location" $ encodeUtf8 loginText + + either (fail . unpack) (\_ -> return ()) =<< followRedirect + statusIs 200 - get ProfileR - statusIs 200 + it "asserts access to my-account for authenticated users" $ do + userEntity <- createUser "foo" + authenticateAs userEntity + + get ProfileR + statusIs 200 + + it "displays basic user data" $ do + userEntity@(Entity _userId User{..}) <- createUser "foo" + authenticateAs userEntity + + get ProfileDataR + statusIs 200 + + forM_ (words userDisplayName) $ \nameWord -> do + htmlAnyContain ".profile dd" $ unpack nameWord + htmlAnyContain ".profile dd" $ unpack userSurname + htmlAnyContain ".profile dd" . unpack $ CI.original userIdent + htmlAnyContain ".profile dd" . unpack $ CI.original userEmail + diff --git a/test/Handler/Utils/ZipSpec.hs b/test/Handler/Utils/ZipSpec.hs index b384143fd..eca7d9c6a 100644 --- a/test/Handler/Utils/ZipSpec.hs +++ b/test/Handler/Utils/ZipSpec.hs @@ -23,6 +23,7 @@ instance Arbitrary File where fileModified <- addUTCTime <$> arbitrary <*> pure (UTCTime date 0) fileContent <- arbitrary return File{..} + shrink = genericShrink spec :: Spec spec = describe "Zip file handling" $ do @@ -31,7 +32,7 @@ spec = describe "Zip file handling" $ do zipFiles' <- runConduit $ Conduit.sourceList zipFiles =$= produceZip def =$= void consumeZip =$= Conduit.consume forM_ (zipFiles `zip` zipFiles') $ \(file, file') -> do let acceptableFilenameChanges - = makeValid . bool (dropWhileEnd isPathSeparator) addTrailingPathSeparator (isNothing $ fileContent file) . normalise . makeValid + = makeValid . dropWhile isPathSeparator . bool (dropWhileEnd isPathSeparator) addTrailingPathSeparator (isNothing $ fileContent file) . normalise . makeValid acceptableTimeDifference t1 t2 = abs (diffUTCTime t1 t2) <= 2 (shouldBe `on` acceptableFilenameChanges) (fileTitle file') (fileTitle file) when (inZipRange $ fileModified file) $ diff --git a/test/Model/TypesSpec.hs b/test/Model/TypesSpec.hs index 87302d3c7..568412251 100644 --- a/test/Model/TypesSpec.hs +++ b/test/Model/TypesSpec.hs @@ -14,7 +14,7 @@ instance Arbitrary Season where instance Arbitrary TermIdentifier where arbitrary = do season <- arbitrary - year <- arbitrary + year <- arbitrary `suchThat` (\y -> abs y >= 100) return $ TermIdentifier{..} shrink = genericShrink @@ -24,8 +24,9 @@ spec = do it "has compatible encoding/decoding to/from Text" . property $ \term -> termFromText (termToText term) == Right term it "works for some examples" . mapM_ termExample $ - [ (TermIdentifier 2017 Summer, "S2017") - , (TermIdentifier 1995 Winter, "W1995") + [ (TermIdentifier 2017 Summer, "S17") + , (TermIdentifier 1995 Winter, "W95") + , (TermIdentifier 3068 Winter, "W3068") ] termExample :: (TermIdentifier, Text) -> Expectation diff --git a/test/TestImport.hs b/test/TestImport.hs index 32b83ad33..35464d9ce 100644 --- a/test/TestImport.hs +++ b/test/TestImport.hs @@ -75,8 +75,6 @@ wipeDB app = runDBWithApp app $ do -- | Authenticate as a user. This relies on the `auth-dummy-login: true` flag -- being set in test-settings.yaml, which enables dummy authentication in -- Foundation.hs --- --- FIXME authenticateAs :: Entity User -> YesodExample UniWorX () authenticateAs (Entity _ User{..}) = do request $ do @@ -86,7 +84,7 @@ authenticateAs (Entity _ User{..}) = do request $ do setMethod "POST" - addTokenFromCookie + addToken_ "#login--dummy" byLabelExact "Nutzer-Kennung" $ CI.original userIdent setUrl $ AuthR $ PluginR "dummy" []