diff --git a/yesod-auth-oauth/Yesod/Auth/OAuth.hs b/yesod-auth-oauth/Yesod/Auth/OAuth.hs index fa7f1c76..4839a356 100644 --- a/yesod-auth-oauth/Yesod/Auth/OAuth.hs +++ b/yesod-auth-oauth/Yesod/Auth/OAuth.hs @@ -43,6 +43,7 @@ authOAuth oauth mkCreds = AuthPlugin name dispatch login url = PluginR name [] lookupTokenSecret = bsToText . fromMaybe "" . lookup "oauth_token_secret" . unCredential oauthSessionName = "__oauth_token_secret" + dispatch "GET" ["forward"] = do render <- lift getUrlRender tm <- getRouteToParent @@ -72,8 +73,9 @@ authOAuth oauth mkCreds = AuthPlugin name dispatch login master <- getYesod accTok <- getAccessToken oauth reqTok (authHttpManager master) creds <- liftIO $ mkCreds accTok - setCreds True creds + setCredsRedirect creds dispatch _ _ = notFound + login tm = do render <- getUrlRender let oaUrl = render $ tm $ oauthUrl name diff --git a/yesod-auth-oauth/yesod-auth-oauth.cabal b/yesod-auth-oauth/yesod-auth-oauth.cabal index a3e89f30..dff15167 100644 --- a/yesod-auth-oauth/yesod-auth-oauth.cabal +++ b/yesod-auth-oauth/yesod-auth-oauth.cabal @@ -1,5 +1,5 @@ name: yesod-auth-oauth -version: 1.2.0 +version: 1.3.0 license: BSD3 license-file: LICENSE author: Hiromi Ishii @@ -20,13 +20,13 @@ library cpp-options: -DGHC7 else build-depends: base >= 4 && < 4.3 - build-depends: authenticate-oauth >= 1.4 && < 1.5 + build-depends: authenticate-oauth >= 1.5 && < 1.6 , bytestring >= 0.9.1.4 , yesod-core >= 1.2 && < 1.3 - , yesod-auth >= 1.2 && < 1.3 - , text >= 0.7 && < 1.1 + , yesod-auth >= 1.3 && < 1.4 + , text >= 0.7 , yesod-form >= 1.3 && < 1.4 - , transformers >= 0.2.2 && < 0.4 + , transformers >= 0.2.2 && < 0.5 , lifted-base >= 0.2 && < 0.3 exposed-modules: Yesod.Auth.OAuth ghc-options: -Wall diff --git a/yesod-auth/Yesod/Auth.hs b/yesod-auth/Yesod/Auth.hs index 0a1a351b..5495e9cd 100644 --- a/yesod-auth/Yesod/Auth.hs +++ b/yesod-auth/Yesod/Auth.hs @@ -57,7 +57,6 @@ import Data.Monoid (Endo) import Network.HTTP.Conduit (Manager) import qualified Network.Wai as W -import Text.Hamlet (shamlet) import Yesod.Core import Yesod.Persist @@ -483,7 +482,7 @@ type AuthEntity master = KeyEntity (AuthId master) -- authenticated. -- -- Since 1.1.0 -requireAuthId :: YesodAuthPersist master => HandlerT master IO (AuthId master) +requireAuthId :: YesodAuth master => HandlerT master IO (AuthId master) requireAuthId = maybeAuthId >>= maybe redirectLogin return -- | Similar to 'maybeAuth', but redirects to a login page if user is not diff --git a/yesod-auth/Yesod/Auth/GoogleEmail2.hs b/yesod-auth/Yesod/Auth/GoogleEmail2.hs index 1f53dfa1..bfe3d897 100644 --- a/yesod-auth/Yesod/Auth/GoogleEmail2.hs +++ b/yesod-auth/Yesod/Auth/GoogleEmail2.hs @@ -53,9 +53,10 @@ import qualified Yesod.Auth.Message as Msg import Yesod.Core (HandlerSite, MonadHandler, getRouteToParent, getUrlRender, getYesod, invalidArgs, lift, - liftBase, lookupGetParam, + lookupGetParam, lookupSession, notFound, redirect, - setSession, whamlet, (.:)) + setSession, whamlet, (.:), + TypedContent, HandlerT, liftIO) pid :: Text pid = "googleemail2" @@ -75,7 +76,7 @@ getCreateCsrfToken = do case mtoken of Just token -> return token Nothing -> do - stdgen <- liftBase newStdGen + stdgen <- liftIO newStdGen let token = T.pack $ fst $ randomString 10 stdgen setSession csrfKey token return token @@ -111,6 +112,11 @@ authGoogleEmail clientID clientSecret = login tm = do url <- getDest tm [whamlet|_{Msg.LoginGoogle}|] + + dispatch :: YesodAuth site + => Text + -> [Text] + -> HandlerT Auth (HandlerT site IO) TypedContent dispatch "GET" ["forward"] = do tm <- getRouteToParent lift (getDest tm) >>= redirect @@ -130,7 +136,7 @@ authGoogleEmail clientID clientSecret = render <- getUrlRender - req' <- parseUrl "https://accounts.google.com/o/oauth2/token" -- FIXME don't hardcode, use: https://accounts.google.com/.well-known/openid-configuration + req' <- liftIO $ parseUrl "https://accounts.google.com/o/oauth2/token" -- FIXME don't hardcode, use: https://accounts.google.com/.well-known/openid-configuration let req = urlEncodedBody [ ("code", encodeUtf8 code) @@ -152,7 +158,7 @@ authGoogleEmail clientID clientSecret = unless (tokenType == "Bearer") $ error $ "Unknown token type: " ++ show tokenType - req2' <- parseUrl "https://www.googleapis.com/plus/v1/people/me" + req2' <- liftIO $ parseUrl "https://www.googleapis.com/plus/v1/people/me" let req2 = req2' { requestHeaders = [ ("Authorization", encodeUtf8 $ "Bearer " `mappend` accessToken) diff --git a/yesod-auth/yesod-auth.cabal b/yesod-auth/yesod-auth.cabal index 667566b6..b9227c87 100644 --- a/yesod-auth/yesod-auth.cabal +++ b/yesod-auth/yesod-auth.cabal @@ -1,5 +1,5 @@ name: yesod-auth -version: 1.3.1 +version: 1.3.1.1 license: MIT license-file: LICENSE author: Michael Snoyman, Patrick Brisbin diff --git a/yesod-bin/Devel.hs b/yesod-bin/Devel.hs index ccd4c358..77f34286 100644 --- a/yesod-bin/Devel.hs +++ b/yesod-bin/Devel.hs @@ -266,7 +266,7 @@ devel opts passThroughArgs = withSocketsDo $ withManager $ \manager -> do unless (anyTouched || haskellFileChanged) $ loop list1 if not success then liftIO $ do - putStrLn "Build failure, pausing..." + putStrLn "\x1b[1;31mBuild failure, pausing...\x1b[0m" runBuildHook $ failHook opts else do liftIO $ runBuildHook $ successHook opts diff --git a/yesod-bin/Keter.hs b/yesod-bin/Keter.hs index 8093d6f0..1a7192a4 100644 --- a/yesod-bin/Keter.hs +++ b/yesod-bin/Keter.hs @@ -7,7 +7,7 @@ import Data.Yaml import qualified Data.HashMap.Strict as Map import qualified Data.Text as T import System.Exit -import System.Cmd +import System.Process import Control.Monad import System.Directory import Data.Maybe (mapMaybe) diff --git a/yesod-bin/Scaffolding/Scaffolder.hs b/yesod-bin/Scaffolding/Scaffolder.hs index e3a69faa..6bdfedb8 100644 --- a/yesod-bin/Scaffolding/Scaffolder.hs +++ b/yesod-bin/Scaffolding/Scaffolder.hs @@ -73,7 +73,6 @@ scaffold isBare = do if validPackageName s && s /= "test" then Just s else Nothing - let dir = project puts $ renderTextUrl undefined $(textFile "input/database.cg") diff --git a/yesod-bin/hsfiles/mongo.hsfiles b/yesod-bin/hsfiles/mongo.hsfiles index fd63bda9..ed261fe2 100644 --- a/yesod-bin/hsfiles/mongo.hsfiles +++ b/yesod-bin/hsfiles/mongo.hsfiles @@ -1,5 +1,12 @@ +{-# START_FILE .dir-locals.el #-} +((haskell-mode . ((haskell-indent-spaces . 4) + (haskell-process-use-ghci . t))) + (hamlet-mode . ((hamlet/basic-offset . 4) + (haskell-process-use-ghci . t)))) + {-# START_FILE .ghci #-} :set -i.:config:dist/build/autogen +:set -DDEVELOPMENT :set -XCPP -XTemplateHaskell -XQuasiQuotes -XTypeFamilies -XFlexibleContexts -XGADTs -XOverloadedStrings -XMultiParamTypeClasses -XGeneralizedNewtypeDeriving -XEmptyDataDecls -XDeriveDataTypeable {-# START_FILE .gitignore #-} @@ -204,6 +211,13 @@ instance Yesod App where -- The page to be redirected to when authentication is required. authRoute _ = Just $ AuthR LoginR + -- Routes not requiring authenitcation. + isAuthorized (AuthR _) _ = return Authorized + isAuthorized FaviconR _ = return Authorized + isAuthorized RobotsR _ = return Authorized + -- Default to Authorized for now. + isAuthorized _ _ = return Authorized + -- This function creates static content files in the static folder -- and names them based on a hash of their content. This allows -- expiration dates to be set far in the future without worry of @@ -351,6 +365,7 @@ import Database.Persist.Quasi import Database.Persist.MongoDB hiding (master) import Language.Haskell.TH.Syntax import Data.Typeable (Typeable) +import Prelude -- You can define all of your database entities in the entities file. -- You can find more information on persistent and how to declare entities @@ -594,6 +609,75 @@ combineStylesheets = combineStylesheets' development combineSettings combineScripts :: Name -> [Route Static] -> Q Exp combineScripts = combineScripts' development combineSettings +{-# START_FILE app/DevelMain.hs #-} +-- | Development version to be run inside GHCi. +-- +-- start this up with: +-- +-- cabal repl --ghc-options="-O0 -fobject-code" +-- +-- run with: +-- +-- :l DevelMain +-- DevelMain.update +-- +-- You will need to add these packages to your .cabal file +-- * foreign-store >= 0.1 (very light-weight) +-- * warp (you already depend on this, it just isn't in your .cabal file) +-- +-- If you don't use cabal repl, you will need +-- to add settings to your .ghci file. +-- +-- :set -DDEVELOPMENT +-- +-- There is more information about using ghci +-- on the wiki: https://github.com/yesodweb/yesod/wiki/ghci + +module DevelMain where + +import Application (getApplicationDev) + +import Control.Exception (finally) +import Control.Concurrent +import Data.IORef +import Foreign.Store +import Network.Wai.Handler.Warp + +-- | Start or restart the server. +-- A Store holds onto some data across ghci reloads +update :: IO () +update = do + mtidStore <- lookupStore tidStoreNum + case mtidStore of + -- no server running + Nothing -> do + done <- storeAction doneStore newEmptyMVar + tid <- start done + _ <- storeAction (Store tidStoreNum) (newIORef tid) + return () + -- server is already running + Just tidStore -> + -- shut the server down with killThread and wait for the done signal + modifyStoredIORef tidStore $ \tid -> do + killThread tid + withStore doneStore takeMVar >> readStore doneStore >>= start + where + doneStore = Store 0 + tidStoreNum = 1 + + modifyStoredIORef :: Store (IORef a) -> (a -> IO a) -> IO () + modifyStoredIORef store f = withStore store $ \ref -> do + v <- readIORef ref + f v >>= writeIORef ref + +-- | Start the server in a separate thread. +start :: MVar () -- ^ Written to when the thread is killed. + -> IO ThreadId +start done = do + (port,app) <- getApplicationDev + forkIO (finally (runSettings (setPort port defaultSettings) app) + (putMVar done ())) + {-# START_FILE app/main.hs #-} import Prelude (IO) import Yesod.Default.Config (fromArgs) diff --git a/yesod-bin/hsfiles/mysql.hsfiles b/yesod-bin/hsfiles/mysql.hsfiles index 613142ec..9d6b7b9a 100644 --- a/yesod-bin/hsfiles/mysql.hsfiles +++ b/yesod-bin/hsfiles/mysql.hsfiles @@ -1,5 +1,12 @@ +{-# START_FILE .dir-locals.el #-} +((haskell-mode . ((haskell-indent-spaces . 4) + (haskell-process-use-ghci . t))) + (hamlet-mode . ((hamlet/basic-offset . 4) + (haskell-process-use-ghci . t)))) + {-# START_FILE .ghci #-} :set -i.:config:dist/build/autogen +:set -DDEVELOPMENT :set -XCPP -XTemplateHaskell -XQuasiQuotes -XTypeFamilies -XFlexibleContexts -XGADTs -XOverloadedStrings -XMultiParamTypeClasses -XGeneralizedNewtypeDeriving -XEmptyDataDecls -XDeriveDataTypeable {-# START_FILE .gitignore #-} @@ -211,6 +218,13 @@ instance Yesod App where -- The page to be redirected to when authentication is required. authRoute _ = Just $ AuthR LoginR + -- Routes not requiring authenitcation. + isAuthorized (AuthR _) _ = return Authorized + isAuthorized FaviconR _ = return Authorized + isAuthorized RobotsR _ = return Authorized + -- Default to Authorized for now. + isAuthorized _ _ = return Authorized + -- This function creates static content files in the static folder -- and names them based on a hash of their content. This allows -- expiration dates to be set far in the future without worry of @@ -358,6 +372,7 @@ import Yesod import Data.Text (Text) import Database.Persist.Quasi import Data.Typeable (Typeable) +import Prelude -- You can define all of your database entities in the entities file. -- You can find more information on persistent and how to declare entities @@ -598,6 +613,75 @@ combineStylesheets = combineStylesheets' development combineSettings combineScripts :: Name -> [Route Static] -> Q Exp combineScripts = combineScripts' development combineSettings +{-# START_FILE app/DevelMain.hs #-} +-- | Development version to be run inside GHCi. +-- +-- start this up with: +-- +-- cabal repl --ghc-options="-O0 -fobject-code" +-- +-- run with: +-- +-- :l DevelMain +-- DevelMain.update +-- +-- You will need to add these packages to your .cabal file +-- * foreign-store >= 0.1 (very light-weight) +-- * warp (you already depend on this, it just isn't in your .cabal file) +-- +-- If you don't use cabal repl, you will need +-- to add settings to your .ghci file. +-- +-- :set -DDEVELOPMENT +-- +-- There is more information about using ghci +-- on the wiki: https://github.com/yesodweb/yesod/wiki/ghci + +module DevelMain where + +import Application (getApplicationDev) + +import Control.Exception (finally) +import Control.Concurrent +import Data.IORef +import Foreign.Store +import Network.Wai.Handler.Warp + +-- | Start or restart the server. +-- A Store holds onto some data across ghci reloads +update :: IO () +update = do + mtidStore <- lookupStore tidStoreNum + case mtidStore of + -- no server running + Nothing -> do + done <- storeAction doneStore newEmptyMVar + tid <- start done + _ <- storeAction (Store tidStoreNum) (newIORef tid) + return () + -- server is already running + Just tidStore -> + -- shut the server down with killThread and wait for the done signal + modifyStoredIORef tidStore $ \tid -> do + killThread tid + withStore doneStore takeMVar >> readStore doneStore >>= start + where + doneStore = Store 0 + tidStoreNum = 1 + + modifyStoredIORef :: Store (IORef a) -> (a -> IO a) -> IO () + modifyStoredIORef store f = withStore store $ \ref -> do + v <- readIORef ref + f v >>= writeIORef ref + +-- | Start the server in a separate thread. +start :: MVar () -- ^ Written to when the thread is killed. + -> IO ThreadId +start done = do + (port,app) <- getApplicationDev + forkIO (finally (runSettings (setPort port defaultSettings) app) + (putMVar done ())) + {-# START_FILE app/main.hs #-} import Prelude (IO) import Yesod.Default.Config (fromArgs) diff --git a/yesod-bin/hsfiles/postgres-fay.hsfiles b/yesod-bin/hsfiles/postgres-fay.hsfiles index 6ae1cf2d..64387842 100644 --- a/yesod-bin/hsfiles/postgres-fay.hsfiles +++ b/yesod-bin/hsfiles/postgres-fay.hsfiles @@ -1,5 +1,12 @@ +{-# START_FILE .dir-locals.el #-} +((haskell-mode . ((haskell-indent-spaces . 4) + (haskell-process-use-ghci . t))) + (hamlet-mode . ((hamlet/basic-offset . 4) + (haskell-process-use-ghci . t)))) + {-# START_FILE .ghci #-} :set -i.:config:dist/build/autogen +:set -DDEVELOPMENT :set -XCPP -XTemplateHaskell -XQuasiQuotes -XTypeFamilies -XFlexibleContexts -XGADTs -XOverloadedStrings -XMultiParamTypeClasses -XGeneralizedNewtypeDeriving -XEmptyDataDecls -XDeriveDataTypeable {-# START_FILE .gitignore #-} @@ -215,6 +222,13 @@ instance Yesod App where -- The page to be redirected to when authentication is required. authRoute _ = Just $ AuthR LoginR + -- Routes not requiring authenitcation. + isAuthorized (AuthR _) _ = return Authorized + isAuthorized FaviconR _ = return Authorized + isAuthorized RobotsR _ = return Authorized + -- Default to Authorized for now. + isAuthorized _ _ = return Authorized + -- This function creates static content files in the static folder -- and names them based on a hash of their content. This allows -- expiration dates to be set far in the future without worry of @@ -390,6 +404,7 @@ import Yesod import Data.Text (Text) import Database.Persist.Quasi import Data.Typeable (Typeable) +import Prelude -- You can define all of your database entities in the entities file. -- You can find more information on persistent and how to declare entities @@ -647,6 +662,75 @@ combineStylesheets = combineStylesheets' development combineSettings combineScripts :: Name -> [Route Static] -> Q Exp combineScripts = combineScripts' development combineSettings +{-# START_FILE app/DevelMain.hs #-} +-- | Development version to be run inside GHCi. +-- +-- start this up with: +-- +-- cabal repl --ghc-options="-O0 -fobject-code" +-- +-- run with: +-- +-- :l DevelMain +-- DevelMain.update +-- +-- You will need to add these packages to your .cabal file +-- * foreign-store >= 0.1 (very light-weight) +-- * warp (you already depend on this, it just isn't in your .cabal file) +-- +-- If you don't use cabal repl, you will need +-- to add settings to your .ghci file. +-- +-- :set -DDEVELOPMENT +-- +-- There is more information about using ghci +-- on the wiki: https://github.com/yesodweb/yesod/wiki/ghci + +module DevelMain where + +import Application (getApplicationDev) + +import Control.Exception (finally) +import Control.Concurrent +import Data.IORef +import Foreign.Store +import Network.Wai.Handler.Warp + +-- | Start or restart the server. +-- A Store holds onto some data across ghci reloads +update :: IO () +update = do + mtidStore <- lookupStore tidStoreNum + case mtidStore of + -- no server running + Nothing -> do + done <- storeAction doneStore newEmptyMVar + tid <- start done + _ <- storeAction (Store tidStoreNum) (newIORef tid) + return () + -- server is already running + Just tidStore -> + -- shut the server down with killThread and wait for the done signal + modifyStoredIORef tidStore $ \tid -> do + killThread tid + withStore doneStore takeMVar >> readStore doneStore >>= start + where + doneStore = Store 0 + tidStoreNum = 1 + + modifyStoredIORef :: Store (IORef a) -> (a -> IO a) -> IO () + modifyStoredIORef store f = withStore store $ \ref -> do + v <- readIORef ref + f v >>= writeIORef ref + +-- | Start the server in a separate thread. +start :: MVar () -- ^ Written to when the thread is killed. + -> IO ThreadId +start done = do + (port,app) <- getApplicationDev + forkIO (finally (runSettings (setPort port defaultSettings) app) + (putMVar done ())) + {-# START_FILE app/main.hs #-} import Prelude (IO) import Yesod.Default.Config (fromArgs) diff --git a/yesod-bin/hsfiles/postgres.hsfiles b/yesod-bin/hsfiles/postgres.hsfiles index 47214641..5ea0d5fb 100644 --- a/yesod-bin/hsfiles/postgres.hsfiles +++ b/yesod-bin/hsfiles/postgres.hsfiles @@ -1,5 +1,12 @@ +{-# START_FILE .dir-locals.el #-} +((haskell-mode . ((haskell-indent-spaces . 4) + (haskell-process-use-ghci . t))) + (hamlet-mode . ((hamlet/basic-offset . 4) + (haskell-process-use-ghci . t)))) + {-# START_FILE .ghci #-} :set -i.:config:dist/build/autogen +:set -DDEVELOPMENT :set -XCPP -XTemplateHaskell -XQuasiQuotes -XTypeFamilies -XFlexibleContexts -XGADTs -XOverloadedStrings -XMultiParamTypeClasses -XGeneralizedNewtypeDeriving -XEmptyDataDecls -XDeriveDataTypeable {-# START_FILE .gitignore #-} @@ -211,6 +218,13 @@ instance Yesod App where -- The page to be redirected to when authentication is required. authRoute _ = Just $ AuthR LoginR + -- Routes not requiring authenitcation. + isAuthorized (AuthR _) _ = return Authorized + isAuthorized FaviconR _ = return Authorized + isAuthorized RobotsR _ = return Authorized + -- Default to Authorized for now. + isAuthorized _ _ = return Authorized + -- This function creates static content files in the static folder -- and names them based on a hash of their content. This allows -- expiration dates to be set far in the future without worry of @@ -358,6 +372,7 @@ import Yesod import Data.Text (Text) import Database.Persist.Quasi import Data.Typeable (Typeable) +import Prelude -- You can define all of your database entities in the entities file. -- You can find more information on persistent and how to declare entities @@ -598,6 +613,75 @@ combineStylesheets = combineStylesheets' development combineSettings combineScripts :: Name -> [Route Static] -> Q Exp combineScripts = combineScripts' development combineSettings +{-# START_FILE app/DevelMain.hs #-} +-- | Development version to be run inside GHCi. +-- +-- start this up with: +-- +-- cabal repl --ghc-options="-O0 -fobject-code" +-- +-- run with: +-- +-- :l DevelMain +-- DevelMain.update +-- +-- You will need to add these packages to your .cabal file +-- * foreign-store >= 0.1 (very light-weight) +-- * warp (you already depend on this, it just isn't in your .cabal file) +-- +-- If you don't use cabal repl, you will need +-- to add settings to your .ghci file. +-- +-- :set -DDEVELOPMENT +-- +-- There is more information about using ghci +-- on the wiki: https://github.com/yesodweb/yesod/wiki/ghci + +module DevelMain where + +import Application (getApplicationDev) + +import Control.Exception (finally) +import Control.Concurrent +import Data.IORef +import Foreign.Store +import Network.Wai.Handler.Warp + +-- | Start or restart the server. +-- A Store holds onto some data across ghci reloads +update :: IO () +update = do + mtidStore <- lookupStore tidStoreNum + case mtidStore of + -- no server running + Nothing -> do + done <- storeAction doneStore newEmptyMVar + tid <- start done + _ <- storeAction (Store tidStoreNum) (newIORef tid) + return () + -- server is already running + Just tidStore -> + -- shut the server down with killThread and wait for the done signal + modifyStoredIORef tidStore $ \tid -> do + killThread tid + withStore doneStore takeMVar >> readStore doneStore >>= start + where + doneStore = Store 0 + tidStoreNum = 1 + + modifyStoredIORef :: Store (IORef a) -> (a -> IO a) -> IO () + modifyStoredIORef store f = withStore store $ \ref -> do + v <- readIORef ref + f v >>= writeIORef ref + +-- | Start the server in a separate thread. +start :: MVar () -- ^ Written to when the thread is killed. + -> IO ThreadId +start done = do + (port,app) <- getApplicationDev + forkIO (finally (runSettings (setPort port defaultSettings) app) + (putMVar done ())) + {-# START_FILE app/main.hs #-} import Prelude (IO) import Yesod.Default.Config (fromArgs) diff --git a/yesod-bin/hsfiles/simple.hsfiles b/yesod-bin/hsfiles/simple.hsfiles index 65150af4..11a3e6f6 100644 --- a/yesod-bin/hsfiles/simple.hsfiles +++ b/yesod-bin/hsfiles/simple.hsfiles @@ -1,5 +1,12 @@ +{-# START_FILE .dir-locals.el #-} +((haskell-mode . ((haskell-indent-spaces . 4) + (haskell-process-use-ghci . t))) + (hamlet-mode . ((hamlet/basic-offset . 4) + (haskell-process-use-ghci . t)))) + {-# START_FILE .ghci #-} :set -i.:config:dist/build/autogen +:set -DDEVELOPMENT :set -XCPP -XTemplateHaskell -XQuasiQuotes -XTypeFamilies -XFlexibleContexts -XGADTs -XOverloadedStrings -XMultiParamTypeClasses -XGeneralizedNewtypeDeriving -XEmptyDataDecls -XDeriveDataTypeable {-# START_FILE .gitignore #-} @@ -189,6 +196,13 @@ instance Yesod App where Just $ uncurry (joinPath y (Settings.staticRoot $ settings y)) $ renderRoute s urlRenderOverride _ _ = Nothing + -- Routes not requiring authenitcation. + isAuthorized (AuthR _) _ = return Authorized + isAuthorized FaviconR _ = return Authorized + isAuthorized RobotsR _ = return Authorized + -- Default to Authorized for now. + isAuthorized _ _ = return Authorized + -- This function creates static content files in the static folder -- and names them based on a hash of their content. This allows -- expiration dates to be set far in the future without worry of @@ -517,6 +531,75 @@ combineStylesheets = combineStylesheets' development combineSettings combineScripts :: Name -> [Route Static] -> Q Exp combineScripts = combineScripts' development combineSettings +{-# START_FILE app/DevelMain.hs #-} +-- | Development version to be run inside GHCi. +-- +-- start this up with: +-- +-- cabal repl --ghc-options="-O0 -fobject-code" +-- +-- run with: +-- +-- :l DevelMain +-- DevelMain.update +-- +-- You will need to add these packages to your .cabal file +-- * foreign-store >= 0.1 (very light-weight) +-- * warp (you already depend on this, it just isn't in your .cabal file) +-- +-- If you don't use cabal repl, you will need +-- to add settings to your .ghci file. +-- +-- :set -DDEVELOPMENT +-- +-- There is more information about using ghci +-- on the wiki: https://github.com/yesodweb/yesod/wiki/ghci + +module DevelMain where + +import Application (getApplicationDev) + +import Control.Exception (finally) +import Control.Concurrent +import Data.IORef +import Foreign.Store +import Network.Wai.Handler.Warp + +-- | Start or restart the server. +-- A Store holds onto some data across ghci reloads +update :: IO () +update = do + mtidStore <- lookupStore tidStoreNum + case mtidStore of + -- no server running + Nothing -> do + done <- storeAction doneStore newEmptyMVar + tid <- start done + _ <- storeAction (Store tidStoreNum) (newIORef tid) + return () + -- server is already running + Just tidStore -> + -- shut the server down with killThread and wait for the done signal + modifyStoredIORef tidStore $ \tid -> do + killThread tid + withStore doneStore takeMVar >> readStore doneStore >>= start + where + doneStore = Store 0 + tidStoreNum = 1 + + modifyStoredIORef :: Store (IORef a) -> (a -> IO a) -> IO () + modifyStoredIORef store f = withStore store $ \ref -> do + v <- readIORef ref + f v >>= writeIORef ref + +-- | Start the server in a separate thread. +start :: MVar () -- ^ Written to when the thread is killed. + -> IO ThreadId +start done = do + (port,app) <- getApplicationDev + forkIO (finally (runSettings (setPort port defaultSettings) app) + (putMVar done ())) + {-# START_FILE app/main.hs #-} import Prelude (IO) import Yesod.Default.Config (fromArgs) diff --git a/yesod-bin/hsfiles/sqlite.hsfiles b/yesod-bin/hsfiles/sqlite.hsfiles index 9c57415e..30436df7 100644 --- a/yesod-bin/hsfiles/sqlite.hsfiles +++ b/yesod-bin/hsfiles/sqlite.hsfiles @@ -1,5 +1,12 @@ +{-# START_FILE .dir-locals.el #-} +((haskell-mode . ((haskell-indent-spaces . 4) + (haskell-process-use-ghci . t))) + (hamlet-mode . ((hamlet/basic-offset . 4) + (haskell-process-use-ghci . t)))) + {-# START_FILE .ghci #-} :set -i.:config:dist/build/autogen +:set -DDEVELOPMENT :set -XCPP -XTemplateHaskell -XQuasiQuotes -XTypeFamilies -XFlexibleContexts -XGADTs -XOverloadedStrings -XMultiParamTypeClasses -XGeneralizedNewtypeDeriving -XEmptyDataDecls -XDeriveDataTypeable {-# START_FILE .gitignore #-} @@ -211,6 +218,13 @@ instance Yesod App where -- The page to be redirected to when authentication is required. authRoute _ = Just $ AuthR LoginR + -- Routes not requiring authenitcation. + isAuthorized (AuthR _) _ = return Authorized + isAuthorized FaviconR _ = return Authorized + isAuthorized RobotsR _ = return Authorized + -- Default to Authorized for now. + isAuthorized _ _ = return Authorized + -- This function creates static content files in the static folder -- and names them based on a hash of their content. This allows -- expiration dates to be set far in the future without worry of @@ -358,6 +372,7 @@ import Yesod import Data.Text (Text) import Database.Persist.Quasi import Data.Typeable (Typeable) +import Prelude -- You can define all of your database entities in the entities file. -- You can find more information on persistent and how to declare entities @@ -598,6 +613,75 @@ combineStylesheets = combineStylesheets' development combineSettings combineScripts :: Name -> [Route Static] -> Q Exp combineScripts = combineScripts' development combineSettings +{-# START_FILE app/DevelMain.hs #-} +-- | Development version to be run inside GHCi. +-- +-- start this up with: +-- +-- cabal repl --ghc-options="-O0 -fobject-code" +-- +-- run with: +-- +-- :l DevelMain +-- DevelMain.update +-- +-- You will need to add these packages to your .cabal file +-- * foreign-store >= 0.1 (very light-weight) +-- * warp (you already depend on this, it just isn't in your .cabal file) +-- +-- If you don't use cabal repl, you will need +-- to add settings to your .ghci file. +-- +-- :set -DDEVELOPMENT +-- +-- There is more information about using ghci +-- on the wiki: https://github.com/yesodweb/yesod/wiki/ghci + +module DevelMain where + +import Application (getApplicationDev) + +import Control.Exception (finally) +import Control.Concurrent +import Data.IORef +import Foreign.Store +import Network.Wai.Handler.Warp + +-- | Start or restart the server. +-- A Store holds onto some data across ghci reloads +update :: IO () +update = do + mtidStore <- lookupStore tidStoreNum + case mtidStore of + -- no server running + Nothing -> do + done <- storeAction doneStore newEmptyMVar + tid <- start done + _ <- storeAction (Store tidStoreNum) (newIORef tid) + return () + -- server is already running + Just tidStore -> + -- shut the server down with killThread and wait for the done signal + modifyStoredIORef tidStore $ \tid -> do + killThread tid + withStore doneStore takeMVar >> readStore doneStore >>= start + where + doneStore = Store 0 + tidStoreNum = 1 + + modifyStoredIORef :: Store (IORef a) -> (a -> IO a) -> IO () + modifyStoredIORef store f = withStore store $ \ref -> do + v <- readIORef ref + f v >>= writeIORef ref + +-- | Start the server in a separate thread. +start :: MVar () -- ^ Written to when the thread is killed. + -> IO ThreadId +start done = do + (port,app) <- getApplicationDev + forkIO (finally (runSettings (setPort port defaultSettings) app) + (putMVar done ())) + {-# START_FILE app/main.hs #-} import Prelude (IO) import Yesod.Default.Config (fromArgs) diff --git a/yesod-bin/yesod-bin.cabal b/yesod-bin/yesod-bin.cabal index 7b9408a9..2a346157 100644 --- a/yesod-bin/yesod-bin.cabal +++ b/yesod-bin/yesod-bin.cabal @@ -1,5 +1,5 @@ name: yesod-bin -version: 1.2.10.2 +version: 1.2.11 license: MIT license-file: LICENSE author: Michael Snoyman diff --git a/yesod-core/README b/yesod-core/README index 987fd1b3..fd05b7a5 100644 --- a/yesod-core/README +++ b/yesod-core/README @@ -1 +1 @@ -Learn more at http://docs.yesodweb.com/ +Learn more at http://www.yesodweb.com/ diff --git a/yesod-core/Yesod/Core/Handler.hs b/yesod-core/Yesod/Core/Handler.hs index aa2f6195..7347d4f3 100644 --- a/yesod-core/Yesod/Core/Handler.hs +++ b/yesod-core/Yesod/Core/Handler.hs @@ -1018,8 +1018,8 @@ lookupCookies pn = do -- representations, e.g.: -- -- > selectRep $ do --- > provideRep typeHtml $ produceHtmlOutput --- > provideRep typeJson $ produceJsonOutput +-- > provideRep produceHtmlOutput +-- > provideRep produceJsonOutput -- -- The first provided representation will be used if no matches are found. diff --git a/yesod-form/Yesod/Form/Fields.hs b/yesod-form/Yesod/Form/Fields.hs index 23c7cf4c..00f748b4 100644 --- a/yesod-form/Yesod/Form/Fields.hs +++ b/yesod-form/Yesod/Form/Fields.hs @@ -237,7 +237,7 @@ $newline never } readMay :: Read a => String -> Maybe a -readMay s = case reads s of +readMay s = case filter (Prelude.null . snd) $ reads s of (x, _):_ -> Just x [] -> Nothing diff --git a/yesod-form/Yesod/Form/Functions.hs b/yesod-form/Yesod/Form/Functions.hs index 801d4899..ae3a3bac 100644 --- a/yesod-form/Yesod/Form/Functions.hs +++ b/yesod-form/Yesod/Form/Functions.hs @@ -1,4 +1,5 @@ {-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} @@ -23,6 +24,7 @@ module Yesod.Form.Functions , runFormGet -- * Generate a blank form , generateFormPost + , generateFormGet' , generateFormGet -- * More than one form on a handler , identifyForm @@ -270,6 +272,17 @@ runFormGet form = do Just _ -> Just (Map.unionsWith (++) $ map (\(x, y) -> Map.singleton x [y]) gets, Map.empty) getHelper form env +{- FIXME: generateFormGet' "Will be renamed to generateFormGet in next verison of Yesod" -} +-- | +-- +-- Since 1.3.11 +generateFormGet' + :: (RenderMessage (HandlerSite m) FormMessage, MonadHandler m) + => (Html -> MForm m (FormResult a, xml)) + -> m (xml, Enctype) +generateFormGet' form = first snd `liftM` getHelper form Nothing + +{-# DEPRECATED generateFormGet "Will require RenderMessage in next verison of Yesod" #-} generateFormGet :: MonadHandler m => (Html -> MForm m a) -> m (a, Enctype) @@ -345,15 +358,21 @@ type FormRender m a = -> MForm m (FormResult a, WidgetT (HandlerSite m) IO ()) renderTable, renderDivs, renderDivsNoLabels :: Monad m => FormRender m a +-- | Render a form into a series of tr tags. Note that, in order to allow +-- you to add extra rows to the table, this function does /not/ wrap up +-- the resulting HTML in a table tag; you must do that yourself. renderTable aform fragment = do (res, views') <- aFormToForm aform let views = views' [] let widget = [whamlet| $newline never -\#{fragment} -$forall view <- views +$if null views + \#{fragment} +$forall (isFirst, view) <- addIsFirst views + $if isFirst + \#{fragment}