diff --git a/scripts b/scripts index e791ced0..2fc59a85 160000 --- a/scripts +++ b/scripts @@ -1 +1 @@ -Subproject commit e791ced0395245e30d37b5098a27bba5e818ecb7 +Subproject commit 2fc59a850bdc49e01f7a5e062b813df321ce5c78 diff --git a/yesod-core/test/Test/InternalRequest.hs b/yesod-core/test/Test/InternalRequest.hs index ba510cb5..97e90b98 100644 --- a/yesod-core/test/Test/InternalRequest.hs +++ b/yesod-core/test/Test/InternalRequest.hs @@ -30,16 +30,16 @@ g = undefined nonceSpecs :: [Spec] nonceSpecs = describe "Yesod.Internal.Request.parseWaiRequest (reqNonce)" - [ it "is Nothing for unsecure sessions" noUnsecureNonce - , it "ignores pre-existing nonce for unsecure sessions" ignoreUnsecureNonce - , it "uses preexisting nonce for secure sessions" useOldNonce - , it "generates a new nonce for secure sessions without nonce" generateNonce + [ it "is Nothing if sessions are disabled" noDisabledNonce + , it "ignores pre-existing nonce if sessions are disabled" ignoreDisabledNonce + , it "uses preexisting nonce in session" useOldNonce + , it "generates a new nonce for sessions without nonce" generateNonce ] -noUnsecureNonce = reqNonce r == Nothing where +noDisabledNonce = reqNonce r == Nothing where r = parseWaiRequest' defaultRequest [] Nothing g -ignoreUnsecureNonce = reqNonce r == Nothing where +ignoreDisabledNonce = reqNonce r == Nothing where r = parseWaiRequest' defaultRequest [("_NONCE", "old")] Nothing g useOldNonce = reqNonce r == Just "old" where diff --git a/yesod-default/Yesod/Default/Main.hs b/yesod-default/Yesod/Default/Main.hs index f19e5d41..9cb36d8d 100644 --- a/yesod-default/Yesod/Default/Main.hs +++ b/yesod-default/Yesod/Default/Main.hs @@ -1,16 +1,25 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} module Yesod.Default.Main ( defaultMain + , defaultRunner , defaultDevelApp , defaultDevelAppWith ) where +import Yesod.Core import Yesod.Default.Config import Yesod.Logger (Logger, makeLogger, logString, logLazyText, flushLogger) import Network.Wai (Application) import Network.Wai.Handler.Warp (run) import Network.Wai.Middleware.Debug (debugHandle) +#ifndef WINDOWS +import qualified System.Posix.Signals as Signal +import Control.Concurrent (forkIO, killThread) +import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar) +#endif + -- | Run your app, taking environment and port settings from the -- commandline. -- @@ -31,6 +40,35 @@ defaultMain load withSite = do logger <- makeLogger withSite config logger $ run (appPort config) +-- | Run your application continously, listening for SIGINT and exiting +-- when recieved +-- +-- > withYourSite :: AppConfig DefaultEnv -> Logger -> (Application -> IO a) -> IO () +-- > withYourSite conf logger f = do +-- > Settings.withConnectionPool conf $ \p -> do +-- > runConnectionPool (runMigration yourMigration) p +-- > defaultRunner f $ YourSite conf logger p +-- +-- TODO: ifdef WINDOWS +-- +defaultRunner :: (YesodDispatch y y, Yesod y) + => (Application -> IO a) + -> y -- ^ your foundation type + -> IO () +defaultRunner f h = +#ifdef WINDOWS + toWaiApp h >>= f >> return () +#else + do + tid <- forkIO $ toWaiApp h >>= f >> return () + flag <- newEmptyMVar + _ <- Signal.installHandler Signal.sigINT (Signal.CatchOnce $ do + putStrLn "Caught an interrupt" + killThread tid + putMVar flag ()) Nothing + takeMVar flag +#endif + -- | Run your development app using the provided @'DefaultEnv'@ type -- -- > withDevelAppPort :: Dynamic diff --git a/yesod-default/Yesod/Default/Util.hs b/yesod-default/Yesod/Default/Util.hs index c344b5c6..4ab93b33 100644 --- a/yesod-default/Yesod/Default/Util.hs +++ b/yesod-default/Yesod/Default/Util.hs @@ -7,7 +7,6 @@ module Yesod.Default.Util , globFile , widgetFileProduction , widgetFileDebug - , runWaiApp ) where import Control.Monad.IO.Class (liftIO) @@ -21,13 +20,6 @@ import Text.Lucius (luciusFile, luciusFileDebug) import Text.Julius (juliusFile, juliusFileDebug) import Text.Cassius (cassiusFile, cassiusFileDebug) import Data.Monoid (mempty) -import Network.Wai (Application) - -#ifndef WINDOWS -import qualified System.Posix.Signals as Signal -import Control.Concurrent (forkIO, killThread) -import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar) -#endif -- | An implementation of 'addStaticContent' which stores the contents in an -- external file. Files are created in the given static folder with names based @@ -85,21 +77,3 @@ whenExists x glob f = do let fn = globFile glob x e <- qRunIO $ doesFileExist fn if e then f fn else [|mempty|] - --- | A signal-aware runner for WAI applications. On Windows, this doesn't do --- anything special. On POSIX systems, this installs a signal handler for INT --- and automatically kills the application when the signal is received. This --- allows you to add cleanup code (like log flushing) after an application --- exits. -runWaiApp :: (Application -> IO ()) -> Application -> IO () -#ifdef WINDOWS -runWaiApp f app = f app -#else -runWaiApp f app = do - tid <- forkIO $ f app >> return () - flag <- newEmptyMVar - _ <- Signal.installHandler Signal.sigINT (Signal.CatchOnce $ do - killThread tid - putMVar flag ()) Nothing - takeMVar flag -#endif diff --git a/yesod-default/yesod-default.cabal b/yesod-default/yesod-default.cabal index aca6a020..ba8a818c 100644 --- a/yesod-default/yesod-default.cabal +++ b/yesod-default/yesod-default.cabal @@ -14,24 +14,25 @@ description: Convenient wrappers for your the configuration and execution of your yesod application library - build-depends: base >= 4 && < 5 - , yesod-core >= 0.9 && < 0.10 - , cmdargs >= 0.8 && < 0.9 - , warp >= 0.4 && < 0.5 - , wai >= 0.4 && < 0.5 - , wai-extra >= 0.4 && < 0.5 - , bytestring >= 0.9 && < 0.10 - , transformers >= 0.2 && < 0.3 - , text >= 0.9 && < 1.0 - , directory >= 1.0 && < 1.2 + if os(windows) + cpp-options: -DWINDOWS + + build-depends: base >= 4 && < 5 + , yesod-core >= 0.9 && < 0.10 + , cmdargs >= 0.8 && < 0.9 + , warp >= 0.4 && < 0.5 + , wai >= 0.4 && < 0.5 + , wai-extra >= 0.4 && < 0.5 + , bytestring >= 0.9 && < 0.10 + , transformers >= 0.2 && < 0.3 + , text >= 0.9 && < 1.0 + , directory >= 1.0 && < 1.2 , shakespeare-css >= 0.10 && < 0.11 , shakespeare-js >= 0.10 && < 0.11 , template-haskell - if os(windows) - cpp-options: -DWINDOWS - else - build-depends: unix + if !os(windows) + build-depends: unix exposed-modules: Yesod.Default.Config , Yesod.Default.Main diff --git a/yesod/scaffold/Application.hs.cg b/yesod/scaffold/Application.hs.cg index 56735e75..ff12c582 100644 --- a/yesod/scaffold/Application.hs.cg +++ b/yesod/scaffold/Application.hs.cg @@ -14,7 +14,6 @@ import Yesod.Static import Yesod.Auth import Yesod.Default.Config import Yesod.Default.Main -import Yesod.Default.Util (runWaiApp) import Yesod.Logger (Logger) import Database.Persist.~importGenericDB~ import Data.ByteString (ByteString) @@ -49,8 +48,7 @@ with~sitearg~ conf logger f = do #endif Settings.withConnectionPool conf $ \p -> do~runMigration~ let h = ~sitearg~ conf logger s p - app <- toWaiApp h - runWaiApp f app + defaultRunner f h -- for yesod devel withDevelAppPort :: Dynamic diff --git a/yesod/scaffold/tiny/Application.hs.cg b/yesod/scaffold/tiny/Application.hs.cg index a13991fc..5142288d 100644 --- a/yesod/scaffold/tiny/Application.hs.cg +++ b/yesod/scaffold/tiny/Application.hs.cg @@ -12,8 +12,7 @@ import Foundation import Settings import Yesod.Static import Yesod.Default.Config -import Yesod.Default.Main (defaultDevelApp) -import Yesod.Default.Util (runWaiApp) +import Yesod.Default.Main (defaultDevelApp, defaultRunner) import Yesod.Logger (Logger) import Data.ByteString (ByteString) import Network.Wai (Application) @@ -47,8 +46,7 @@ with~sitearg~ conf logger f = do s <- staticDevel Settings.staticDir #endif let h = ~sitearg~ conf logger s - app <- toWaiApp h - runWaiApp f app + defaultRunner f h -- for yesod devel withDevelAppPort :: Dynamic diff --git a/yesod/test/run.sh b/yesod/test/run.sh index 3b81e612..7095acda 100755 --- a/yesod/test/run.sh +++ b/yesod/test/run.sh @@ -1,97 +1,12 @@ -#!/bin/bash -e -# -# Runs test/scaffold.sh with a variety of inputs. Hides all output -# besides failure details. -# -### +#!/bin/bash -[[ "$1" =~ -v|--verbose ]] && stdout=/dev/stdout || stdout=/dev/null +cat << EOF -tmp='/tmp' -pwd="$PWD" +You're using the deprecated ./test/run.sh. This file will be removed +soon in favor of ../scripts/runtests. -pkg= -dir= +Running ../scripts/runtests... -failures=() -n_tested=0 -n_failed=0 +EOF -# runs the function named by $1, silencing stdout and redirecting stderr -# to /tmp/function.errors. failures are tracked to be reported on during -# cleanup -run_test() { # {{{ - local test_function="$*" - - n_tested=$((n_tested+1)) - - if $test_function >"$stdout" 2>"$tmp/$test_function.errors"; then - echo -n '.' - [[ -f "$tmp/$test_function.errors" ]] && rm "$tmp/$test_function.errors" - else - echo -n 'F' - failures+=( "$test_function" ) - n_failed=$((n_failed+1)) - fi -} -# }}} - -# changes back to the original directory, removes the dist file and -# outputs a report of tests and failures -cleanup() { # {{{ - cd "$pwd" - [[ -d "$dir" ]] && rm -r "$dir" - - echo - echo - echo "Tests: $n_tested, Failures: $n_failed." - echo - - [[ $n_failed -eq 0 ]] && return 0 - - for test in ${failures[@]}; do - echo "Failure: $test" - echo 'details:' - echo - - if [[ -f "$tmp/$test.errors" ]]; then - cat "$tmp/$test.errors" - rm "$tmp/$test.errors" - else - echo '' - fi - - echo - done - - return $n_failed -} -# }}} - -# compilation is test #1, sets global variable dir. other tests are run -# from within this directory and it is removed as part of cleanup -test_compile() { - cabal clean - cabal install - cabal sdist - - read -r pkg < <(find dist/ -type f -name '*.tar.gz' | sort -rV) - dir="$(basename "$pkg" .tar.gz)" - - tar -xzf "$pkg" && cd "$dir" -} - -test_sqlite() { ../test/scaffold.sh < ../test/sqlite-input.txt ; } -test_postgresql() { ../test/scaffold.sh < ../test/postgresql-input.txt; } -test_mongodb() { ../test/scaffold.sh < ../test/mongodb-input.txt ; } -test_tiny() { ../test/scaffold.sh < ../test/tiny-input.txt ; } - -echo 'Started' -run_test 'test_compile' -run_test 'test_sqlite' -run_test 'test_postgresql' -run_test 'test_mongodb' -run_test 'test_tiny' -cleanup - -exit $? +../scripts/runtests "$@" diff --git a/yesod/test/scaffold.sh b/yesod/test/scaffold.sh index 303a9656..303fc363 100755 --- a/yesod/test/scaffold.sh +++ b/yesod/test/scaffold.sh @@ -1,12 +1,10 @@ #!/bin/bash -ex -rm -rf foobar runghc main.hs init ( cd foobar cabal install cabal install -fdevel + cabal install -fproduction ) - -ghc-pkg unregister foobar diff --git a/yesod/test/scaffold_test.sh b/yesod/test/scaffold_test.sh new file mode 100644 index 00000000..d12ea1ea --- /dev/null +++ b/yesod/test/scaffold_test.sh @@ -0,0 +1,7 @@ +setup() { rm -rf foobar; } +teardown() { rm -rf foobar; ghc-pkg unregister foobar &>/dev/null; } + +test_sqlite() { ../test/scaffold.sh < ../test/sqlite-input.txt ; } +test_postgresql() { ../test/scaffold.sh < ../test/postgresql-input.txt; } +test_mongodb() { ../test/scaffold.sh < ../test/mongodb-input.txt ; } +test_tiny() { ../test/scaffold.sh < ../test/tiny-input.txt ; }