gdritter repos bb8 / master src / BB8 / Server.hs
master

Tree @master (Download .tar.gz)

Server.hs @masterraw · history · blame

{-# 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