diff options
Diffstat (limited to 'src/Sproxy/Application/OAuth2')
-rw-r--r-- | src/Sproxy/Application/OAuth2/Common.hs | 3 | ||||
-rw-r--r-- | src/Sproxy/Application/OAuth2/Google.hs | 15 | ||||
-rw-r--r-- | src/Sproxy/Application/OAuth2/LinkedIn.hs | 19 |
3 files changed, 21 insertions, 16 deletions
diff --git a/src/Sproxy/Application/OAuth2/Common.hs b/src/Sproxy/Application/OAuth2/Common.hs index 07fb759..0324e62 100644 --- a/src/Sproxy/Application/OAuth2/Common.hs +++ b/src/Sproxy/Application/OAuth2/Common.hs @@ -8,6 +8,7 @@ module Sproxy.Application.OAuth2.Common ( import Control.Applicative (empty) import Data.Aeson (FromJSON, parseJSON, Value(Object), (.:)) import Data.ByteString(ByteString) +import Data.Text (Text) import Sproxy.Application.Cookie (AuthUser) @@ -29,7 +30,7 @@ type OAuth2Provider = (ByteString, ByteString) -> OAuth2Client -- and expires_in because we don't use them, *and* expires_in creates troubles: -- it's an integer from Google and string from LinkedIn (sic!) data AccessTokenBody = AccessTokenBody { - accessToken :: String + accessToken :: Text } deriving (Eq, Show) instance FromJSON AccessTokenBody where diff --git a/src/Sproxy/Application/OAuth2/Google.hs b/src/Sproxy/Application/OAuth2/Google.hs index 6b68f44..5a1834c 100644 --- a/src/Sproxy/Application/OAuth2/Google.hs +++ b/src/Sproxy/Application/OAuth2/Google.hs @@ -9,12 +9,13 @@ import Control.Exception (Exception, throwIO) import Data.Aeson (FromJSON, decode, parseJSON, Value(Object), (.:)) import Data.ByteString.Lazy (ByteString) import Data.Monoid ((<>)) +import Data.Text (Text, unpack) import Data.Typeable (Typeable) import Network.HTTP.Types (hContentType) import Network.HTTP.Types.URI (urlEncode) import qualified Network.HTTP.Conduit as H -import Sproxy.Application.Cookie (AuthUser(..)) +import Sproxy.Application.Cookie (newUser, setFamilyName, setGivenName) import Sproxy.Application.OAuth2.Common (AccessTokenBody(accessToken), OAuth2Client(..), OAuth2Provider) @@ -48,11 +49,13 @@ provider (client_id, client_secret) = case decode $ H.responseBody tresp of Nothing -> throwIO $ GoogleException tresp Just atResp -> do - ureq <- H.parseRequest $ "https://www.googleapis.com/oauth2/v1/userinfo?access_token=" ++ accessToken atResp + ureq <- H.parseRequest $ unpack ("https://www.googleapis.com/oauth2/v1/userinfo?access_token=" <> accessToken atResp) uresp <- H.httpLbs ureq mgr case decode $ H.responseBody uresp of Nothing -> throwIO $ GoogleException uresp - Just u -> return AuthUser { auEmail = email u, auGivenName = givenName u, auFamilyName = familyName u } + Just u -> return $ setFamilyName (familyName u) $ + setGivenName (givenName u) $ + newUser (email u) } @@ -64,9 +67,9 @@ instance Exception GoogleException data GoogleUserInfo = GoogleUserInfo { - email :: String -, givenName :: String -, familyName :: String + email :: Text +, givenName :: Text +, familyName :: Text } deriving (Eq, Show) instance FromJSON GoogleUserInfo where diff --git a/src/Sproxy/Application/OAuth2/LinkedIn.hs b/src/Sproxy/Application/OAuth2/LinkedIn.hs index b60afde..b35c566 100644 --- a/src/Sproxy/Application/OAuth2/LinkedIn.hs +++ b/src/Sproxy/Application/OAuth2/LinkedIn.hs @@ -7,15 +7,16 @@ module Sproxy.Application.OAuth2.LinkedIn ( import Control.Applicative (empty) import Control.Exception (Exception, throwIO) import Data.Aeson (FromJSON, decode, parseJSON, Value(Object), (.:)) -import Data.ByteString.Char8 (pack) import Data.ByteString.Lazy (ByteString) import Data.Monoid ((<>)) +import Data.Text (Text) +import Data.Text.Encoding (encodeUtf8) import Data.Typeable (Typeable) import Network.HTTP.Types (hContentType) import Network.HTTP.Types.URI (urlEncode) import qualified Network.HTTP.Conduit as H -import Sproxy.Application.Cookie (AuthUser(..)) +import Sproxy.Application.Cookie (newUser, setFamilyName, setGivenName) import Sproxy.Application.OAuth2.Common (AccessTokenBody(accessToken), OAuth2Client(..), OAuth2Provider) @@ -50,14 +51,14 @@ provider (client_id, client_secret) = Just atResp -> do let ureq = (H.parseRequest_ "https://api.linkedin.com/v1/people/\ \~:(email-address,first-name,last-name)?format=json") { - H.requestHeaders = [ ("Authorization", "Bearer " <> pack (accessToken atResp)) ] + H.requestHeaders = [ ("Authorization", "Bearer " <> encodeUtf8 (accessToken atResp)) ] } uresp <- H.httpLbs ureq mgr case decode $ H.responseBody uresp of Nothing -> throwIO $ LinkedInException uresp - Just u -> return AuthUser { auEmail = emailAddress u - , auGivenName = firstName u - , auFamilyName = lastName u } + Just u -> return $ setFamilyName (lastName u) $ + setGivenName (firstName u) $ + newUser (emailAddress u) } @@ -69,9 +70,9 @@ instance Exception LinkedInException data LinkedInUserInfo = LinkedInUserInfo { - emailAddress :: String -, firstName :: String -, lastName :: String + emailAddress :: Text +, firstName :: Text +, lastName :: Text } deriving (Eq, Show) instance FromJSON LinkedInUserInfo where |