forked from filipg/gonito
update to Stack LTS 11.9
This commit is contained in:
parent
4e3fb94ce0
commit
0662522a44
@ -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
|
||||||
|
@ -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.
|
||||||
|
16
gonito.cabal
16
gonito.cabal
@ -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
|
||||||
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user