yesod 1.1.7.1 → 1.1.7.2
raw patch · 8 files changed
+141/−49 lines, 8 filesdep ~http-reverse-proxy
Dependency ranges changed: http-reverse-proxy
Files
- Build.hs +26/−11
- Devel.hs +38/−21
- hsfiles/mongo.hsfiles +15/−3
- hsfiles/mysql.hsfiles +15/−3
- hsfiles/postgres.hsfiles +15/−3
- hsfiles/simple.hsfiles +15/−3
- hsfiles/sqlite.hsfiles +15/−3
- yesod.cabal +2/−2
Build.hs view
@@ -7,22 +7,27 @@ , touch , recompDeps , isNewerThan+ , safeReadFile ) where -- FIXME there's a bug when getFileStatus applies to a file -- temporary deleted (e.g., Vim saving a file) import Control.Applicative ((<|>), many, (<$>))-import qualified Data.Attoparsec.Text.Lazy as A+import qualified Data.Attoparsec.Text as A import Data.Char (isSpace, isUpper)-import qualified Data.Text.Lazy.IO as TIO+import qualified Data.Text as T+import Data.Text.Encoding (decodeUtf8With)+import Data.Text.Encoding.Error (lenientDecode)+import Data.ByteString (ByteString)+import qualified Data.ByteString as S -import Control.Exception (SomeException, try)+import Control.Exception (SomeException, try, IOException) import Control.Exception.Lifted (handle) import Control.Monad (when, filterM, forM, forM_, (>=>)) import Control.Monad.Trans.State (StateT, get, put, execStateT) import Control.Monad.Trans.Writer (WriterT, tell, execWriterT)-import Control.Monad.IO.Class (liftIO)+import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Trans.Class (lift) import Data.Monoid (Monoid (mappend, mempty))@@ -40,6 +45,9 @@ import Text.Cassius (cassiusUsedIdentifiers) import Text.Lucius (luciusUsedIdentifiers) +safeReadFile :: MonadIO m => FilePath -> m (Either IOException ByteString)+safeReadFile = liftIO . try . S.readFile+ touch :: IO () touch = do m <- handle (\(_ :: SomeException) -> return Map.empty) $ readFile touchCache >>= readIO@@ -86,8 +94,11 @@ AlwaysOutdated -> return True CompareUsedIdentifiers getDerefs -> do derefMap <- get- s <- liftIO $ readFile x- let newDerefs = Set.fromList $ getDerefs s+ ebs <- safeReadFile x+ let newDerefs =+ case ebs of+ Left _ -> Set.empty+ Right bs -> Set.fromList $ getDerefs $ T.unpack $ decodeUtf8With lenientDecode bs put $ Map.insert x newDerefs derefMap case Map.lookup x derefMap of Just oldDerefs | oldDerefs == newDerefs -> return False@@ -176,11 +187,15 @@ determineDeps :: FilePath -> IO [(ComparisonType, FilePath)] determineDeps x = do- y <- TIO.readFile x -- FIXME catch IO exceptions- let z = A.parse (many $ (parser <|> (A.anyChar >> return Nothing))) y- case z of- A.Fail{} -> return []- A.Done _ r -> mapM go r >>= filterM (doesFileExist . snd) . concat+ y <- safeReadFile x+ case y of+ Left _ -> return []+ Right bs -> do+ let z = A.parseOnly (many $ (parser <|> (A.anyChar >> return Nothing)))+ $ decodeUtf8With lenientDecode bs+ case z of+ Left _ -> return []+ Right r -> mapM go r >>= filterM (doesFileExist . snd) . concat where go (Just (StaticFiles fp, _)) = map ((,) AlwaysOutdated) <$> getFolderContents fp go (Just (Hamlet, f)) = return [(AlwaysOutdated, f)]
Devel.hs view
@@ -33,12 +33,16 @@ when) import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.State (evalStateT, get)+import qualified Data.IORef as I import Data.Char (isNumber, isUpper) import qualified Data.List as L import qualified Data.Map as Map import Data.Maybe (fromMaybe) import qualified Data.Set as Set+import qualified Data.Text as T+import Data.Text.Encoding (decodeUtf8With)+import Data.Text.Encoding.Error (lenientDecode) import System.Directory import System.Environment (getEnvironment)@@ -62,7 +66,7 @@ import System.Timeout (timeout) import Build (getDeps, isNewerThan,- recompDeps)+ recompDeps, safeReadFile) import GhcBuild (buildPackage, getBuildFlags) @@ -72,7 +76,7 @@ import Network (withSocketsDo) import Network.HTTP.Conduit (def, newManager) import Network.HTTP.ReverseProxy (ProxyDest (ProxyDest),- waiProxyTo)+ waiProxyToSettings, wpsTimeout, wpsOnExc) import Network.HTTP.Types (status200) import Network.Socket (sClose) import Network.Wai (responseLBS)@@ -113,13 +117,18 @@ -- | Run a reverse proxy from port 3000 to 3001. If there is no response on -- 3001, give an appropriate message to the user.-reverseProxy :: DevelOpts -> Int -> IO ()-reverseProxy opts appPort = do+reverseProxy :: DevelOpts -> I.IORef Int -> IO ()+reverseProxy opts iappPort = do manager <- newManager def let loop = forever $ do- run (develPort opts) $ waiProxyTo- (const $ return $ Right $ ProxyDest "127.0.0.1" appPort)- onExc+ run (develPort opts) $ waiProxyToSettings+ (const $ do+ appPort <- liftIO $ I.readIORef iappPort+ return $ Right $ ProxyDest "127.0.0.1" appPort)+ def+ { wpsOnExc = onExc+ , wpsTimeout = Just 10000000+ } manager putStrLn "Reverse proxy stopped, but it shouldn't" threadDelay 1000000@@ -151,8 +160,8 @@ devel opts passThroughArgs = withSocketsDo $ withManager $ \manager -> do avail <- checkPort $ develPort opts unless avail $ error "devel port unavailable"- appPort <- getPort 17834- _ <- forkIO $ reverseProxy opts appPort+ iappPort <- getPort 17834 >>= I.newIORef+ _ <- forkIO $ reverseProxy opts iappPort checkDevelFile writeLock opts @@ -160,7 +169,7 @@ _ <- forkIO $ do filesModified <- newEmptyMVar watchTree manager "." (const True) (\_ -> void (tryPutMVar filesModified ()))- evalStateT (mainOuterLoop appPort filesModified) Map.empty+ evalStateT (mainOuterLoop iappPort filesModified) Map.empty _ <- getLine writeLock opts exitSuccess@@ -168,7 +177,7 @@ bd = getBuildDir opts -- outer loop re-reads the cabal file- mainOuterLoop appPort filesModified = do+ mainOuterLoop iappPort filesModified = do ghcVer <- liftIO ghcVersion cabal <- liftIO $ D.findPackageDesc "." gpd <- liftIO $ D.readPackageDescription D.normal cabal@@ -180,10 +189,10 @@ liftIO $ removeFileIfExists "yesod-devel/arargs.txt" -- the configure step, remove them to force liftIO $ removeFileIfExists "yesod-devel/ldargs.txt" -- a cabal build first rebuild <- liftIO $ mkRebuild gpd ghcVer cabal opts ldar- mainInnerLoop appPort hsSourceDirs filesModified cabal gpd lib ghcVer rebuild+ mainInnerLoop iappPort hsSourceDirs filesModified cabal gpd lib ghcVer rebuild -- inner loop rebuilds after files change- mainInnerLoop appPort hsSourceDirs filesModified cabal gpd lib ghcVer rebuild = go+ mainInnerLoop iappPort hsSourceDirs filesModified cabal gpd lib ghcVer rebuild = go where go = do _ <- recompDeps hsSourceDirs@@ -206,6 +215,11 @@ $ if verbose opts then "Starting development server: runghc " ++ L.unwords devArgs else "Starting development server..." env0 <- liftIO getEnvironment++ -- get a new port for the new process to listen on+ appPort <- liftIO $ I.readIORef iappPort >>= getPort . (+ 1)+ liftIO $ I.writeIORef iappPort appPort+ (_,_,_,ph) <- liftIO $ createProcess (proc "runghc" devArgs) { env = Just $ ("PORT", show appPort) : ("DISPLAY_PORT", show $ develPort opts) : env0 }@@ -223,7 +237,7 @@ liftIO $ Ex.throwTo watchTid (userError "process finished") loop list n <- liftIO $ cabal `isNewerThan` (bd </> "setup-config")- if n then mainOuterLoop appPort filesModified else go+ if n then mainOuterLoop iappPort filesModified else go runBuildHook :: Maybe String -> IO () runBuildHook (Just s) = do@@ -439,13 +453,16 @@ if not exists then return (Left $ "file does not exist: " ++ file) else do- xs <- readFile file- return $ case lines xs of- [_,l2] -> -- two lines, header and serialized rest- case reads l2 of- [(bi,_)] -> Right bi- _ -> (Left "cannot parse contents")- _ -> (Left "not a valid header/content file")+ xs <- safeReadFile file+ case xs of+ Left e -> return $ Left $ show e+ Right bs ->+ return $ case lines $ T.unpack $ decodeUtf8With lenientDecode bs of+ [_,l2] -> -- two lines, header and serialized rest+ case reads l2 of+ [(bi,_)] -> Right bi+ _ -> (Left "cannot parse contents")+ _ -> (Left "not a valid header/content file") fromMaybeErr :: String -> Maybe b -> IO b fromMaybeErr err Nothing = failWith err
hsfiles/mongo.hsfiles view
@@ -139,7 +139,9 @@ -- default session idle timeout is 120 minutes makeSessionBackend _ = do key <- getKey "config/client_session_key.aes"- return . Just $ clientSessionBackend key 120+ let timeout = 120 * 60 -- 120 minutes+ (getCachedDate, _closeDateCache) <- clientSessionDateCacher timeout+ return . Just $ clientSessionBackend2 key getCachedDate defaultLayout widget = do master <- getYesod@@ -170,7 +172,13 @@ -- and names them based on a hash of their content. This allows -- expiration dates to be set far in the future without worry of -- users receiving stale content.- addStaticContent = addStaticContentExternal minifym base64md5 Settings.staticDir (StaticR . flip StaticRoute [])+ addStaticContent =+ addStaticContentExternal minifym genFileName Settings.staticDir (StaticR . flip StaticRoute [])+ where+ -- Generate a unique filename based on the content itself+ genFileName lbs+ | development = "autogen-" ++ base64md5 lbs+ | otherwise = base64md5 lbs -- Place Javascript at bottom of the body tag so the rest of the page loads first jsLoader _ = BottomOfBody@@ -364,7 +372,7 @@ build-depends: base >= 4 && < 5 -- , yesod-platform >= 1.1 && < 1.2 , yesod >= 1.1.5 && < 1.2- , yesod-core >= 1.1.5 && < 1.2+ , yesod-core >= 1.1.7 && < 1.2 , yesod-auth >= 1.1 && < 1.2 , yesod-static >= 1.1 && < 1.2 , yesod-default >= 1.1 && < 1.2@@ -465,6 +473,10 @@ -- | Settings for 'widgetFile', such as which template languages to support and -- default Hamlet settings.+--+-- For more information on modifying behavior, see:+--+-- https://github.com/yesodweb/yesod/wiki/Overriding-widgetFile widgetFileSettings :: WidgetFileSettings widgetFileSettings = def { wfsHamletSettings = defaultHamletSettings
hsfiles/mysql.hsfiles view
@@ -141,7 +141,9 @@ -- default session idle timeout is 120 minutes makeSessionBackend _ = do key <- getKey "config/client_session_key.aes"- return . Just $ clientSessionBackend key 120+ let timeout = 120 * 60 -- 120 minutes+ (getCachedDate, _closeDateCache) <- clientSessionDateCacher timeout+ return . Just $ clientSessionBackend2 key getCachedDate defaultLayout widget = do master <- getYesod@@ -172,7 +174,13 @@ -- and names them based on a hash of their content. This allows -- expiration dates to be set far in the future without worry of -- users receiving stale content.- addStaticContent = addStaticContentExternal minifym base64md5 Settings.staticDir (StaticR . flip StaticRoute [])+ addStaticContent =+ addStaticContentExternal minifym genFileName Settings.staticDir (StaticR . flip StaticRoute [])+ where+ -- Generate a unique filename based on the content itself+ genFileName lbs+ | development = "autogen-" ++ base64md5 lbs+ | otherwise = base64md5 lbs -- Place Javascript at bottom of the body tag so the rest of the page loads first jsLoader _ = BottomOfBody@@ -362,7 +370,7 @@ build-depends: base >= 4 && < 5 -- , yesod-platform >= 1.1 && < 1.2 , yesod >= 1.1.5 && < 1.2- , yesod-core >= 1.1.5 && < 1.2+ , yesod-core >= 1.1.7 && < 1.2 , yesod-auth >= 1.1 && < 1.2 , yesod-static >= 1.1 && < 1.2 , yesod-default >= 1.1 && < 1.2@@ -463,6 +471,10 @@ -- | Settings for 'widgetFile', such as which template languages to support and -- default Hamlet settings.+--+-- For more information on modifying behavior, see:+--+-- https://github.com/yesodweb/yesod/wiki/Overriding-widgetFile widgetFileSettings :: WidgetFileSettings widgetFileSettings = def { wfsHamletSettings = defaultHamletSettings
hsfiles/postgres.hsfiles view
@@ -141,7 +141,9 @@ -- default session idle timeout is 120 minutes makeSessionBackend _ = do key <- getKey "config/client_session_key.aes"- return . Just $ clientSessionBackend key 120+ let timeout = 120 * 60 -- 120 minutes+ (getCachedDate, _closeDateCache) <- clientSessionDateCacher timeout+ return . Just $ clientSessionBackend2 key getCachedDate defaultLayout widget = do master <- getYesod@@ -172,7 +174,13 @@ -- and names them based on a hash of their content. This allows -- expiration dates to be set far in the future without worry of -- users receiving stale content.- addStaticContent = addStaticContentExternal minifym base64md5 Settings.staticDir (StaticR . flip StaticRoute [])+ addStaticContent =+ addStaticContentExternal minifym genFileName Settings.staticDir (StaticR . flip StaticRoute [])+ where+ -- Generate a unique filename based on the content itself+ genFileName lbs+ | development = "autogen-" ++ base64md5 lbs+ | otherwise = base64md5 lbs -- Place Javascript at bottom of the body tag so the rest of the page loads first jsLoader _ = BottomOfBody@@ -362,7 +370,7 @@ build-depends: base >= 4 && < 5 -- , yesod-platform >= 1.1 && < 1.2 , yesod >= 1.1.5 && < 1.2- , yesod-core >= 1.1.5 && < 1.2+ , yesod-core >= 1.1.7 && < 1.2 , yesod-auth >= 1.1 && < 1.2 , yesod-static >= 1.1 && < 1.2 , yesod-default >= 1.1 && < 1.2@@ -463,6 +471,10 @@ -- | Settings for 'widgetFile', such as which template languages to support and -- default Hamlet settings.+--+-- For more information on modifying behavior, see:+--+-- https://github.com/yesodweb/yesod/wiki/Overriding-widgetFile widgetFileSettings :: WidgetFileSettings widgetFileSettings = def { wfsHamletSettings = defaultHamletSettings
hsfiles/simple.hsfiles view
@@ -124,7 +124,9 @@ -- default session idle timeout is 120 minutes makeSessionBackend _ = do key <- getKey "config/client_session_key.aes"- return . Just $ clientSessionBackend key 120+ let timeout = 120 * 60 -- 120 minutes+ (getCachedDate, _closeDateCache) <- clientSessionDateCacher timeout+ return . Just $ clientSessionBackend2 key getCachedDate defaultLayout widget = do master <- getYesod@@ -152,7 +154,13 @@ -- and names them based on a hash of their content. This allows -- expiration dates to be set far in the future without worry of -- users receiving stale content.- addStaticContent = addStaticContentExternal minifym base64md5 Settings.staticDir (StaticR . flip StaticRoute [])+ addStaticContent =+ addStaticContentExternal minifym genFileName Settings.staticDir (StaticR . flip StaticRoute [])+ where+ -- Generate a unique filename based on the content itself+ genFileName lbs+ | development = "autogen-" ++ base64md5 lbs+ | otherwise = base64md5 lbs -- Place Javascript at bottom of the body tag so the rest of the page loads first jsLoader _ = BottomOfBody@@ -294,7 +302,7 @@ build-depends: base >= 4 && < 5 -- , yesod-platform >= 1.1 && < 1.2 , yesod >= 1.1.5 && < 1.2- , yesod-core >= 1.1.5 && < 1.2+ , yesod-core >= 1.1.7 && < 1.2 , yesod-static >= 1.1 && < 1.2 , yesod-default >= 1.1 && < 1.2 , yesod-form >= 1.1 && < 1.3@@ -385,6 +393,10 @@ -- | Settings for 'widgetFile', such as which template languages to support and -- default Hamlet settings.+--+-- For more information on modifying behavior, see:+--+-- https://github.com/yesodweb/yesod/wiki/Overriding-widgetFile widgetFileSettings :: WidgetFileSettings widgetFileSettings = def { wfsHamletSettings = defaultHamletSettings
hsfiles/sqlite.hsfiles view
@@ -141,7 +141,9 @@ -- default session idle timeout is 120 minutes makeSessionBackend _ = do key <- getKey "config/client_session_key.aes"- return . Just $ clientSessionBackend key 120+ let timeout = 120 * 60 -- 120 minutes+ (getCachedDate, _closeDateCache) <- clientSessionDateCacher timeout+ return . Just $ clientSessionBackend2 key getCachedDate defaultLayout widget = do master <- getYesod@@ -172,7 +174,13 @@ -- and names them based on a hash of their content. This allows -- expiration dates to be set far in the future without worry of -- users receiving stale content.- addStaticContent = addStaticContentExternal minifym base64md5 Settings.staticDir (StaticR . flip StaticRoute [])+ addStaticContent =+ addStaticContentExternal minifym genFileName Settings.staticDir (StaticR . flip StaticRoute [])+ where+ -- Generate a unique filename based on the content itself+ genFileName lbs+ | development = "autogen-" ++ base64md5 lbs+ | otherwise = base64md5 lbs -- Place Javascript at bottom of the body tag so the rest of the page loads first jsLoader _ = BottomOfBody@@ -362,7 +370,7 @@ build-depends: base >= 4 && < 5 -- , yesod-platform >= 1.1 && < 1.2 , yesod >= 1.1.5 && < 1.2- , yesod-core >= 1.1.5 && < 1.2+ , yesod-core >= 1.1.7 && < 1.2 , yesod-auth >= 1.1 && < 1.2 , yesod-static >= 1.1 && < 1.2 , yesod-default >= 1.1 && < 1.2@@ -463,6 +471,10 @@ -- | Settings for 'widgetFile', such as which template languages to support and -- default Hamlet settings.+--+-- For more information on modifying behavior, see:+--+-- https://github.com/yesodweb/yesod/wiki/Overriding-widgetFile widgetFileSettings :: WidgetFileSettings widgetFileSettings = def { wfsHamletSettings = defaultHamletSettings
yesod.cabal view
@@ -1,5 +1,5 @@ name: yesod-version: 1.1.7.1+version: 1.1.7.2 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -105,7 +105,7 @@ , resourcet >= 0.3 && < 0.5 , base64-bytestring , lifted-base- , http-reverse-proxy >= 0.1.0.4+ , http-reverse-proxy >= 0.1.1 , network , http-conduit , network-conduit