diff --git a/package.yaml b/package.yaml
index a1b6b73..425aaa9 100644
--- a/package.yaml
+++ b/package.yaml
@@ -11,7 +11,7 @@ github: thoughtbot/yesod-auth-oauth2.git
homepage: http://github.com/thoughtbot/yesod-auth-oauth2
dependencies:
- - base >=4.5 && <5
+ - base >=4.8.0.0 && <5
library:
source-dirs: src
@@ -21,8 +21,6 @@ library:
- hoauth2 >=1.3.0 && <1.6
- http-client >=0.4.0 && <0.6
- http-conduit >=2.0 && <3.0
- - http-types >=0.8 && <0.10
- - lifted-base >=0.2 && <0.4
- microlens
- random
- text >=0.7 && <2.0
diff --git a/src/URI/ByteString/Extension.hs b/src/URI/ByteString/Extension.hs
index 1c59aa3..e8cc840 100644
--- a/src/URI/ByteString/Extension.hs
+++ b/src/URI/ByteString/Extension.hs
@@ -7,11 +7,10 @@ import Data.String (IsString(..))
import Data.Text (Text)
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import Lens.Micro
+import URI.ByteString
import qualified Data.ByteString.Char8 as C8
-import URI.ByteString
-
instance IsString Scheme where
fromString = Scheme . fromString
diff --git a/src/Yesod/Auth/OAuth2.hs b/src/Yesod/Auth/OAuth2.hs
index cf29b69..9cd1d01 100644
--- a/src/Yesod/Auth/OAuth2.hs
+++ b/src/Yesod/Auth/OAuth2.hs
@@ -1,167 +1,69 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE TupleSections #-}
--- |
---
--- Generic OAuth2 plugin for Yesod
---
--- * See Yesod.Auth.OAuth2.GitHub for example usage.
---
+{-# LANGUAGE RecordWildCards #-}
module Yesod.Auth.OAuth2
- ( authOAuth2
- , authOAuth2Widget
- , oauth2Url
- , fromProfileURL
- , YesodOAuth2Exception(..)
- , invalidProfileResponse
- , scopeParam
- , maybeExtra
- , module Network.OAuth.OAuth2
- , module URI.ByteString
- , module URI.ByteString.Extension
+ ( oauth2Url
+ , authOAuth2
) where
-#if __GLASGOW_HASKELL__ < 710
-import Control.Applicative ((<$>))
-#endif
-
-import Control.Exception.Lifted
-import Control.Monad (unless)
-import Control.Monad.IO.Class
-import Data.Aeson (Value(..), encode)
-import Data.ByteString (ByteString)
-import Data.Monoid ((<>))
-import Data.Text (Text, pack)
-import Data.Text.Encoding (encodeUtf8)
-import Data.Typeable
-import Network.HTTP.Conduit (Manager)
-import Network.OAuth.OAuth2 hiding (error)
-import System.Random
-import URI.ByteString
-import URI.ByteString.Extension
+import Data.Aeson (FromJSON)
import Yesod.Auth
-import Yesod.Core
+import Yesod.Auth.OAuth2.Dispatch
+import Yesod.Auth.OAuth2.Provider
+import Yesod.Core (WidgetT, whamlet)
-import qualified Data.ByteString.Lazy as BL
-import qualified Data.Text as T
+-- | Login route for a provider by name
+oauth2Url :: ProviderName -> AuthRoute
+oauth2Url (ProviderName name) = PluginR name ["forward"]
--- | Provider name and Aeson parse error
-data YesodOAuth2Exception = InvalidProfileResponse Text BL.ByteString
- deriving (Show, Typeable)
-
-instance Exception YesodOAuth2Exception
-
--- | Construct an @'InvalidProfileResponse'@ exception from an @'OAuth2Error'@
+-- | Yesod Auth Plugin for a given Provider
--
--- This forces the @e@ in @'OAuth2Error' e@ to parse as a JSON @'Value'@ which
--- is then re-encoded for the exception message.
+-- Example:
--
-invalidProfileResponse :: Text -> OAuth2Error Value -> YesodOAuth2Exception
-invalidProfileResponse name = InvalidProfileResponse name . encode
-
-oauth2Url :: Text -> AuthRoute
-oauth2Url name = PluginR name ["forward"]
-
--- | Create an @'AuthPlugin'@ for the given OAuth2 provider
+-- > import Yesod.Auth.OAuth2
+-- > import Yesod.Auth.OAuth2.Github
+-- >
+-- > authOAuth2 (oauth2Github defaultScopes) "CLIENT_ID" "CLIENT_SECRET"
--
--- Presents a generic @"Login via name"@ link
+authOAuth2
+ :: ( FromJSON a
+ , ToIdent a
+ , YesodAuth m
+ )
+ => Provider m a
+ -> ClientId
+ -> ClientSecret
+ -> AuthPlugin m
+authOAuth2 = authOAuth2Widget $ \name toParent ->
+ [whamlet|
+
+ Login via #{providerName name}
+ |]
+
+-- | Same, but with custom login Widget
--
-authOAuth2 :: YesodAuth m
- => Text -- ^ Service name
- -> OAuth2 -- ^ Service details
- -> (Manager -> OAuth2Token -> IO (Creds m))
- -- ^ This function defines how to take an @'OAuth2Token'@ and
- -- retrieve additional information about the user, to be set in the
- -- session as @'Creds'@. Usually this means a second authorized
- -- request to @api/me.json@.
- --
- -- See @'fromProfileURL'@ for an example.
- -> AuthPlugin m
-authOAuth2 name = authOAuth2Widget [whamlet|Login via #{name}|] name
-
--- | Create an @'AuthPlugin'@ for the given OAuth2 provider
+-- > import Yesod.Auth.OAuth2
+-- > import Yesod.Auth.OAuth2.Github
+-- >
+-- > authOAuth2Widget
+-- > (\name toParent ->
+-- > [whamlet|
+-- >
+-- > Login via #{providerName name}
+-- > |]
+-- > )
+-- > $ (oauth2Github defaultScopes) -- ...
--
--- Allows passing a custom widget for the login link. See @'oauth2Eve'@ for an
--- example.
---
-authOAuth2Widget :: YesodAuth m
- => WidgetT m IO ()
- -> Text
- -> OAuth2
- -> (Manager -> OAuth2Token -> IO (Creds m))
- -> AuthPlugin m
-authOAuth2Widget widget name oauth getCreds = AuthPlugin name dispatch login
-
- where
- url = PluginR name ["callback"]
-
- withCallback csrfToken = do
- tm <- getRouteToParent
- render <- lift getUrlRender
- return oauth
- { oauthCallback = Just $ unsafeFromText $ render $ tm url
- , oauthOAuthorizeEndpoint = oauthOAuthorizeEndpoint oauth
- `withQuery` [("state", encodeUtf8 csrfToken)]
- }
-
- dispatch "GET" ["forward"] = do
- csrfToken <- liftIO generateToken
- setSession tokenSessionKey csrfToken
- authUrl <- toText . authorizationUrl <$> withCallback csrfToken
- lift $ redirect authUrl
-
- dispatch "GET" ["callback"] = do
- csrfToken <- requireGetParam "state"
- oldToken <- lookupSession tokenSessionKey
- deleteSession tokenSessionKey
- unless (oldToken == Just csrfToken) $ permissionDenied "Invalid OAuth2 state token"
- code <- requireGetParam "code"
- oauth' <- withCallback csrfToken
- master <- lift getYesod
- result <- liftIO $ fetchAccessToken (authHttpManager master) oauth' (ExchangeToken code)
- case result of
- Left _ -> permissionDenied "Unable to retrieve OAuth2 token"
- Right token -> do
- creds <- liftIO $ getCreds (authHttpManager master) token
- lift $ setCredsRedirect creds
- where
- requireGetParam key = do
- m <- lookupGetParam key
- maybe (permissionDenied $ "'" <> key <> "' parameter not provided") return m
-
- dispatch _ _ = notFound
-
- generateToken = pack . take 30 . randomRs ('a', 'z') <$> newStdGen
-
- tokenSessionKey :: Text
- tokenSessionKey = "_yesod_oauth2_" <> name
-
- login tm = [whamlet|^{widget}|]
-
--- | Handle the common case of fetching Profile information from a JSON endpoint
---
--- Throws @'InvalidProfileResponse'@ if JSON parsing fails
---
-fromProfileURL :: FromJSON a
- => Text -- ^ Plugin name
- -> URI -- ^ Profile URI
- -> (a -> Creds m) -- ^ Conversion to Creds
- -> Manager -> OAuth2Token -> IO (Creds m)
-fromProfileURL name url toCreds manager token = do
- result <- authGetJSON manager (accessToken token) url
-
- case result of
- Right profile -> return $ toCreds profile
- Left err -> throwIO $ invalidProfileResponse name err
-
--- | A tuple of @scope@ and the given scopes separated by a delimiter
-scopeParam :: Text -> [Text] -> (ByteString, ByteString)
-scopeParam d = ("scope",) . encodeUtf8 . T.intercalate d
-
--- | A helper for providing an optional value to credsExtra
-maybeExtra :: Text -> Maybe Text -> [(Text, Text)]
-maybeExtra k (Just v) = [(k, v)]
-maybeExtra _ Nothing = []
+authOAuth2Widget
+ :: ( FromJSON a
+ , ToIdent a
+ , YesodAuth m
+ )
+ => (ProviderName -> (Route Auth -> Route m) -> WidgetT m IO ())
+ -> Provider m a
+ -> ClientId
+ -> ClientSecret
+ -> AuthPlugin m
+authOAuth2Widget widget p@Provider{..} cid cs =
+ AuthPlugin (providerName pName) (dispatchAuthRequest p cid cs) $ widget pName
diff --git a/src/Yesod/Auth/OAuth2/BattleNet.hs b/src/Yesod/Auth/OAuth2/BattleNet.hs
index 43b9758..149c677 100644
--- a/src/Yesod/Auth/OAuth2/BattleNet.hs
+++ b/src/Yesod/Auth/OAuth2/BattleNet.hs
@@ -1,85 +1,33 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE OverloadedStrings #-}
-
--- |
---
--- OAuth2 plugin for Battle.Net
---
--- * Authenticates against battle.net.
--- * Uses user's id as credentials identifier.
--- * Returns user's battletag in extras.
---
-module Yesod.Auth.OAuth2.BattleNet
- ( oAuth2BattleNet
- ) where
-
-#if __GLASGOW_HASKELL__ < 710
-import Control.Applicative ((<$>), (<*>))
-#endif
-
-import Control.Exception (throwIO)
-import Control.Monad (mzero)
-import Data.Aeson
-import Data.Monoid ((<>))
-import Data.Text (Text)
-import qualified Data.Text as T (pack, toLower)
-import qualified Data.Text.Encoding as E (encodeUtf8)
-import Network.HTTP.Conduit (Manager)
-import Prelude
-import Yesod.Auth
-import Yesod.Auth.OAuth2
-import Yesod.Core.Widget
-
-data BattleNetUser = BattleNetUser
- { userId :: Int
- , battleTag :: Text
- }
-
-instance FromJSON BattleNetUser where
- parseJSON (Object o) = BattleNetUser
- <$> o .: "id"
- <*> o .: "battletag"
- parseJSON _ = mzero
-
-oAuth2BattleNet
- :: YesodAuth m
- => Text -- ^ Client ID
- -> Text -- ^ Client Secret
- -> Text -- ^ User region (e.g. "eu", "cn", "us")
- -> WidgetT m IO () -- ^ Login widget
- -> AuthPlugin m
-oAuth2BattleNet clientId clientSecret region widget =
- authOAuth2Widget widget "battle.net" oAuthData $ makeCredentials region
- where
- oAuthData = OAuth2
- { oauthClientId = clientId
- , oauthClientSecret = clientSecret
- , oauthOAuthorizeEndpoint = fromRelative "https" host "/oauth/authorize"
- , oauthAccessTokenEndpoint = fromRelative "https" host "/oauth/token"
- , oauthCallback = Nothing
- }
-
- host = wwwHost $ T.toLower region
-
-makeCredentials :: Text -> Manager -> OAuth2Token -> IO (Creds m)
-makeCredentials region manager token = do
- userResult <- authGetJSON manager (accessToken token)
- $ fromRelative "https" (apiHost $ T.toLower region) "/account/user"
-
- either
- (throwIO . invalidProfileResponse "battle.net")
- (\user ->
- return Creds
- { credsPlugin = "battle.net"
- , credsIdent = T.pack $ show $ userId user
- , credsExtra = [("battletag", battleTag user)]
- }
- ) userResult
-
-apiHost :: Text -> Host
-apiHost "cn" = "api.battlenet.com.cn"
-apiHost region = Host $ E.encodeUtf8 $ region <> ".api.battle.net"
-
-wwwHost :: Text -> Host
-wwwHost "cn" = "www.battlenet.com.cn"
-wwwHost region = Host $ E.encodeUtf8 $ region <> ".battle.net"
+{-# LANGUAGE OverloadedStrings #-}
+module Yesod.Auth.OAuth2.BattleNet
+ ( oauth2BattleNet
+ ) where
+
+import Data.Monoid ((<>))
+import Data.Text (Text)
+import Data.Text.Encoding (encodeUtf8)
+import URI.ByteString (Host(..))
+import URI.ByteString.Extension (fromRelative)
+import Yesod.Auth.OAuth2.Provider
+import Yesod.Auth.OAuth2.UserId
+
+oauth2BattleNet
+ :: Text -- ^ Lower-case region (cn, us, etc)
+ -> Provider m UserId
+oauth2BattleNet region = Provider
+ { pName = "battle.net"
+ , pAuthorizeEndpoint = const $ AuthorizeEndpoint $ wwwPath "/oauth/authorize"
+ , pAccessTokenEndpoint = AccessTokenEndpoint $ wwwPath "/oauth/token"
+ , pFetchUserProfile = authGetProfile $ apiPath "/account/user"
+ }
+ where
+ apiPath = fromRelative "https" (apiHost region)
+ wwwPath = fromRelative "https" (wwwHost region)
+
+apiHost :: Text -> Host
+apiHost "cn" = "api.battlenet.com.cn"
+apiHost region = Host $ encodeUtf8 $ region <> ".api.battle.net"
+
+wwwHost :: Text -> Host
+wwwHost "cn" = "www.battlenet.com.cn"
+wwwHost region = Host $ encodeUtf8 $ region <> ".battle.net"
diff --git a/src/Yesod/Auth/OAuth2/Bitbucket.hs b/src/Yesod/Auth/OAuth2/Bitbucket.hs
index eb6ca99..4582116 100644
--- a/src/Yesod/Auth/OAuth2/Bitbucket.hs
+++ b/src/Yesod/Auth/OAuth2/Bitbucket.hs
@@ -1,141 +1,26 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
--- |
---
--- OAuth2 plugin for http://bitbucket.com
---
--- * Authenticates against bitbucket
--- * Uses bitbucket uuid as credentials identifier
--- * Returns email, username, full name, location and avatar as extras
---
module Yesod.Auth.OAuth2.Bitbucket
( oauth2Bitbucket
- , oauth2BitbucketScoped
- , module Yesod.Auth.OAuth2
) where
-#if __GLASGOW_HASKELL__ < 710
-import Control.Applicative ((<$>), (<*>))
-#endif
-
-import Control.Exception.Lifted (throwIO)
-import Control.Monad (mzero)
-import Data.Aeson (FromJSON, Value(Object), parseJSON, (.:), (.:?))
-import Data.List (find)
-import Data.Maybe (fromMaybe)
+import Data.Aeson
import Data.Text (Text)
-import Network.HTTP.Conduit (Manager)
-import Yesod.Auth (AuthPlugin, Creds(..), YesodAuth)
-import Yesod.Auth.OAuth2
+import Yesod.Auth.OAuth2.Provider
-import qualified Data.Text as T
+newtype UserId = UserId Text
+ deriving ToIdent
-data BitbucketUser = BitbucketUser
- { bitbucketUserId :: Text
- , bitbucketUserName :: Maybe Text
- , bitbucketUserLogin :: Text
- , bitbucketUserLocation :: Maybe Text
- , bitbucketUserLinks :: BitbucketUserLinks
- }
+instance FromJSON UserId where
+ parseJSON = withObject "User" $ \o -> UserId <$> o .: "uuid"
-instance FromJSON BitbucketUser where
- parseJSON (Object o) = BitbucketUser
- <$> o .: "uuid"
- <*> o .:? "display_name"
- <*> o .: "username"
- <*> o .:? "location"
- <*> o .: "links"
-
- parseJSON _ = mzero
-
-newtype BitbucketUserLinks = BitbucketUserLinks
- { bitbucketAvatarLink :: BitbucketLink
- }
-
-instance FromJSON BitbucketUserLinks where
- parseJSON (Object o) = BitbucketUserLinks
- <$> o .: "avatar"
-
- parseJSON _ = mzero
-
-newtype BitbucketLink = BitbucketLink
- { bitbucketLinkHref :: Text
- }
-
-instance FromJSON BitbucketLink where
- parseJSON (Object o) = BitbucketLink
- <$> o .: "href"
-
- parseJSON _ = mzero
-
-newtype BitbucketEmailSearchResults = BitbucketEmailSearchResults
- { bitbucketEmails :: [BitbucketUserEmail]
- }
-
-instance FromJSON BitbucketEmailSearchResults where
- parseJSON (Object o) = BitbucketEmailSearchResults
- <$> o .: "values"
-
- parseJSON _ = mzero
-
-data BitbucketUserEmail = BitbucketUserEmail
- { bitbucketUserEmailAddress :: Text
- , bitbucketUserEmailPrimary :: Bool
- }
-
-instance FromJSON BitbucketUserEmail where
- parseJSON (Object o) = BitbucketUserEmail
- <$> o .: "email"
- <*> o .: "is_primary"
-
- parseJSON _ = mzero
-
-oauth2Bitbucket :: YesodAuth m
- => Text -- ^ Client ID
- -> Text -- ^ Client Secret
- -> AuthPlugin m
-oauth2Bitbucket clientId clientSecret = oauth2BitbucketScoped clientId clientSecret ["account"]
-
-oauth2BitbucketScoped :: YesodAuth m
- => Text -- ^ Client ID
- -> Text -- ^ Client Secret
- -> [Text] -- ^ List of scopes to request
- -> AuthPlugin m
-oauth2BitbucketScoped clientId clientSecret scopes = authOAuth2 "bitbucket" oauth fetchBitbucketProfile
- where
- oauth = OAuth2
- { oauthClientId = clientId
- , oauthClientSecret = clientSecret
- , oauthOAuthorizeEndpoint = "https://bitbucket.com/site/oauth2/authorize" `withQuery`
+oauth2Bitbucket :: [Scope] -> Provider m UserId
+oauth2Bitbucket scopes = Provider
+ { pName = "bitbucket"
+ , pAuthorizeEndpoint = const $ AuthorizeEndpoint
+ $ "https://bitbucket.com/site/oauth2/authorize" `withQuery`
[ scopeParam "," scopes
]
- , oauthAccessTokenEndpoint = "https://bitbucket.com/site/oauth2/access_token"
- , oauthCallback = Nothing
- }
-
-fetchBitbucketProfile :: Manager -> OAuth2Token -> IO (Creds m)
-fetchBitbucketProfile manager token = do
- userResult <- authGetJSON manager (accessToken token) "https://api.bitbucket.com/2.0/user"
- mailResult <- authGetJSON manager (accessToken token) "https://api.bitbucket.com/2.0/user/emails"
-
- case (userResult, mailResult) of
- (Right user, Right mails) -> return $ toCreds user (bitbucketEmails mails) token
- (Left err, _) -> throwIO $ invalidProfileResponse "bitbucket" err
- (_, Left err) -> throwIO $ invalidProfileResponse "bitbucket" err
-
-toCreds :: BitbucketUser -> [BitbucketUserEmail] -> OAuth2Token -> Creds m
-toCreds user userMails token = Creds
- { credsPlugin = "bitbucket"
- , credsIdent = T.pack $ show $ bitbucketUserId user
- , credsExtra =
- [ ("email", bitbucketUserEmailAddress email)
- , ("login", bitbucketUserLogin user)
- , ("avatar_url", bitbucketLinkHref (bitbucketAvatarLink (bitbucketUserLinks user)))
- , ("access_token", atoken $ accessToken token)
- ]
- ++ maybeExtra "name" (bitbucketUserName user)
- ++ maybeExtra "location" (bitbucketUserLocation user)
+ , pAccessTokenEndpoint = "https://bitbucket.com/site/oauth2/access_token"
+ , pFetchUserProfile = authGetProfile "https://api.bitbucket.com/2.0/user"
}
-
- where
- email = fromMaybe (head userMails) $ find bitbucketUserEmailPrimary userMails
diff --git a/src/Yesod/Auth/OAuth2/Dispatch.hs b/src/Yesod/Auth/OAuth2/Dispatch.hs
new file mode 100644
index 0000000..daf8631
--- /dev/null
+++ b/src/Yesod/Auth/OAuth2/Dispatch.hs
@@ -0,0 +1,116 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Yesod.Auth.OAuth2.Dispatch
+ ( dispatchAuthRequest
+ ) where
+
+import Control.Monad (unless)
+import Data.Monoid ((<>))
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Text.Encoding (encodeUtf8)
+import Network.OAuth.OAuth2
+import System.Random (newStdGen, randomRs)
+import URI.ByteString.Extension
+import Yesod.Auth
+import Yesod.Auth.OAuth2.Provider
+import Yesod.Core
+
+-- | Dispatch the various OAuth2 handshake routes
+dispatchAuthRequest :: (FromJSON a, ToIdent a) => Provider app a -> ClientId -> ClientSecret -> Text -> [Text] -> AuthHandler app TypedContent
+dispatchAuthRequest p cid cs "GET" ["forward"] = dispatchForward p cid cs
+dispatchAuthRequest p cid cs "GET" ["callback"] = dispatchCallback p cid cs
+dispatchAuthRequest _ _ _ _ _ = notFound
+
+-- | Handle @GET \/forward@
+--
+-- 1. Set a random CSRF token in our session
+-- 2. Redirect to the Provider's authorization URL
+--
+dispatchForward :: Provider app a -> ClientId -> ClientSecret -> AuthHandler app TypedContent
+dispatchForward p cid cs = do
+ csrf <- setSessionCSRF $ tokenSessionKey p
+ oauth2 <- providerToOAuth2 p csrf cid cs
+ lift $ redirect $ toText $ authorizationUrl oauth2
+
+-- | Handle @GET \/callback@
+--
+-- 1. Verify the URL's CSRF token matches our session
+-- 2. Use the code parameter to fetch an AccessToken for the Provider
+-- 3. Use the AccessToken to construct a @'Creds'@ value for the Provider
+--
+dispatchCallback :: (FromJSON a, ToIdent a) => Provider app a -> ClientId -> ClientSecret -> AuthHandler app TypedContent
+dispatchCallback p cid cs = do
+ csrf <- verifySessionCSRF $ tokenSessionKey p
+ code <- requireGetParam "code"
+ oauth2 <- providerToOAuth2 p csrf cid cs
+ manager <- lift $ getsYesod authHttpManager
+ token <- denyLeft $ fetchAccessToken manager oauth2 $ ExchangeToken code
+ creds <- denyLeft $ providerCreds p manager token
+ lift $ setCredsRedirect creds
+ where
+ -- 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 act = do
+ result <- liftIO act
+ either
+ (\err -> do
+ $(logError) $ T.pack $ "OAuth2 error: " <> show err
+ permissionDenied "Invalid OAuth2 authentication attempt"
+ )
+ return
+ result
+
+-- | Convert our @'Provider'@ to an @'OAuth2'@ value
+--
+-- Append the CSRF token to the authorization URL as a state parameter.
+--
+providerToOAuth2 :: Provider app a -> Text -> ClientId -> ClientSecret -> AuthHandler app OAuth2
+providerToOAuth2 Provider{..} csrfToken cid cs = do
+ toParent <- getRouteToParent
+ urlRender <- lift getUrlRender
+
+ return OAuth2
+ { oauthClientId = clientId cid
+ , oauthClientSecret = clientSecret cs
+ , oauthAccessTokenEndpoint = accessTokenEndpoint pAccessTokenEndpoint
+ , oauthOAuthorizeEndpoint = authorizeEndpoint (pAuthorizeEndpoint cid)
+ `withQuery` [("state", encodeUtf8 csrfToken)]
+ , oauthCallback = Just
+ -- FIXME: clarify the error here when appRoot is non-absolute
+ $ unsafeFromText $ urlRender $ toParent
+ $ PluginR (providerName pName) ["callback"]
+ }
+
+-- | Set a random, 30-character value in the session
+setSessionCSRF :: MonadHandler m => Text -> m Text
+setSessionCSRF sessionKey = do
+ csrfToken <- liftIO randomToken
+ csrfToken <$ setSession sessionKey csrfToken
+ where
+ randomToken = T.pack . take 30 . randomRs ('a', 'z') <$> newStdGen
+
+-- | Verify the callback provided the same CSRF token as in our session
+verifySessionCSRF :: MonadHandler m => Text -> m Text
+verifySessionCSRF sessionKey = do
+ token <- requireGetParam "state"
+ sessionToken <- lookupSession sessionKey
+ deleteSession sessionKey
+
+ unless (sessionToken == Just token)
+ $ permissionDenied "Invalid OAuth2 state token"
+
+ return token
+
+requireGetParam :: MonadHandler m => Text -> m Text
+requireGetParam key = do
+ m <- lookupGetParam key
+ maybe errInvalidArgs return m
+ where
+ errInvalidArgs = invalidArgs ["The '" <> key <> "' parameter is required"]
+
+tokenSessionKey :: Provider m a -> Text
+tokenSessionKey Provider{..} = "_yesod_oauth2_" <> providerName pName
diff --git a/src/Yesod/Auth/OAuth2/EveOnline.hs b/src/Yesod/Auth/OAuth2/EveOnline.hs
index 2a5fb7c..92d3256 100644
--- a/src/Yesod/Auth/OAuth2/EveOnline.hs
+++ b/src/Yesod/Auth/OAuth2/EveOnline.hs
@@ -1,116 +1,26 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
--- |
---
--- OAuth2 plugin for http://eveonline.com
---
--- * Authenticates against eveonline
--- * Uses EVEs unique account-user-char-hash as credentials identifier
--- * Returns charName, charId, tokenType, accessToken and expires as extras
---
module Yesod.Auth.OAuth2.EveOnline
- ( oauth2Eve
- , oauth2EveScoped
- , WidgetType(..)
- , module Yesod.Auth.OAuth2
+ ( oauth2EveOnline
) where
-#if __GLASGOW_HASKELL__ < 710
-import Control.Applicative ((<$>), (<*>))
-#endif
-
-import Control.Exception.Lifted
-import Control.Monad (mzero)
import Data.Aeson
-import Data.Text (Text)
-import Network.HTTP.Conduit (Manager)
-import Yesod.Auth
-import Yesod.Auth.OAuth2
-import Yesod.Core.Widget
+import Yesod.Auth.OAuth2.Provider
-import qualified Data.Text as T
+newtype CharId = CharId Int
+ deriving ToIdent
-data WidgetType m
- = Plain -- ^ Simple "Login via eveonline" text
- | BigWhite
- | SmallWhite
- | BigBlack
- | SmallBlack
- | Custom (WidgetT m IO ())
+instance FromJSON CharId where
+ parseJSON = withObject "Character" $ \o -> CharId <$> o .: "CharacterId"
-data EveUser = EveUser
- { eveUserName :: Text
- , eveUserExpire :: Text
- , eveTokenType :: Text
- , eveCharOwnerHash :: Text
- , eveCharId :: Integer
- }
-
-instance FromJSON EveUser where
- parseJSON (Object o) = EveUser
- <$> o .: "CharacterName"
- <*> o .: "ExpiresOn"
- <*> o .: "TokenType"
- <*> o .: "CharacterOwnerHash"
- <*> o .: "CharacterID"
-
- parseJSON _ = mzero
-
-oauth2Eve :: YesodAuth m
- => Text -- ^ Client ID
- -> Text -- ^ Client Secret
- -> WidgetType m
- -> AuthPlugin m
-oauth2Eve clientId clientSecret = oauth2EveScoped clientId clientSecret ["publicData"] . asWidget
-
- where
- asWidget :: YesodAuth m => WidgetType m -> WidgetT m IO ()
- asWidget Plain = [whamlet|Login via eveonline|]
- asWidget BigWhite = [whamlet|
|]
- asWidget BigBlack = [whamlet|
|]
- asWidget SmallWhite = [whamlet|
|]
- asWidget SmallBlack = [whamlet|
|]
- asWidget (Custom a) = a
-
-oauth2EveScoped :: YesodAuth m
- => Text -- ^ Client ID
- -> Text -- ^ Client Secret
- -> [Text] -- ^ List of scopes to request
- -> WidgetT m IO () -- ^ Login widget
- -> AuthPlugin m
-oauth2EveScoped clientId clientSecret scopes widget =
- authOAuth2Widget widget "eveonline" oauth fetchEveProfile
-
- where
- oauth = OAuth2
- { oauthClientId = clientId
- , oauthClientSecret = clientSecret
- , oauthOAuthorizeEndpoint = "https://login.eveonline.com/oauth/authorize" `withQuery`
+oauth2EveOnline :: [Scope] -> Provider m CharId
+oauth2EveOnline scopes = Provider
+ { pName = "eveonline"
+ , pAuthorizeEndpoint = const $ AuthorizeEndpoint
+ $ "https://login.eveonline.com/oauth/authorize" `withQuery`
[ ("response_type", "code")
, scopeParam " " scopes
]
- , oauthAccessTokenEndpoint = "https://login.eveonline.com/oauth/token"
- , oauthCallback = Nothing
- }
-
-fetchEveProfile :: Manager -> OAuth2Token -> IO (Creds m)
-fetchEveProfile manager token = do
- userResult <- authGetJSON manager (accessToken token) "https://login.eveonline.com/oauth/verify"
-
- case userResult of
- Right user -> return $ toCreds user token
- Left err-> throwIO $ invalidProfileResponse "eveonline" err
-
-toCreds :: EveUser -> OAuth2Token -> Creds m
-toCreds user token = Creds
- { credsPlugin = "eveonline"
- , credsIdent = T.pack $ show $ eveCharOwnerHash user
- , credsExtra =
- [ ("charName", eveUserName user)
- , ("charId", T.pack . show . eveCharId $ user)
- , ("tokenType", eveTokenType user)
- , ("expires", eveUserExpire user)
- , ("accessToken", atoken $ accessToken token)
- ]
+ , pAccessTokenEndpoint = "https://login.eveonline.com/oauth/token"
+ , pFetchUserProfile = authGetProfile "https://login.eveonline.com/oauth/verify"
}
diff --git a/src/Yesod/Auth/OAuth2/Github.hs b/src/Yesod/Auth/OAuth2/Github.hs
index d4b8f8f..aab61bc 100644
--- a/src/Yesod/Auth/OAuth2/Github.hs
+++ b/src/Yesod/Auth/OAuth2/Github.hs
@@ -1,115 +1,22 @@
-{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
--- |
---
--- OAuth2 plugin for http://github.com
---
--- * Authenticates against github
--- * Uses github user id as credentials identifier
--- * Returns first_name, last_name, and email as extras
---
module Yesod.Auth.OAuth2.Github
( oauth2Github
- , oauth2GithubScoped
- , module Yesod.Auth.OAuth2
+ , defaultScopes
) where
-#if __GLASGOW_HASKELL__ < 710
-import Control.Applicative ((<$>), (<*>))
-#endif
+import Yesod.Auth.OAuth2.Provider
+import Yesod.Auth.OAuth2.UserId
-import Control.Exception.Lifted
-import Control.Monad (mzero)
-import Data.Aeson
-import Data.List (find)
-import Data.Maybe (fromMaybe)
-import Data.Text (Text)
-import Network.HTTP.Conduit (Manager)
-import Yesod.Auth
-import Yesod.Auth.OAuth2
-
-import qualified Data.Text as T
-
-data GithubUser = GithubUser
- { githubUserId :: Int
- , githubUserName :: Maybe Text
- , githubUserLogin :: Text
- , githubUserAvatarUrl :: Text
- , githubUserLocation :: Maybe Text
- , githubUserPublicEmail :: Maybe Text
- }
-
-instance FromJSON GithubUser where
- parseJSON (Object o) = GithubUser
- <$> o .: "id"
- <*> o .:? "name"
- <*> o .: "login"
- <*> o .: "avatar_url"
- <*> o .:? "location"
- <*> o .:? "email"
-
- parseJSON _ = mzero
-
-data GithubUserEmail = GithubUserEmail
- { githubUserEmailAddress :: Text
- , githubUserEmailPrimary :: Bool
- }
-
-instance FromJSON GithubUserEmail where
- parseJSON (Object o) = GithubUserEmail
- <$> o .: "email"
- <*> o .: "primary"
-
- parseJSON _ = mzero
-
-oauth2Github :: YesodAuth m
- => Text -- ^ Client ID
- -> Text -- ^ Client Secret
- -> AuthPlugin m
-oauth2Github clientId clientSecret = oauth2GithubScoped clientId clientSecret ["user:email"]
-
-oauth2GithubScoped :: YesodAuth m
- => Text -- ^ Client ID
- -> Text -- ^ Client Secret
- -> [Text] -- ^ List of scopes to request
- -> AuthPlugin m
-oauth2GithubScoped clientId clientSecret scopes = authOAuth2 "github" oauth fetchGithubProfile
- where
- oauth = OAuth2
- { oauthClientId = clientId
- , oauthClientSecret = clientSecret
- , oauthOAuthorizeEndpoint = "https://github.com/login/oauth/authorize" `withQuery`
+oauth2Github :: [Scope] -> Provider m UserId
+oauth2Github scopes = Provider
+ { pName = "github"
+ , pAuthorizeEndpoint = const $ AuthorizeEndpoint
+ $ "http://github.com/login/oauth/authorize" `withQuery`
[ scopeParam "," scopes
]
- , oauthAccessTokenEndpoint = "https://github.com/login/oauth/access_token"
- , oauthCallback = Nothing
- }
-
-fetchGithubProfile :: Manager -> OAuth2Token -> IO (Creds m)
-fetchGithubProfile manager token = do
- userResult <- authGetJSON manager (accessToken token) "https://api.github.com/user"
- mailResult <- authGetJSON manager (accessToken token) "https://api.github.com/user/emails"
-
- case (userResult, mailResult) of
- (Right _, Right []) -> throwIO $ InvalidProfileResponse "github" "no mail address for user"
- (Right user, Right mails) -> return $ toCreds user mails token
- (Left err, _) -> throwIO $ invalidProfileResponse "github" err
- (_, Left err) -> throwIO $ invalidProfileResponse "github" err
-
-toCreds :: GithubUser -> [GithubUserEmail] -> OAuth2Token -> Creds m
-toCreds user userMails token = Creds
- { credsPlugin = "github"
- , credsIdent = T.pack $ show $ githubUserId user
- , credsExtra =
- [ ("email", githubUserEmailAddress email)
- , ("login", githubUserLogin user)
- , ("avatar_url", githubUserAvatarUrl user)
- , ("access_token", atoken $ accessToken token)
- ]
- ++ maybeExtra "name" (githubUserName user)
- ++ maybeExtra "public_email" (githubUserPublicEmail user)
- ++ maybeExtra "location" (githubUserLocation user)
+ , pAccessTokenEndpoint = "http://github.com/login/oauth/access_token"
+ , pFetchUserProfile = authGetProfile "https://api.github.com/user"
}
- where
- email = fromMaybe (head userMails) $ find githubUserEmailPrimary userMails
+defaultScopes :: [Scope]
+defaultScopes = ["user:email"]
diff --git a/src/Yesod/Auth/OAuth2/Google.hs b/src/Yesod/Auth/OAuth2/Google.hs
index edbc5c4..43a7c75 100644
--- a/src/Yesod/Auth/OAuth2/Google.hs
+++ b/src/Yesod/Auth/OAuth2/Google.hs
@@ -1,137 +1,30 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
--- |
---
--- OAuth2 plugin for http://www.google.com
---
--- * Authenticates against Google
--- * Uses Google user id or email as credentials identifier
--- * Returns given_name, family_name, email, and avatar_url as extras
---
--- Note: This may eventually replace Yesod.Auth.GoogleEmail2. Currently it
--- provides the same functionality except that GoogleEmail2 returns more profile
--- information.
---
module Yesod.Auth.OAuth2.Google
( oauth2Google
- , oauth2GoogleScoped
- , oauth2GoogleScopedWithCustomId
- , googleUid
- , emailUid
- , module Yesod.Auth.OAuth2
+ , defaultScopes
) where
-#if __GLASGOW_HASKELL__ < 710
-import Control.Applicative ((<$>), (<*>))
-#endif
-
-import Control.Exception.Lifted
-import Control.Monad (mzero)
import Data.Aeson
-import Data.Monoid ((<>))
import Data.Text (Text)
-import Network.HTTP.Conduit (Manager)
-import Yesod.Auth
-import Yesod.Auth.OAuth2
+import Yesod.Auth.OAuth2.Provider
--- | Auth with Google
---
--- Requests @openid@ and @email@ scopes and uses email as the @'Creds'@
--- identifier.
---
-oauth2Google :: YesodAuth m
- => Text -- ^ Client ID
- -> Text -- ^ Client Secret
- -> AuthPlugin m
-oauth2Google = oauth2GoogleScoped ["openid", "email"]
+newtype UserId = UserId Text
+ deriving ToIdent
--- | Auth with Google
---
--- Requests custom scopes and uses email as the @'Creds'@ identifier.
---
-oauth2GoogleScoped :: YesodAuth m
- => [Text] -- ^ List of scopes to request
- -> Text -- ^ Client ID
- -> Text -- ^ Client Secret
- -> AuthPlugin m
-oauth2GoogleScoped = oauth2GoogleScopedWithCustomId emailUid
+instance FromJSON UserId where
+ parseJSON = withObject "User" $ \o -> UserId <$> o .: "sub"
--- | Auth with Google
---
--- Requests custom scopes and uses the given function to create credentials
--- which allows for using any attribute as the identifier.
---
--- See @'emailUid'@ and @'googleUid'@.
---
-oauth2GoogleScopedWithCustomId :: YesodAuth m
- => (GoogleUser -> OAuth2Token -> Creds m)
- -- ^ A function to generate the credentials
- -> [Text] -- ^ List of scopes to request
- -> Text -- ^ Client ID
- -> Text -- ^ Client secret
- -> AuthPlugin m
-oauth2GoogleScopedWithCustomId toCreds scopes clientId clientSecret =
- authOAuth2 "google" oauth $ fetchGoogleProfile toCreds
-
- where
- oauth = OAuth2
- { oauthClientId = clientId
- , oauthClientSecret = clientSecret
- , oauthOAuthorizeEndpoint = "https://accounts.google.com/o/oauth2/auth" `withQuery`
+oauth2Google :: [Scope] -> Provider m UserId
+oauth2Google scopes = Provider
+ { pName = "google"
+ , pAuthorizeEndpoint = const $ AuthorizeEndpoint
+ $ "https://accounts.google.com/o/oauth2/auth" `withQuery`
[ scopeParam "+" scopes
]
- , oauthAccessTokenEndpoint = "https://www.googleapis.com/oauth2/v3/token"
- , oauthCallback = Nothing
- }
-
-fetchGoogleProfile :: (GoogleUser -> OAuth2Token -> Creds m) -> Manager -> OAuth2Token -> IO (Creds m)
-fetchGoogleProfile toCreds manager token = do
- userInfo <- authGetJSON manager (accessToken token) "https://www.googleapis.com/oauth2/v3/userinfo"
- case userInfo of
- Right user -> return $ toCreds user token
- Left err -> throwIO $ invalidProfileResponse "google" err
-
-data GoogleUser = GoogleUser
- { googleUserId :: Text
- , googleUserName :: Text
- , googleUserEmail :: Text
- , googleUserPicture :: Text
- , googleUserGivenName :: Text
- , googleUserFamilyName :: Text
- , googleUserHostedDomain :: Maybe Text
+ , pAccessTokenEndpoint = "https://www.googleapis.com/oauth2/v3/token"
+ , pFetchUserProfile = authGetProfile "https://www.googleapis.com/oauth2/v3/userinfo"
}
-instance FromJSON GoogleUser where
- parseJSON (Object o) = GoogleUser
- <$> o .: "sub"
- <*> o .: "name"
- <*> o .: "email"
- <*> o .: "picture"
- <*> o .: "given_name"
- <*> o .: "family_name"
- <*> o .:? "hd"
-
- parseJSON _ = mzero
-
--- | Build a @'Creds'@ using the user's google-uid as the identifier
-googleUid :: GoogleUser -> OAuth2Token -> Creds m
-googleUid = uidBuilder $ ("google-uid:" <>) . googleUserId
-
--- | Build a @'Creds'@ using the user's email as the identifier
-emailUid :: GoogleUser -> OAuth2Token -> Creds m
-emailUid = uidBuilder googleUserEmail
-
-uidBuilder :: (GoogleUser -> Text) -> GoogleUser -> OAuth2Token -> Creds m
-uidBuilder f user token = Creds
- { credsPlugin = "google"
- , credsIdent = f user
- , credsExtra =
- [ ("email", googleUserEmail user)
- , ("name", googleUserName user)
- , ("given_name", googleUserGivenName user)
- , ("family_name", googleUserFamilyName user)
- , ("avatar_url", googleUserPicture user)
- , ("access_token", atoken $ accessToken token)
- ]
- ++ maybeExtra "hosted_domain" (googleUserHostedDomain user)
- }
+defaultScopes :: [Scope]
+defaultScopes = ["openid", "email"]
diff --git a/src/Yesod/Auth/OAuth2/Nylas.hs b/src/Yesod/Auth/OAuth2/Nylas.hs
index 1b1f9c3..f4f3073 100644
--- a/src/Yesod/Auth/OAuth2/Nylas.hs
+++ b/src/Yesod/Auth/OAuth2/Nylas.hs
@@ -1,86 +1,28 @@
-{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
-
module Yesod.Auth.OAuth2.Nylas
( oauth2Nylas
- , module Yesod.Auth.OAuth2
) where
-#if __GLASGOW_HASKELL__ < 710
-import Control.Applicative ((<$>), (<*>))
-#endif
-
-import Control.Exception.Lifted (throwIO)
-import Control.Monad (mzero)
-import Data.Aeson (FromJSON, Value(..), decode, parseJSON, (.:))
-import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8)
import Network.HTTP.Client
- (applyBasicAuth, httpLbs, parseRequest, responseBody, responseStatus)
-import Network.HTTP.Conduit (Manager)
-import Yesod.Auth (AuthPlugin, Creds(..), YesodAuth)
-import Yesod.Auth.OAuth2
+ (applyBasicAuth, httpLbs, parseUrlThrow, responseBody)
+import Network.OAuth.OAuth2 (AccessToken(..))
+import URI.ByteString.Extension (withQuery)
+import Yesod.Auth.OAuth2.Provider
+import Yesod.Auth.OAuth2.UserId
-import qualified Network.HTTP.Types as HT
-
-data NylasAccount = NylasAccount
- { nylasAccountId :: Text
- , nylasAccountEmailAddress :: Text
- , nylasAccountName :: Text
- , nylasAccountProvider :: Text
- , nylasAccountOrganizationUnit :: Text
- }
-
-instance FromJSON NylasAccount where
- parseJSON (Object o) = NylasAccount
- <$> o .: "id"
- <*> o .: "email_address"
- <*> o .: "name"
- <*> o .: "provider"
- <*> o .: "organization_unit"
- parseJSON _ = mzero
-
-oauth2Nylas :: YesodAuth m
- => Text -- ^ Client ID
- -> Text -- ^ Client Secret
- -> AuthPlugin m
-oauth2Nylas clientId clientSecret = authOAuth2 "nylas" oauth fetchCreds
- where
- oauth = OAuth2
- { oauthClientId = clientId
- , oauthClientSecret = clientSecret
- , oauthOAuthorizeEndpoint = "https://api.nylas.com/oauth/authorize" `withQuery`
- [ ("response_type", "code")
+oauth2Nylas :: Provider m UserIdText
+oauth2Nylas = Provider
+ { pName = "nylas"
+ , pAuthorizeEndpoint = \cid -> AuthorizeEndpoint $
+ "https://api.nylas.com/oauth/authorize" `withQuery`
+ [ ("client_id", encodeUtf8 $ clientId cid)
+ , ("response_type", "code")
, ("scope", "email")
- , ("client_id", encodeUtf8 clientId)
]
- , oauthAccessTokenEndpoint = "https://api.nylas.com/oauth/token"
- , oauthCallback = Nothing
- }
-
-fetchCreds :: Manager -> OAuth2Token -> IO (Creds a)
-fetchCreds manager token = do
- req <- authorize <$> parseRequest "https://api.nylas.com/account"
- resp <- httpLbs req manager
- if HT.statusIsSuccessful (responseStatus resp)
- then case decode (responseBody resp) of
- Just ns -> return $ toCreds ns token
- Nothing -> throwIO parseFailure
- else throwIO requestFailure
- where
- authorize = applyBasicAuth (encodeUtf8 $ atoken $ accessToken token) ""
- parseFailure = InvalidProfileResponse "nylas" "failed to parse account"
- requestFailure = InvalidProfileResponse "nylas" "failed to get account"
-
-toCreds :: NylasAccount -> OAuth2Token -> Creds a
-toCreds ns token = Creds
- { credsPlugin = "nylas"
- , credsIdent = nylasAccountId ns
- , credsExtra =
- [ ("email_address", nylasAccountEmailAddress ns)
- , ("name", nylasAccountName ns)
- , ("provider", nylasAccountProvider ns)
- , ("organization_unit", nylasAccountOrganizationUnit ns)
- , ("access_token", atoken $ accessToken token)
- ]
+ , pAccessTokenEndpoint = "https://api.nylas.com/oauth/token"
+ , pFetchUserProfile = \manager token -> do
+ req <- applyBasicAuth (encodeUtf8 $ atoken token) ""
+ <$> parseUrlThrow "https://api.nylas.com/account"
+ Right . responseBody <$> httpLbs req manager
}
diff --git a/src/Yesod/Auth/OAuth2/Provider.hs b/src/Yesod/Auth/OAuth2/Provider.hs
new file mode 100644
index 0000000..682d1df
--- /dev/null
+++ b/src/Yesod/Auth/OAuth2/Provider.hs
@@ -0,0 +1,99 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TupleSections #-}
+module Yesod.Auth.OAuth2.Provider
+ ( ClientId(..)
+ , ClientSecret(..)
+ , AuthorizeEndpoint(..)
+ , AccessTokenEndpoint(..)
+ , ProviderName(..)
+ , Provider(..)
+ , authGetProfile
+ , providerCreds
+ , Scope(..)
+ , scopeParam
+ , withQuery
+ , ToIdent(..)
+ ) where
+
+import Control.Monad.Trans.Except
+import Data.Aeson (FromJSON, eitherDecode)
+import Data.Bifunctor (first)
+import qualified Data.ByteString as BS
+import Data.ByteString.Lazy (ByteString, toStrict)
+import Data.String (IsString)
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Text.Encoding (decodeUtf8, encodeUtf8)
+import Network.HTTP.Conduit (Manager)
+import Network.OAuth.OAuth2
+ (AccessToken(..), OAuth2Error(..), OAuth2Token(..), authGetBS)
+import URI.ByteString (URI)
+import URI.ByteString.Extension (withQuery)
+import Yesod.Auth (Creds(..))
+
+newtype ClientId = ClientId { clientId :: Text }
+newtype ClientSecret = ClientSecret { clientSecret :: Text }
+
+newtype AuthorizeEndpoint = AuthorizeEndpoint { authorizeEndpoint :: URI }
+ deriving (IsString)
+
+newtype AccessTokenEndpoint = AccessTokenEndpoint { accessTokenEndpoint :: URI }
+ deriving (IsString)
+
+newtype Scope = Scope { scope :: Text }
+ deriving (IsString)
+
+newtype ProviderName = ProviderName { providerName :: Text }
+ deriving (IsString)
+
+data Provider m a = Provider
+ { pName :: ProviderName
+ , pAuthorizeEndpoint :: ClientId -> AuthorizeEndpoint
+ -- ^ Authorization endpoint
+ --
+ -- Some providers need to include the client-id in the request, so it's
+ -- provided here. Most providers can ignore it
+ --
+ -- > pAuthorizeEndpoint = const "http://example.com/oauth2/authorize"
+ --
+ , pAccessTokenEndpoint :: AccessTokenEndpoint
+ , pFetchUserProfile :: Manager -> AccessToken -> IO (Either Text ByteString)
+ }
+
+pParseUserProfile :: FromJSON a => Provider m a -> ByteString -> Either String a
+pParseUserProfile _ = eitherDecode
+
+authGetProfile :: URI -> Manager -> AccessToken -> IO (Either Text ByteString)
+authGetProfile uri manager token =
+ first prettyOAuth2Error <$> authGetBS manager token uri
+ where
+ prettyOAuth2Error :: OAuth2Error Text -> Text
+ prettyOAuth2Error = T.pack . show -- FIXME
+
+class ToIdent a where
+ toIdent :: a -> Text
+
+instance ToIdent Int where
+ toIdent = T.pack . show
+
+instance ToIdent Text where
+ toIdent = id
+
+providerCreds :: (FromJSON a, ToIdent a) => Provider m a -> Manager -> OAuth2Token -> IO (Either Text (Creds m))
+providerCreds p@Provider{..} manager token = runExceptT $ do
+ lbs <- ExceptT $ pFetchUserProfile manager $ accessToken token
+ user <- withExceptT T.pack $ ExceptT $ return $ pParseUserProfile p lbs
+
+ return Creds
+ { credsPlugin = providerName pName
+ , credsIdent = toIdent user
+ , credsExtra =
+ [ ("accessToken", atoken $ accessToken token)
+ , ("userResponseBody", decodeUtf8 $ toStrict lbs)
+ ]
+ }
+
+scopeParam :: Text -> [Scope] -> (BS.ByteString, BS.ByteString)
+scopeParam d = ("scope",) . encodeUtf8 . T.intercalate d . map scope
diff --git a/src/Yesod/Auth/OAuth2/Salesforce.hs b/src/Yesod/Auth/OAuth2/Salesforce.hs
index dd5102f..06518aa 100644
--- a/src/Yesod/Auth/OAuth2/Salesforce.hs
+++ b/src/Yesod/Auth/OAuth2/Salesforce.hs
@@ -1,154 +1,42 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
--- |
---
--- OAuth2 plugin for http://login.salesforce.com
---
--- * Authenticates against Salesforce
--- * Uses Salesforce user id as credentials identifier
--- * Returns given_name, family_name, email and avatar_url as extras
---
module Yesod.Auth.OAuth2.Salesforce
( oauth2Salesforce
- , oauth2SalesforceScoped
, oauth2SalesforceSandbox
- , oauth2SalesforceSandboxScoped
- , module Yesod.Auth.OAuth2
+ , defaultScopes
) where
-#if __GLASGOW_HASKELL__ < 710
-import Control.Applicative ((<$>), (<*>))
-#endif
-
-import Control.Exception.Lifted
-import Control.Monad (mzero)
import Data.Aeson
import Data.Text (Text)
-import Network.HTTP.Conduit (Manager)
-import Yesod.Auth
-import Yesod.Auth.OAuth2
+import Yesod.Auth.OAuth2.Provider
-import qualified Data.Text as T
+newtype UserId = UserId Text
+ deriving ToIdent
-oauth2Salesforce :: YesodAuth m
- => Text -- ^ Client ID
- -> Text -- ^ Client Secret
- -> AuthPlugin m
-oauth2Salesforce = oauth2SalesforceScoped ["openid", "email", "api"]
+instance FromJSON UserId where
+ parseJSON = withObject "User" $ \o -> UserId <$> o .: "user_id"
-svcName :: Text
-svcName = "salesforce"
-
-oauth2SalesforceScoped :: YesodAuth m
- => [Text] -- ^ List of scopes to request
- -> Text -- ^ Client ID
- -> Text -- ^ Client Secret
- -> AuthPlugin m
-oauth2SalesforceScoped scopes clientId clientSecret =
- authOAuth2 svcName oauth fetchSalesforceUser
- where
- oauth = OAuth2
- { oauthClientId = clientId
- , oauthClientSecret = clientSecret
- , oauthOAuthorizeEndpoint = "https://login.salesforce.com/services/oauth2/authorize" `withQuery`
+oauth2Salesforce :: [Scope] -> Provider m UserId
+oauth2Salesforce scopes = Provider
+ { pName = "salesforce"
+ , pAuthorizeEndpoint = const $ AuthorizeEndpoint
+ $ "https://login.salesforce.com/services/oauth2/authorize" `withQuery`
[ scopeParam " " scopes
]
- , oauthAccessTokenEndpoint = "https://login.salesforce.com/services/oauth2/token"
- , oauthCallback = Nothing
- }
+ , pAccessTokenEndpoint = "https://login.salesforce.com/services/oauth2/token"
+ , pFetchUserProfile = authGetProfile "https://login.salesforce.com/services/oauth2/userinfo"
+ }
-fetchSalesforceUser :: Manager -> OAuth2Token -> IO (Creds m)
-fetchSalesforceUser manager token = do
- result <- authGetJSON manager (accessToken token) "https://login.salesforce.com/services/oauth2/userinfo"
- case result of
- Right user -> return $ toCreds svcName user token
- Left err -> throwIO $ invalidProfileResponse svcName err
-
-svcNameSb :: Text
-svcNameSb = "salesforce-sandbox"
-
-oauth2SalesforceSandbox :: YesodAuth m
- => Text -- ^ Client ID
- -> Text -- ^ Client Secret
- -> AuthPlugin m
-oauth2SalesforceSandbox = oauth2SalesforceSandboxScoped ["openid", "email"]
-
-
-oauth2SalesforceSandboxScoped :: YesodAuth m
- => [Text] -- ^ List of scopes to request
- -> Text -- ^ Client ID
- -> Text -- ^ Client Secret
- -> AuthPlugin m
-oauth2SalesforceSandboxScoped scopes clientId clientSecret =
- authOAuth2 svcNameSb oauth fetchSalesforceSandboxUser
- where
- oauth = OAuth2
- { oauthClientId = clientId
- , oauthClientSecret = clientSecret
- , oauthOAuthorizeEndpoint = "https://test.salesforce.com/services/oauth2/authorize" `withQuery`
+oauth2SalesforceSandbox :: [Scope] -> Provider m UserId
+oauth2SalesforceSandbox scopes = Provider
+ { pName = "salesforce-sandbox"
+ , pAuthorizeEndpoint = const $ AuthorizeEndpoint
+ $ "https://test.salesforce.com/services/oauth2/authorize" `withQuery`
[ scopeParam " " scopes
]
- , oauthAccessTokenEndpoint = "https://test.salesforce.com/services/oauth2/token"
- , oauthCallback = Nothing
- }
-
-fetchSalesforceSandboxUser :: Manager -> OAuth2Token -> IO (Creds m)
-fetchSalesforceSandboxUser manager token = do
- result <- authGetJSON manager (accessToken token) "https://test.salesforce.com/services/oauth2/userinfo"
- case result of
- Right user -> return $ toCreds svcNameSb user token
- Left err -> throwIO $ invalidProfileResponse svcNameSb err
-
-data User = User
- { userId :: Text
- , userOrg :: Text
- , userNickname :: Text
- , userName :: Text
- , userGivenName :: Text
- , userFamilyName :: Text
- , userTimeZone :: Text
- , userEmail :: Text
- , userPicture :: Text
- , userPhone :: Maybe Text
- , userRestUrl :: Text
+ , pAccessTokenEndpoint = "https://test.salesforce.com/services/oauth2/token"
+ , pFetchUserProfile = authGetProfile "https://test.salesforce.com/services/oauth2/userinfo"
}
-instance FromJSON User where
- parseJSON (Object o) = do
- userId <- o .: "user_id"
- userOrg <- o .: "organization_id"
- userNickname <- o .: "nickname"
- userName <- o .: "name"
- userGivenName <- o .: "given_name"
- userFamilyName <- o .: "family_name"
- userTimeZone <- o .: "zoneinfo"
- userEmail <- o .: "email"
- userPicture <- o .: "picture"
- userPhone <- o .:? "phone_number"
- urls <- o .: "urls"
- userRestUrl <- urls .: "rest"
- return User{..}
-
- parseJSON _ = mzero
-
-toCreds :: Text -> User -> OAuth2Token -> Creds m
-toCreds name user token = Creds
- { credsPlugin = name
- , credsIdent = userId user
- , credsExtra =
- [ ("email", userEmail user)
- , ("org", userOrg user)
- , ("nickname", userName user)
- , ("name", userName user)
- , ("given_name", userGivenName user)
- , ("family_name", userFamilyName user)
- , ("time_zone", userTimeZone user)
- , ("avatar_url", userPicture user)
- , ("rest_url", userRestUrl user)
- , ("access_token", atoken $ accessToken token)
- ]
- ++ maybeExtra "refresh_token" (rtoken <$> refreshToken token)
- ++ maybeExtra "expires_in" ((T.pack . show) <$> expiresIn token)
- ++ maybeExtra "phone_number" (userPhone user)
- }
+defaultScopes :: [Scope]
+defaultScopes = ["openid", "email", "api"]
diff --git a/src/Yesod/Auth/OAuth2/Slack.hs b/src/Yesod/Auth/OAuth2/Slack.hs
index 1a06edf..28c0789 100644
--- a/src/Yesod/Auth/OAuth2/Slack.hs
+++ b/src/Yesod/Auth/OAuth2/Slack.hs
@@ -1,123 +1,29 @@
{-# LANGUAGE OverloadedStrings #-}
--- |
--- OAuth2 plugin for https://slack.com/
---
--- * Authenticates against slack
--- * Uses slack user id as credentials identifier
--- * Returns name, access_token, email, avatar, team_id, and team_name as extras
---
module Yesod.Auth.OAuth2.Slack
- ( SlackScope(..)
- , oauth2Slack
- , oauth2SlackScoped
+ ( oauth2Slack
+ , defaultScopes
) where
-import Data.Aeson
-import Yesod.Auth
-import Yesod.Auth.OAuth2
-
-import Control.Exception.Lifted (throwIO)
-import Data.Maybe (catMaybes)
-import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8)
-import Network.HTTP.Conduit (Manager)
+import Network.HTTP.Client
+ (httpLbs, parseUrlThrow, responseBody, setQueryString)
+import Network.OAuth.OAuth2 (AccessToken(..))
+import Yesod.Auth.OAuth2.Provider
+import Yesod.Auth.OAuth2.UserId
-import qualified Network.HTTP.Conduit as HTTP
-
-data SlackScope
- = SlackEmailScope
- | SlackTeamScope
- | SlackAvatarScope
-
-data SlackUser = SlackUser
- { slackUserId :: Text
- , slackUserName :: Text
- , slackUserEmail :: Maybe Text
- , slackUserAvatarUrl :: Maybe Text
- , slackUserTeam :: Maybe SlackTeam
- }
-
-data SlackTeam = SlackTeam
- { slackTeamId :: Text
- , slackTeamName :: Text
- }
-
-instance FromJSON SlackUser where
- parseJSON = withObject "root" $ \root -> do
- user <- root .: "user"
-
- SlackUser
- <$> user .: "id"
- <*> user .: "name"
- <*> user .:? "email"
- <*> user .:? "image_512"
- <*> root .:? "team"
-
-instance FromJSON SlackTeam where
- parseJSON = withObject "team" $ \team ->
- SlackTeam
- <$> team .: "id"
- <*> team .: "name"
-
--- | Auth with Slack
---
--- Requests @identity.basic@ scopes and uses the user's Slack ID as the @'Creds'@
--- identifier.
---
-oauth2Slack :: YesodAuth m
- => Text -- ^ Client ID
- -> Text -- ^ Client Secret
- -> AuthPlugin m
-oauth2Slack clientId clientSecret = oauth2SlackScoped clientId clientSecret []
-
--- | Auth with Slack
---
--- Requests custom scopes and uses the user's Slack ID as the @'Creds'@
--- identifier.
---
-oauth2SlackScoped :: YesodAuth m
- => Text -- ^ Client ID
- -> Text -- ^ Client Secret
- -> [SlackScope]
- -> AuthPlugin m
-oauth2SlackScoped clientId clientSecret scopes =
- authOAuth2 "slack" oauth fetchSlackProfile
- where
- oauth = OAuth2
- { oauthClientId = clientId
- , oauthClientSecret = clientSecret
- , oauthOAuthorizeEndpoint = "https://slack.com/oauth/authorize" `withQuery`
- [ scopeParam "," $ "identity.basic" : map scopeText scopes
+oauth2Slack :: [Scope] -> Provider m UserIdText
+oauth2Slack scopes = Provider
+ { pName = "slack"
+ , pAuthorizeEndpoint = const $ AuthorizeEndpoint
+ $ "https://slack.com/oauth/authorize" `withQuery`
+ [ scopeParam "," scopes
]
- , oauthAccessTokenEndpoint = "https://slack.com/api/oauth.access"
- , oauthCallback = Nothing
- }
-
-scopeText :: SlackScope -> Text
-scopeText SlackEmailScope = "identity.email"
-scopeText SlackTeamScope = "identity.team"
-scopeText SlackAvatarScope = "identity.avatar"
-
-fetchSlackProfile :: Manager -> OAuth2Token -> IO (Creds m)
-fetchSlackProfile manager token = do
- request
- <- HTTP.setQueryString [("token", Just $ encodeUtf8 $ atoken $ accessToken token)]
- <$> HTTP.parseUrlThrow "https://slack.com/api/users.identity"
- body <- HTTP.responseBody <$> HTTP.httpLbs request manager
- case eitherDecode body of
- Left _ -> throwIO $ InvalidProfileResponse "slack" body
- Right u -> return $ toCreds u token
-
-toCreds :: SlackUser -> OAuth2Token -> Creds m
-toCreds user token = Creds
- { credsPlugin = "slack"
- , credsIdent = slackUserId user
- , credsExtra = catMaybes
- [ Just ("name", slackUserName user)
- , Just ("access_token", atoken $ accessToken token)
- , (,) <$> pure "email" <*> slackUserEmail user
- , (,) <$> pure "avatar" <*> slackUserAvatarUrl user
- , (,) <$> pure "team_name" <*> (slackTeamName <$> slackUserTeam user)
- , (,) <$> pure "team_id" <*> (slackTeamId <$> slackUserTeam user)
- ]
+ , pAccessTokenEndpoint = "https://slack.com/api/oauth.access"
+ , pFetchUserProfile = \manager token -> do
+ request <- setQueryString [("token", Just $ encodeUtf8 $ atoken token)]
+ <$> parseUrlThrow "https://slack.com/api/users.identity"
+ Right . responseBody <$> httpLbs request manager
}
+
+defaultScopes :: [Scope]
+defaultScopes = ["identity.basic"]
diff --git a/src/Yesod/Auth/OAuth2/Spotify.hs b/src/Yesod/Auth/OAuth2/Spotify.hs
index 7bb328e..c8d2625 100644
--- a/src/Yesod/Auth/OAuth2/Spotify.hs
+++ b/src/Yesod/Auth/OAuth2/Spotify.hs
@@ -1,107 +1,18 @@
-{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
--- |
---
--- OAuth2 plugin for http://spotify.com
---
module Yesod.Auth.OAuth2.Spotify
( oauth2Spotify
- , module Yesod.Auth.OAuth2
) where
-#if __GLASGOW_HASKELL__ < 710
-import Control.Applicative (pure, (<$>), (<*>))
-#endif
+import Yesod.Auth.OAuth2.Provider
+import Yesod.Auth.OAuth2.UserId
-import Control.Monad (mzero)
-import Data.Aeson
-import Data.Maybe
-import Data.Text (Text)
-import Data.Text.Encoding (encodeUtf8)
-import Yesod.Auth
-import Yesod.Auth.OAuth2
-
-import qualified Data.Text as T
-
-data SpotifyUserImage = SpotifyUserImage
- { spotifyUserImageHeight :: Maybe Int
- , spotifyUserImageWidth :: Maybe Int
- , spotifyUserImageUrl :: Text
- }
-
-instance FromJSON SpotifyUserImage where
- parseJSON (Object v) = SpotifyUserImage
- <$> v .:? "height"
- <*> v .:? "width"
- <*> v .: "url"
-
- parseJSON _ = mzero
-
-data SpotifyUser = SpotifyUser
- { spotifyUserId :: Text
- , spotifyUserHref :: Text
- , spotifyUserUri :: Text
- , spotifyUserDisplayName :: Maybe Text
- , spotifyUserProduct :: Maybe Text
- , spotifyUserCountry :: Maybe Text
- , spotifyUserEmail :: Maybe Text
- , spotifyUserImages :: Maybe [SpotifyUserImage]
- }
-
-instance FromJSON SpotifyUser where
- parseJSON (Object v) = SpotifyUser
- <$> v .: "id"
- <*> v .: "href"
- <*> v .: "uri"
- <*> v .:? "display_name"
- <*> v .:? "product"
- <*> v .:? "country"
- <*> v .:? "email"
- <*> v .:? "images"
-
- parseJSON _ = mzero
-
-oauth2Spotify :: YesodAuth m
- => Text -- ^ Client ID
- -> Text -- ^ Client Secret
- -> [Text] -- ^ Scopes
- -> AuthPlugin m
-oauth2Spotify clientId clientSecret scope = authOAuth2 "spotify"
- OAuth2
- { oauthClientId = clientId
- , oauthClientSecret = clientSecret
- , oauthOAuthorizeEndpoint = "https://accounts.spotify.com/authorize" `withQuery`
- [ ("scope", encodeUtf8 $ T.intercalate " " scope)
+oauth2Spotify :: [Scope] -> Provider m UserIdText
+oauth2Spotify scopes = Provider
+ { pName = "spotify"
+ , pAuthorizeEndpoint = const $ AuthorizeEndpoint
+ $ "https://accounts.spotify.com/authorize" `withQuery`
+ [ scopeParam " " scopes
]
- , oauthAccessTokenEndpoint = "https://accounts.spotify.com/api/token"
- , oauthCallback = Nothing
- }
- $ fromProfileURL "spotify" "https://api.spotify.com/v1/me" toCreds
-
-toCreds :: SpotifyUser -> Creds m
-toCreds user = Creds
- { credsPlugin = "spotify"
- , credsIdent = spotifyUserId user
- , credsExtra = mapMaybe getExtra extrasTemplate
+ , pAccessTokenEndpoint = "https://accounts.spotify.com/api/token"
+ , pFetchUserProfile = authGetProfile "https://api.spotify.com/v1/me"
}
-
- where
- userImage :: Maybe SpotifyUserImage
- userImage = spotifyUserImages user >>= listToMaybe
-
- userImagePart :: (SpotifyUserImage -> Maybe a) -> Maybe a
- userImagePart getter = userImage >>= getter
-
- extrasTemplate = [ ("href", Just $ spotifyUserHref user)
- , ("uri", Just $ spotifyUserUri user)
- , ("display_name", spotifyUserDisplayName user)
- , ("product", spotifyUserProduct user)
- , ("country", spotifyUserCountry user)
- , ("email", spotifyUserEmail user)
- , ("image_url", spotifyUserImageUrl <$> userImage)
- , ("image_height", T.pack . show <$> userImagePart spotifyUserImageHeight)
- , ("image_width", T.pack . show <$> userImagePart spotifyUserImageWidth)
- ]
-
- getExtra :: (Text, Maybe Text) -> Maybe (Text, Text)
- getExtra (key, val) = fmap ((,) key) val
diff --git a/src/Yesod/Auth/OAuth2/Upcase.hs b/src/Yesod/Auth/OAuth2/Upcase.hs
index 4acd935..b399c64 100644
--- a/src/Yesod/Auth/OAuth2/Upcase.hs
+++ b/src/Yesod/Auth/OAuth2/Upcase.hs
@@ -1,72 +1,15 @@
-{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
--- |
---
--- OAuth2 plugin for http://upcase.com
---
--- * Authenticates against upcase
--- * Uses upcase user id as credentials identifier
--- * Returns first_name, last_name, and email as extras
---
module Yesod.Auth.OAuth2.Upcase
( oauth2Upcase
- , module Yesod.Auth.OAuth2
) where
-#if __GLASGOW_HASKELL__ < 710
-import Control.Applicative ((<$>), (<*>))
-#endif
+import Yesod.Auth.OAuth2.Provider
+import Yesod.Auth.OAuth2.UserId
-import Control.Monad (mzero)
-import Data.Aeson
-import Data.Text (Text)
-import qualified Data.Text as T
-import Yesod.Auth
-import Yesod.Auth.OAuth2
-
-data UpcaseUser = UpcaseUser
- { upcaseUserId :: Int
- , upcaseUserFirstName :: Text
- , upcaseUserLastName :: Text
- , upcaseUserEmail :: Text
+oauth2Upcase :: Provider m UserId
+oauth2Upcase = Provider
+ { pName = "upcase"
+ , pAuthorizeEndpoint = const "http://upcase.com/oauth/authorize"
+ , pAccessTokenEndpoint = "http://upcase.com/oauth/token"
+ , pFetchUserProfile = authGetProfile "http://upcase.com/api/v1/me.json"
}
-
-instance FromJSON UpcaseUser where
- parseJSON (Object o) = UpcaseUser
- <$> o .: "id"
- <*> o .: "first_name"
- <*> o .: "last_name"
- <*> o .: "email"
-
- parseJSON _ = mzero
-
-newtype UpcaseResponse = UpcaseResponse UpcaseUser
-
-instance FromJSON UpcaseResponse where
- parseJSON (Object o) = UpcaseResponse
- <$> o .: "user"
-
- parseJSON _ = mzero
-
-oauth2Upcase :: YesodAuth m
- => Text -- ^ Client ID
- -> Text -- ^ Client Secret
- -> AuthPlugin m
-oauth2Upcase clientId clientSecret = authOAuth2 "upcase"
- OAuth2
- { oauthClientId = clientId
- , oauthClientSecret = clientSecret
- , oauthOAuthorizeEndpoint = "http://upcase.com/oauth/authorize"
- , oauthAccessTokenEndpoint = "http://upcase.com/oauth/token"
- , oauthCallback = Nothing
- }
- $ fromProfileURL "upcase" "http://upcase.com/api/v1/me.json"
- $ \user -> Creds
- { credsPlugin = "upcase"
- , credsIdent = T.pack $ show $ upcaseUserId user
- , credsExtra =
- [ ("first_name", upcaseUserFirstName user)
- , ("last_name", upcaseUserLastName user)
- , ("email", upcaseUserEmail user)
- ]
- }
diff --git a/src/Yesod/Auth/OAuth2/UserId.hs b/src/Yesod/Auth/OAuth2/UserId.hs
new file mode 100644
index 0000000..cefe5a9
--- /dev/null
+++ b/src/Yesod/Auth/OAuth2/UserId.hs
@@ -0,0 +1,24 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings #-}
+module Yesod.Auth.OAuth2.UserId
+ ( UserId(..)
+ , UserIdText(..)
+ ) where
+
+import Data.Aeson
+import Data.Text (Text)
+import Yesod.Auth.OAuth2.Provider (ToIdent(..))
+
+-- | Parse-able type to use for responses with an integer @id@ field
+newtype UserId = UserId Int
+ deriving ToIdent
+
+instance FromJSON UserId where
+ parseJSON = withObject "User" $ \o -> UserId <$> o .: "id"
+
+-- | Parse-able type to use for responses with a textual @id@ field
+newtype UserIdText = UserIdText Text
+ deriving ToIdent
+
+instance FromJSON UserIdText where
+ parseJSON = withObject "User" $ \o -> UserIdText <$> o .: "id"
diff --git a/stack.yaml b/stack.yaml
index 98c8e2e..cffde61 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -1,6 +1,4 @@
---
-resolver: lts-9.18
+resolver: lts-10.1
packages:
- .
-extra-deps:
- - load-env-0.1.1