diff --git a/CHANGES b/CHANGES --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,14 @@ +Version 0.15.1.1 released 03 Jul 2023 + + * Allow latest aeson. + + * Allow building with Stackage lts-21 (sternenseemann). + + * Allow building with lts-20 (#685, Jens Petersen). + + * Adjust for hoauth2 >= 2.3.0 (sternenseemann). + + Version 0.15.1.0 released 10 Dec 2021 * Set the portable flag on sendfile to avoid an error diff --git a/gitit.cabal b/gitit.cabal --- a/gitit.cabal +++ b/gitit.cabal @@ -1,6 +1,6 @@ cabal-version: 2.0 name: gitit -version: 0.15.1.0 +version: 0.15.1.1 build-type: Simple synopsis: Wiki using happstack, git or darcs, and pandoc. description: Gitit is a wiki backed by a git, darcs, or mercurial @@ -133,9 +133,9 @@ mtl, old-time, temporary, - pandoc >= 2.9 && < 2.17, - pandoc-types >= 1.20 && < 1.23, - skylighting >= 0.8.2.3 && < 0.13, + pandoc >= 2.9 && < 2.20 || >= 3.0 && < 3.2, + pandoc-types >= 1.20 && < 1.24, + skylighting >= 0.8.2.3 && < 0.14, bytestring, text, random, @@ -149,7 +149,7 @@ filestore >= 0.6.5 && < 0.7, zlib >= 0.5 && < 0.7, url >= 2.1, - happstack-server >= 7.5 && < 7.8, + happstack-server >= 7.5 && < 7.9, base64-bytestring >= 0.1, xml >= 1.3.5, hslogger >= 1, @@ -162,11 +162,11 @@ json >= 0.4 && < 0.11, uri-bytestring >= 0.2.3.3, split, - hoauth2 >= 1.3.0 && < 1.17, + hoauth2 >= 2.3.0 && < 2.9, xml-conduit >= 1.5 && < 1.10, http-conduit >= 2.1.6 && < 2.4, http-client-tls >= 0.2.2 && < 0.4, - aeson >= 0.7 && < 2.1, + aeson >= 0.7 && < 2.3, uuid >= 1.3 && < 1.4, network-uri >= 2.6, network >= 2.6 && < 3.2, diff --git a/src/Network/Gitit/Authentication/Github.hs b/src/Network/Gitit/Authentication/Github.hs --- a/src/Network/Gitit/Authentication/Github.hs +++ b/src/Network/Gitit/Authentication/Github.hs @@ -27,6 +27,7 @@ import Data.UUID (toString) import Data.UUID.V4 (nextRandom) import qualified Control.Exception as E +import Control.Monad.Except import Prelude loginGithubUser :: OAuth2 -> Params -> Handler @@ -54,16 +55,14 @@ newManager tlsManagerSettings >>= getUserInternal where getUserInternal mgr = - liftIO $ do + liftIO $ runExceptT $ do let (Just state) = rState githubCallbackPars if state == githubState then do let (Just code) = rCode githubCallbackPars - ifSuccess - "No access token found yet" - (fetchAccessToken mgr (oAuth2 ghConfig) (ExchangeToken $ pack code)) - (\at -> ifSuccess - "User Authentication failed" + at <- withExceptT (oauthToGithubError "No access token found yet") + $ fetchAccessToken mgr (oAuth2 ghConfig) (ExchangeToken $ pack code) + liftIO >=> liftEither $ ifSuccess "User Authentication failed" (userInfo mgr (accessToken at)) (\githubUser -> ifSuccess ("No email for user " ++ unpack (gLogin githubUser) ++ " returned by Github") @@ -79,9 +78,9 @@ Just githuborg -> ifSuccess ("Membership check failed: the user " ++ unpack gitLogin ++ " is required to be a member of the organization " ++ unpack githuborg ++ ".") (orgInfo gitLogin githuborg mgr (accessToken at)) - (\_ -> return $ Right user)))) + (\_ -> return $ Right user))) else - return $ Left $ + throwError $ GithubLoginError ("The state sent to github is not the same as the state received: " ++ state ++ ", but expected sent state: " ++ githubState) Nothing ifSuccess errMsg failableAction successAction = E.catch @@ -90,6 +89,7 @@ (\exception -> liftIO $ return $ Left $ GithubLoginError errMsg (Just $ show (exception :: E.SomeException))) + oauthToGithubError errMsg e = GithubLoginError errMsg (Just $ show e) data GithubCallbackPars = GithubCallbackPars { rCode :: Maybe String , rState :: Maybe String } @@ -106,14 +106,14 @@ #else userInfo :: Manager -> AccessToken -> IO (OAuth2Result OA.Errors GithubUser) #endif -userInfo mgr token = authGetJSON mgr token $ githubUri "/user" +userInfo mgr token = runExceptT $ authGetJSON mgr token $ githubUri "/user" #if MIN_VERSION_hoauth2(1, 9, 0) mailInfo :: Manager -> AccessToken -> IO (Either BSL.ByteString [GithubUserMail]) #else mailInfo :: Manager -> AccessToken -> IO (OAuth2Result OA.Errors [GithubUserMail]) #endif -mailInfo mgr token = authGetJSON mgr token $ githubUri "/user/emails" +mailInfo mgr token = runExceptT $ authGetJSON mgr token $ githubUri "/user/emails" #if MIN_VERSION_hoauth2(1, 9, 0) orgInfo :: Text -> Text -> Manager -> AccessToken -> IO (Either BSL.ByteString BSL.ByteString) @@ -122,7 +122,7 @@ #endif orgInfo gitLogin githubOrg mgr token = do let url = githubUri $ "/orgs/" `BS.append` encodeUtf8 githubOrg `BS.append` "/members/" `BS.append` encodeUtf8 gitLogin - authGetBS mgr token url + runExceptT $ authGetBS mgr token url type UriPath = BS.ByteString diff --git a/src/Network/Gitit/Config.hs b/src/Network/Gitit/Config.hs --- a/src/Network/Gitit/Config.hs +++ b/src/Network/Gitit/Config.hs @@ -40,7 +40,7 @@ import System.FilePath (()) import Text.Pandoc hiding (ERROR, WARNING, MathJax, MathML, WebTeX, getDataFileName) import qualified Control.Exception as E -import Network.OAuth.OAuth2 (OAuth2(..), oauthCallback, oauthOAuthorizeEndpoint, oauthClientId, oauthClientSecret) +import Network.OAuth.OAuth2 (OAuth2(..)) import URI.ByteString (parseURI, laxURIParserOptions) import qualified Data.ByteString.Char8 as BS import Network.Gitit.Compat.Except @@ -254,15 +254,11 @@ cfOrg <- if hasGithubProp "github-org" then fmap Just (getGithubProp "github-org") else return Nothing - let cfgOAuth2 = OAuth2 { oauthClientId = T.pack cfOauthClientId -#if MIN_VERSION_hoauth2(1, 11, 0) - , oauthClientSecret = Just $ T.pack cfOauthClientSecret -#else - , oauthClientSecret = T.pack cfOauthClientSecret -#endif - , oauthCallback = Just cfOauthCallback - , oauthOAuthorizeEndpoint = cfOauthOAuthorizeEndpoint - , oauthAccessTokenEndpoint = cfOauthAccessTokenEndpoint + let cfgOAuth2 = OAuth2 { oauth2ClientId = T.pack cfOauthClientId + , oauth2ClientSecret = T.pack cfOauthClientSecret + , oauth2RedirectUri = cfOauthCallback + , oauth2AuthorizeEndpoint = cfOauthOAuthorizeEndpoint + , oauth2TokenEndpoint = cfOauthAccessTokenEndpoint } return $ githubConfig cfgOAuth2 $ fmap T.pack cfOrg where getGithubProp = get cp "Github" diff --git a/src/Network/Gitit/Initialize.hs b/src/Network/Gitit/Initialize.hs --- a/src/Network/Gitit/Initialize.hs +++ b/src/Network/Gitit/Initialize.hs @@ -138,7 +138,11 @@ RST -> writeRST defOpts <=< toPandoc Textile -> writeTextile defOpts <=< toPandoc Org -> writeOrg defOpts <=< toPandoc +#if MIN_VERSION_pandoc(3,0,0) + DocBook -> writeDocBook5 defOpts <=< toPandoc +#else DocBook -> writeDocbook5 defOpts <=< toPandoc +#endif MediaWiki -> writeMediaWiki defOpts <=< toPandoc CommonMark -> writeCommonMark defOpts <=< toPandoc diff --git a/src/Network/Gitit/Plugins.hs b/src/Network/Gitit/Plugins.hs --- a/src/Network/Gitit/Plugins.hs +++ b/src/Network/Gitit/Plugins.hs @@ -41,7 +41,11 @@ -- initDynFlags unless ("Network.Gitit.Plugin." `isPrefixOf` pluginName) $ do +#if __GLASGOW_HASKELL__ >= 904 + addTarget =<< guessTarget pluginName Nothing Nothing +#else addTarget =<< guessTarget pluginName Nothing +#endif r <- load LoadAllTargets case r of Failed -> error $ "Error loading plugin: " ++ pluginName