Beginning of stackage-server-cron

This commit is contained in:
Michael Snoyman 2015-05-14 14:51:29 +03:00
parent 54645b1eaa
commit a0d2703738
5 changed files with 95 additions and 100 deletions

View File

@ -3,19 +3,13 @@ module Application
( makeApplication ( makeApplication
, getApplicationDev , getApplicationDev
, makeFoundation , makeFoundation
, cabalLoaderMain
) where ) where
import qualified Aws
import Control.Concurrent (forkIO, threadDelay) import Control.Concurrent (forkIO, threadDelay)
import Control.Exception (catch) import Control.Exception (catch)
import Control.Monad.Logger (runLoggingT, LoggingT, defaultLogStr) import Control.Monad.Logger (runLoggingT)
import Data.WebsiteContent import Data.WebsiteContent
import Data.Streaming.Network (bindPortTCP)
import Data.Time (diffUTCTime)
import qualified Database.Esqueleto as E
import qualified Database.Persist import qualified Database.Persist
import Filesystem (getModified, removeTree, isFile)
import Import hiding (catch) import Import hiding (catch)
import Language.Haskell.TH.Syntax (Loc(..)) import Language.Haskell.TH.Syntax (Loc(..))
import Network.Wai (Middleware, responseLBS) import Network.Wai (Middleware, responseLBS)
@ -33,9 +27,6 @@ import Yesod.Default.Handlers
import Yesod.Default.Main import Yesod.Default.Main
import Yesod.GitRepo import Yesod.GitRepo
import System.Environment (getEnvironment) import System.Environment (getEnvironment)
import System.IO (hSetBuffering, BufferMode (LineBuffering))
import qualified Data.ByteString as S
import qualified Data.Text as T
import System.Process (rawSystem) import System.Process (rawSystem)
import Stackage.Database (createStackageDatabase, openStackageDatabase) import Stackage.Database (createStackageDatabase, openStackageDatabase)
@ -152,12 +143,10 @@ makeFoundation useEcho conf = do
let dbfile = "stackage.sqlite3" let dbfile = "stackage.sqlite3"
createStackageDatabase dbfile createStackageDatabase dbfile
stackageDatabase' <- openStackageDatabase dbfile stackageDatabase' <- openStackageDatabase dbfile
-- FIXME refresh this on a regular basis
env <- getEnvironment env <- getEnvironment
let runDB' :: (MonadIO m, MonadBaseControl IO m) => SqlPersistT m a -> m a
runDB' = flip (Database.Persist.runPool dbconf) p
let logger = Yesod.Core.Types.Logger loggerSet' getter let logger = Yesod.Core.Types.Logger loggerSet' getter
foundation = App foundation = App
{ settings = conf { settings = conf
@ -171,8 +160,6 @@ makeFoundation useEcho conf = do
, stackageDatabase = stackageDatabase' , stackageDatabase = stackageDatabase'
} }
let urlRender' = yesodRender foundation (appRoot conf)
-- Perform database migration using our application's logging settings. -- Perform database migration using our application's logging settings.
when (lookup "STACKAGE_SKIP_MIGRATION" env /= Just "1") $ when (lookup "STACKAGE_SKIP_MIGRATION" env /= Just "1") $
runResourceT $ runResourceT $
@ -185,78 +172,7 @@ makeFoundation useEcho conf = do
checkMigration 2 setCorePackages checkMigration 2 setCorePackages
-} -}
let updateDB = lookup "STACKAGE_CABAL_LOADER" env /= Just "0"
hoogleGen = lookup "STACKAGE_HOOGLE_GEN" env /= Just "0"
forceUpdate = lookup "STACKAGE_FORCE_UPDATE" env == Just "1"
return foundation return foundation
where ifRunCabalLoader m =
if cabalFileLoader
then void m
else return ()
data CabalLoaderEnv = CabalLoaderEnv
{ cleSettings :: !(AppConfig DefaultEnv Extra)
, cleManager :: !Manager
}
instance HasHackageRoot CabalLoaderEnv where
getHackageRoot = hackageRoot . appExtra . cleSettings
instance HasHttpManager CabalLoaderEnv where
getHttpManager = cleManager
cabalLoaderMain :: IO ()
cabalLoaderMain = do
-- Hacky approach instead of PID files
void $ catchIO (bindPortTCP 17834 "127.0.0.1") $ \_ ->
error $ "cabal loader process already running, exiting"
error "cabalLoaderMain"
{- FIXME
conf <- fromArgs parseExtra
dbconf <- getDbConf conf
pool <- Database.Persist.createPoolConfig dbconf
manager <- newManager
bs <- loadBlobStore manager conf
hSetBuffering stdout LineBuffering
env <- getEnvironment
let forceUpdate = lookup "STACKAGE_FORCE_UPDATE" env == Just "1"
flip runLoggingT logFunc $ appLoadCabalFiles
True -- update database?
forceUpdate
CabalLoaderEnv
{ cleSettings = conf
, cleBlobStore = bs
, cleManager = manager
}
dbconf
pool
let foundation = App
{ settings = conf
, getStatic = error "getStatic"
, connPool = pool
, httpManager = manager
, persistConfig = dbconf
, appLogger = error "appLogger"
, genIO = error "genIO"
, blobStore = bs
, haddockRootDir = error "haddockRootDir"
, appDocUnpacker = error "appDocUnpacker"
, widgetCache = error "widgetCache"
, websiteContent = error "websiteContent"
}
createHoogleDatabases
bs
(flip (Database.Persist.runPool dbconf) pool)
putStrLn
(yesodRender foundation (appRoot conf))
where
logFunc loc src level str
| level > LevelDebug = S.hPutStr stdout $ fromLogStr $ defaultLogStr loc src level str
| otherwise = return ()
-}
-- for yesod devel -- for yesod devel
getApplicationDev :: Bool -> IO (Int, Application) getApplicationDev :: Bool -> IO (Int, Application)
@ -267,11 +183,11 @@ getApplicationDev useEcho =
{ csParseExtra = parseExtra { csParseExtra = parseExtra
} }
checkMigration :: MonadIO m _checkMigration :: MonadIO m
=> Int => Int
-> ReaderT SqlBackend m () -> ReaderT SqlBackend m ()
-> ReaderT SqlBackend m () -> ReaderT SqlBackend m ()
checkMigration num f = do _checkMigration num f = do
eres <- insertBy $ Migration num eres <- insertBy $ Migration num
case eres of case eres of
Left _ -> return () Left _ -> return ()

