{-# LANGUAGE TemplateHaskell #-}
module BB8.Server where
import qualified Control.Concurrent as Thread
import qualified Control.Concurrent.STM as STM
import qualified Control.Monad as Monad
import qualified Control.Monad.IO.Class as IO
import qualified Data.ByteString.Lazy as BSL
import qualified Data.Sequence as Seq
import qualified Data.FileEmbed as File
import qualified Database.SQLite.Simple as SQL
import qualified Web.Scotty as W
import qualified BB8.Common as BB8
import qualified BB8.Types as Types
import qualified BB8.Queue as Queue
import qualified BB8.DB as DB
data AppState = AppState
{ appJobState :: STM.TVar (Maybe Types.Job)
, appJobTrace :: STM.TVar (Seq.Seq Types.OutputLine)
, appDBHandle :: SQL.Connection
, appConfig :: Types.Config
}
jobRunnerLoop :: AppState -> IO ()
jobRunnerLoop AppState { appJobState = jobState
, appDBHandle = db
, appConfig = conf
, appJobTrace = trace
} =
Monad.forever $ do
value <- STM.atomically $ STM.readTVar jobState
-- we may or may not have a stored job
case value of
-- if not, find one from the db, which again, might not exist
Nothing -> do
next <- DB.getNextJob db
case next of
-- if there is no job to do, simply wait for a while
Nothing -> do
BB8.debug "no job; waiting"
Thread.threadDelay (Types.configSleepAmount conf * 1000 * 1000)
-- otherwise, set the job to the initial job state
Just j -> do
BB8.debug "found a job"
STM.atomically $ STM.writeTVar jobState (Just j)
-- if there IS a current job, then we should check its state
Just job
-- if it's done, then we record the data in the DB and clear the
-- job state
| Types.isFinished job -> do
DB.recordJob job db
STM.atomically $ STM.writeTVar jobState Nothing
-- otherwise, run the next step and record the resulting
-- information in the DB, and then update the job state
| otherwise -> do
next <- Queue.runState conf trace job
DB.recordJob job db
STM.atomically $ STM.writeTVar jobState (Just next)
currentJobs :: AppState -> IO Types.QueueState
currentJobs AppState { appDBHandle = db } = do
completed <- DB.getJobs db
return (Types.QueueState completed)
app :: AppState -> W.ScottyM ()
app state = do
-- all of these are just static, so the binary doesn't depend on any
-- other files being around
W.get "/" $
W.raw (BSL.fromStrict $(File.embedFile "static/main.html"))
W.get "/static/bootstrap.min.css" $
W.raw (BSL.fromStrict $(File.embedFile "static/bootstrap.min.css"))
W.get "/static/bootstrap.min.js" $
W.raw (BSL.fromStrict $(File.embedFile "static/bootstrap.min.js"))
W.get "/static/jquery.js" $
W.raw (BSL.fromStrict $(File.embedFile "static/jquery.js"))
-- all the job data routes are here
W.get "/jobs" $ do
rs <- IO.liftIO (currentJobs state)
W.json rs
W.post "/jobs" $ do
newJob <- W.jsonData
IO.liftIO $ do
BB8.debugShow newJob
j <- DB.createJob newJob (appDBHandle state)
print j
return ()
W.delete "/jobs/:id" $ do
ident <- W.param "id"
IO.liftIO $ do
BB8.debug ("deleting job " ++ show ident)
DB.deleteJob ident (appDBHandle state)
return ()
W.get "/jobs/:id/trace" $ do
ident <- W.param "id"
rs <- IO.liftIO (Queue.getTraceData (appConfig state) ident)
W.json rs