Update LTS and dependencies

- Latest LTS-11.5
- Allow hoauth2-1.7, needs to be extra-dep though
- Support *and require* yesod-1.6

  This required:

  - Less lifts
  - HandlerFor, WidgetFor, etc
  - Lost MonadThrow, but can use MonadIO instead
This commit is contained in:
patrick brisbin 2018-04-18 08:21:24 -04:00
parent 59c6aec74b
commit 98ef5f9aae
6 changed files with 20 additions and 17 deletions

View File

@ -21,7 +21,7 @@ library:
- aeson >=0.6 && <1.4 - aeson >=0.6 && <1.4
- bytestring >=0.9.1.4 - bytestring >=0.9.1.4
- errors - errors
- hoauth2 >=1.3.0 && <1.6 - hoauth2 >=1.3.0 && <1.8
- http-client >=0.4.0 && <0.6 - http-client >=0.4.0 && <0.6
- http-conduit >=2.0 && <3.0 - http-conduit >=2.0 && <3.0
- http-types >=0.8 && <0.13 - http-types >=0.8 && <0.13
@ -31,8 +31,8 @@ library:
- text >=0.7 && <2.0 - text >=0.7 && <2.0
- transformers >=0.2.2 && <0.6 - transformers >=0.2.2 && <0.6
- uri-bytestring - uri-bytestring
- yesod-auth >=1.3 && <1.5 - yesod-auth >=1.6.0 && <1.7
- yesod-core >=1.2 && <1.5 - yesod-core >=1.6.0 && <1.7
executables: executables:
yesod-auth-oauth2-example: yesod-auth-oauth2-example:

View File

