From dc0c7ffef1d355b554b602d7468b7cbb2729f75c Mon Sep 17 00:00:00 2001 From: Petter Rasmussen Date: Sun, 20 Mar 2022 09:07:07 +0100 Subject: [PATCH] Add glot-image-tester --- Glot/Snippet.hs | 2 + app/image-tester.hs | 218 +++++++++++++++++++++++++++++++++++++++++ config/languages.dhall | 2 +- glot.cabal | 11 +++ 4 files changed, 232 insertions(+), 1 deletion(-) create mode 100644 app/image-tester.hs diff --git a/Glot/Snippet.hs b/Glot/Snippet.hs index 12aca2c..91bbbc4 100644 --- a/Glot/Snippet.hs +++ b/Glot/Snippet.hs @@ -6,6 +6,8 @@ module Glot.Snippet , FilePayload(..) , toCodeFile , newSlug + , titleFromText + , fileContentFromText ) where import Import diff --git a/app/image-tester.hs b/app/image-tester.hs new file mode 100644 index 0000000..1847ad8 --- /dev/null +++ b/app/image-tester.hs @@ -0,0 +1,218 @@ +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE OverloadedStrings #-} + +import Prelude +import Data.Text (Text) +import Data.Function ((&)) +import Glot.Language (Language) +import Data.List.NonEmpty( NonEmpty( (:|) ) ) + +import qualified System.Process as Process +import qualified Data.List.NonEmpty as NonEmpty +import qualified Data.Text as Text +import qualified Data.Maybe as Maybe +import qualified Data.Either as Either +import qualified Data.Text.Encoding as Encoding +import qualified Data.ByteString.Lazy as BSL +import qualified Data.Aeson as Aeson +import qualified Glot.Language as Language +import qualified Glot.DockerRun as DockerRun +import qualified Glot.Snippet as Snippet + + +main :: IO () +main = + let + prepareLanguages :: [Language] -> [LanguageData] + prepareLanguages languages = + languages + & map languageDataFromLanguage + & Maybe.catMaybes + in do + languages <- Language.readLanguages + mapM_ runLanguage (prepareLanguages languages) + + +data LanguageData = LanguageData + { languageName :: Text + , container :: Text + , runRequest :: DockerRun.RunRequestPayload + } + deriving (Show) + +languageDataFromLanguage :: Language.Language -> Maybe LanguageData +languageDataFromLanguage lang = do + runConfig <- Language.runConfig lang + Just $ LanguageData + { languageName = Language.idToText (Language.identifier lang) + , container = Language.containerImage runConfig + , runRequest = DockerRun.RunRequestPayload + { language = Language.identifier lang + , stdin = Nothing + , command = Nothing + , files = + singleton $ Snippet.FilePayload + { name = + lang + & Language.editorConfig + & Language.defaultFilename + & Snippet.titleFromText + & Either.fromRight (error "Invalid filename") + , content = + lang + & Language.editorConfig + & Language.exampleCode + & Snippet.fileContentFromText + & Either.fromRight (error "Invalid file content") + } + } + } + + +runLanguage :: LanguageData -> IO () +runLanguage languageData = do + runOutput <- runContainer languageData + printResult languageData (checkRunOutput runOutput) + + +data RunOutput = RunOutput + { stdout :: Text + , stderr :: Text + } + +runContainer :: LanguageData -> IO RunOutput +runContainer LanguageData{..} = + let + cmd = + "docker run --rm -i --read-only --tmpfs /tmp:rw,noexec,nosuid,size=65536k --tmpfs /home/glot:rw,exec,nosuid,uid=1000,gid=1000,size=131072k -u glot -w /home/glot " <> Text.unpack container + + stdinPayload = + runRequest + & Aeson.encode + & BSL.toStrict + & Encoding.decodeUtf8 + & Text.unpack + in do + (_, stdout, stderr) <- Process.readCreateProcessWithExitCode (Process.shell cmd) stdinPayload + pure $ RunOutput + { stdout = Text.pack stdout + , stderr = Text.pack stderr + } + + +checkRunOutput :: RunOutput -> Either Error () +checkRunOutput runOutput = do + runResult <- decodeRunResult runOutput + _ <- checkRunResult runResult + pure () + +decodeRunResult :: RunOutput -> Either Error DockerRun.RunResult +decodeRunResult runOutput@RunOutput{..} = + stdout + & Encoding.encodeUtf8 + & Aeson.eitherDecodeStrict' + & mapErr (FailedToDecodeResult runOutput) + + +checkRunResult :: DockerRun.RunResult -> Either Error () +checkRunResult runResult@DockerRun.RunResult{..} = + if Text.null error && stderrIsOk stderr && isHelloWorld stdout then + Right () + + else + Left (InvalidHelloWorld runResult) + + + + +printResult :: LanguageData -> Either Error () -> IO () +printResult languageData@LanguageData{..} result = + case result of + Right () -> + putStrLn $ Text.unpack $ mconcat + [ "OK: " + , languageName + , " [" + , container + , "]" + ] + + Left err -> + printError languageData err + + +data Error + = FailedToDecodeResult RunOutput String + | InvalidHelloWorld DockerRun.RunResult + +-- TODO: print cmd to run container manually echo 'foo' | docker run ... +printError :: LanguageData -> Error -> IO () +printError LanguageData{..} err = + case err of + FailedToDecodeResult RunOutput{..} _decodeErr -> + putStrLn $ Text.unpack $ mconcat + [ "Failed: " + , languageName + , " [" + , container + , "] failed to decode result, stdout: «" + , Text.stripEnd stdout + , "», stderr: «" + , Text.stripEnd stderr + , "»" + ] + + InvalidHelloWorld DockerRun.RunResult{..} -> + putStrLn $ Text.unpack $ mconcat + [ "Failed: " + , languageName + , " [" + , container + , "] stdout: «" + , Text.stripEnd stdout + , "», stderr: «" + , Text.stripEnd stderr + , "», error: «" + , Text.stripEnd error + , "»" + ] + + +isHelloWorld :: Text -> Bool +isHelloWorld text = + let + normalizedText = + text + & Text.stripEnd + & Text.replace "\"" "" + & Text.toLower + in + normalizedText == "hello world!" + + +stderrIsOk :: Text -> Bool +stderrIsOk err = + let + expectedErrors = + [ "Compiled in DEV mode. Follow the advice at https://elm-lang.org/0.19.1/optimize for better performance and smaller assets.\n" + ] + in + Text.null err || elem err expectedErrors + + + + +-- TODO: Use newer version of NonEmpty +singleton :: a -> NonEmpty a +singleton a = a :| [] + + +-- TODO: Use Bifunctor.first +mapErr :: (e -> b) -> Either e a -> Either b a +mapErr mapper either = + case either of + Left err -> + Left (mapper err) + + Right value -> + Right value \ No newline at end of file diff --git a/config/languages.dhall b/config/languages.dhall index 8a5ca64..d7b0cc8 100644 --- a/config/languages.dhall +++ b/config/languages.dhall @@ -932,7 +932,7 @@ in [ { id = "assembly" ''