From 124a36fec534085a1a1be2e8dabbc19ca48a8d95 Mon Sep 17 00:00:00 2001
From: nimec01 <24428341+nimec01@users.noreply.github.com>
Date: Wed, 22 Apr 2026 13:13:11 +0200
Subject: [PATCH 01/14] remove Model module

---
 codeworld-server/codeworld-server.cabal |  2 +-
 codeworld-server/src/Main.hs            |  1 -
 codeworld-server/src/Model.hs           | 95 -------------------------
 3 files changed, 1 insertion(+), 97 deletions(-)
 delete mode 100644 codeworld-server/src/Model.hs

diff --git a/codeworld-server/codeworld-server.cabal b/codeworld-server/codeworld-server.cabal
index d3fbac94..73526afb 100644
--- a/codeworld-server/codeworld-server.cabal
+++ b/codeworld-server/codeworld-server.cabal
@@ -15,7 +15,7 @@ Description:
 Executable codeworld-server
   Hs-source-dirs: src
   Main-is: Main.hs
-  Other-modules: Model, Util, Config
+  Other-modules: Util, Config
 
   Build-depends:
     aeson,
diff --git a/codeworld-server/src/Main.hs b/codeworld-server/src/Main.hs
index d456a395..fab92b71 100644
--- a/codeworld-server/src/Main.hs
+++ b/codeworld-server/src/Main.hs
@@ -51,7 +51,6 @@ import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 import qualified Data.Text.IO as T
 import qualified Data.Vector as V
-import Model
 import Network.HTTP.Simple
 import Ormolu (OrmoluException, defaultConfig, ormolu)
 import Snap.Core
diff --git a/codeworld-server/src/Model.hs b/codeworld-server/src/Model.hs
deleted file mode 100644
index d14d47a0..00000000
--- a/codeworld-server/src/Model.hs
+++ /dev/null
@@ -1,95 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# OPTIONS_GHC -fno-warn-unused-imports #-}
-
-{-
-  Copyright 2020 The CodeWorld Authors. All rights reserved.
-
-  Licensed under the Apache License, Version 2.0 (the "License");
-  you may not use this file except in compliance with the License.
-  You may obtain a copy of the License at
-
-      http://www.apache.org/licenses/LICENSE-2.0
-
-  Unless required by applicable law or agreed to in writing, software
-  distributed under the License is distributed on an "AS IS" BASIS,
-  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-  See the License for the specific language governing permissions and
-  limitations under the License.
--}
-module Model where
-
-import Control.Applicative
-import Control.Monad
-import Data.Aeson
-import Data.ByteString (ByteString)
-import Data.Text (Text)
-import GHC.Generics (Generic)
-import System.FilePath (FilePath)
-
-data Project = Project
-  { projectName :: Text,
-    projectSource :: Text,
-    projectHistory :: Value
-  }
-
-instance FromJSON Project where
-  parseJSON (Object v) =
-    Project <$> v .: "name" <*> v .: "source" <*> v .: "history"
-  parseJSON _ = mzero
-
-instance ToJSON Project where
-  toJSON p =
-    object
-      [ "name" .= projectName p,
-        "source" .= projectSource p,
-        "history" .= projectHistory p,
-        "type" .= ("project" :: Text)
-      ]
-
-data FileSystemEntryType = Dir | Proj deriving (Eq, Ord, Show)
-
-instance ToJSON FileSystemEntryType where
-  toJSON Dir = Data.Aeson.String "directory"
-  toJSON Proj = Data.Aeson.String "project"
-
-instance FromJSON FileSystemEntryType where
-  parseJSON (Data.Aeson.String "directory") = return $ Dir
-  parseJSON (Data.Aeson.String "project") = return $ Proj
-  parseJSON _ = mzero
-
-data FileSystemEntry = FSEntry
-  { fsEntryIndex :: Int,
-    fsEntryName :: Text,
-    fsEntryType :: FileSystemEntryType,
-    fsEntryChildren :: Maybe [FileSystemEntry]
-  }
-  deriving (Generic, Eq, Ord, Show)
-
-fsEntryJSONOptions :: Options
-fsEntryJSONOptions =
-  defaultOptions
-    { fieldLabelModifier = \f -> case f of
-        "fsEntryIndex" -> "index"
-        "fsEntryName" -> "name"
-        "fsEntryType" -> "type"
-        "fsEntryChildren" -> "children"
-        _ -> f,
-      omitNothingFields = True
-    }
-
-instance ToJSON FileSystemEntry where
-  toJSON = genericToJSON fsEntryJSONOptions
-
-instance FromJSON FileSystemEntry where
-  parseJSON = genericParseJSON fsEntryJSONOptions
-
-data CompileResult = CompileResult
-  { compileHash :: Text,
-    compileDeployHash :: Text
-  }
-
-instance ToJSON CompileResult where
-  toJSON cr =
-    object ["hash" .= compileHash cr, "dhash" .= compileDeployHash cr]
-

From eacc628c373fefe05be46aaeba6c227a94bf9a56 Mon Sep 17 00:00:00 2001
From: nimec01 <24428341+nimec01@users.noreply.github.com>
Date: Wed, 22 Apr 2026 13:16:25 +0200
Subject: [PATCH 02/14] refactor implementation; remove old artifacts

---
 codeworld-server/codeworld-server.cabal |  12 --
 codeworld-server/src/Main.hs            |  85 +++-----
 codeworld-server/src/Util.hs            | 275 +-----------------------
 3 files changed, 37 insertions(+), 335 deletions(-)

diff --git a/codeworld-server/codeworld-server.cabal b/codeworld-server/codeworld-server.cabal
index 73526afb..95f3881b 100644
--- a/codeworld-server/codeworld-server.cabal
+++ b/codeworld-server/codeworld-server.cabal
@@ -20,33 +20,21 @@ Executable codeworld-server
   Build-depends:
     aeson,
     base,
-    base64-bytestring,
     bytestring,
     codeworld-compiler,
     containers,
-    cryptonite,
-    data-default,
     directory,
     extra,
-    fast-logger,
-    filelock,
     filepath,
-    haskell-src-exts < 1.21,
-    http-conduit >= 2.3.0 && < 2.3.9,
     lifted-base,
-    memory,
     mtl,
     ormolu >= 0.1,
-    process,
-    regex-compat,
     regex-tdfa,
     SafeSemaphore,
     snap-core,
     snap-server,
     temporary,
     text,
-    unix,
-    vector,
     yaml
 
   Ghc-options: -threaded
diff --git a/codeworld-server/src/Main.hs b/codeworld-server/src/Main.hs
index fab92b71..38f2a14a 100644
--- a/codeworld-server/src/Main.hs
+++ b/codeworld-server/src/Main.hs
@@ -50,8 +50,6 @@ import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 import qualified Data.Text.IO as T
-import qualified Data.Vector as V
-import Network.HTTP.Simple
 import Ormolu (OrmoluException, defaultConfig, ormolu)
 import Snap.Core
 import Snap.Http.Server (httpServe, ConfigLog (ConfigIoLog))
