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
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
-> Text
-> AuthPlugin m
oauth2Bitbucket clientId clientSecret = oauth2BitbucketScoped clientId clientSecret ["account"]
oauth2BitbucketScoped :: YesodAuth m
=> Text
-> Text
-> [Text]
-> 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