diff --git a/src/swarm-tournament/Swarm/Web/Tournament/Database/Query.hs b/src/swarm-tournament/Swarm/Web/Tournament/Database/Query.hs index 95741d956d..1884b67678 100644 --- a/src/swarm-tournament/Swarm/Web/Tournament/Database/Query.hs +++ b/src/swarm-tournament/Swarm/Web/Tournament/Database/Query.hs @@ -43,7 +43,7 @@ data PersistenceLayer = PersistenceLayer } data ScenarioPersistence b = ScenarioPersistence - { lookupCache :: Sha1 -> IO (Maybe SolutionCharacterization) + { lookupCache :: Sha1 -> IO (Maybe AssociatedSolutionSolutionCharacterization) -- ^ Looks up by key , storeCache :: CharacterizationResponse b -> IO Sha1 -- ^ Stores and returns key @@ -56,7 +56,7 @@ data UserAttributedUpload = UserAttributedUpload data CharacterizationResponse a = CharacterizationResponse { upload :: UserAttributedUpload - , solnCharacterization :: SolutionCharacterization + , associatedCharacterization :: AssociatedSolutionSolutionCharacterization , payload :: a } @@ -68,6 +68,12 @@ newtype SolutionUploadResponsePayload = SolutionUploadResponsePayload { scenariohash :: Sha1 } +instance FromRow AssociatedSolutionSolutionCharacterization where + fromRow = + AssociatedSolutionSolutionCharacterization + <$> (Sha1 <$> field) + <*> fromRow + instance FromRow SolutionCharacterization where fromRow = SolutionCharacterization @@ -216,7 +222,7 @@ lookupScenarioContent sha1 = do liftIO . fmap (fmap fromOnly . listToMaybe) . withConnect connInfo $ \conn -> query conn "SELECT content FROM scenarios WHERE content_sha1 = ?;" (Only sha1) -lookupSolutionSubmission :: Sha1 -> ReaderT ConnectInfo IO (Maybe SolutionCharacterization) +lookupSolutionSubmission :: Sha1 -> ReaderT ConnectInfo IO (Maybe AssociatedSolutionSolutionCharacterization) lookupSolutionSubmission contentSha1 = do connInfo <- ask liftIO $ withConnect connInfo $ \conn -> runMaybeT $ do @@ -227,14 +233,15 @@ lookupSolutionSubmission contentSha1 = do MaybeT $ listToMaybe - <$> query conn "SELECT wall_time_seconds, ticks, seed, char_count, ast_size FROM evaluated_solution WHERE id = ?;" (Only evaluationId) + <$> query conn "SELECT scenario, wall_time_seconds, ticks, seed, char_count, ast_size FROM evaluated_solution WHERE id = ?;" (Only evaluationId) -- | There should only be one builtin solution for the scenario. -lookupScenarioSolution :: Sha1 -> ReaderT ConnectInfo IO (Maybe SolutionCharacterization) -lookupScenarioSolution sha1 = do +lookupScenarioSolution :: Sha1 -> ReaderT ConnectInfo IO (Maybe AssociatedSolutionSolutionCharacterization) +lookupScenarioSolution scenarioSha1 = do connInfo <- ask - liftIO . fmap listToMaybe . withConnect connInfo $ \conn -> - query conn "SELECT wall_time_seconds, ticks, seed, char_count, ast_size FROM evaluated_solution WHERE builtin AND scenario = ? LIMIT 1;" (Only sha1) + solnChar <- liftIO . fmap listToMaybe . withConnect connInfo $ \conn -> + query conn "SELECT wall_time_seconds, ticks, seed, char_count, ast_size FROM evaluated_solution WHERE builtin AND scenario = ? LIMIT 1;" (Only scenarioSha1) + return $ AssociatedSolutionSolutionCharacterization scenarioSha1 <$> solnChar listGames :: ReaderT ConnectInfo IO [TournamentGame] listGames = do @@ -261,7 +268,7 @@ insertScenario s = do , uid , swarmGameVersion $ payload s ) - _ <- insertSolution conn True scenarioSha $ solnCharacterization s + _ <- insertSolution conn True scenarioSha $ characterization $ associatedCharacterization s return resultList return $ Sha1 h @@ -276,7 +283,7 @@ insertSolutionSubmission (CharacterizationResponse solutionUpload s (SolutionUpl liftIO $ withConnect connInfo $ \conn -> do uid <- getUserId conn $ uploader solutionUpload - solutionEvalId <- insertSolution conn False scenarioSha s + solutionEvalId <- insertSolution conn False scenarioSha $ characterization s [Only echoedSha1] <- query diff --git a/src/swarm-tournament/Swarm/Web/Tournament/Type.hs b/src/swarm-tournament/Swarm/Web/Tournament/Type.hs index 0028593073..8ffdf6cd05 100644 --- a/src/swarm-tournament/Swarm/Web/Tournament/Type.hs +++ b/src/swarm-tournament/Swarm/Web/Tournament/Type.hs @@ -49,6 +49,11 @@ data TournamentGame = TournamentGame } deriving (Generic, ToJSON) +data AssociatedSolutionSolutionCharacterization = AssociatedSolutionSolutionCharacterization + { forScenario :: Sha1 + , characterization :: SolutionCharacterization + } + data SolutionCharacterization = SolutionCharacterization { solutionWallTime :: Seconds , solutionTicks :: TickNumber diff --git a/src/swarm-tournament/Swarm/Web/Tournament/Validate.hs b/src/swarm-tournament/Swarm/Web/Tournament/Validate.hs index 52e9d610cd..40d7c7b61d 100644 --- a/src/swarm-tournament/Swarm/Web/Tournament/Validate.hs +++ b/src/swarm-tournament/Swarm/Web/Tournament/Validate.hs @@ -11,6 +11,7 @@ import Control.Arrow (left) import Control.Carrier.Accum.FixedStrict (evalAccum) import Control.Carrier.Throw.Either (runThrow) import Control.Lens +import Control.Monad (unless) import Control.Monad.IO.Class (liftIO) import Control.Monad.State (StateT, evalStateT, gets) import Control.Monad.Trans.Except @@ -77,7 +78,7 @@ validateScenarioUpload (CommonValidationArgs solnTimeout persistenceArgs) gameVe pure $ ScenarioCharacterization fileMeta - solnMetrics + (characterization solnMetrics) where computeMetrics file = do gs <- @@ -91,7 +92,10 @@ validateScenarioUpload (CommonValidationArgs solnTimeout persistenceArgs) gameVe withExceptT ScenarioSolutionEvaluationFailure $ verifySolution solnTimeout soln gs - return (solnMetrics, ScenarioUploadResponsePayload gameVersion) + return + ( AssociatedSolutionSolutionCharacterization (fileHash $ fileMetadata file) solnMetrics + , ScenarioUploadResponsePayload gameVersion + ) validateSubmittedSolution :: CommonValidationArgs SolutionUploadResponsePayload -> @@ -100,30 +104,36 @@ validateSubmittedSolution :: IO (Either SolutionSubmissionFailure SolutionFileCharacterization) validateSubmittedSolution (CommonValidationArgs solnTimeout persistenceArgs) scenarioLookupFunc = runExceptT $ do + userSuppliedScenarioSha1 <- + withExceptT MissingScenarioParameter + . except + . fmap (Sha1 . T.unpack) + $ lookupInput "scenario" multipartData + (fileMeta, solnMetrics) <- withFileCache persistenceArgs SolutionUploadFailure - computeMetrics + (computeMetrics userSuppliedScenarioSha1) + + let retrievedScenarioHash = forScenario solnMetrics - -- TODO: Validate that the uploaded solution, if retrieved from the + -- We validate that the uploaded solution, if retrieved from the -- cache, actually is for the scenario with the hash they -- supplied in the upload metadata. -- If someone re-uploads a solution file that already happens to be -- stored in the database, but specifies a different scenario hash, -- we should alert about this mistake with an error. + unless (userSuppliedScenarioSha1 == retrievedScenarioHash) + . except + . Left + $ CachedSolutionScenarioMismatch userSuppliedScenarioSha1 retrievedScenarioHash - pure $ SolutionFileCharacterization (fileHash fileMeta) solnMetrics + pure $ SolutionFileCharacterization (fileHash fileMeta) $ characterization solnMetrics where PersistenceArgs _ multipartData _ = persistenceArgs - computeMetrics file = do - scenarioSha1 <- - withExceptT MissingScenarioParameter - . except - . fmap (Sha1 . T.unpack) - $ lookupInput "scenario" multipartData - + computeMetrics scenarioSha1 file = do solText <- withExceptT SolutionUnicodeError . except @@ -147,7 +157,10 @@ validateSubmittedSolution (CommonValidationArgs solnTimeout persistenceArgs) sce withExceptT SubmittedSolutionEvaluationFailure $ verifySolution solnTimeout soln gs - return (solnMetrics, SolutionUploadResponsePayload scenarioSha1) + return + ( AssociatedSolutionSolutionCharacterization scenarioSha1 solnMetrics + , SolutionUploadResponsePayload scenarioSha1 + ) -- * Utils diff --git a/src/swarm-tournament/Swarm/Web/Tournament/Validate/FailureMode.hs b/src/swarm-tournament/Swarm/Web/Tournament/Validate/FailureMode.hs index 92639f149e..9d804b55bf 100644 --- a/src/swarm-tournament/Swarm/Web/Tournament/Validate/FailureMode.hs +++ b/src/swarm-tournament/Swarm/Web/Tournament/Validate/FailureMode.hs @@ -14,7 +14,7 @@ import Data.Text.Encoding.Error (UnicodeException) import Data.Yaml (ParseException) import Swarm.Game.Failure (SystemFailure) import Swarm.Game.State (Sha1 (..)) -import Swarm.Util (showT) +import Swarm.Util (parens, showT) import System.Time.Extra (Seconds, showDuration) class Describable a where @@ -103,6 +103,7 @@ data SolutionSubmissionFailure | SolutionUnicodeError UnicodeException | SolutionParseError T.Text | ScenarioRetrievalFailure ScenarioRetrievalFailure + | CachedSolutionScenarioMismatch Sha1 Sha1 instance Describable SolutionSubmissionFailure where describeText (SolutionUploadFailure x) = describeText x @@ -111,3 +112,10 @@ instance Describable SolutionSubmissionFailure where describeText (SolutionUnicodeError x) = T.pack $ displayException x describeText (SolutionParseError x) = x describeText (ScenarioRetrievalFailure x) = describeText x + describeText (CachedSolutionScenarioMismatch (Sha1 userSuppliedScenarioSha1) (Sha1 retrievedScenarioHash)) = + T.unwords + [ "User-supplied scenario hash" + , parens $ T.pack userSuppliedScenarioSha1 + , "did not match scenario hash for previously computed solution" + , parens $ T.pack retrievedScenarioHash + ] diff --git a/src/swarm-tournament/Swarm/Web/Tournament/Validate/Upload.hs b/src/swarm-tournament/Swarm/Web/Tournament/Validate/Upload.hs index df6178a93d..1e23e33c98 100644 --- a/src/swarm-tournament/Swarm/Web/Tournament/Validate/Upload.hs +++ b/src/swarm-tournament/Swarm/Web/Tournament/Validate/Upload.hs @@ -47,8 +47,8 @@ obtainFileUpload multipartData = withFileCache :: PersistenceArgs a -> (GenericUploadFailure -> e) -> - (FileUpload -> ExceptT e IO (SolutionCharacterization, a)) -> - ExceptT e IO (FileMetadata, SolutionCharacterization) + (FileUpload -> ExceptT e IO (AssociatedSolutionSolutionCharacterization, a)) -> + ExceptT e IO (FileMetadata, AssociatedSolutionSolutionCharacterization) withFileCache (PersistenceArgs userAlias multipartData persistenceFunctions) errorWrapper cacheStoreFunction = do file <- withExceptT errorWrapper $ obtainFileUpload multipartData maybePreexisting <- diff --git a/tournament/scripts/demo/client/submit.sh b/tournament/scripts/demo/client/submit.sh index 3de43d4c25..1a0ef2d02e 100755 --- a/tournament/scripts/demo/client/submit.sh +++ b/tournament/scripts/demo/client/submit.sh @@ -1,5 +1,17 @@ #!/bin/bash -ex +# Parameters: +# $1 = hostname (and optional port) +# $2 = path to scenario file +# $3 = path to solution file + +HOST=$1 +SCENARIO_FILEPATH=$2 +SOLUTION_FILEPATH=$3 + +# Example: +# tournament/scripts/demo/client/submit.sh localhost:8008 data/scenarios/Challenges/dimsum.yaml data/scenarios/Challenges/_arbitrage/solution.sw +# # This exercises the tournament API by: # # 1. Uploading a scenario file @@ -10,18 +22,13 @@ cd $(git rev-parse --show-toplevel) -SCENARIO_DATA_DIR=data/scenarios PORT=8080 -#HOST=localhost:$PORT -HOST=swarmgame.net +HOST=localhost:$PORT +# HOST=swarmgame.net BASE_UPLOAD_URL=http://$HOST/upload SCENARIO_UPLOAD_URL=$BASE_UPLOAD_URL/scenario -SCENARIO_FILEPATH=$SCENARIO_DATA_DIR/Challenges/arbitrage.yaml SCENARIO_HASH=$(curl --silent -F "my_file=@$SCENARIO_FILEPATH" $SCENARIO_UPLOAD_URL | jq -r .scenarioFileMetadata.fileHash) -echo "Scenario hash: $SCENARIO_HASH" - SOLUTION_UPLOAD_URL=$BASE_UPLOAD_URL/solution -SOLUTION_FILEPATH=$SCENARIO_DATA_DIR/Challenges/_arbitrage/solution.sw -curl --silent -F "scenario=$SCENARIO_HASH" -F "my_file=@$SOLUTION_FILEPATH" $SOLUTION_UPLOAD_URL | jq . +curl --silent -F "scenario=$SCENARIO_HASH" -F "my_file=@$SOLUTION_FILEPATH" $SOLUTION_UPLOAD_URL diff --git a/tournament/scripts/demo/client/test-cases/local/good-submit.sh b/tournament/scripts/demo/client/test-cases/local/good-submit.sh new file mode 100755 index 0000000000..1d28a44be0 --- /dev/null +++ b/tournament/scripts/demo/client/test-cases/local/good-submit.sh @@ -0,0 +1,8 @@ +#!/bin/bash -ex + +cd $(git rev-parse --show-toplevel) + +tournament/scripts/demo/client/submit.sh \ + localhost:8008 \ + data/scenarios/Challenges/arbitrage.yaml \ + data/scenarios/Challenges/_arbitrage/solution.sw diff --git a/tournament/scripts/demo/client/test-cases/local/wrong-scenario-cached-solution.sh b/tournament/scripts/demo/client/test-cases/local/wrong-scenario-cached-solution.sh new file mode 100755 index 0000000000..1bc50530ae --- /dev/null +++ b/tournament/scripts/demo/client/test-cases/local/wrong-scenario-cached-solution.sh @@ -0,0 +1,13 @@ +#!/bin/bash -ex + +# This test cases demonstrates the failure whether or +# not the solutions to both scenarios have already been submitted. + +cd $(git rev-parse --show-toplevel) + +tournament/scripts/demo/client/test-cases/local/good-submit.sh + +tournament/scripts/demo/client/submit.sh \ + localhost:8008 \ + data/scenarios/Challenges/dimsum.yaml \ + data/scenarios/Challenges/_arbitrage/solution.sw