SunRed/myriad
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Add /containers and /cleanup endpoints

Browse source
This commit is contained in:
1computer1 2019-07-11 02:20:36 -04:00
parent 8e246c8851
commit 92cb8a6388
3 changed files with 22 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
README.md
View file

@ -39,3 +39,9 @@ Example response:
``` ```
Errors with 404 if `language` is not found, `504` if evaluation timed out, or `500` if evaluation failed for other reasons. Errors with 404 if `language` is not found, `504` if evaluation timed out, or `500` if evaluation failed for other reasons.
### **GET** `/containers`
List of containers being handled by Myriad.
### **POST** `/cleanup`
Kill all containers, giving back the names of the containers killed.

6
src/Myriad/Docker.hs
View file

@ -125,11 +125,11 @@ killAllContainers = do
containers <- asks containers >>= readIORef containers <- asks containers >>= readIORef
forConcurrently_ (M.keys containers) $ killContainer forConcurrently_ (M.keys containers) $ killContainer
killAllContainersMaybe :: MonadWithIO m => MyriadT m Int killAllContainersMaybe :: MonadWithIO m => MyriadT m [ContainerName]
killAllContainersMaybe = do killAllContainersMaybe = do
containers <- asks containers >>= readIORef containers <- asks containers >>= readIORef
xs <- forConcurrently (M.keys containers) $ killContainerMaybe xs <- forConcurrently (M.toList containers) \(k, v) -> (v,) <$> killContainerMaybe k
pure . length $ filter id xs pure . map fst $ filter snd xs
evalCode :: MonadWithIO m => LanguageConfig -> Int -> String -> MyriadT m EvalResult evalCode :: MonadWithIO m => LanguageConfig -> Int -> String -> MyriadT m EvalResult
evalCode lang@LanguageConfig { name, timeout, retries } numRetries code = do evalCode lang@LanguageConfig { name, timeout, retries } numRetries code = do

14
src/Myriad/Server.hs
View file

@ -10,10 +10,12 @@ import Control.Monad.Reader
import Data.Aeson import Data.Aeson
import Data.List (find) import Data.List (find)
import qualified Data.Map as M
import qualified Data.Text as T import qualified Data.Text as T
import GHC.Generics import GHC.Generics
import Control.Concurrent.Async.Lifted import Control.Concurrent.Async.Lifted
import Data.IORef.Lifted
import Servant import Servant
import Myriad.Core import Myriad.Core
@ -26,6 +28,8 @@ data EvalResponse = EvalResponse { result :: T.Text } deriving (Generic, ToJSON)
type API type API
= "languages" :> Get '[JSON] [T.Text] = "languages" :> Get '[JSON] [T.Text]
:<|> "eval" :> ReqBody '[JSON] EvalRequest :> Post '[JSON] EvalResponse :<|> "eval" :> ReqBody '[JSON] EvalRequest :> Post '[JSON] EvalResponse
:<|> "containers" :> Get '[JSON] [T.Text]
:<|> "cleanup" :> Post '[JSON] [T.Text]
app :: Env -> Application app :: Env -> Application
app = serve (Proxy @API) . server app = serve (Proxy @API) . server
@ -34,7 +38,7 @@ server :: Env -> Server API
server env = hoistServer (Proxy @API) (runMyriadT env) serverT server env = hoistServer (Proxy @API) (runMyriadT env) serverT
serverT :: forall m. (MonadWithIO m, MonadError ServantErr m) => ServerT API (MyriadT m) serverT :: forall m. (MonadWithIO m, MonadError ServantErr m) => ServerT API (MyriadT m)
serverT = handleLanguages :<|> handleEval serverT = handleLanguages :<|> handleEval :<|> handleContainers :<|> handleCleanup
where where
handleLanguages :: MyriadT m [T.Text] handleLanguages :: MyriadT m [T.Text]
handleLanguages = do handleLanguages = do
@ -54,3 +58,11 @@ serverT = handleLanguages :<|> handleEval
EvalErrored -> throwError $ err500 { errBody = "Evaluation failed" } EvalErrored -> throwError $ err500 { errBody = "Evaluation failed" }
EvalTimedOut -> throwError $ err504 { errBody = "Evaluation timed out" } EvalTimedOut -> throwError $ err504 { errBody = "Evaluation timed out" }
EvalOk xs -> pure . EvalResponse $ cvs xs EvalOk xs -> pure . EvalResponse $ cvs xs
handleContainers :: MyriadT m [T.Text]
handleContainers = do
containers <- asks containers >>= readIORef
pure . map cvs $ M.elems containers
handleCleanup :: MyriadT m [T.Text]
handleCleanup = map cvs <$> killAllContainersMaybe