haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Include google person information in the credsExtra field for GoogleEmail2 auth

Browse Source
This commit is contained in:
John Lenz 2014-08-05 22:46:55 -05:00
parent 6088f9049c
commit 8cc1accc11
1 changed files with 10 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
yesod-auth/Yesod/Auth/GoogleEmail2.hs
View File

@ -30,11 +30,14 @@ import Blaze.ByteString.Builder (fromByteString, toByteString)
import Control.Applicative ((<$>), (<*>)) import Control.Applicative ((<$>), (<*>))
import Control.Arrow (second) import Control.Arrow (second)
import Control.Monad (liftM, unless) import Control.Monad (liftM, unless)
import qualified Data.Aeson as A
import Data.Aeson.Parser (json') import Data.Aeson.Parser (json')
import Data.Aeson.Types (FromJSON (parseJSON), parseEither, import Data.Aeson.Types (FromJSON (parseJSON), parseEither,
withObject) withObject)
import qualified Data.ByteString.Lazy as BL
import Data.Conduit (($$+-)) import Data.Conduit (($$+-))
import Data.Conduit.Attoparsec (sinkParser) import Data.Conduit.Attoparsec (sinkParser)
import qualified Data.HashMap.Strict as M
import Data.Monoid (mappend) import Data.Monoid (mappend)
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
@ -175,7 +178,7 @@ authGoogleEmail clientID clientSecret =
[e] -> return e [e] -> return e
[] -> error "No account email" [] -> error "No account email"
x -> error $ "Too many account emails: " ++ show x x -> error $ "Too many account emails: " ++ show x
lift $ setCredsRedirect $ Creds pid email [] lift $ setCredsRedirect $ Creds pid email $ allPersonInfo value2
dispatch _ _ = notFound dispatch _ _ = notFound
@ -200,3 +203,9 @@ instance FromJSON Email where
parseJSON = withObject "Email" $ \o -> Email parseJSON = withObject "Email" $ \o -> Email
<$> o .: "value" <$> o .: "value"
<*> o .: "type" <*> o .: "type"
allPersonInfo :: A.Value -> [(Text, Text)]
allPersonInfo (A.Object o) = map enc $ M.toList o
where enc (key, A.String s) = (key, s)
enc (key, v) = (key, decodeUtf8 $ BL.toStrict $ A.encode v)
allPersonInfo _ = error "Google did not return a person object"