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

View File

@ -9,9 +9,12 @@ import qualified Hoogle
import Import import Import
import Text.Blaze.Html (preEscapedToHtml) import Text.Blaze.Html (preEscapedToHtml)
import Stackage.Database import Stackage.Database
import qualified Stackage.Database.Cron as Cron
getHoogleDB :: SnapName -> Handler (Maybe FilePath) 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 :: SnapName -> Handler Html
getHoogleR name = do getHoogleR name = do

View File

@ -28,6 +28,7 @@ module Stackage.Database
, prettyName , prettyName
, getSnapshotsForPackage , getSnapshotsForPackage
, getSnapshots , getSnapshots
, currentSchema
) where ) where
import Database.Sqlite (SqliteException) import Database.Sqlite (SqliteException)
@ -393,7 +394,7 @@ prettyName name ghc =
SNLts x y -> concat ["LTS Haskell ", tshow x, ".", tshow y] SNLts x y -> concat ["LTS Haskell ", tshow x, ".", tshow y]
SNNightly d -> "Stackage Nightly " ++ tshow d 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 getAllPackages = liftM (map toPair) $ run $ do
E.select $ E.from $ \p -> do E.select $ E.from $ \p -> do
E.orderBy [E.asc $ p E.^. PackageName] E.orderBy [E.asc $ p E.^. PackageName]

View File

@ -1,13 +1,83 @@
module Stackage.Database.Cron module Stackage.Database.Cron
( stackageServerCron ( stackageServerCron
, loadFromS3
, getHoogleDB
) where ) where
import ClassyPrelude.Conduit 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 :: IO ()
stackageServerCron = error "FIXME: stackageServerCron not implemented" 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) import Data.Streaming.Network (bindPortTCP)

View File

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