@@ -59,7 +57,6 @@ import qualified Snap.Http.Server.Config as S (commandLineConfig, defaultConfig,
 import Snap.Util.FileServe
 import Snap.Util.FileUploads
 import System.Directory
-import System.FileLock
 import System.FilePath
 import System.IO (hPutStrLn, stderr)
 import System.IO.Temp
@@ -160,33 +157,27 @@ dirConfig = defaultDirectoryConfig {preServeHook = disableCache}
   where
     disableCache _ = modifyRequest (addHeader "Cache-control" "no-cache")
 
-withProgramLock :: BuildMode -> ProgramId -> IO a -> IO a
-withProgramLock (BuildMode mode) (ProgramId hash) action = do
-  tmpDir <- getTemporaryDirectory
-  let tmpFile = tmpDir </> "codeworld" <.> T.unpack hash <.> mode
-  withFileLock tmpFile Exclusive (const action)
 
-
-runCompile :: Context -> ProgramId -> BuildMode -> Text -> IO (CompileStatus, Either Text (Text,Text))
-runCompile ctx programId mode source = withSystemTempDirectory "codeworld" $ \tempDir -> do
+runCompile :: Context -> BuildMode -> Text -> IO (CompileStatus, Either Text (Text,Text))
+runCompile ctx mode source = withSystemTempDirectory "codeworld" $ \tempDir -> do
     let sourceDir = tempDir </> "source"
         buildDir = tempDir </> "build"
     createDirectoryIfMissing True sourceDir
     createDirectoryIfMissing True buildDir
 
-    status <- withProgramLock mode programId $ do
-      T.writeFile (sourceDir </> sourceFile programId) source
-      compileIfNeeded ctx tempDir mode programId
+    status <- do
+      T.writeFile (sourceDir </> "program.hs") source
+      compileIfNeeded ctx tempDir mode
 
-    hasResultFile <- doesFileExist (buildDir </> resultFile programId)
+    hasResultFile <- doesFileExist (buildDir </> "err.txt")
 
     case status of
       CompileSuccess | hasResultFile -> do
-        content <- readFile (buildDir </> resultFile programId)
-        target <- readFile (buildDir </> targetFile programId)
+        content <- readFile (buildDir </> "err.txt")
+        target <- readFile (buildDir </> "program.js")
         pure (status, Right (T.pack content,T.pack target))
       _ | hasResultFile -> do
-        content <- readFile (buildDir </> resultFile programId)
+        content <- readFile (buildDir </> "err.txt")
         pure (status, Left $ T.pack content)
       _ -> pure (status, Left "Something went wrong")
 
@@ -231,10 +222,7 @@ compileHandler ctx = do
   let previewConf = previewConfig $ config ctx
   Just source <- (T.decodeUtf8 <$>) <$> getParam "source"
   mPreview <- getParam "enablePreview"
-  let programId = sourceToProgramId $ T.encodeUtf8 source
-      id = unProgramId programId
-      did = "deploy_id"
-      previewsEnabled = case mPreview of
+  let previewsEnabled = case mPreview of
         Just "True" -> True
         Just "true" -> True
         Just "False" -> False
@@ -242,7 +230,7 @@ compileHandler ctx = do
         _ -> enabledByDefault previewConf
 
   (compileStatus, result) <- liftIO $ do 
-    (originalStatus, originalResult) <- runCompile ctx programId mode source
+    (originalStatus, originalResult) <- runCompile ctx mode source
 
     tryOr (originalStatus, originalResult) $ do
       assert previewsEnabled
@@ -251,21 +239,21 @@ compileHandler ctx = do
       let (replaceCount, sourceWithHolePlaceholders) = replaceUndefinedWithHole source
       assert $ replaceCount > 0
 
-      (_,Left error) <- runCompile ctx programId mode sourceWithHolePlaceholders
+      (_,Left error) <- runCompile ctx mode sourceWithHolePlaceholders
 
       let holes = extractHolesFromErrorText error
           replacementMap = defaultHoleValues previewConf
           Just withDefaultValues = replaceHolesWithDefaultValue holes replacementMap source
 
-      (status', res') <- runCompile ctx programId mode withDefaultValues
+      (status', res') <- runCompile ctx mode withDefaultValues
 
       assert $ status' == CompileSuccess
 
       pure (status', res')
 
   let responseBody = T.intercalate "\n=======================\n" $ case result of 
-          Right (content, target) -> [id,did,content,target]
-          Left errorMessage -> [id,did,errorMessage]    
+          Right (content, target) -> [content,target]
+          Left errorMessage -> [errorMessage]
 
   modifyResponse $ setResponseCode (responseCodeFromCompileStatus compileStatus)
   modifyResponse $ setContentType "text/plain"
@@ -282,13 +270,6 @@ errorCheckHandler ctx = do
     CompileSuccess -> writeBS ""
     _ -> writeBS output
 
-getHashParam :: Bool -> BuildMode -> Snap ProgramId
-getHashParam allowDeploy mode = do
-  maybeHash <- getParam "hash"
-  case maybeHash of
-    Just h -> return (ProgramId (T.decodeUtf8 h))
-    Nothing -> pass
-
 runBaseHandler :: CodeWorldHandler
 runBaseHandler ctx = do
   maybeVer <- fmap T.decodeUtf8 <$> getParam "version"
@@ -357,42 +338,42 @@ waitAndLogExhausted name sem action = do
     hPutStrLn stderr $ name ++ " has exhausted its available resources, but there is further demand." 
   MSem.with sem action
 
-compileIfNeeded :: Context -> FilePath -> BuildMode -> ProgramId -> IO CompileStatus
-compileIfNeeded ctx basePath mode programId = do
-  hasResult <- doesFileExist (basePath </> "build" </> resultFile programId)
-  hasTarget <- doesFileExist (basePath </> "build" </> targetFile programId)
+compileIfNeeded :: Context -> FilePath -> BuildMode -> IO CompileStatus
+compileIfNeeded ctx basePath mode = do
+  hasResult <- doesFileExist (basePath </> "build" </> "err.txt")
+  hasTarget <- doesFileExist (basePath </> "build" </> "program.js")
   if
       | hasResult && hasTarget -> return CompileSuccess
       | hasResult -> return CompileError
       | otherwise ->
-        waitAndLogExhausted "Compile" (compileSem ctx) $ compileProgram ctx basePath mode programId
+        waitAndLogExhausted "Compile" (compileSem ctx) $ compileProgram ctx basePath mode
 
-compileProgram :: Context -> FilePath -> BuildMode -> ProgramId -> IO CompileStatus
-compileProgram ctx basePath mode programId = do
+compileProgram :: Context -> FilePath -> BuildMode -> IO CompileStatus
+compileProgram ctx basePath mode = do
   ver <- baseVersion
   baseStatus <- buildBaseIfNeeded ctx ver
 
   case baseStatus of
     CompileSuccess -> do
-      status <- compileIncrementally ctx basePath mode programId ver
-      T.writeFile (basePath </> "build" </> baseVersionFile programId) ver
+      status <- compileIncrementally ctx basePath mode ver
+      T.writeFile (basePath </> "build" </> "basever") ver
 
       -- It's possible that a new library was built during the compile.  If so, then the code
       -- we've just built is suspect, and it's better to just build it anew!
       checkVer <- baseVersion
       if ver == checkVer
         then return status
-        else compileProgram ctx basePath mode programId
+        else compileProgram ctx basePath mode
     _ -> return CompileAborted
 
-compileIncrementally :: Context -> FilePath -> BuildMode -> ProgramId -> Text -> IO CompileStatus
-compileIncrementally ctx basePath mode programId ver =
+compileIncrementally :: Context -> FilePath -> BuildMode -> Text -> IO CompileStatus
+compileIncrementally ctx basePath mode ver =
   compileSource stage source (projectModuleFinder (Just sourceDir) mode) extraExt result (getMode mode) False
   where
     sourceDir = basePath </> "source"
-    source = sourceDir </> sourceFile programId
-    target = basePath </> "build" </> targetFile programId
-    result = basePath </> "build" </> resultFile programId
+    source = sourceDir </> "program.hs"
+    target = basePath </> "build" </> "program.js"
+    result = basePath </> "build" </> "err.txt"
     baseURL = "runBaseJS?version=" ++ T.unpack ver
     stage = UseBase target (baseSymbolFile ver) baseURL
     extraExt = extraExtensions $ config ctx
@@ -400,14 +381,14 @@ compileIncrementally ctx basePath mode programId ver =
 projectModuleFinder :: Maybe FilePath -> BuildMode -> String -> IO (Maybe FilePath)
 projectModuleFinder mSourceDir mode modName
   | length modName /= 23 || '.' `elem` modName = return Nothing
-  | "P" `isPrefixOf` modName = go (ProgramId (T.pack modName))
+  | "P" `isPrefixOf` modName = go
   | otherwise = return Nothing
   where
-    go programId = do
+    go = do
       case mSourceDir of
         Nothing -> return Nothing
         Just sourceDir -> do 
-          let path = sourceDir </> sourceFile programId
+          let path = sourceDir </> "program.hs"
           exists <- doesFileExist path
           if exists then return (Just path) else return Nothing
 
diff --git a/codeworld-server/src/Util.hs b/codeworld-server/src/Util.hs
index 7255ed8a..88d3e958 100644
--- a/codeworld-server/src/Util.hs
+++ b/codeworld-server/src/Util.hs
@@ -18,287 +18,20 @@
 -}
 module Util where
 
