From 8cc1accc1156483ed4cc345bc6d205bb48daf5db Mon Sep 17 00:00:00 2001 From: John Lenz Date: Tue, 5 Aug 2014 22:46:55 -0500 Subject: [PATCH 1/4] Include google person information in the credsExtra field for GoogleEmail2 auth --- yesod-auth/Yesod/Auth/GoogleEmail2.hs | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/yesod-auth/Yesod/Auth/GoogleEmail2.hs b/yesod-auth/Yesod/Auth/GoogleEmail2.hs index bfe3d897..d836c73a 100644 --- a/yesod-auth/Yesod/Auth/GoogleEmail2.hs +++ b/yesod-auth/Yesod/Auth/GoogleEmail2.hs @@ -30,11 +30,14 @@ import Blaze.ByteString.Builder (fromByteString, toByteString) import Control.Applicative ((<$>), (<*>)) import Control.Arrow (second) import Control.Monad (liftM, unless) +import qualified Data.Aeson as A import Data.Aeson.Parser (json') import Data.Aeson.Types (FromJSON (parseJSON), parseEither, withObject) +import qualified Data.ByteString.Lazy as BL import Data.Conduit (($$+-)) import Data.Conduit.Attoparsec (sinkParser) +import qualified Data.HashMap.Strict as M import Data.Monoid (mappend) import Data.Text (Text) import qualified Data.Text as T @@ -175,7 +178,7 @@ authGoogleEmail clientID clientSecret = [e] -> return e [] -> error "No account email" x -> error $ "Too many account emails: " ++ show x - lift $ setCredsRedirect $ Creds pid email [] + lift $ setCredsRedirect $ Creds pid email $ allPersonInfo value2 dispatch _ _ = notFound @@ -200,3 +203,9 @@ instance FromJSON Email where parseJSON = withObject "Email" $ \o -> Email <$> o .: "value" <*> 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" From 2a6956a85c26a0c629f8ee40833956fdc83b2822 Mon Sep 17 00:00:00 2001 From: John Lenz Date: Fri, 15 Aug 2014 21:17:52 -0500 Subject: [PATCH 2/4] Small fixes to adding person info to creds extra for google auth --- yesod-auth/Yesod/Auth/GoogleEmail2.hs | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/yesod-auth/Yesod/Auth/GoogleEmail2.hs b/yesod-auth/Yesod/Auth/GoogleEmail2.hs index d836c73a..04afd433 100644 --- a/yesod-auth/Yesod/Auth/GoogleEmail2.hs +++ b/yesod-auth/Yesod/Auth/GoogleEmail2.hs @@ -31,10 +31,10 @@ import Control.Applicative ((<$>), (<*>)) import Control.Arrow (second) 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.Types (FromJSON (parseJSON), parseEither, withObject) -import qualified Data.ByteString.Lazy as BL import Data.Conduit (($$+-)) import Data.Conduit.Attoparsec (sinkParser) import qualified Data.HashMap.Strict as M @@ -42,6 +42,8 @@ import Data.Monoid (mappend) import Data.Text (Text) import qualified Data.Text as T 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, responseBody, urlEncodedBody) import Network.HTTP.Conduit (http) @@ -207,5 +209,5 @@ instance FromJSON Email where 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" + enc (key, v) = (key, TL.toStrict $ TL.toLazyText $ A.encodeToTextBuilder v) +allPersonInfo _ = [] From 9831220c4759cae169e560dc328b9615aa283c67 Mon Sep 17 00:00:00 2001 From: Dunric Date: Sun, 17 Aug 2014 20:15:50 +0200 Subject: [PATCH 3/4] add-handler interactive --- yesod-bin/AddHandler.hs | 34 +++++++++++++++++++++------------- 1 file changed, 21 insertions(+), 13 deletions(-) diff --git a/yesod-bin/AddHandler.hs b/yesod-bin/AddHandler.hs index ca3a6ce3..9c59c59b 100644 --- a/yesod-bin/AddHandler.hs +++ b/yesod-bin/AddHandler.hs @@ -22,20 +22,28 @@ addHandler = do [] -> error "No cabal file found" _ -> error "Too many cabal files found" - putStr "Name of route (without trailing R): " - hFlush stdout - name <- getLine - case name of - [] -> error "Please provide a name" - c:_ - | isLower c -> error "Name must start with an upper case letter" - | otherwise -> return () - - -- Check that the handler file doesn't already exist - let handlerFile = concat ["Handler/", name, ".hs"] - exists <- doesFileExist handlerFile - when exists $ error $ "File already exists: " ++ show handlerFile + let routeInput = do + putStr "Name of route (without trailing R): " + hFlush stdout + name <- getLine + case name of + [] -> error "No name entered. Quitting ..." + c:_ + | isLower c -> do + putStrLn "Name must start with an upper case letter" + routeInput + | otherwise -> do + -- Check that the handler file doesn't already exist + let handlerFile = concat ["Handler/", name, ".hs"] + exists <- doesFileExist handlerFile + if exists + then do + putStrLn $ "File already exists: " ++ show handlerFile + putStrLn "Try another name or leave blank to exit" + routeInput + else return (name, handlerFile) + (name, handlerFile) <- routeInput putStr "Enter route pattern (ex: /entry/#EntryId): " hFlush stdout pattern <- getLine From d4175f11ccd22f33c700b9e88b63e75f977c9b06 Mon Sep 17 00:00:00 2001 From: Dunric Date: Wed, 20 Aug 2014 01:53:59 +0200 Subject: [PATCH 4/4] `required' attribute for nicHtmlField (textfield tag) --- yesod-form/Yesod/Form/Nic.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/yesod-form/Yesod/Form/Nic.hs b/yesod-form/Yesod/Form/Nic.hs index 28626789..7e4af077 100644 --- a/yesod-form/Yesod/Form/Nic.hs +++ b/yesod-form/Yesod/Form/Nic.hs @@ -26,10 +26,10 @@ class Yesod a => YesodNic a where nicHtmlField :: YesodNic site => Field (HandlerT site IO) Html nicHtmlField = Field { fieldParse = \e _ -> return . Right . fmap (preEscapedToMarkup . sanitizeBalance) . listToMaybe $ e - , fieldView = \theId name attrs val _isReq -> do + , fieldView = \theId name attrs val isReq -> do toWidget [shamlet| $newline never -