mirror of
https://github.com/commercialhaskell/stackage-server.git
synced 2026-02-15 04:15:48 +01:00
cabal file loader
This commit is contained in:
parent
0f4ba8595b
commit
437818735c
@ -3,11 +3,12 @@ module Application
|
|||||||
( makeApplication
|
( makeApplication
|
||||||
, getApplicationDev
|
, getApplicationDev
|
||||||
, makeFoundation
|
, makeFoundation
|
||||||
|
, cabalLoaderMain
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Aws
|
import qualified Aws
|
||||||
import Control.Concurrent (forkIO, threadDelay)
|
import Control.Concurrent (forkIO, threadDelay)
|
||||||
import Control.Monad.Logger (runLoggingT, LoggingT)
|
import Control.Monad.Logger (runLoggingT, LoggingT, runStdoutLoggingT)
|
||||||
import Control.Monad.Reader (MonadReader (..))
|
import Control.Monad.Reader (MonadReader (..))
|
||||||
import Control.Monad.Reader (runReaderT, ReaderT)
|
import Control.Monad.Reader (runReaderT, ReaderT)
|
||||||
import Control.Monad.Trans.Control
|
import Control.Monad.Trans.Control
|
||||||
@ -34,7 +35,7 @@ import Yesod.Default.Config
|
|||||||
import Yesod.Default.Handlers
|
import Yesod.Default.Handlers
|
||||||
import Yesod.Default.Main
|
import Yesod.Default.Main
|
||||||
import System.Environment (getEnvironment)
|
import System.Environment (getEnvironment)
|
||||||
import Data.BlobStore (HasBlobStore)
|
import Data.BlobStore (HasBlobStore (..), BlobStore)
|
||||||
|
|
||||||
import qualified Echo
|
import qualified Echo
|
||||||
|
|
||||||
@ -99,16 +100,32 @@ makeApplication echo@False conf = do
|
|||||||
middleware = logWare . defaultMiddlewaresNoLogging
|
middleware = logWare . defaultMiddlewaresNoLogging
|
||||||
return (middleware app, logFunc)
|
return (middleware app, logFunc)
|
||||||
|
|
||||||
|
getDbConf :: AppConfig DefaultEnv Extra -> IO Settings.PersistConf
|
||||||
|
getDbConf conf =
|
||||||
|
withYamlEnvironment "config/postgresql.yml" (appEnv conf)
|
||||||
|
Database.Persist.loadConfig >>=
|
||||||
|
Database.Persist.applyEnv
|
||||||
|
|
||||||
|
loadBlobStore :: Manager -> AppConfig DefaultEnv Extra -> IO (BlobStore StoreKey)
|
||||||
|
loadBlobStore manager conf =
|
||||||
|
case storeConfig $ appExtra conf of
|
||||||
|
BSCFile root -> return $ fileStore root
|
||||||
|
BSCAWS root access secret bucket prefix -> do
|
||||||
|
creds <- Aws.Credentials
|
||||||
|
<$> pure (encodeUtf8 access)
|
||||||
|
<*> pure (encodeUtf8 secret)
|
||||||
|
<*> newIORef []
|
||||||
|
<*> pure Nothing
|
||||||
|
return $ cachedS3Store root creds bucket prefix manager
|
||||||
|
|
||||||
-- | Loads up any necessary settings, creates your foundation datatype, and
|
-- | Loads up any necessary settings, creates your foundation datatype, and
|
||||||
-- performs some initialization.
|
-- performs some initialization.
|
||||||
makeFoundation :: Bool -> AppConfig DefaultEnv Extra -> IO App
|
makeFoundation :: Bool -> AppConfig DefaultEnv Extra -> IO App
|
||||||
makeFoundation useEcho conf = do
|
makeFoundation useEcho conf = do
|
||||||
manager <- newManager
|
manager <- newManager
|
||||||
s <- staticSite
|
s <- staticSite
|
||||||
dbconf <- withYamlEnvironment "config/postgresql.yml" (appEnv conf)
|
dbconf <- getDbConf conf
|
||||||
Database.Persist.loadConfig >>=
|
p <- Database.Persist.createPoolConfig dbconf
|
||||||
Database.Persist.applyEnv
|
|
||||||
p <- Database.Persist.createPoolConfig (dbconf :: Settings.PersistConf)
|
|
||||||
|
|
||||||
loggerSet' <- if useEcho
|
loggerSet' <- if useEcho
|
||||||
then newFileLoggerSet defaultBufSize "/dev/null"
|
then newFileLoggerSet defaultBufSize "/dev/null"
|
||||||
@ -130,16 +147,7 @@ makeFoundation useEcho conf = do
|
|||||||
progressMap' <- newIORef mempty
|
progressMap' <- newIORef mempty
|
||||||
nextProgressKey' <- newIORef 0
|
nextProgressKey' <- newIORef 0
|
||||||
|
|
||||||
blobStore' <-
|
blobStore' <- loadBlobStore manager conf
|
||||||
case storeConfig $ appExtra conf of
|
|
||||||
BSCFile root -> return $ fileStore root
|
|
||||||
BSCAWS root access secret bucket prefix -> do
|
|
||||||
creds <- Aws.Credentials
|
|
||||||
<$> pure (encodeUtf8 access)
|
|
||||||
<*> pure (encodeUtf8 secret)
|
|
||||||
<*> newIORef []
|
|
||||||
<*> pure Nothing
|
|
||||||
return $ cachedS3Store root creds bucket prefix manager
|
|
||||||
|
|
||||||
let haddockRootDir' = "/tmp/stackage-server-haddocks2"
|
let haddockRootDir' = "/tmp/stackage-server-haddocks2"
|
||||||
(statusRef, unpacker) <- createHaddockUnpacker haddockRootDir' blobStore'
|
(statusRef, unpacker) <- createHaddockUnpacker haddockRootDir' blobStore'
|
||||||
@ -190,6 +198,35 @@ makeFoundation useEcho conf = do
|
|||||||
then void m
|
then void m
|
||||||
else return ()
|
else return ()
|
||||||
|
|
||||||
|
data CabalLoaderEnv = CabalLoaderEnv
|
||||||
|
{ cleSettings :: !(AppConfig DefaultEnv Extra)
|
||||||
|
, cleBlobStore :: !(BlobStore StoreKey)
|
||||||
|
, cleManager :: !Manager
|
||||||
|
}
|
||||||
|
|
||||||
|
instance HasHackageRoot CabalLoaderEnv where
|
||||||
|
getHackageRoot = hackageRoot . appExtra . cleSettings
|
||||||
|
instance HasBlobStore CabalLoaderEnv StoreKey where
|
||||||
|
getBlobStore = cleBlobStore
|
||||||
|
instance HasHttpManager CabalLoaderEnv where
|
||||||
|
getHttpManager = cleManager
|
||||||
|
|
||||||
|
cabalLoaderMain :: IO ()
|
||||||
|
cabalLoaderMain = do
|
||||||
|
conf <- fromArgs parseExtra
|
||||||
|
dbconf <- getDbConf conf
|
||||||
|
pool <- Database.Persist.createPoolConfig dbconf
|
||||||
|
manager <- newManager
|
||||||
|
bs <- loadBlobStore manager conf
|
||||||
|
runStdoutLoggingT $ appLoadCabalFiles
|
||||||
|
CabalLoaderEnv
|
||||||
|
{ cleSettings = conf
|
||||||
|
, cleBlobStore = bs
|
||||||
|
, cleManager = manager
|
||||||
|
}
|
||||||
|
dbconf
|
||||||
|
pool
|
||||||
|
|
||||||
appLoadCabalFiles :: ( PersistConfig c
|
appLoadCabalFiles :: ( PersistConfig c
|
||||||
, PersistConfigBackend c ~ SqlPersistT
|
, PersistConfigBackend c ~ SqlPersistT
|
||||||
, HasHackageRoot env
|
, HasHackageRoot env
|
||||||
|
|||||||
4
app/cabal-loader.hs
Normal file
4
app/cabal-loader.hs
Normal file
@ -0,0 +1,4 @@
|
|||||||
|
import Application
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main = cabalLoaderMain
|
||||||
@ -155,6 +155,18 @@ executable stackage-server
|
|||||||
|
|
||||||
ghc-options: -threaded -O2 -rtsopts -with-rtsopts=-N
|
ghc-options: -threaded -O2 -rtsopts -with-rtsopts=-N
|
||||||
|
|
||||||
|
executable cabal-loader-stackage
|
||||||
|
if flag(library-only)
|
||||||
|
Buildable: False
|
||||||
|
|
||||||
|
main-is: cabal-loader.hs
|
||||||
|
hs-source-dirs: app
|
||||||
|
build-depends: base
|
||||||
|
, stackage-server
|
||||||
|
, yesod
|
||||||
|
|
||||||
|
ghc-options: -threaded -O2 -rtsopts -with-rtsopts=-N
|
||||||
|
|
||||||
test-suite test
|
test-suite test
|
||||||
type: exitcode-stdio-1.0
|
type: exitcode-stdio-1.0
|
||||||
main-is: main.hs
|
main-is: main.hs
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user