-import Control.Exception
-import Control.Monad
-import qualified Crypto.Hash as Crypto
-import Data.Aeson
-import Data.ByteArray (convert)
-import Data.ByteString (ByteString)
-import qualified Data.ByteString as B
-import qualified Data.ByteString.Base64 as B64
-import qualified Data.ByteString.Lazy as LB
-import Data.List (sort, sortOn)
-import Data.Maybe
-import Data.Text (Text)
-import qualified Data.Text as T
-import qualified Data.Text.Encoding as T
-import qualified Data.Text.IO as T
-import Model
-import System.Directory
-import System.FilePath
-import System.IO.Error
-import System.Posix.Files
+import Data.Text (Text, unpack)
+import System.FilePath ((</>))
 
 newtype BuildMode = BuildMode String
   deriving (Eq)
 
-newtype ProgramId = ProgramId
-  { unProgramId :: Text
-  }
-  deriving (Eq)
-
-newtype ProjectId = ProjectId
-  { unProjectId :: Text
-  }
-  deriving (Eq)
-
-newtype DeployId = DeployId
-  { unDeployId :: Text
-  }
-  deriving (Eq)
-
-newtype DirId = DirId
-  { unDirId :: Text
-  }
-  deriving (Eq)
-
-newtype ShareId = ShareId
-  { unShareId :: Text
-  }
-  deriving (Eq)
-
 type BaseVersion = Text
 
-autocompletePath :: FilePath
-autocompletePath = "web/codeworld-base.txt"
-
-clientIdPath :: FilePath
-clientIdPath = "web/clientId.txt"
 
 baseRootDir :: FilePath
 baseRootDir = "data/base"
 
 baseCodeFile :: BaseVersion -> FilePath
-baseCodeFile ver = baseRootDir </> T.unpack ver </> "base.js"
+baseCodeFile ver = baseRootDir </> unpack ver </> "base.js"
 
 baseSymbolFile :: BaseVersion -> FilePath
-baseSymbolFile ver = baseRootDir </> T.unpack ver </> "base.symbs"
-
-sourceBase :: ProgramId -> FilePath
-sourceBase (ProgramId p) = T.unpack p
-
-sourceFile :: ProgramId -> FilePath
-sourceFile programId = sourceBase programId <.> "hs"
-
-sourceXML :: ProgramId -> FilePath
-sourceXML programId = sourceBase programId <.> "xml"
-
-targetFile :: ProgramId -> FilePath
-targetFile programId = sourceBase programId <.> "js"
-
-resultFile :: ProgramId -> FilePath
-resultFile programId = sourceBase programId <.> "err.txt"
-
-baseVersionFile :: ProgramId -> FilePath
-baseVersionFile programId = sourceBase programId <.> "basever"
-
-auxiliaryFiles :: ProgramId -> [FilePath]
-auxiliaryFiles programId =
-  [ sourceBase programId <.> "js_hi",
-    sourceBase programId <.> "js_o",
-    sourceBase programId <.> "jsexe" </> "index.html",
-    sourceBase programId <.> "jsexe" </> "lib.js",
-    sourceBase programId <.> "jsexe" </> "manifest.webapp",
-    sourceBase programId <.> "jsexe" </> "out.js",
-    sourceBase programId <.> "jsexe" </> "out.stats",
-    sourceBase programId <.> "jsexe" </> "rts.js",
-    sourceBase programId <.> "jsexe" </> "runmain.js"
-  ]
-
-deployLink :: DeployId -> FilePath
-deployLink (DeployId d) =
-  let s = T.unpack d
-   in take 3 s </> s
-
-shareLink :: ShareId -> FilePath
-shareLink (ShareId sh) =
-  let s = T.unpack sh
-   in take 3 s </> s
-
-projectBase :: ProjectId -> FilePath
-projectBase (ProjectId p) = T.unpack p
-
-projectFile :: ProjectId -> FilePath
-projectFile projectId = projectBase projectId <.> "cw"
-
-sourceToProgramId :: ByteString -> ProgramId
-sourceToProgramId = ProgramId . T.map dashToUnderscore . hashToId "P"
-
-sourceToDeployId :: ByteString -> DeployId
-sourceToDeployId = DeployId . T.map dashToUnderscore . hashToId "D" . ("DEPLOY_ID" <>)
-
-dashToUnderscore :: Char -> Char
-dashToUnderscore '-' = '_'
-dashToUnderscore c = c
-
-nameToProjectId :: Text -> ProjectId
-nameToProjectId = ProjectId . hashToId "S" . T.encodeUtf8
-
-dirBase :: DirId -> FilePath
-dirBase (DirId d) = T.unpack d
-
-nameToDirId :: Text -> DirId
-nameToDirId = DirId . hashToId "D" . T.encodeUtf8
-
-listDirectoryWithPrefix :: FilePath -> IO [FilePath]
-listDirectoryWithPrefix filePath = map (filePath </>) <$> listDirectory filePath
-
-listDirectoryWithPrefixRecursive :: FilePath -> IO [FilePath]
-listDirectoryWithPrefixRecursive filePath = do
-  subpaths <- map (filePath </>) <$> listDirectory filePath
-  dirs <- filterM doesDirectoryExist subpaths
-  subtrees <- mapM listDirectoryWithPrefixRecursive dirs
-  return $ subpaths ++ (concat subtrees)
-
-dirFilter :: [FilePath] -> Char -> [FilePath]
-dirFilter dirs char = filter (\x -> head (takeBaseName x) == char) dirs
-
-fsEntries :: Bool -> FilePath -> IO [FileSystemEntry]
-fsEntries recurse dir = do
-  subHashedDirs <- listDirectoryWithPrefix dir
-  let hashedFiles = dirFilter subHashedDirs 'S'
-      hashedDirs = dirFilter subHashedDirs 'D'
-  projNames <- sort <$> mapM projName hashedFiles
-  dirNames <- sort <$> catMaybes <$> mapM dirName hashedDirs
-  haveSavedOrderFile <- doesFileExist $ dir </> "order.info"
-  shallowResult <- case haveSavedOrderFile of
-    True -> do
-      dumpedEntries <- fromJust . decode <$> LB.readFile (dir </> "order.info")
-      let (dumpedDirs, dumpedProjects) = span (\x -> fsEntryType x == Dir) $ sortOn fsEntryType dumpedEntries
-          existingDirs = onlyExisting (sortOn fsEntryName dumpedDirs) dirNames
-          existingProjects = onlyExisting (sortOn fsEntryName dumpedProjects) projNames
-      return $
-        updateOrder Dir existingDirs dirNames
-          ++ updateOrder Proj existingProjects projNames
-    False -> return $ updateOrder Dir [] dirNames ++ updateOrder Proj [] projNames
-  if recurse then recurseInto shallowResult else return shallowResult
-  where
-    onlyExisting :: [FileSystemEntry] -> [Text] -> [FileSystemEntry]
-    onlyExisting dumped existing = filter (\d -> fsEntryName d `elem` existing) dumped
-    updateOrder :: FileSystemEntryType -> [FileSystemEntry] -> [Text] -> [FileSystemEntry]
-    updateOrder _ [] [] = []
-    updateOrder _ (_ : _) [] = []
-    updateOrder defType [] (name : names) = (FSEntry 0 name defType Nothing) : updateOrder defType [] names
-    updateOrder defType (entry@(FSEntry _ dumpedName _ _) : entries) (name : names)
-      | dumpedName == name = entry : updateOrder defType entries names
-      | otherwise = (FSEntry 0 name defType Nothing) : updateOrder defType (entry : entries) names
-    projName path = do
-      Just project <- decode <$> LB.readFile path
-      return $ projectName project
-    dirName path = do
-      hasInfo <- doesFileExist (path </> "dir.info")
-      if hasInfo then Just <$> T.readFile (path </> "dir.info") else return Nothing
-    recurseInto :: [FileSystemEntry] -> IO [FileSystemEntry]
-    recurseInto [] = return []
-    recurseInto (e : es) = (:) <$> expand e <*> recurseInto es
-    expand :: FileSystemEntry -> IO FileSystemEntry
-    expand (FSEntry i name Dir _) =
-      FSEntry i name Dir <$> Just <$> fsEntries True (dir </> dirBase (nameToDirId name))
-    expand otherEntry = return otherEntry
-
-projectFileNames :: FilePath -> IO [Text]
-projectFileNames dir = do
-  subHashedDirs <- listDirectoryWithPrefix dir
-  let hashedFiles = dirFilter subHashedDirs 'S'
-  projects <- fmap catMaybes
-    $ forM hashedFiles
-    $ \f -> do
-      exists <- doesFileExist f
-      if exists
-        then decode <$> LB.readFile f
-        else return Nothing
-  return $ map projectName projects
-
-projectDirNames :: FilePath -> IO [Text]
-projectDirNames dir = do
-  subHashedDirs <- listDirectoryWithPrefix dir
-  let hashedDirs = dirFilter subHashedDirs 'D'
-  dirNames <- mapM (\x -> T.readFile $ x </> "dir.info") hashedDirs
-  return dirNames
-
-
-isDir :: FilePath -> IO Bool
-isDir path = do
-  status <- getFileStatus path
-  return $ isDirectory status
-
-getFilesRecursive :: FilePath -> IO [FilePath]
-getFilesRecursive path = do
-  dirBool <- isDir path
-  case dirBool of
-    True -> do
-      contents <- listDirectory path
-      concat <$> mapM (getFilesRecursive . (path </>)) contents
-    False -> return [path]
-
-dirToCheckSum :: FilePath -> IO Text
-dirToCheckSum path = do
-  files <- getFilesRecursive path
-  fileContents <- mapM B.readFile files
-  let cryptoContext = Crypto.hashInitWith Crypto.MD5
-  return
-    $ (T.pack "F" <>)
-      . T.takeWhile (/= '=')
-      . T.map toWebSafe
-      . T.decodeUtf8
-      . B64.encode
-      . convert
-      . Crypto.hashFinalize
-      . Crypto.hashUpdates cryptoContext
-    $ fileContents
-  where
-    toWebSafe '/' = '_'
-    toWebSafe '+' = '-'
-    toWebSafe c = c
-
-hashToId :: Text -> ByteString -> Text
-hashToId pfx =
-  (pfx <>)
-    . T.takeWhile (/= '=')
-    . T.map toWebSafe
-    . T.decodeUtf8
-    . B64.encode
-    . convert
-    . Crypto.hashWith Crypto.MD5
-  where
-    toWebSafe '/' = '_'
-    toWebSafe '+' = '-'
-    toWebSafe c = c
-
-copyDirIfExists :: FilePath -> FilePath -> IO ()
-copyDirIfExists src dst = do
-  contents <- listDirectory src
-  dstExists <- doesDirectoryExist dst
-  when (not dstExists) $ createDirectoryIfMissing True dst
-  forM_ contents $ \f -> do
-    let srcPath = src </> f
-    let dstPath = dst </> f
-    isDir <- doesDirectoryExist srcPath
-    if isDir
-      then copyDirIfExists srcPath dstPath
-      else copyFile srcPath dstPath
-
-removeFileIfExists :: FilePath -> IO ()
-removeFileIfExists fileName = removeFile fileName `catch` handleExists
-  where
-    handleExists e
-      | isDoesNotExistError e = return ()
-      | otherwise = throwIO e
-
-removeDirectoryIfExists :: FilePath -> IO ()
-removeDirectoryIfExists dirName =
-  removeDirectoryRecursive dirName `catch` handleExists
-  where
-    handleExists e
-      | isDoesNotExistError e = return ()
-      | otherwise = throwIO e
+baseSymbolFile ver = baseRootDir </> unpack ver </> "base.symbs"

