Just need to actually write and run the cron job

This commit is contained in:
Michael Snoyman 2015-05-14 17:35:41 +03:00
parent 7caaf7ba23
commit a923a4e5ff
5 changed files with 85 additions and 11 deletions

View File

@ -28,7 +28,7 @@ import Yesod.Default.Main
import Yesod.GitRepo
import System.Environment (getEnvironment)
import System.Process (rawSystem)
import Stackage.Database (createStackageDatabase, openStackageDatabase)
import Stackage.Database.Cron (loadFromS3)
import qualified Echo
@ -134,16 +134,14 @@ makeFoundation useEcho conf = do
"master"
loadWebsiteContent
(stackageDatabase', refreshDB) <- loadFromS3
-- Temporary workaround to force content updates regularly, until
-- distribution of webhooks is handled via consul
void $ forkIO $ forever $ void $ tryAny $ do
threadDelay $ 1000 * 1000 * 60 * 20
grRefresh websiteContent'
let dbfile = "stackage.sqlite3"
createStackageDatabase dbfile
stackageDatabase' <- openStackageDatabase dbfile
-- FIXME refresh this on a regular basis
void $ forkIO $ forever $ void $ do
handleAny print $ refreshDB manager
threadDelay $ 1000 * 1000 * 60 * 5
handleAny print $ grRefresh websiteContent'
env <- getEnvironment

View File

@ -9,9 +9,12 @@ import qualified Hoogle
import Import
import Text.Blaze.Html (preEscapedToHtml)
import Stackage.Database
import qualified Stackage.Database.Cron as Cron
getHoogleDB :: SnapName -> Handler (Maybe FilePath)
getHoogleDB _ = return Nothing -- FIXME
getHoogleDB name = do
app <- getYesod
liftIO $ Cron.getHoogleDB (httpManager app) name
getHoogleR :: SnapName -> Handler Html
getHoogleR name = do

View File

@ -28,6 +28,7 @@ module Stackage.Database
, prettyName
, getSnapshotsForPackage
, getSnapshots
, currentSchema
) where
import Database.Sqlite (SqliteException)
@ -393,7 +394,7 @@ prettyName name ghc =
SNLts x y -> concat ["LTS Haskell ", tshow x, ".", tshow y]
SNNightly d -> "Stackage Nightly " ++ tshow d
getAllPackages :: GetStackageDatabase m => m [(Text, Text, Text)]
getAllPackages :: GetStackageDatabase m => m [(Text, Text, Text)] -- FIXME add information on whether included in LTS and Nightly
getAllPackages = liftM (map toPair) $ run $ do
E.select $ E.from $ \p -> do
E.orderBy [E.asc $ p E.^. PackageName]

View File

@ -1,13 +1,83 @@
module Stackage.Database.Cron
( stackageServerCron
, loadFromS3
, getHoogleDB
) where
import ClassyPrelude.Conduit
import Stackage.Database
import Network.HTTP.Client
import Network.HTTP.Client.Conduit (bodyReaderSource)
import Filesystem (rename)
import Web.PathPieces (toPathPiece)
import Filesystem (isFile)
import Network.HTTP.Types (status200)
filename' :: Text
filename' = concat
[ "stackage-database-"
, tshow currentSchema
, ".sqlite3"
]
keyName :: Text
keyName = "stackage-database/" ++ filename'
url :: Text
url = "https://s3.amazonaws.com/haddock.stackage.org/" ++ keyName
-- | Provides an action to be used to refresh the file from S3.
loadFromS3 :: IO (StackageDatabase, Manager -> IO ())
loadFromS3 = do
let fp = fpFromText filename'
fptmp = fp <.> "tmp"
req <- parseUrl $ unpack url
let download man = withResponse req man $ \res -> do
runResourceT
$ bodyReaderSource (responseBody res)
$$ sinkFile fptmp
rename fptmp fp
db <- openStackageDatabase fp
return (db, download)
stackageServerCron :: IO ()
stackageServerCron = error "FIXME: stackageServerCron not implemented"
hoogleKey :: SnapName -> Text
hoogleKey name = concat
[ "hoogle/"
, toPathPiece name
, "/"
, VERSION_hoogle
, ".hoo"
]
hoogleUrl :: SnapName -> Text
hoogleUrl n = "https://s3.amazonaws.com/haddock.stackage.org/" ++ hoogleKey n
getHoogleDB :: Manager -> SnapName -> IO (Maybe FilePath)
getHoogleDB man name = do
let fp = fpFromText $ hoogleKey name
fptmp = fp <.> "tmp"
exists <- isFile fp
if exists
then return $ Just fp
else do
req' <- parseUrl $ unpack $ hoogleUrl name
let req = req' { checkStatus = \_ _ _ -> Nothing }
withResponse req man $ \res -> if responseStatus res == status200
then do
runResourceT $ bodyReaderSource (responseBody res)
$$ sinkFile fptmp
rename fptmp fp
return $ Just fp
else do
mapM brRead res >>= print
return Nothing
{-
createStackageDatabase dbfile
import Data.Streaming.Network (bindPortTCP)

View File

@ -173,6 +173,8 @@ library
, persistent-sqlite
, stackage-metadata >= 0.2
, filepath
, http-client
, http-types
executable stackage-server
if flag(library-only)