@ -52,7 +52,7 @@ authOAuth2 name = authOAuth2Widget [whamlet|Login via #{name}|] name
-- --
authOAuth2Widget authOAuth2Widget
:: YesodAuth m :: YesodAuth m
=> WidgetT m IO () => WidgetFor m ()
-> Text -> Text
-> OAuth2 -> OAuth2
-> FetchCreds m -> FetchCreds m

View File

@ -29,7 +29,7 @@ pluginName = "battle.net"
oauth2BattleNet oauth2BattleNet
:: YesodAuth m :: YesodAuth m
=> WidgetT m IO () -- ^ Login widget => WidgetFor m () -- ^ Login widget
-> Text -- ^ User region (e.g. "eu", "cn", "us") -> Text -- ^ User region (e.g. "eu", "cn", "us")
-> Text -- ^ Client ID -> Text -- ^ Client ID
-> Text -- ^ Client Secret -> Text -- ^ Client Secret
@ -64,6 +64,6 @@ wwwHost :: Text -> Host
wwwHost "cn" = "www.battlenet.com.cn" wwwHost "cn" = "www.battlenet.com.cn"
wwwHost region = Host $ encodeUtf8 $ region <> ".battle.net" wwwHost region = Host $ encodeUtf8 $ region <> ".battle.net"
oAuth2BattleNet :: YesodAuth m => Text -> Text -> Text -> WidgetT m IO () -> AuthPlugin m oAuth2BattleNet :: YesodAuth m => Text -> Text -> Text -> WidgetFor m () -> AuthPlugin m
oAuth2BattleNet i s r w = oauth2BattleNet w r i s oAuth2BattleNet i s r w = oauth2BattleNet w r i s
{-# DEPRECATED oAuth2BattleNet "Use oauth2BattleNet" #-} {-# DEPRECATED oAuth2BattleNet "Use oauth2BattleNet" #-}

View File

@ -3,6 +3,7 @@
{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
module Yesod.Auth.OAuth2.Dispatch module Yesod.Auth.OAuth2.Dispatch
( FetchCreds ( FetchCreds
, dispatchAuthRequest , dispatchAuthRequest
@ -46,7 +47,7 @@ dispatchForward :: Text -> OAuth2 -> AuthHandler m TypedContent
dispatchForward name oauth2 = do dispatchForward name oauth2 = do
csrf <- setSessionCSRF $ tokenSessionKey name csrf <- setSessionCSRF $ tokenSessionKey name
oauth2' <- withCallbackAndState name oauth2 csrf oauth2' <- withCallbackAndState name oauth2 csrf
lift $ redirect $ toText $ authorizationUrl oauth2' redirect $ toText $ authorizationUrl oauth2'
-- | Handle @GET \/callback@ -- | Handle @GET \/callback@
-- --
@ -59,11 +60,11 @@ dispatchCallback name oauth2 getCreds = do
csrf <- verifySessionCSRF $ tokenSessionKey name csrf <- verifySessionCSRF $ tokenSessionKey name
onErrorResponse errInvalidOAuth onErrorResponse errInvalidOAuth
code <- requireGetParam "code" code <- requireGetParam "code"
manager <- lift $ getsYesod authHttpManager manager <- authHttpManager
oauth2' <- withCallbackAndState name oauth2 csrf oauth2' <- withCallbackAndState name oauth2 csrf
token <- denyLeft $ fetchAccessToken manager oauth2' $ ExchangeToken code token <- denyLeft $ fetchAccessToken manager oauth2' $ ExchangeToken code
creds <- denyLeft $ tryIO $ getCreds manager token creds <- denyLeft $ tryIO $ getCreds manager token
lift $ setCredsRedirect creds setCredsRedirect creds
where where
-- On a Left result, log it and return an opaque permission-denied -- On a Left result, log it and return an opaque permission-denied
denyLeft :: (MonadHandler m, MonadLogger m, Show e) => IO (Either e a) -> m a denyLeft :: (MonadHandler m, MonadLogger m, Show e) => IO (Either e a) -> m a
@ -81,7 +82,8 @@ withCallbackAndState name oauth2 csrf = do
let callbackText = render url let callbackText = render url
callback <- maybe callback <- maybe
(throwString (liftIO
$ throwString
$ "Invalid callback URI: " $ "Invalid callback URI: "
<> T.unpack callbackText <> T.unpack callbackText
<> ". Not using an absolute Approot?" <> ". Not using an absolute Approot?"
@ -93,9 +95,9 @@ withCallbackAndState name oauth2 csrf = do
`withQuery` [("state", encodeUtf8 csrf)] `withQuery` [("state", encodeUtf8 csrf)]
} }
getParentUrlRender :: HandlerT child (HandlerT parent IO) (Route child -> Text) getParentUrlRender :: MonadHandler m => m (Route (SubHandlerSite m) -> Text)
getParentUrlRender = (.) getParentUrlRender = (.)
<$> lift getUrlRender <$> getUrlRender
<*> getRouteToParent <*> getRouteToParent
-- | Set a random, 30-character value in the session -- | Set a random, 30-character value in the session

View File

@ -30,9 +30,9 @@ data WidgetType m
| SmallWhite | SmallWhite
| BigBlack | BigBlack
| SmallBlack | SmallBlack
| Custom (WidgetT m IO ()) | Custom (WidgetFor m ())
asWidget :: YesodAuth m => WidgetType m -> WidgetT m IO () asWidget :: YesodAuth m => WidgetType m -> WidgetFor m ()
asWidget Plain = [whamlet|Login via eveonline|] asWidget Plain = [whamlet|Login via eveonline|]
asWidget BigWhite = [whamlet|<img src="https://images.contentful.com/idjq7aai9ylm/4PTzeiAshqiM8osU2giO0Y/5cc4cb60bac52422da2e45db87b6819c/EVE_SSO_Login_Buttons_Large_White.png?w=270&h=45">|] asWidget BigWhite = [whamlet|<img src="https://images.contentful.com/idjq7aai9ylm/4PTzeiAshqiM8osU2giO0Y/5cc4cb60bac52422da2e45db87b6819c/EVE_SSO_Login_Buttons_Large_White.png?w=270&h=45">|]
asWidget BigBlack = [whamlet|<img src="https://images.contentful.com/idjq7aai9ylm/4fSjj56uD6CYwYyus4KmES/4f6385c91e6de56274d99496e6adebab/EVE_SSO_Login_Buttons_Large_Black.png?w=270&h=45">|] asWidget BigBlack = [whamlet|<img src="https://images.contentful.com/idjq7aai9ylm/4fSjj56uD6CYwYyus4KmES/4f6385c91e6de56274d99496e6adebab/EVE_SSO_Login_Buttons_Large_Black.png?w=270&h=45">|]

View File

@ -1,5 +1,6 @@
--- ---
resolver: lts-10.7 resolver: lts-11.5
extra-deps:
- hoauth2-1.7.1
ghc-options: ghc-options:
"$locals": -fhide-source-paths "$locals": -fhide-source-paths