mirror of
https://github.com/commercialhaskell/stackage-server.git
synced 2026-02-05 07:40:26 +01:00
Beginning of stackage-server-cron
This commit is contained in:
parent
54645b1eaa
commit
a0d2703738
@ -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
77
Stackage/Database/Cron.hs
Normal 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 ()
|
||||||
|
-}
|
||||||
|
|
||||||
|
|
||||||
|
-}
|
||||||
@ -1,4 +0,0 @@
|
|||||||
import Application
|
|
||||||
|
|
||||||
main :: IO ()
|
|
||||||
main = cabalLoaderMain
|
|
||||||
4
app/stackage-server-cron.hs
Normal file
4
app/stackage-server-cron.hs
Normal file
@ -0,0 +1,4 @@
|
|||||||
|
import Stackage.Database.Cron
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main = stackageServerCron
|
||||||
@ -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
|
||||||
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user