update to Stack LTS 11.9

This commit is contained in:
Filip Gralinski 2018-05-20 16:58:48 +02:00
parent 4e3fb94ce0
commit 0662522a44
4 changed files with 22 additions and 21 deletions

View File

@ -1,3 +1,5 @@
{-# LANGUAGE InstanceSigs #-}
module Foundation where module Foundation where
import Database.Persist.Sql (ConnectionPool, runSqlPool) import Database.Persist.Sql (ConnectionPool, runSqlPool)
@ -173,13 +175,6 @@ instance Yesod App where
-- Generate a unique filename based on the content itself -- Generate a unique filename based on the content itself
genFileName lbs = "autogen-" ++ base64md5 lbs genFileName lbs = "autogen-" ++ base64md5 lbs
-- What messages should be logged. The following includes all messages when
-- in development, and warnings and errors in production.
shouldLog app _source level =
appShouldLogAll (appSettings app)
|| level == LevelWarn
|| level == LevelError
makeLogger = return . appLogger makeLogger = return . appLogger
-- How to run database actions. -- How to run database actions.
@ -201,7 +196,9 @@ instance YesodAuth App where
-- Override the above two destinations when a Referer: header is present -- Override the above two destinations when a Referer: header is present
redirectToReferer _ = True redirectToReferer _ = True
authenticate creds = runDB $ do authenticate :: (MonadHandler m, HandlerSite m ~ App)
=> Creds App -> m (AuthenticationResult App)
authenticate creds = liftHandler $ runDB $ do
x <- getBy $ UniqueUser $ credsIdent creds x <- getBy $ UniqueUser $ credsIdent creds
Authenticated <$> case x of Authenticated <$> case x of
Just (Entity uid _) -> return $ uid Just (Entity uid _) -> return $ uid
@ -222,8 +219,6 @@ instance YesodAuth App where
-- You can add other plugins like BrowserID, email or OAuth here -- You can add other plugins like BrowserID, email or OAuth here
authPlugins master = [authHashDBWithForm (myLoginForm master) (Just . UniqueUser)] authPlugins master = [authHashDBWithForm (myLoginForm master) (Just . UniqueUser)]
authHttpManager = getHttpManager
contactEmailLabel :: App -> Text contactEmailLabel :: App -> Text
contactEmailLabel site = contactEmailLabel site =
case maybeContactMail of case maybeContactMail of

View File

@ -14,6 +14,7 @@ import qualified Data.Text as T
import Database.Persist.Sql (ConnectionPool, runSqlPool, fromSqlKey) import Database.Persist.Sql (ConnectionPool, runSqlPool, fromSqlKey)
import Control.Concurrent.Lifted (fork, threadDelay) import Control.Concurrent.Lifted (fork, threadDelay)
import Control.Concurrent (forkIO)
import qualified Crypto.Hash.SHA1 as CHS import qualified Crypto.Hash.SHA1 as CHS
@ -95,7 +96,8 @@ runViewProgress' route action = do
m <- readTVar jobs m <- readTVar jobs
writeTVar jobs $ IntMap.insert jobId chan m writeTVar jobs $ IntMap.insert jobId chan m
return chan return chan
fork $ do runInnerHandler <- handlerToIO
liftIO $ forkIO $ runInnerHandler $ do
liftIO $ threadDelay 1000000 liftIO $ threadDelay 1000000
action chan action chan
liftIO $ atom $ do liftIO $ atom $ do
@ -308,7 +310,7 @@ gatherOutput ph hout herr chan = work mempty mempty
-- Read any outstanding input. -- Read any outstanding input.
resterr <- takeABit herr accerr resterr <- takeABit herr accerr
restout <- takeABit hout accout restout <- takeABit hout accout
threadDelay 1000000 liftIO $ threadDelay 1000000
-- Check on the process. -- Check on the process.
s <- liftIO $ getProcessExitCode ph s <- liftIO $ getProcessExitCode ph
-- Exit or loop. -- Exit or loop.

View File

@ -78,25 +78,25 @@ library
RecordWildCards RecordWildCards
build-depends: base >= 4 && < 5 build-depends: base >= 4 && < 5
, yesod >= 1.4.1 && < 1.5 , yesod >= 1.6 && < 1.7
, yesod-core >= 1.4.6 && < 1.5 , yesod-core >= 1.6 && < 1.7
, yesod-auth >= 1.4.0 && < 1.5 , yesod-auth >= 1.6 && < 1.7
, yesod-static >= 1.4.0.3 && < 1.6 , yesod-static >= 1.6 && < 1.7
, yesod-form >= 1.4.0 && < 1.5 , yesod-form >= 1.6 && < 1.7
, classy-prelude >= 0.10.2 , classy-prelude >= 0.10.2
, classy-prelude-conduit >= 0.10.2 , classy-prelude-conduit >= 0.10.2
, classy-prelude-yesod >= 0.10.2 , classy-prelude-yesod >= 0.10.2
, bytestring >= 0.9 && < 0.11 , bytestring >= 0.9 && < 0.11
, text >= 0.11 && < 2.0 , text >= 0.11 && < 2.0
, persistent >= 2.0 && < 2.8 , persistent >= 2.0 && < 2.9
, persistent-postgresql >= 2.1.1 && < 2.7 , persistent-postgresql >= 2.1.1 && < 2.9
, persistent-template >= 2.0 && < 2.6 , persistent-template >= 2.0 && < 2.6
, template-haskell , template-haskell
, shakespeare >= 2.0 && < 2.1 , shakespeare >= 2.0 && < 2.1
, monad-control >= 0.3 && < 1.1 , monad-control >= 0.3 && < 1.1
, wai-extra >= 3.0 && < 3.1 , wai-extra >= 3.0 && < 3.1
, yaml >= 0.8 && < 0.9 , yaml >= 0.8 && < 0.9
, http-conduit >= 2.1 && < 2.3 , http-conduit >= 2.1 && < 2.4
, directory >= 1.1 && < 1.4 , directory >= 1.1 && < 1.4
, warp >= 3.0 && < 3.3 , warp >= 3.0 && < 3.3
, data-default , data-default

View File

@ -4,5 +4,9 @@ flags:
dev: false dev: false
packages: packages:
- '.' - '.'
- location:
git: https://github.com/bitemyapp/esqueleto
commit: b81e0d951e510ebffca03c5a58658ad884cc6fbd
extra-dep: true
extra-deps: [../geval,wai-handler-fastcgi-3.0.0.2,murmur3-1.0.3] extra-deps: [../geval,wai-handler-fastcgi-3.0.0.2,murmur3-1.0.3]
resolver: lts-10.10 resolver: lts-11.9