yesod-auth-oauth2/Yesod/Auth/OAuth2/EveOnline.hs
patrick brisbin 937ad572a3 Update to LTS-9.5 and hoauth2 1.3.0
The largest changes were around the hoauth2 interface:

The OAuth2 type replaced all of its ByteString fields with either Text
or URI. This is a huge improvement. The fields that are now Text are the
type we had them in anyway. The fields that are now URI are type safe
and easier to manipulate. For example, we were doing very unsafe query
string manipulations looking for raw ? or & values, but now we can work
with tuples in a well-typed property.

Additionally the AccessToken type was upgraded to OAuth2Token with an
accessToken field, and the simple Either ByteString a results were
replaced by a real OAuth2Error type. This required changes to our
InvalidProfileResponse mechanism to support.

To make working with uri-bytestring more convenient, an Extension
library was added with some useful instances and helper functions. This
library may be upstreamed at some point.
2017-10-18 17:21:47 -04:00

117 lines
4.0 KiB
Haskell

{-# LANGUAGE CPP #-}
{-# 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
) 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 qualified Data.Text as T
data WidgetType m
= Plain -- ^ Simple "Login via eveonline" text
| BigWhite
| SmallWhite
| BigBlack
| SmallBlack
| Custom (WidgetT m IO ())
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|<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 SmallWhite = [whamlet|<img src="https://images.contentful.com/idjq7aai9ylm/18BxKSXCymyqY4QKo8KwKe/c2bdded6118472dd587c8107f24104d7/EVE_SSO_Login_Buttons_Small_White.png?w=195&h=30">|]
asWidget SmallBlack = [whamlet|<img src="https://images.contentful.com/idjq7aai9ylm/12vrPsIMBQi28QwCGOAqGk/33234da7672c6b0cdca394fc8e0b1c2b/EVE_SSO_Login_Buttons_Small_Black.png?w=195&h=30">|]
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`
[ ("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)
]
}