From bf8f33680f334b45f2df03c471806096221bd904 Mon Sep 17 00:00:00 2001
From: nimec01 <24428341+nimec01@users.noreply.github.com>
Date: Wed, 22 Apr 2026 13:17:50 +0200
Subject: [PATCH 03/14] adapt JS scripts to latest changes

---
 web/js/codeworld.js        | 74 ++++++++++++++------------------------
 web/js/codeworld_shared.js | 10 ++++++
 web/js/run.js              |  2 +-
 3 files changed, 37 insertions(+), 49 deletions(-)

diff --git a/web/js/codeworld.js b/web/js/codeworld.js
index f3057032..144297d2 100644
--- a/web/js/codeworld.js
+++ b/web/js/codeworld.js
@@ -30,6 +30,7 @@ import {
   run,
   toggleObsoleteCodeAlert,
   warnIfUnsaved,
+  sha256digest,
 } from './codeworld_shared.js';
 
 import * as Alert from './utils/alert.js';
@@ -177,22 +178,10 @@ async function init() {
   if(window.buildMode === 'codeworld')
     document.querySelector("#docButton").style.display = "none";
 
-  let hash = location.hash.slice(1);
-  if (hash.length > 0) {
-    if (hash.slice(-2) === '==') {
-      hash = hash.slice(0, -2);
-    }
-  }
+  const savedCode = localStorage.getItem(`${window.buildMode}-${window.location.hash.slice(1)}`);
 
-  if (hash.length > 0) {
-    if (hash.slice(-2) === '==') {
-      hash = hash.slice(0, -2);
-    }
-    if (hash[0] === 'P') {
-      setCode(localStorage.getItem(`${window.buildMode}-${hash}`) || '');
-    } else if (hash[0] !== 'F') {
-      setCode('');
-    }
+  if (savedCode) {
+    setCode(savedCode);
   } else {
     if(window.buildMode === "codeworld") setCode(`import Prelude hiding (rotated, translated, colored, lettering,
                        scaled, polyline, Text, Number)
@@ -1013,52 +1002,41 @@ function compile() {
     stopRun();
   });
 
-  sendHttp('POST', 'compile', data, (request) => {
+  sendHttp('POST', 'compile', data, async (request) => {
     if (compileFinished) return;
 
     const { status, responseText } = request;
 
     window.cancelCompile();
 
-    const success = status === 200;
     const parts = responseText.split('\n=======================\n')
 
-    let hash, dhash, msg;
-    if (status < 500) {
-      if (responseText.length === 23) {
-        // will not happen
-	      hash = responseText;
-        dhash = null;
-      } else {	
-        try {
-          hash = parts[0];
-          dhash = parts[1];
-          msg = parts[2];
-          if(msg) {
-              msg = msg.replace(/^[\r\n]+|[\r\n]+$/g, '');
-          } else {
-            msg = 'Sorry!  Your program couldn\'t be run right now.';
-          }
+    if(status < 500) {
 
-          window.program = parts[3];
-          run(hash,dhash,msg,false,compileGeneration);
-          localStorage.setItem(`${window.buildMode}-${hash}`, window.codeworldEditor.getValue());
-        } catch (e) {
-          hash = '';
-        }
+      const compilerMessage = parts[0];
+      let compiledProgram = parts[1];
+
+      if(!compilerMessage) {
+        compilerMessage = 'Sorry!  Your program couldn\'t be run right now.';
       }
-    }
 
-    if (!hash) {
-      sweetAlert({
-        title: Alert.title('Could not compile'),
-        text: 'The compiler is unavailable.  Please try again later.',
-        type: 'error',
-      });
-      return;
-    } else {
+      const codeHash = await sha256digest(src.trim());
+
+      window.program = compiledProgram;
+      run(codeHash,"deploy_hash",compilerMessage,false,compileGeneration);
+      localStorage.setItem(`${window.buildMode}-${codeHash}`, src);
+
+
       sweetAlert.close();
+      return;
     }
+
+    sweetAlert({
+      title: Alert.title('Could not compile'),
+      text: 'The compiler is unavailable.  Please try again later.',
+      type: 'error',
+    });
+
   });
 }
 
diff --git a/web/js/codeworld_shared.js b/web/js/codeworld_shared.js
index e2942e1d..1d7833ea 100644
--- a/web/js/codeworld_shared.js
+++ b/web/js/codeworld_shared.js
@@ -1110,6 +1110,15 @@ function parseCompileErrors(rawErrors) {
   return errors;
 }
 
+async function sha256digest(data) {
+  const buffer = new TextEncoder().encode(data);
+  return await crypto.subtle.digest('SHA-256', buffer).then((hash) => {
+    return Array.from(new Uint8Array(hash))
+      .map((b) => b.toString(16).padStart(2, '0'))
+      .join('');
+  });
+}
+
 export {
   clearMessages,
   definePanelExtension,
@@ -1126,4 +1135,5 @@ export {
   run,
   toggleObsoleteCodeAlert,
   warnIfUnsaved,
+  sha256digest,
 };
diff --git a/web/js/run.js b/web/js/run.js
index 1fab8e5a..3800f43f 100644
--- a/web/js/run.js
+++ b/web/js/run.js
@@ -275,7 +275,7 @@ async function init() {
         const { status, responseText } = request;
         if(status < 500) {
           const parts = responseText.split('\n=======================\n');
-          const program = parts[3];
+          const program = parts[1];
           const loadScript = document.createElement('script');
           loadScript.setAttribute('type', 'text/javascript');
           loadScript.innerHTML = program;

From 7e76661219cb51d023eccf0a409df13eb8a29222 Mon Sep 17 00:00:00 2001
From: nimec01 <24428341+nimec01@users.noreply.github.com>
Date: Wed, 22 Apr 2026 14:06:46 +0200
Subject: [PATCH 04/14] use explicit import list; remove aeson dependency

---
 codeworld-server/codeworld-server.cabal |  1 -
 codeworld-server/src/Main.hs            | 54 ++++++++++++-------------
 2 files changed, 26 insertions(+), 29 deletions(-)

diff --git a/codeworld-server/codeworld-server.cabal b/codeworld-server/codeworld-server.cabal
index 95f3881b..f77abdc9 100644
--- a/codeworld-server/codeworld-server.cabal
+++ b/codeworld-server/codeworld-server.cabal
@@ -18,7 +18,6 @@ Executable codeworld-server
   Other-modules: Util, Config
 
   Build-depends:
-    aeson,
     base,
     bytestring,
     codeworld-compiler,
diff --git a/codeworld-server/src/Main.hs b/codeworld-server/src/Main.hs
index 38f2a14a..0945f09d 100644
--- a/codeworld-server/src/Main.hs
+++ b/codeworld-server/src/Main.hs
@@ -25,45 +25,43 @@
 -}
 module Main where
 
-import CodeWorld.Compile
-import CodeWorld.Compile.Base
-import Config
-import Control.Applicative
+import CodeWorld.Compile (CompileStatus (..), Stage (..), compileSource)
+import CodeWorld.Compile.Base (baseVersion, generateBaseBundle)
+import Config (CompilerConfig (..), Config (..), PreviewConfig (..), loadConfig)
+import Control.Applicative ((<|>))
 import Control.Concurrent (forkIO)
 import Control.Concurrent.MSem (MSem)
-import qualified Control.Concurrent.MSem as MSem
+import qualified Control.Concurrent.MSem as MSem (new, peekAvail, with)
 import Control.Exception (SomeException, bracket_, catch)
 import qualified Control.Exception.Lifted as CE (catch)
-import Control.Monad
-import Control.Monad.Trans
-import Data.Aeson
-import qualified Data.ByteString as B
+import Control.Monad (when)
+import Control.Monad.Trans (liftIO)
+import qualified Data.ByteString as B (ByteString, empty, hPutStr, readFile, writeFile)
 import Data.ByteString.Builder (toLazyByteString)
-import qualified Data.ByteString.Lazy as LB
+import qualified Data.ByteString.Lazy as LB (fromStrict)
 import Data.Char (isSpace)
-import Data.List
+import Data.List (isPrefixOf)
 import Data.List.Extra (replace)
-import qualified Data.Map as M
-import Data.Maybe
-import Data.Monoid
+import qualified Data.Map as M (Map, lookup)
+import Data.Maybe (mapMaybe)
 import Data.Text (Text)
-import qualified Data.Text as T
-import qualified Data.Text.Encoding as T
-import qualified Data.Text.IO as T
+import qualified Data.Text as T (drop, intercalate, lines, pack, splitAt, splitOn, unlines, unpack)
+import qualified Data.Text.Encoding as T (decodeUtf8, encodeUtf8)
+import qualified Data.Text.IO as T (writeFile)
 import Ormolu (OrmoluException, defaultConfig, ormolu)
-import Snap.Core
-import Snap.Http.Server (httpServe, ConfigLog (ConfigIoLog))
-import qualified Snap.Http.Server.Config as S (commandLineConfig, defaultConfig, setPort, setErrorLog)
-import Snap.Util.FileServe
-import Snap.Util.FileUploads
-import System.Directory
-import System.FilePath
-import System.IO (hPutStrLn, stderr)
-import System.IO.Temp
+import Snap.Core (Snap, addHeader, getParam, modifyRequest, modifyResponse, redirect, route, setContentType, setResponseCode, writeBS, writeLBS)
+import Snap.Http.Server (ConfigLog (ConfigIoLog), httpServe)
+import qualified Snap.Http.Server.Config as S (commandLineConfig, defaultConfig, setErrorLog, setPort)
+import Snap.Util.FileServe (DirectoryConfig (..), defaultDirectoryConfig, serveDirectory, serveFile)
+import Snap.Util.FileUploads (UploadPolicy, defaultUploadPolicy, handleMultipart, setMaximumFormInputSize)
+import System.Directory (createDirectoryIfMissing, doesFileExist)
 import System.Environment (lookupEnv)
-import Util
+import System.FilePath ((</>))
+import System.IO (hPutStrLn, stderr)
+import System.IO.Temp (withSystemTempDirectory)
 import Text.Read (readMaybe)
-import Text.Regex.TDFA
+import Text.Regex.TDFA (getAllMatches, (=~))
+import Util (BuildMode (..), baseCodeFile, baseSymbolFile)
 
 data Context = Context
   { compileSem :: MSem Int,

From cf39a6170ac32e4c18e6f3ab0d6046214eb69a47 Mon Sep 17 00:00:00 2001
From: nimec01 <24428341+nimec01@users.noreply.github.com>
Date: Wed, 22 Apr 2026 14:11:28 +0200
Subject: [PATCH 05/14] remove some ghc options

---
 codeworld-server/src/Main.hs | 5 +----
 codeworld-server/src/Util.hs | 1 -
 2 files changed, 1 insertion(+), 5 deletions(-)

diff --git a/codeworld-server/src/Main.hs b/codeworld-server/src/Main.hs
index 0945f09d..37ba7c38 100644
--- a/codeworld-server/src/Main.hs
+++ b/codeworld-server/src/Main.hs
@@ -3,10 +3,7 @@
 {-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# OPTIONS_GHC -fno-warn-incomplete-patterns
-    -fno-warn-name-shadowing
-    -fno-warn-unused-imports
-    -fno-warn-unused-matches #-}
+
 
 {-
   Copyright 2020 The CodeWorld Authors. All rights reserved.
diff --git a/codeworld-server/src/Util.hs b/codeworld-server/src/Util.hs
index 88d3e958..bb126188 100644
--- a/codeworld-server/src/Util.hs
+++ b/codeworld-server/src/Util.hs
@@ -1,5 +1,4 @@
 {-# LANGUAGE OverloadedStrings #-}
-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
 
 {-
   Copyright 2020 The CodeWorld Authors. All rights reserved.

From 9976f164aaeb2c6abe313bdd2875d6a4961f8140 Mon Sep 17 00:00:00 2001
From: nimec01 <24428341+nimec01@users.noreply.github.com>
Date: Wed, 22 Apr 2026 14:19:38 +0200
Subject: [PATCH 06/14] fix warnings

---
 codeworld-server/src/Main.hs | 48 +++++++++++++++---------------------
 1 file changed, 20 insertions(+), 28 deletions(-)

diff --git a/codeworld-server/src/Main.hs b/codeworld-server/src/Main.hs
index 37ba7c38..f279b038 100644
--- a/codeworld-server/src/Main.hs
+++ b/codeworld-server/src/Main.hs
@@ -29,14 +29,12 @@ import Control.Applicative ((<|>))
 import Control.Concurrent (forkIO)
 import Control.Concurrent.MSem (MSem)
 import qualified Control.Concurrent.MSem as MSem (new, peekAvail, with)
-import Control.Exception (SomeException, bracket_, catch)
+import Control.Exception (SomeException, catch)
 import qualified Control.Exception.Lifted as CE (catch)
 import Control.Monad (when)
 import Control.Monad.Trans (liftIO)
 import qualified Data.ByteString as B (ByteString, empty, hPutStr, readFile, writeFile)
-import Data.ByteString.Builder (toLazyByteString)
 import qualified Data.ByteString.Lazy as LB (fromStrict)
-import Data.Char (isSpace)
 import Data.List (isPrefixOf)
 import Data.List.Extra (replace)
 import qualified Data.Map as M (Map, lookup)
@@ -76,9 +74,9 @@ main = do
   ctx <- makeContext cfg
   port <- maybe Nothing readMaybe <$> lookupEnv "PORT" :: IO (Maybe Int)
   let customDefaultConfig = S.setErrorLog customErrorLog ((maybe id (\p -> S.setPort p) port) S.defaultConfig)
-  cfg <- S.commandLineConfig customDefaultConfig
+  snapCfg <- S.commandLineConfig customDefaultConfig
   forkIO $ baseVersion >>= buildBaseIfNeeded ctx >> return ()
-  httpServe cfg $ (processBody >> site ctx) <|> site ctx
+  httpServe snapCfg $ (processBody >> site ctx) <|> site ctx
 
 makeContext :: Config -> IO Context
 makeContext cfg = do
@@ -104,12 +102,12 @@ codeworldUploadPolicy =
 #if MIN_VERSION_snap_core(1,0,0)
 processBody :: Snap ()
 processBody = do
-    handleMultipart codeworldUploadPolicy (\x y -> return ())
+    handleMultipart codeworldUploadPolicy (\_ _ -> return ())
     return ()
 #else
 processBody :: Snap ()
 processBody = do
-    handleMultipart codeworldUploadPolicy (\x -> return ())
+    handleMultipart codeworldUploadPolicy (\_ -> return ())
     return ()
 #endif
 
@@ -177,22 +175,22 @@ runCompile ctx mode source = withSystemTempDirectory "codeworld" $ \tempDir -> d
       _ -> pure (status, Left "Something went wrong")
 
 replaceUndefinedWithHole :: Text -> (Int, Text)
-replaceUndefinedWithHole txt = (length matches, replace matches 0 txt)
+replaceUndefinedWithHole txt = (length matches, replaceFn matches 0 txt)
   where
     undefinedRegex = "\\bundefined\\b" :: Text
     matches = getAllMatches (txt =~ undefinedRegex) :: [(Int,Int)]
 
-    replace [] _ t = t
-    replace ((targetIndex,_):xs) cursor t = 
+    replaceFn [] _ t = t
+    replaceFn ((targetIndex,_):xs) cursor t = 
       let (before, rest) = T.splitAt (targetIndex - cursor) t
-       in before <> "_" <> replace xs (targetIndex + 9) (T.drop 9 rest)
+       in before <> "_" <> replaceFn xs (targetIndex + 9) (T.drop 9 rest)
 
 replaceHolesWithDefaultValue :: [(Int,Int,Text)] -> M.Map Text Text -> Text -> Maybe Text
-replaceHolesWithDefaultValue holes defaults input = T.unlines <$> replaceHolesInLines lines
+replaceHolesWithDefaultValue holes defaults input = T.unlines <$> replaceHolesInLines codeLines
   where 
-    lines = zip [1 :: Int ..] $ T.lines input
+    codeLines = zip [1 :: Int ..] $ T.lines input
 
-    replaceHolesInLines lines = traverse (\(num,line) -> replaceHolesInLine (filter (\(r,_,_) -> r == num) holes) 1 line) lines
+    replaceHolesInLines codeLines' = traverse (\(num,line) -> replaceHolesInLine (filter (\(r,_,_) -> r == num) holes) 1 line) codeLines'
 
     replaceHolesInLine [] _ line = Just line
     replaceHolesInLine ((_,c,ty):xs) cursor line = 
@@ -204,8 +202,8 @@ replaceHolesWithDefaultValue holes defaults input = T.unlines <$> replaceHolesIn
           pure $ before <> "(" <> defaultValue <> ")" <> newRest
 
 extractHolesFromErrorText :: Text -> [(Int,Int,Text)]
-extractHolesFromErrorText error =
-  let errorSplit = T.splitOn "\n\n" error
+extractHolesFromErrorText err =
+  let errorSplit = T.splitOn "\n\n" err
       regex = "^program\\.hs:([[:digit:]]+):([[:digit:]]+): error:[[:cntrl:]] +[^F]+Found hole: _ :: ([[:print:]]+)[[:cntrl:]]" :: Text
       matches = concatMap (\block -> block =~ regex :: [[Text]]) errorSplit
       textToInt = read . T.unpack
@@ -234,9 +232,9 @@ compileHandler ctx = do
       let (replaceCount, sourceWithHolePlaceholders) = replaceUndefinedWithHole source
       assert $ replaceCount > 0
 
-      (_,Left error) <- runCompile ctx mode sourceWithHolePlaceholders
+      (_,Left err) <- runCompile ctx mode sourceWithHolePlaceholders
 
-      let holes = extractHolesFromErrorText error
+      let holes = extractHolesFromErrorText err
           replacementMap = defaultHoleValues previewConf
           Just withDefaultValues = replaceHolesWithDefaultValue holes replacementMap source
 
@@ -268,17 +266,12 @@ errorCheckHandler ctx = do
 runBaseHandler :: CodeWorldHandler
 runBaseHandler ctx = do
   maybeVer <- fmap T.decodeUtf8 <$> getParam "version"
-  hasProgram <-
-    (\mode hash dhash -> mode && (hash || dhash))
-      <$> hasParam "mode" <*> hasParam "hash" <*> hasParam "dhash"
   case maybeVer of
     Just ver -> serveFile (baseCodeFile ver)
     Nothing -> do
       ver <- liftIO baseVersion
       liftIO $ buildBaseIfNeeded ctx ver
       serveFile (baseCodeFile ver)
-  where
-    hasParam name = (/= Nothing) <$> getParam name
 
 escapeCode :: String -> String
 escapeCode input = foldr
@@ -290,7 +283,7 @@ escapeCode input = foldr
     toBeEscaped = ["${","`"]
 
 serveEditor :: CodeWorldHandler
-serveEditor ctx = do
+serveEditor _ = do
   msource <- getParam "source"
   modifyResponse $ setContentType "text/html"
   template <- liftIO $ readFile "web/env.html"
@@ -299,8 +292,7 @@ serveEditor ctx = do
   writeBS $ T.encodeUtf8 $ T.pack content
 
 indentHandler :: CodeWorldHandler
-indentHandler ctx = do
-  mode <- getBuildMode
+indentHandler _ = do
   Just source <- getParam "source"
   reformat source `CE.catch` handleError
   where
@@ -313,7 +305,7 @@ indentHandler ctx = do
       writeLBS $ LB.fromStrict $ T.encodeUtf8 $ T.pack (show e)
 
 runHandler :: CodeWorldHandler
-runHandler ctx = do
+runHandler _ = do
   msource <- getParam "source"
   modifyResponse $ setContentType "text/html"
   template <- liftIO $ readFile "web/run.html"
@@ -374,7 +366,7 @@ compileIncrementally ctx basePath mode ver =
     extraExt = extraExtensions $ config ctx
 
 projectModuleFinder :: Maybe FilePath -> BuildMode -> String -> IO (Maybe FilePath)
-projectModuleFinder mSourceDir mode modName
+projectModuleFinder mSourceDir _ modName
   | length modName /= 23 || '.' `elem` modName = return Nothing
   | "P" `isPrefixOf` modName = go
   | otherwise = return Nothing

From 2def195824f2e278d67ee0b0675cceca39388c6b Mon Sep 17 00:00:00 2001
From: nimec01 <24428341+nimec01@users.noreply.github.com>
Date: Wed, 22 Apr 2026 14:25:49 +0200
Subject: [PATCH 07/14] remove unused function

---
 codeworld-server/src/Main.hs | 12 ++----------
 1 file changed, 2 insertions(+), 10 deletions(-)

diff --git a/codeworld-server/src/Main.hs b/codeworld-server/src/Main.hs
index f279b038..d89dbbd5 100644
--- a/codeworld-server/src/Main.hs
+++ b/codeworld-server/src/Main.hs
@@ -44,10 +44,10 @@ import qualified Data.Text as T (drop, intercalate, lines, pack, splitAt, splitO
 import qualified Data.Text.Encoding as T (decodeUtf8, encodeUtf8)
 import qualified Data.Text.IO as T (writeFile)
 import Ormolu (OrmoluException, defaultConfig, ormolu)
-import Snap.Core (Snap, addHeader, getParam, modifyRequest, modifyResponse, redirect, route, setContentType, setResponseCode, writeBS, writeLBS)
+import Snap.Core (Snap, getParam, modifyResponse, redirect, route, setContentType, setResponseCode, writeBS, writeLBS)
 import Snap.Http.Server (ConfigLog (ConfigIoLog), httpServe)
 import qualified Snap.Http.Server.Config as S (commandLineConfig, defaultConfig, setErrorLog, setPort)
-import Snap.Util.FileServe (DirectoryConfig (..), defaultDirectoryConfig, serveDirectory, serveFile)
+import Snap.Util.FileServe (serveDirectory, serveFile)
 import Snap.Util.FileUploads (UploadPolicy, defaultUploadPolicy, handleMultipart, setMaximumFormInputSize)
 import System.Directory (createDirectoryIfMissing, doesFileExist)
 import System.Environment (lookupEnv)
@@ -143,14 +143,6 @@ tryOr :: a -> IO a -> IO a
 tryOr fallback action = 
   catch action (\(_ :: SomeException) -> pure fallback)
 
--- A DirectoryConfig that sets the cache-control header to avoid errors when new
--- changes are made to JavaScript.
-dirConfig :: DirectoryConfig Snap
-dirConfig = defaultDirectoryConfig {preServeHook = disableCache}
-  where
-    disableCache _ = modifyRequest (addHeader "Cache-control" "no-cache")
-
-
 runCompile :: Context -> BuildMode -> Text -> IO (CompileStatus, Either Text (Text,Text))
 runCompile ctx mode source = withSystemTempDirectory "codeworld" $ \tempDir -> do
     let sourceDir = tempDir </> "source"

From e555d938c90300f739814bd0dc6baf431b9571ff Mon Sep 17 00:00:00 2001
From: nimec01 <24428341+nimec01@users.noreply.github.com>
Date: Wed, 22 Apr 2026 14:34:28 +0200
Subject: [PATCH 08/14] inline remaining Util module

---
 codeworld-server/codeworld-server.cabal |  2 +-
 codeworld-server/src/Main.hs            | 17 +++++++-----
 codeworld-server/src/Util.hs            | 36 -------------------------
 3 files changed, 11 insertions(+), 44 deletions(-)
 delete mode 100644 codeworld-server/src/Util.hs

diff --git a/codeworld-server/codeworld-server.cabal b/codeworld-server/codeworld-server.cabal
index f77abdc9..dfb909ae 100644
--- a/codeworld-server/codeworld-server.cabal
+++ b/codeworld-server/codeworld-server.cabal
@@ -15,7 +15,7 @@ Description:
 Executable codeworld-server
   Hs-source-dirs: src
   Main-is: Main.hs
-  Other-modules: Util, Config
+  Other-modules: Config
 
   Build-depends:
     base,
diff --git a/codeworld-server/src/Main.hs b/codeworld-server/src/Main.hs
index d89dbbd5..6b16ed86 100644
--- a/codeworld-server/src/Main.hs
+++ b/codeworld-server/src/Main.hs
@@ -56,7 +56,10 @@ import System.IO (hPutStrLn, stderr)
 import System.IO.Temp (withSystemTempDirectory)
 import Text.Read (readMaybe)
 import Text.Regex.TDFA (getAllMatches, (=~))
-import Util (BuildMode (..), baseCodeFile, baseSymbolFile)
+
+
+newtype BuildMode = BuildMode String
+  deriving (Eq)
 
 data Context = Context
   { compileSem :: MSem Int,
@@ -259,11 +262,11 @@ runBaseHandler :: CodeWorldHandler
 runBaseHandler ctx = do
   maybeVer <- fmap T.decodeUtf8 <$> getParam "version"
   case maybeVer of
-    Just ver -> serveFile (baseCodeFile ver)
+    Just ver -> serveFile ("data/base" </> T.unpack ver </> "base.js")
     Nothing -> do
       ver <- liftIO baseVersion
       liftIO $ buildBaseIfNeeded ctx ver
-      serveFile (baseCodeFile ver)
+      serveFile ("data/base" </> T.unpack ver </> "base.js")
 
 escapeCode :: String -> String
 escapeCode input = foldr
@@ -354,7 +357,7 @@ compileIncrementally ctx basePath mode ver =
     target = basePath </> "build" </> "program.js"
     result = basePath </> "build" </> "err.txt"
     baseURL = "runBaseJS?version=" ++ T.unpack ver
-    stage = UseBase target (baseSymbolFile ver) baseURL
+    stage = UseBase target ("data/base" </> T.unpack ver </> "base.symbs") baseURL
     extraExt = extraExtensions $ config ctx
 
 projectModuleFinder :: Maybe FilePath -> BuildMode -> String -> IO (Maybe FilePath)
@@ -376,15 +379,15 @@ noModuleFinder _ = return Nothing
 
 buildBaseIfNeeded :: Context -> Text -> IO CompileStatus
 buildBaseIfNeeded ctx ver = do
-  codeExists <- doesFileExist (baseCodeFile ver)
-  symbolsExist <- doesFileExist (baseSymbolFile ver)
+  codeExists <- doesFileExist ("data/base" </> T.unpack ver </> "base.js")
+  symbolsExist <- doesFileExist ("data/base" </> T.unpack ver </> "base.symbs")
   if not codeExists || not symbolsExist
     then waitAndLogExhausted "Base" (baseSem ctx) $ withSystemTempDirectory "genbase" $ \tmpdir -> do
       let linkMain = tmpdir </> "LinkMain.hs"
       let linkBase = tmpdir </> "LinkBase.hs"
       let err = tmpdir </> "output.txt"
       generateBaseBundle basePaths baseIgnore "codeworld" linkMain linkBase
-      let stage = GenBase "LinkBase" linkBase (baseCodeFile ver) (baseSymbolFile ver)
+      let stage = GenBase "LinkBase" linkBase ("data/base" </> T.unpack ver </> "base.js") ("data/base" </> T.unpack ver </> "base.symbs")
       let extraExt = extraExtensions $ config ctx
       compileSource stage linkMain noModuleFinder extraExt err "codeworld" False
     else return CompileSuccess
diff --git a/codeworld-server/src/Util.hs b/codeworld-server/src/Util.hs
deleted file mode 100644
index bb126188..00000000
--- a/codeworld-server/src/Util.hs
+++ /dev/null
@@ -1,36 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-{-
-  Copyright 2020 The CodeWorld Authors. All rights reserved.
-
-  Licensed under the Apache License, Version 2.0 (the "License");
-  you may not use this file except in compliance with the License.
-  You may obtain a copy of the License at
-
-      http://www.apache.org/licenses/LICENSE-2.0
-
-  Unless required by applicable law or agreed to in writing, software
-  distributed under the License is distributed on an "AS IS" BASIS,
-  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-  See the License for the specific language governing permissions and
-  limitations under the License.
--}
-module Util where
-
-import Data.Text (Text, unpack)
-import System.FilePath ((</>))
-
-newtype BuildMode = BuildMode String
-  deriving (Eq)
-
-type BaseVersion = Text
-
-
-baseRootDir :: FilePath
-baseRootDir = "data/base"
-
-baseCodeFile :: BaseVersion -> FilePath
-baseCodeFile ver = baseRootDir </> unpack ver </> "base.js"
-
-baseSymbolFile :: BaseVersion -> FilePath
-baseSymbolFile ver = baseRootDir </> unpack ver </> "base.symbs"

From 39520682d63cc2d152f97827e26280c22e721173 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Janis=20Voigtl=C3=A4nder?=
 <jvoigtlaender@users.noreply.github.com>
Date: Wed, 22 Apr 2026 16:35:21 +0200
Subject: [PATCH 09/14] Remove unnecessary blank line in Main.hs

---
 codeworld-server/src/Main.hs | 1 -
 1 file changed, 1 deletion(-)

diff --git a/codeworld-server/src/Main.hs b/codeworld-server/src/Main.hs
index 6b16ed86..19919755 100644
--- a/codeworld-server/src/Main.hs
+++ b/codeworld-server/src/Main.hs
@@ -4,7 +4,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
-
 {-
   Copyright 2020 The CodeWorld Authors. All rights reserved.
 

From 0206eeae8334e84012095048668a70938d839fbb Mon Sep 17 00:00:00 2001
From: nimec01 <24428341+nimec01@users.noreply.github.com>
Date: Wed, 29 Apr 2026 10:29:13 +0200
Subject: [PATCH 10/14] refactor projectModuleFinder

---
 codeworld-server/src/Main.hs | 16 +++-------------
 1 file changed, 3 insertions(+), 13 deletions(-)

diff --git a/codeworld-server/src/Main.hs b/codeworld-server/src/Main.hs
index 19919755..2fa376bd 100644
--- a/codeworld-server/src/Main.hs
+++ b/codeworld-server/src/Main.hs
@@ -34,7 +34,6 @@ import Control.Monad (when)
 import Control.Monad.Trans (liftIO)
 import qualified Data.ByteString as B (ByteString, empty, hPutStr, readFile, writeFile)
 import qualified Data.ByteString.Lazy as LB (fromStrict)
-import Data.List (isPrefixOf)
 import Data.List.Extra (replace)
 import qualified Data.Map as M (Map, lookup)
 import Data.Maybe (mapMaybe)
@@ -359,19 +358,10 @@ compileIncrementally ctx basePath mode ver =
     stage = UseBase target ("data/base" </> T.unpack ver </> "base.symbs") baseURL
     extraExt = extraExtensions $ config ctx
 
+-- This function was originally used to allow importing shared programs via its deploy id.
+-- We don't use this feature.
 projectModuleFinder :: Maybe FilePath -> BuildMode -> String -> IO (Maybe FilePath)
-projectModuleFinder mSourceDir _ modName
-  | length modName /= 23 || '.' `elem` modName = return Nothing
-  | "P" `isPrefixOf` modName = go
-  | otherwise = return Nothing
-  where
-    go = do
-      case mSourceDir of
-        Nothing -> return Nothing
-        Just sourceDir -> do 
-          let path = sourceDir </> "program.hs"
-          exists <- doesFileExist path
-          if exists then return (Just path) else return Nothing
+projectModuleFinder _ _ _ = pure Nothing
 
 noModuleFinder :: String -> IO (Maybe FilePath)
 noModuleFinder _ = return Nothing

From cfd179a45321de870f62c289afed0b47ed498df7 Mon Sep 17 00:00:00 2001
From: nimec01 <24428341+nimec01@users.noreply.github.com>
Date: Wed, 29 Apr 2026 10:43:18 +0200
Subject: [PATCH 11/14] Only show result in runner when compilation was
 successful

---
 web/js/run.js | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/web/js/run.js b/web/js/run.js
index 3800f43f..6fe7da80 100644
--- a/web/js/run.js
+++ b/web/js/run.js
@@ -273,7 +273,7 @@ async function init() {
       
       sendHttp('POST', 'compile', data, (request) => {
         const { status, responseText } = request;
-        if(status < 500) {
+        if(status === 200) {
           const parts = responseText.split('\n=======================\n');
           const program = parts[1];
           const loadScript = document.createElement('script');

From bfecd34698767a963c6ae18a83c8fd499b2c7e25 Mon Sep 17 00:00:00 2001
From: nimec01 <24428341+nimec01@users.noreply.github.com>
Date: Wed, 29 Apr 2026 10:44:20 +0200
Subject: [PATCH 12/14] fix const reassigning

---
 web/js/codeworld.js | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/web/js/codeworld.js b/web/js/codeworld.js
index 144297d2..b5dbdbef 100644
--- a/web/js/codeworld.js
+++ b/web/js/codeworld.js
@@ -1013,8 +1013,8 @@ function compile() {
 
     if(status < 500) {
 
-      const compilerMessage = parts[0];
-      let compiledProgram = parts[1];
+      let compilerMessage = parts[0];
+      const compiledProgram = parts[1];
 
       if(!compilerMessage) {
         compilerMessage = 'Sorry!  Your program couldn\'t be run right now.';

From 9192af25de7023c8f1858505746fc8c08b72d548 Mon Sep 17 00:00:00 2001
From: nimec01 <24428341+nimec01@users.noreply.github.com>
Date: Wed, 29 Apr 2026 10:46:25 +0200
Subject: [PATCH 13/14] simplify run function

---
 web/js/codeworld_shared.js | 28 +++-------------------------
 1 file changed, 3 insertions(+), 25 deletions(-)

diff --git a/web/js/codeworld_shared.js b/web/js/codeworld_shared.js
index 1d7833ea..b1451df8 100644
--- a/web/js/codeworld_shared.js
+++ b/web/js/codeworld_shared.js
@@ -967,38 +967,18 @@ function run(hash, dhash, msg, error, generation) {
 
   if (hash) {
     window.location.hash = `#${hash}`;
-    // document.getElementById('shareButton').style.display = '';
   }
 
-  if (dhash) {
-    // const loc = `run.html?dhash=${dhash}&mode=${window.buildMode}`;
-    const loc = `run?mode=${window.buildMode}`;
-    runner.contentWindow.location.replace(loc);
-    if (
-      Boolean(navigator.mediaDevices) &&
-      Boolean(navigator.mediaDevices.getUserMedia)
-    ) {
-      document.getElementById('startRecButton').style.display = '';
-    }
-  } else {
-    runner.contentWindow.location.replace('about:blank');
-    document.getElementById('runner').style.display = 'none';
-    document.getElementById('startRecButton').style.display = 'none';
-  }
+  runner.contentWindow.location.replace(`run?mode=${window.buildMode}`);
+  document.getElementById('runner').style.display = 'none';
+  document.getElementById('startRecButton').style.display = 'none';
 
-  // const $shareFolderButton = $('#shareFolderButton');
   const layoutHandler = $(LAYOUT_CONTAINER_CLASSNAME).layout();
 
   if (hash || msg) {
-    // $shareFolderButton.hide();
-
     layoutHandler.show('east');
     layoutHandler.open('east');
   } else {
-    // if ($shareFolderButton.css('display') !== 'none') {
-    //   $shareFolderButton.show();
-    // }
-
     layoutHandler.hide('east');
   }
 
@@ -1009,8 +989,6 @@ function run(hash, dhash, msg, error, generation) {
   });
 
   if (error) markFailed();
-
-  window.deployHash = dhash;
 }
 
 function toggleObsoleteCodeAlert() {

From 78fd6cacb8eef973e37e3660de541150b73393fe Mon Sep 17 00:00:00 2001
From: nimec01 <24428341+nimec01@users.noreply.github.com>
Date: Wed, 29 Apr 2026 16:00:23 +0200
Subject: [PATCH 14/14] improve error messages related to required parameters

---
 codeworld-server/src/Main.hs | 20 ++++++++++++++------
 1 file changed, 14 insertions(+), 6 deletions(-)

diff --git a/codeworld-server/src/Main.hs b/codeworld-server/src/Main.hs
index 2fa376bd..48f4f586 100644
--- a/codeworld-server/src/Main.hs
+++ b/codeworld-server/src/Main.hs
@@ -144,6 +144,16 @@ tryOr :: a -> IO a -> IO a
 tryOr fallback action = 
   catch action (\(_ :: SomeException) -> pure fallback)
 
+withRequiredParam :: B.ByteString -> (B.ByteString -> Snap ()) -> Snap ()
+withRequiredParam paramName handler = do
+  mValue <- getParam paramName
+  case mValue of
+    Nothing -> do
+      modifyResponse $ setResponseCode 400
+      modifyResponse $ setContentType "text/plain"
+      writeBS $ ("Unable to process request. Parameter '" <> paramName <> "' required but not present.")
+    Just value -> handler value
+
 runCompile :: Context -> BuildMode -> Text -> IO (CompileStatus, Either Text (Text,Text))
 runCompile ctx mode source = withSystemTempDirectory "codeworld" $ \tempDir -> do
     let sourceDir = tempDir </> "source"
@@ -203,10 +213,10 @@ extractHolesFromErrorText err =
    in mapMaybe (\input -> case input of { [_,line,col,ty] -> Just (textToInt line, textToInt col, ty); _ -> Nothing } ) matches
 
 compileHandler :: CodeWorldHandler
-compileHandler ctx = do
+compileHandler ctx = withRequiredParam "source" $ \sourceBS -> do
   mode <- getBuildMode
   let previewConf = previewConfig $ config ctx
-  Just source <- (T.decodeUtf8 <$>) <$> getParam "source"
+      source = T.decodeUtf8 sourceBS
   mPreview <- getParam "enablePreview"
   let previewsEnabled = case mPreview of
         Just "True" -> True
@@ -246,9 +256,8 @@ compileHandler ctx = do
   writeBS $ T.encodeUtf8 responseBody
 
 errorCheckHandler :: CodeWorldHandler
-errorCheckHandler ctx = do
+errorCheckHandler ctx = withRequiredParam "source" $ \source -> do
   mode <- getBuildMode
-  Just source <- getParam "source"
   (status, output) <- liftIO $ errorCheck ctx mode source
   modifyResponse $ setResponseCode (responseCodeFromCompileStatus status)
   modifyResponse $ setContentType "text/plain"
@@ -285,8 +294,7 @@ serveEditor _ = do
   writeBS $ T.encodeUtf8 $ T.pack content
 
 indentHandler :: CodeWorldHandler
-indentHandler _ = do
-  Just source <- getParam "source"
+indentHandler _ = withRequiredParam "source" $ \source -> do
   reformat source `CE.catch` handleError
   where
     reformat source = do