77
Stackage/Database/Cron.hs Normal file
View File

@ -0,0 +1,77 @@
module Stackage.Database.Cron
( stackageServerCron
) where
import ClassyPrelude.Conduit
stackageServerCron :: IO ()
stackageServerCron = error "FIXME: stackageServerCron not implemented"
{-
import Data.Streaming.Network (bindPortTCP)
data CabalLoaderEnv = CabalLoaderEnv
{ cleSettings :: !(AppConfig DefaultEnv Extra)
, cleManager :: !Manager
}
instance HasHackageRoot CabalLoaderEnv where
getHackageRoot = hackageRoot . appExtra . cleSettings
instance HasHttpManager CabalLoaderEnv where
getHttpManager = cleManager
cabalLoaderMain :: IO ()
cabalLoaderMain = do
-- Hacky approach instead of PID files
void $ catchIO (bindPortTCP 17834 "127.0.0.1") $ \_ ->
error $ "cabal loader process already running, exiting"
error "cabalLoaderMain"
{- FIXME
conf <- fromArgs parseExtra
dbconf <- getDbConf conf
pool <- Database.Persist.createPoolConfig dbconf
manager <- newManager
bs <- loadBlobStore manager conf
hSetBuffering stdout LineBuffering
env <- getEnvironment
let forceUpdate = lookup "STACKAGE_FORCE_UPDATE" env == Just "1"
flip runLoggingT logFunc $ appLoadCabalFiles
True -- update database?
forceUpdate
CabalLoaderEnv
{ cleSettings = conf
, cleBlobStore = bs
, cleManager = manager
}
dbconf
pool
let foundation = App
{ settings = conf
, getStatic = error "getStatic"
, connPool = pool
, httpManager = manager
, persistConfig = dbconf
, appLogger = error "appLogger"
, genIO = error "genIO"
, blobStore = bs
, haddockRootDir = error "haddockRootDir"
, appDocUnpacker = error "appDocUnpacker"
, widgetCache = error "widgetCache"
, websiteContent = error "websiteContent"
}
createHoogleDatabases
bs
(flip (Database.Persist.runPool dbconf) pool)
putStrLn
(yesodRender foundation (appRoot conf))
where
logFunc loc src level str
| level > LevelDebug = S.hPutStr stdout $ fromLogStr $ defaultLogStr loc src level str
| otherwise = return ()
-}
-}

View File

@ -1,4 +0,0 @@
import Application
main :: IO ()
main = cabalLoaderMain

View File

@ -0,0 +1,4 @@
import Stackage.Database.Cron
main :: IO ()
main = stackageServerCron

View File

@ -25,9 +25,13 @@ library
Data.GhcLinks Data.GhcLinks
Data.WebsiteContent Data.WebsiteContent
Types Types
-- once stabilized, will likely move into its own package
Stackage.Database Stackage.Database
Stackage.Database.Haddock Stackage.Database.Haddock
Stackage.Database.Types Stackage.Database.Types
Stackage.Database.Cron
Handler.Home Handler.Home
Handler.Snapshots Handler.Snapshots
Handler.Profile Handler.Profile
@ -182,15 +186,13 @@ executable stackage-server
ghc-options: -threaded -O2 -rtsopts -with-rtsopts=-N ghc-options: -threaded -O2 -rtsopts -with-rtsopts=-N
executable cabal-loader-stackage executable stackage-server-cron
if flag(library-only) if flag(library-only)
Buildable: False Buildable: False
main-is: cabal-loader.hs main-is: stackage-server-cron.hs
hs-source-dirs: app hs-source-dirs: app
build-depends: base build-depends: base, stackage-server
, stackage-server
, yesod
ghc-options: -threaded -O2 -rtsopts -with-rtsopts=-N ghc-options: -threaded -O2 -rtsopts -with-rtsopts=-N