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

Merge pull request #797 from wuzzeb/master

Browse Source 
Include google person information in the credsExtra field for GoogleEmail2 auth
This commit is contained in:
Michael Snoyman 2014-08-17 11:20:29 +03:00
commit 587080dbff
1 changed files with 12 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -30,15 +30,20 @@ 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 qualified Data.Aeson.Encode 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 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
import Data.Text.Encoding (decodeUtf8, encodeUtf8) import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TL
import Network.HTTP.Client (parseUrl, requestHeaders, import Network.HTTP.Client (parseUrl, requestHeaders,
responseBody, urlEncodedBody) responseBody, urlEncodedBody)
import Network.HTTP.Conduit (http) import Network.HTTP.Conduit (http)
@ -175,7 +180,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 +205,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, TL.toStrict $ TL.toLazyText $ A.encodeToTextBuilder v)
allPersonInfo _ = []