diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,8 @@ +## 1.7 + +* Update for changes in yesod version 1.6, but retain compatibility with previous versions +* Remove support for GHC below 7.10, and lts below 6 + ## 1.6.2 * Use `PasswordStore` from `yesod-auth` instead of `pwstore-fast` (uses `cryptonite` instead of `cryptohash`) diff --git a/Yesod/Auth/HashDB.hs b/Yesod/Auth/HashDB.hs --- a/Yesod/Auth/HashDB.hs +++ b/Yesod/Auth/HashDB.hs @@ -3,6 +3,8 @@ {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE OverloadedStrings #-} ------------------------------------------------------------------------------- -- | @@ -166,9 +168,6 @@ ) where -#if __GLASGOW_HASKELL__ < 710 -import Control.Applicative ((<$>), (<*>), pure) -#endif import Yesod.Auth.Util.PasswordStore (makePassword, strengthenPassword, verifyPassword, passwordStrength) import Data.Aeson ((.:?)) @@ -181,9 +180,10 @@ import Yesod.Form import Yesod.Persist -#if !MIN_VERSION_yesod_core(1,4,14) -defaultCsrfParamName :: Text -defaultCsrfParamName = "_token" +#if !MIN_VERSION_yesod_core(1,6,0) +type HandlerFor site a = HandlerT site IO a +type WidgetFor site a = WidgetT site IO () +#define liftHandler lift #endif -- | Default strength used for passwords (see "Yesod.Auth.Util.PasswordStore" @@ -325,7 +325,7 @@ validateUser :: HashDBPersist site user => Unique user -- ^ User unique identifier -> Text -- ^ Password in plaintext - -> HandlerT site IO Bool + -> HandlerFor site Bool validateUser userID passwd = do -- Get user data user <- runDB $ getBy userID @@ -343,21 +343,21 @@ -- See the \"JSON Interface\" section above for more details. postLoginR :: HashDBPersist site user => (Text -> Maybe (Unique user)) - -> HandlerT Auth (HandlerT site IO) TypedContent + -> AuthHandler site TypedContent postLoginR uniq = do ct <- lookupHeader "Content-Type" let jsonContent = ((== "application/json") . simpleContentType) <$> ct UserPass mu mp <- case jsonContent of Just True -> requireJsonBody - _ -> lift $ runInputPost $ UserPass + _ -> liftHandler $ runInputPost $ UserPass <$> iopt textField "username" <*> iopt textField "password" - isValid <- lift $ fromMaybe (return False) + isValid <- liftHandler $ fromMaybe (return False) (validateUser <$> (uniq =<< mu) <*> mp) if isValid - then lift $ setCredsRedirect $ Creds "hashdb" (fromMaybe "" mu) [] + then liftHandler $ setCredsRedirect $ Creds "hashdb" (fromMaybe "" mu) [] else loginErrorMessageI LoginR Msg.InvalidUsernamePass @@ -380,18 +380,20 @@ -- -- Since 1.3.2 -- -authHashDBWithForm :: HashDBPersist site user => - (Route site -> WidgetT site IO ()) +authHashDBWithForm :: forall site user. + HashDBPersist site user => + (Route site -> WidgetFor site ()) -> (Text -> Maybe (Unique user)) -> AuthPlugin site authHashDBWithForm form uniq = AuthPlugin "hashdb" dispatch $ \tm -> form (tm login) where + dispatch :: Text -> [Text] -> AuthHandler site TypedContent dispatch "POST" ["login"] = postLoginR uniq >>= sendResponse dispatch _ _ = notFound -defaultForm :: Yesod app => Route app -> WidgetT app IO () +defaultForm :: Yesod app => Route app -> WidgetFor app () defaultForm loginRoute = do request <- getRequest let mtok = reqToken request @@ -433,8 +435,7 @@ -- details. -- -- Since 1.6 -submitRouteHashDB :: YesodAuth site => - HandlerT Auth (HandlerT site IO) (Route site) +submitRouteHashDB :: YesodAuth site => AuthHandler site (Route site) submitRouteHashDB = do toParent <- getRouteToParent return $ toParent login diff --git a/stack.yaml b/stack.yaml --- a/stack.yaml +++ b/stack.yaml @@ -1,5 +1,4 @@ -resolver: lts-8.24 -packages: +resolver: lts-10.5 +packages: - . -extra-deps: -- yesod-auth-1.4.18 +extra-deps: [] diff --git a/test/IntegrationTest.hs b/test/IntegrationTest.hs --- a/test/IntegrationTest.hs +++ b/test/IntegrationTest.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} @@ -18,15 +17,9 @@ import TestSite (App, Route(..), Handler, runDB) import TestTools -#if MIN_VERSION_yesod_test(1,5,0) type MyTestApp = YT.TestApp App withApp :: App -> SpecWith (YT.TestApp App) -> Spec withApp app = before $ return (app, id) -#else -type MyTestApp = App -withApp :: App -> SpecWith App -> Spec -withApp app = before $ return app -#endif authUrl :: Text authUrl = "http://localhost:3000/auth/login" @@ -84,15 +77,8 @@ YT.request $ do YT.setMethod "POST" YT.setUrl $ AuthR LogoutR -#if MIN_VERSION_yesod_core(1,4,19) -- yesod-core-1.4.19 added the CSRF token to the redirectToPost form YT.addToken -#elif MIN_VERSION_yesod_core(1,4,14) && MIN_VERSION_yesod_test(1,4,4) - -- Otherwise we still use CSRF middleware (see TestSite.hs) from - -- yesod-core 1.4.14 onwards as long as we can get the token - -- from the cookie, which was implemented in yesod-test-1.4.4 - YT.addTokenFromCookie -#endif YT.get HomeR YT.statusIs 200 YT.bodyContains "Your current auth ID: Nothing" @@ -124,8 +110,7 @@ YT.statusIs 200 login <- getBodyJSON YT.assertEqual "Login URL" login (Just $ LoginUrl loginUrl) -#if MIN_VERSION_yesod_test(1,5,0) - -- Disable this example for yesod-test < 1.5.0.1, since it uses the wrong + -- 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 @@ -139,10 +124,8 @@ 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 a - -- dependency of yesod-test >= 1.5 on which this item is conditional. + -- CSRF token is being checked, since yesod-core >= 1.4.14 is forced YT.addTokenFromCookie YT.statusIs 200 msg <- getBodyJSON YT.assertEqual "Login success" msg (Just $ SuccessMsg successMsg) -#endif diff --git a/test/TestSite.hs b/test/TestSite.hs --- a/test/TestSite.hs +++ b/test/TestSite.hs @@ -1,7 +1,4 @@ {-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ < 710 -{-# LANGUAGE DeriveDataTypeable #-} -#endif {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} @@ -19,10 +16,6 @@ runDB ) where -#if __GLASGOW_HASKELL__ < 710 -import Control.Applicative ((<$>)) -import Data.Typeable (Typeable) -#endif import Control.Monad (when) import Data.Text import Database.Persist.Sqlite @@ -33,18 +26,7 @@ submitRouteHashDB) import Yesod.Auth.Message (AuthMessage (InvalidLogin)) -#if ! MIN_VERSION_yesod_auth(1,4,9) -import Yesod.Auth.Message (AuthMessage (LoginTitle)) -defaultLoginHandler :: AuthHandler master Html -defaultLoginHandler = do - tp <- getRouteToParent - lift $ authLayout $ do - setTitleI LoginTitle - master <- getYesod - mapM_ (flip apLogin tp) (authPlugins master) -#endif - -- Trivial example site needing authentication -- share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase| @@ -53,9 +35,6 @@ password Text Maybe UniqueUser name deriving Show -#if __GLASGOW_HASKELL__ < 710 - deriving Typeable -#endif |] instance HashDBUser User where @@ -67,6 +46,17 @@ , appDBConnection :: SqlBackend } +#if !MIN_VERSION_yesod_core(1,6,0) +#define liftHandler lift +#define doRunDB runDB +getAppHttpManager :: App -> Manager +getAppHttpManager = appHttpManager +#else +#define doRunDB liftHandler $ runDB +getAppHttpManager :: (MonadHandler m, HandlerSite m ~ App) => m Manager +getAppHttpManager = appHttpManager <$> getYesod +#endif + mkYesod "App" [parseRoutes| / HomeR GET /prot ProtectedR GET @@ -86,11 +76,9 @@ -- Other pages (HomeR and AuthR _) do not require login isAuthorized _ _ = return Authorized -#if MIN_VERSION_yesod_core(1,4,19) || (MIN_VERSION_yesod_core(1,4,14) && MIN_VERSION_yesod_test(1,4,4)) - -- CSRF middleware requires yesod-core-1.4.14, but only include it if tests - -- can get at the token (see IntegrationTest.hs for additional comment). + -- CSRF middleware requires yesod-core-1.4.14, yesod-test >= 1.5 is + -- required so that tests can get at the token. yesodMiddleware = defaultCsrfMiddleware . defaultYesodMiddleware -#endif instance YesodPersist App where type YesodPersistBackend App = SqlBackend @@ -104,7 +92,7 @@ loginDest _ = HomeR logoutDest _ = HomeR - authenticate creds = runDB $ do + authenticate creds = doRunDB $ do x <- getBy $ UniqueUser $ credsIdent creds case x of Just (Entity uid _) -> return $ Authenticated uid @@ -112,11 +100,11 @@ authPlugins _ = [ authHashDB (Just . UniqueUser) ] - authHttpManager = appHttpManager + authHttpManager = getAppHttpManager loginHandler = do submission <- submitRouteHashDB - render <- lift getUrlRender + render <- liftHandler getUrlRender typedContent@(TypedContent ct _) <- selectRep $ do provideRepType typeHtml $ return emptyContent -- Dummy: the real Html version is at the end diff --git a/yesod-auth-hashdb.cabal b/yesod-auth-hashdb.cabal --- a/yesod-auth-hashdb.cabal +++ b/yesod-auth-hashdb.cabal @@ -1,5 +1,5 @@ name: yesod-auth-hashdb -version: 1.6.2 +version: 1.7 license: MIT license-file: LICENSE author: Patrick Brisbin, later changes Paul Rouse @@ -32,14 +32,14 @@ test/standalone-testsite.cabal library - build-depends: base >= 4 && < 5 + build-depends: base >= 4.8 && < 5 , bytestring >= 0.9.1.4 - , yesod-core >= 1.4 && < 1.5 - , yesod-auth >= 1.4.18 && < 1.5 + , yesod-core >= 1.4.19 && < 1.7 + , yesod-auth >= 1.4.18 && < 1.7 , text >= 0.7 , yesod-persistent >= 1.2 - , persistent >= 2.1 && < 2.8 - , yesod-form >= 1.4 && < 1.5 + , persistent >= 2.1 && < 2.9 + , yesod-form >= 1.4 && < 1.7 , aeson exposed-modules: Yesod.Auth.HashDB @@ -52,7 +52,7 @@ ghc-options: -Wall other-modules: ExampleData NonDBTests - build-depends: base >= 4 && < 5 + build-depends: base >= 4.8 && < 5 , yesod-auth-hashdb , hspec , text @@ -65,12 +65,12 @@ other-modules: IntegrationTest , TestSite , TestTools - build-depends: base >= 4 && < 5 + build-depends: base >= 4.8 && < 5 , aeson , bytestring , basic-prelude , containers - , hspec >= 2.0.0 + , hspec >= 2.0.0 , http-conduit , http-types , monad-logger @@ -81,10 +81,10 @@ , unordered-containers , wai-extra , yesod - , yesod-auth + , yesod-auth >= 1.4.18 && < 1.5 || >= 1.6.1 && < 1.7 , yesod-auth-hashdb , yesod-core - , yesod-test >= 1.4.3 + , yesod-test >= 1.5.0.1 source-repository head type: git