yesod-auth-oauth2 0.2.1 → 0.2.2

raw patch · 3 files changed

+296/−1 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Yesod/Auth/OAuth2/Bitbucket.hs +141/−0
• Yesod/Auth/OAuth2/Salesforce.hs +152/−0
• yesod-auth-oauth2.cabal +3/−1

@@ -0,0 +1,141 @@+{-# LANGUAGE CPP #-}+{-# 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.Maybe (fromMaybe)+import Data.List (find)+import Data.Monoid ((<>))+import Data.Text (Text)+import Data.Text.Encoding (encodeUtf8, decodeUtf8)+import Network.HTTP.Conduit (Manager)+import Yesod.Auth (YesodAuth, Creds(..), AuthPlugin)+import Yesod.Auth.OAuth2 (AccessToken, YesodOAuth2Exception(InvalidProfileResponse), OAuth2(..), authOAuth2, maybeExtra, accessToken, authGetJSON)++import qualified Data.Text as T++data BitbucketUser = BitbucketUser+    { bitbucketUserId :: Text+    , bitbucketUserName :: Maybe Text+    , bitbucketUserLogin :: Text+    , bitbucketUserLocation :: Maybe Text+    , bitbucketUserLinks :: BitbucketUserLinks+    }++instance FromJSON BitbucketUser where+    parseJSON (Object o) = BitbucketUser+        <$> o .: "uuid"+        <*> o .:? "display_name"+        <*> o .: "username"+        <*> o .:? "location"+        <*> o .: "links"++    parseJSON _ = mzero++data BitbucketUserLinks = BitbucketUserLinks+    { bitbucketAvatarLink :: BitbucketLink+    }++instance FromJSON BitbucketUserLinks where+    parseJSON (Object o) = BitbucketUserLinks+        <$> o .: "avatar"++    parseJSON _ = mzero++data BitbucketLink = BitbucketLink+    { bitbucketLinkHref :: Text+    }++instance FromJSON BitbucketLink where+    parseJSON (Object o) = BitbucketLink+        <$> o .: "href"+  +    parseJSON _ = mzero++data 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 = encodeUtf8 clientId+        , oauthClientSecret = encodeUtf8 clientSecret+        , oauthOAuthorizeEndpoint = encodeUtf8 $ "https://bitbucket.com/site/oauth2/authorize?scope=" <> T.intercalate "," scopes+        , oauthAccessTokenEndpoint = "https://bitbucket.com/site/oauth2/access_token"+        , oauthCallback = Nothing+        }++fetchBitbucketProfile :: Manager -> AccessToken -> IO (Creds m)+fetchBitbucketProfile manager token = do+    userResult <- authGetJSON manager token "https://api.bitbucket.com/2.0/user"+    mailResult <- authGetJSON manager 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] -> AccessToken -> 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", decodeUtf8 $ accessToken token)+        ]+        ++ maybeExtra "name" (bitbucketUserName user)+        ++ maybeExtra "location" (bitbucketUserLocation user)+    }++  where+    email = fromMaybe (head userMails) $ find bitbucketUserEmailPrimary userMails

@@ -0,0 +1,152 @@+{-# LANGUAGE CPP #-}+{-# 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+    ) 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 Data.Text.Encoding (encodeUtf8, decodeUtf8)+import Network.HTTP.Conduit (Manager)+import Yesod.Auth+import Yesod.Auth.OAuth2++import qualified Data.Text as T++oauth2Salesforce :: YesodAuth m+                 => Text -- ^ Client ID+                 -> Text -- ^ Client Secret+                 -> AuthPlugin m+oauth2Salesforce = oauth2SalesforceScoped ["openid", "email", "api"]++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            = encodeUtf8 clientId+        , oauthClientSecret        = encodeUtf8 clientSecret+        , oauthOAuthorizeEndpoint  = encodeUtf8 $ "https://login.salesforce.com/services/oauth2/authorize?scope=" <> T.intercalate " " scopes+        , oauthAccessTokenEndpoint = "https://login.salesforce.com/services/oauth2/token"+        , oauthCallback            = Nothing+        }++fetchSalesforceUser :: Manager -> AccessToken -> IO (Creds m)+fetchSalesforceUser manager token = do+    result <- authGetJSON manager 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            = encodeUtf8 clientId+        , oauthClientSecret        = encodeUtf8 clientSecret+        , oauthOAuthorizeEndpoint  = encodeUtf8 $ "https://test.salesforce.com/services/oauth2/authorize?scope=" <> T.intercalate " " scopes+        , oauthAccessTokenEndpoint = "https://test.salesforce.com/services/oauth2/token"+        , oauthCallback            = Nothing+        }++fetchSalesforceSandboxUser :: Manager -> AccessToken -> IO (Creds m)+fetchSalesforceSandboxUser manager token = do+    result <- authGetJSON manager 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+    }++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 -> AccessToken -> 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", decodeUtf8 $ accessToken token)+        ]+        ++ maybeExtra "refresh_token" (decodeUtf8 <$> refreshToken token)+        ++ maybeExtra "expires_in" ((T.pack . show) <$> expiresIn token)+        ++ maybeExtra "phone_number" (userPhone user)+    }

@@ -1,5 +1,5 @@ name:            yesod-auth-oauth2-version:         0.2.1+version:         0.2.2 license:         BSD3 license-file:    LICENSE author:          Tom Streller@@ -51,6 +51,8 @@                      Yesod.Auth.OAuth2.EveOnline                      Yesod.Auth.OAuth2.Nylas                      Yesod.Auth.OAuth2.Slack+                     Yesod.Auth.OAuth2.Salesforce+                     Yesod.Auth.OAuth2.Bitbucket      ghc-options:     -Wall