diff --git a/build.sh b/build.sh
index 526742615..d4289f068 100755
--- a/build.sh
+++ b/build.sh
@@ -43,13 +43,14 @@ run codeworld-api cabal haddock --hoogle
# Build codeworld-server from this project.
-run . cabal_install ./codeworld-server \
+run . cabal_install ./funblocks-server \
./codeworld-error-sanitizer \
./codeworld-compiler \
+ ./codeworld-server \
./codeworld-game-api \
./codeworld-prediction \
./codeworld-api \
- ./codeworld-game-server
+ ./codeworld-collab-server
# Build the JavaScript client code for FunBlocks, the block-based UI.
run . cabal_install --ghcjs ./funblocks-client
diff --git a/codeworld-game-server/LICENSE b/codeworld-collab-server/LICENSE
similarity index 100%
rename from codeworld-game-server/LICENSE
rename to codeworld-collab-server/LICENSE
diff --git a/codeworld-game-server/Setup.hs b/codeworld-collab-server/Setup.hs
similarity index 100%
rename from codeworld-game-server/Setup.hs
rename to codeworld-collab-server/Setup.hs
diff --git a/codeworld-game-server/codeworld-game-server.cabal b/codeworld-collab-server/codeworld-collab-server.cabal
similarity index 81%
rename from codeworld-game-server/codeworld-game-server.cabal
rename to codeworld-collab-server/codeworld-collab-server.cabal
index 6f2d29d6f..f2edea1d6 100644
--- a/codeworld-game-server/codeworld-game-server.cabal
+++ b/codeworld-collab-server/codeworld-collab-server.cabal
@@ -10,22 +10,34 @@ Build-type: Simple
Extra-source-files: ChangeLog.md
Cabal-version: >=1.10
-Executable codeworld-game-server
+Executable codeworld-collab-server
Main-is: Main.hs
Other-modules: CodeWorld.GameServer
Build-depends: base >=4.8 && <4.10,
aeson,
+ directory,
+ engine-io,
+ engine-io-snap,
+ filepath,
+ hashable,
+ http-conduit,
+ mtl,
+ ot,
text,
websockets == 0.9.*,
websockets-snap == 0.10.*,
snap-core == 1.0.*,
+ snap-cors,
snap-server == 1.0.*,
+ socket-io,
+ stm,
transformers,
bytestring,
random,
unordered-containers,
time,
- codeworld-game-api
+ codeworld-game-api,
+ codeworld-server
Hs-source-dirs: src
Default-language: Haskell2010
Ghc-options: -threaded -rtsopts "-with-rtsopts=-N"
diff --git a/codeworld-game-server/src/Bot.hs b/codeworld-collab-server/src/Bot.hs
similarity index 100%
rename from codeworld-game-server/src/Bot.hs
rename to codeworld-collab-server/src/Bot.hs
diff --git a/codeworld-collab-server/src/CodeWorld/CollabModel.hs b/codeworld-collab-server/src/CodeWorld/CollabModel.hs
new file mode 100644
index 000000000..598464485
--- /dev/null
+++ b/codeworld-collab-server/src/CodeWorld/CollabModel.hs
@@ -0,0 +1,59 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+{-
+ Copyright 2017 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 CodeWorld.CollabModel where
+
+import qualified Control.Concurrent.STM as STM
+import Control.OperationalTransformation.Selection (Selection)
+import Control.OperationalTransformation.Server (ServerState)
+import Control.OperationalTransformation.Text (TextOperation)
+import Data.Aeson
+import GHC.Generics (Generic)
+import Data.Hashable (Hashable)
+import qualified Data.HashMap.Strict as HM
+import Data.Text (Text)
+import Data.Time.Clock (UTCTime)
+
+data CollabServerState = CollabServerState
+ { collabProjects :: STM.TVar CollabProjects
+ , started :: UTCTime
+ }
+
+type CollabProjects = HM.HashMap CollabId (STM.TVar CollabProject)
+
+data CollabProject = CollabProject
+ { totalUsers :: !Int
+ , collabKey :: CollabId
+ , collabState :: ServerState Text TextOperation
+ , users :: [CollabUserState]
+ }
+
+data CollabUserState = CollabUserState
+ { suserId :: !Text
+ , suserIdent :: !Text
+ , userSelection :: !Selection
+ }
+
+instance ToJSON CollabUserState where
+ toJSON (CollabUserState _ userIdent' sel) =
+ object $ [ "name" .= userIdent' ] ++ (if sel == mempty then [] else [ "selection" .= sel ])
+
+newtype CollabId = CollabId { unCollabId :: Text } deriving (Eq, Generic)
+
+instance Hashable CollabId
diff --git a/codeworld-collab-server/src/CodeWorld/CollabServer.hs b/codeworld-collab-server/src/CodeWorld/CollabServer.hs
new file mode 100644
index 000000000..dc23cecc6
--- /dev/null
+++ b/codeworld-collab-server/src/CodeWorld/CollabServer.hs
@@ -0,0 +1,209 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+{-
+ Copyright 2017 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 CodeWorld.CollabServer
+ ( initCollabServer
+ , collabServer
+ ) where
+
+import qualified Control.Concurrent.STM as STM
+import Control.Monad (when)
+import Control.Monad.State.Strict (StateT)
+import Control.Monad.Trans
+import Control.Monad.Trans.Reader (ReaderT)
+import qualified Control.OperationalTransformation.Selection as Sel
+import qualified Control.OperationalTransformation.Server as OTS
+import Data.Aeson
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Char8 as BC
+import qualified Data.HashMap.Strict as HM
+import Data.Maybe (fromJust)
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
+import Data.Time.Clock
+import DataUtil
+import Model
+import Network.HTTP.Conduit (simpleHttp)
+import qualified Network.SocketIO as SIO
+import Snap.Core
+import SnapUtil
+import System.Directory
+import System.FilePath
+
+import CodeWorld.CollabModel
+
+-- Initialize Collab Server
+
+initCollabServer :: IO CollabServerState
+initCollabServer = do
+ started <- getCurrentTime
+ collabProjects <- STM.newTVarIO HM.empty
+ return CollabServerState {..}
+
+-- Collaboration requests helpers
+
+getRequestParams :: ClientId -> Snap (User, FilePath)
+getRequestParams clientId = do
+ user <- getUser clientId
+ mode <- getBuildMode
+ Just path' <- fmap (splitDirectories . BC.unpack) <$> getParam "path"
+ Just name <- getParam "name"
+ let projectId = nameToProjectId $ T.decodeUtf8 name
+ finalDir = joinPath $ map (dirBase . nameToDirId . T.pack) path'
+ file = userProjectDir mode (userId user) </> finalDir </> projectFile projectId
+ case (length path', path' !! 0) of
+ (0, _) -> return (user, file)
+ (_, x) | x /= "commentables" -> return (user, file)
+
+initCollaborationHandler :: CollabServerState -> ClientId -> Snap (Text, Text, CollabId)
+initCollaborationHandler state clientId = do
+ (user, filePath) <- getRequestParams clientId
+ collabHashPath <- liftIO $ BC.unpack <$> B.readFile filePath
+ let collabHash = take (length collabHashPath - 3) . takeFileName $ collabHashPath
+ Just (currentUsers :: [UserDump]) <- liftIO $ decodeStrict <$>
+ B.readFile (collabHashPath <.> "users")
+ let userIdent' = uuserIdent $ (filter (\x -> uuserId x == userId user) currentUsers) !! 0
+ Just (project :: Project) <- liftIO $ decodeStrict <$>
+ B.readFile collabHashPath
+ liftIO $ addNewCollaborator state (userId user) userIdent' (projectSource project) $
+ CollabId . T.pack $ collabHash
+ return ((userId user), userIdent', CollabId . T.pack $ collabHash)
+
+getCollabProject :: CollabServerState -> CollabId -> STM.STM (STM.TVar CollabProject)
+getCollabProject state collabHash = do
+ fromJust . HM.lookup collabHash <$> STM.readTVar (collabProjects state)
+
+addNewCollaborator :: CollabServerState -> Text -> Text -> Text -> CollabId -> IO ()
+addNewCollaborator state userId' userIdent' projectSource collabHash = do
+ let collabUser = CollabUserState userId' userIdent' mempty
+ STM.atomically $ do
+ hm <- STM.readTVar $ collabProjects state
+ case HM.lookup collabHash hm of
+ Just collabProjectTV -> do
+ collabProject <- STM.readTVar collabProjectTV
+ case userId' `elem` (map suserId $ users collabProject) of
+ True -> do
+ let collabProject' = collabProject
+ { users = map (\x -> if suserId x == userId'
+ then collabUser
+ else x) $ users collabProject
+ }
+ collabProjectTV' <- STM.newTVar collabProject'
+ STM.modifyTVar (collabProjects state) $
+ \x -> HM.adjust (\_ -> collabProjectTV') collabHash x
+ False -> do
+ let collabProject' = collabProject
+ { totalUsers = totalUsers collabProject + 1
+ , users = collabUser : users collabProject
+ }
+ collabProjectTV' <- STM.newTVar collabProject'
+ STM.modifyTVar (collabProjects state) $
+ \x -> HM.adjust (\_ -> collabProjectTV') collabHash x
+ Nothing -> do
+ let collabProject = CollabProject
+ { totalUsers = 1
+ , collabKey = collabHash
+ , collabState = OTS.initialServerState projectSource
+ , users = [collabUser]
+ }
+ collabProjectTV <- STM.newTVar collabProject
+ STM.modifyTVar (collabProjects state) $
+ \x -> HM.insert collabHash collabProjectTV x
+
+cleanUp :: CollabServerState -> Text -> STM.TVar CollabProject -> STM.STM ()
+cleanUp state userId' collabProjectTV = do
+ collabProject <- STM.readTVar collabProjectTV
+ case null (filter ((/= userId') . suserId) $ users collabProject) of
+ True -> do
+ STM.modifyTVar collabProjectTV (\collabProject' -> collabProject'
+ { totalUsers = 0
+ , users = []
+ })
+ let collabHash = collabKey collabProject
+ STM.modifyTVar (collabProjects state) $ HM.delete collabHash
+ False -> do
+ STM.modifyTVar collabProjectTV (\collabProject' -> collabProject'
+ { totalUsers = totalUsers collabProject' - 1
+ , users = filter ((/= userId') . suserId) $
+ users collabProject'
+ })
+
+-- Collaboration requests handler
+
+collabServer :: CollabServerState -> ClientId -> StateT SIO.RoutingTable (ReaderT SIO.Socket Snap) ()
+collabServer state clientId = do
+ (userId', userIdent', collabHash) <- liftSnap $ initCollaborationHandler state clientId
+ let userHash = hashToId "U" . BC.pack $ (show userId') ++ (show . unCollabId $ collabHash)
+ SIO.broadcastJSON "set_name" [toJSON userHash, toJSON userIdent']
+ SIO.broadcast "add_user" userIdent'
+ SIO.emitJSON "logged_in" []
+ currentUsers' <- liftIO . STM.atomically $ do
+ collabProjectTV <- getCollabProject state collabHash
+ (\x -> map suserIdent $ users x) <$> STM.readTVar collabProjectTV
+ collabProjectTV' <- liftIO . STM.atomically $ getCollabProject state collabHash
+ OTS.ServerState rev' doc _ <- liftIO $ collabState <$> STM.readTVarIO collabProjectTV'
+ SIO.emit "doc" $ object
+ [ "str" .= doc
+ , "revision" .= rev'
+ , "clients" .= currentUsers'
+ ]
+
+ SIO.on "operation" $ \rev op (sel :: Sel.Selection) -> do
+ res <- liftIO . STM.atomically $ do
+ collabProjectTV <- getCollabProject state collabHash
+ serverState <- collabState <$> STM.readTVar collabProjectTV
+ case OTS.applyOperation serverState rev op sel of
+ Left err -> return $ Left err
+ Right (op', sel', serverState') -> do
+ STM.modifyTVar collabProjectTV (\collabProject ->
+ collabProject { collabState = serverState' })
+ STM.modifyTVar (collabProjects state) $
+ \x -> HM.adjust (\_ -> collabProjectTV) collabHash x
+ return $ Right (op', sel')
+ case res of
+ Left _ -> return ()
+ Right (op', sel') -> do
+ SIO.emitJSON "ack" []
+ SIO.broadcastJSON "operation" [toJSON userHash, toJSON op', toJSON sel']
+
+ SIO.on "selection" $ \sel -> do
+ liftIO . STM.atomically $ do
+ collabProjectTV <- getCollabProject state collabHash
+ currentUsers <- users <$> STM.readTVar collabProjectTV
+ let currentUsers'' = map (\x -> if ((/= userId') . suserId) x
+ then x
+ else x{ userSelection = sel }) currentUsers
+ STM.modifyTVar collabProjectTV (\collabProject ->
+ collabProject { users = currentUsers'' })
+ STM.modifyTVar (collabProjects state) $
+ \x -> HM.adjust (\_ -> collabProjectTV) collabHash x
+ SIO.broadcastJSON "selection" [toJSON userHash, toJSON sel]
+
+ SIO.appendDisconnectHandler $ do
+ liftIO . STM.atomically $ do
+ collabProjectTV <- getCollabProject state collabHash
+ cleanUp state userId' collabProjectTV
+ SIO.broadcast "client_left" userHash
+ SIO.broadcast "remove_user" userIdent'
diff --git a/codeworld-game-server/src/CodeWorld/GameServer.hs b/codeworld-collab-server/src/CodeWorld/GameServer.hs
similarity index 100%
rename from codeworld-game-server/src/CodeWorld/GameServer.hs
rename to codeworld-collab-server/src/CodeWorld/GameServer.hs
diff --git a/codeworld-collab-server/src/Main.hs b/codeworld-collab-server/src/Main.hs
new file mode 100644
index 000000000..d5b9a5499
--- /dev/null
+++ b/codeworld-collab-server/src/Main.hs
@@ -0,0 +1,60 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+{-
+ Copyright 2017 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.
+-}
+
+import Control.Applicative ((<|>))
+import Control.Monad (unless)
+import qualified Data.Text as T
+import qualified Data.Text.IO as T
+import qualified Network.SocketIO as SIO
+import Network.EngineIO.Snap (snapAPI)
+import Snap.Core
+import qualified Snap.CORS as CORS
+import Snap.Http.Server
+import System.Directory
+
+import CodeWorld.GameServer
+import CodeWorld.CollabServer
+import SnapUtil
+
+main :: IO ()
+main = do
+ hasClientId <- doesFileExist "web/clientId.txt"
+ unless hasClientId $ do
+ putStrLn "WARNING: Missing web/clientId.txt"
+ putStrLn "User logins will not function properly!"
+
+ clientId <- case hasClientId of
+ True -> do
+ txt <- T.readFile "web/clientId.txt"
+ return . ClientId . Just . T.strip $ txt
+ False -> do
+ return $ ClientId Nothing
+
+ gameServerState <- initGameServer
+ collabServerState <- initCollabServer
+ socketIOHandler <- SIO.initialize snapAPI (collabServer collabServerState clientId)
+ config <- commandLineConfig $
+ setPort 9160 $
+ setErrorLog (ConfigFileLog "log/collab-error.log") $
+ setAccessLog (ConfigFileLog "log/collab-access.log") $
+ mempty
+ httpServe config $ CORS.applyCORS CORS.defaultOptions $
+ ifTop (gameStats gameServerState) <|>
+ route [ ("gameserver", gameServer gameServerState)
+ , ("socket.io" , socketIOHandler)
+ ]
diff --git a/codeworld-game-server/src/Stresstest.hs b/codeworld-collab-server/src/Stresstest.hs
similarity index 100%
rename from codeworld-game-server/src/Stresstest.hs
rename to codeworld-collab-server/src/Stresstest.hs
diff --git a/codeworld-server/codeworld-server.cabal b/codeworld-server/codeworld-server.cabal
index 65acbc532..08bbf1668 100644
--- a/codeworld-server/codeworld-server.cabal
+++ b/codeworld-server/codeworld-server.cabal
@@ -26,6 +26,7 @@ Executable codeworld-server
directory,
filepath,
filesystem-trees,
+ funblocks-server,
hindent >= 5 && < 5.2.3,
http-conduit,
memory,
@@ -37,7 +38,33 @@ Executable codeworld-server
snap-server,
temporary,
text,
- unix
+ time,
+ transformers,
+ unix,
+ unordered-containers
Ghc-options: -threaded -Wall -funbox-strict-fields -O2
-fno-warn-unused-do-bind
+
+Library
+ Hs-source-dirs: src
+ Exposed-modules: DataUtil,
+ Model,
+ SnapUtil
+ Build-Depends: aeson,
+ base,
+ base64-bytestring,
+ bytestring,
+ cryptonite,
+ data-default,
+ directory,
+ http-conduit,
+ filesystem-trees,
+ filepath,
+ mtl,
+ snap-core,
+ unix,
+ text
+
+ Exposed: True
+ Ghc-options: -O2
diff --git a/codeworld-server/src/Collaboration.hs b/codeworld-server/src/Collaboration.hs
new file mode 100644
index 000000000..04933acbe
--- /dev/null
+++ b/codeworld-server/src/Collaboration.hs
@@ -0,0 +1,105 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+{-
+ Copyright 2017 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 Collaboration (
+ -- routes for simultaneous editing and adding user for collaboration into the project
+ collabRoutes,
+ ) where
+
+import Control.Monad.Trans
+import Data.Aeson
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Char8 as BC
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
+import Snap.Core
+import System.FilePath
+
+import CollaborationUtil
+import DataUtil
+import Model
+import SnapUtil
+
+collabRoutes :: ClientId -> [(B.ByteString, Snap ())]
+collabRoutes clientId =
+ [ ("addToCollaborate", addToCollaborateHandler clientId)
+ , ("collabShare", collabShareHandler clientId)
+ , ("listCurrentOwners", listCurrentOwnersHandler clientId)
+ ]
+
+data ParamsGetType = GetFromHash | NotInCommentables deriving (Eq)
+
+getFrequentParams :: ParamsGetType -> ClientId -> Snap (User, BuildMode, FilePath)
+getFrequentParams getType clientId = do
+ user <- getUser clientId
+ mode <- getBuildMode
+ case getType of
+ NotInCommentables -> do
+ Just path' <- fmap (splitDirectories . BC.unpack) <$> getParam "path"
+ Just name <- getParam "name"
+ let projectId = nameToProjectId $ T.decodeUtf8 name
+ finalDir = joinPath $ map (dirBase . nameToDirId . T.pack) path'
+ file = userProjectDir mode (userId user) </> finalDir </> projectFile projectId
+ case (length path', path' !! 0) of
+ (0, _) -> return (user, mode, file)
+ (_, x) | x /= "commentables" -> return (user, mode, file)
+ GetFromHash -> do
+ Just collabHash <- fmap (CollabId . T.decodeUtf8) <$> getParam "collabHash"
+ let collabHashPath = collabHashRootDir mode </> collabHashLink collabHash <.> "cw"
+ return (user, mode, collabHashPath)
+
+addToCollaborateHandler :: ClientId -> Snap ()
+addToCollaborateHandler clientId = do
+ (user, mode, collabHashPath) <- getFrequentParams GetFromHash clientId
+ Just path' <- fmap (splitDirectories . BC.unpack) <$> getParam "path"
+ case length path' of
+ x | x /= 0 && path' !! 0 == "commentables" -> do
+ modifyResponse $ setContentType "text/plain"
+ modifyResponse $ setResponseCode 404
+ writeBS . BC.pack $ "Cannot add a project to collaborate with in `commentables` directory."
+ | otherwise -> do
+ Just userIdent' <- fmap T.decodeUtf8 <$> getParam "userIdent"
+ Just name <- getParam "name"
+ let pathDir = joinPath $ map (dirBase . nameToDirId . T.pack) path'
+ projectId = nameToProjectId . T.decodeUtf8 $ name
+ filePath = userProjectDir mode (userId user) </> pathDir </> projectFile projectId
+ res <- liftIO $ addForCollaboration mode (userId user) userIdent' name filePath collabHashPath
+ case res of
+ Left err -> do
+ modifyResponse $ setContentType "text/plain"
+ modifyResponse $ setResponseCode 404
+ writeBS . BC.pack $ err
+ Right _ -> return ()
+
+collabShareHandler :: ClientId -> Snap ()
+collabShareHandler clientId = do
+ (_, _, filePath) <- getFrequentParams NotInCommentables clientId
+ collabHashFile <- liftIO $ takeFileName . BC.unpack <$> B.readFile filePath
+ modifyResponse $ setContentType "text/plain"
+ writeBS . BC.pack . take (length collabHashFile - 3) $ collabHashFile
+
+listCurrentOwnersHandler :: ClientId -> Snap ()
+listCurrentOwnersHandler clientId = do
+ (_, _, filePath) <- getFrequentParams NotInCommentables clientId
+ collabHashPath <- liftIO $ BC.unpack <$> B.readFile filePath
+ Just (currentUsers :: [UserDump]) <- liftIO $ decodeStrict <$>
+ B.readFile (collabHashPath <.> "users")
+ let currentOwners = map (T.unpack . uuserIdent) $ filter (\u -> utype u == "owner") currentUsers
+ modifyResponse $ setContentType "application/json"
+ writeLBS . encode $ currentOwners
diff --git a/codeworld-server/src/CollaborationUtil.hs b/codeworld-server/src/CollaborationUtil.hs
new file mode 100644
index 000000000..e49d6df4d
--- /dev/null
+++ b/codeworld-server/src/CollaborationUtil.hs
@@ -0,0 +1,168 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-
+ Copyright 2017 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 CollaborationUtil where
+
+import Control.Monad
+import Data.Aeson
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Char8 as BC
+import qualified Data.ByteString.Lazy as LB
+import Data.Text (Text)
+import qualified Data.Text as T
+import System.Directory
+import System.FilePath
+
+import CommentUtil
+import DataUtil
+import Model
+
+newtype CollabId = CollabId { unCollabId :: Text } deriving (Eq)
+
+collabHashRootDir :: BuildMode -> FilePath
+collabHashRootDir (BuildMode m) = "data" </> m </> "projectContents"
+
+nameToCollabHash :: FilePath -> CollabId
+nameToCollabHash = CollabId . hashToId "H" . BC.pack
+
+ensureCollabHashDir :: BuildMode -> CollabId -> IO ()
+ensureCollabHashDir mode (CollabId c) = createDirectoryIfMissing True dir
+ where dir = collabHashRootDir mode </> take 3 (T.unpack c)
+
+collabHashLink :: CollabId -> FilePath
+collabHashLink (CollabId c) = let s = T.unpack c in take 3 s </> s
+
+newCollaboratedProject :: BuildMode -> Text -> Text -> ByteString -> FilePath -> Project -> IO (Either String ())
+newCollaboratedProject mode userId' userIdent' name projectFilePath project = do
+ let collabHash = nameToCollabHash projectFilePath
+ collabHashPath = collabHashRootDir mode </> collabHashLink collabHash <.> "cw"
+ userDump = UserDump userId' userIdent' (T.pack projectFilePath) "owner"
+ identAllowed = foldl (\acc l -> if l `elem` (T.unpack userIdent')
+ then False else acc) True ['/', '.', '+']
+ case identAllowed of
+ False -> return $ Left "User Identifier Has Unallowed Characters(/+.)"
+ True -> do
+ ensureCollabHashDir mode collabHash
+ B.writeFile collabHashPath $ LB.toStrict . encode $ project
+ B.writeFile (collabHashPath <.> "users") $
+ LB.toStrict . encode $ userDump : []
+ B.writeFile projectFilePath $ BC.pack collabHashPath
+ B.writeFile (projectFilePath <.> "info") name
+ addCommentFunc mode userDump project $ collabHashPath <.> "comments"
+ return $ Right ()
+
+addForCollaboration :: BuildMode -> Text -> Text -> ByteString -> FilePath -> FilePath -> IO (Either String ())
+addForCollaboration mode userId' userIdent' name projectFilePath collabFilePath = do
+ let userDump = UserDump userId' userIdent' (T.pack projectFilePath) "owner"
+ identAllowed = foldl (\acc l -> if l `elem` (T.unpack userIdent')
+ then False else acc) True ['/', '.', '+']
+ case identAllowed of
+ False -> return $ Left "User Identifier Has Unallowed Characters(/+.)"
+ True -> do
+ Just (currentUsers :: [UserDump]) <- decodeStrict <$>
+ B.readFile (collabFilePath <.> "users")
+ let currentIdents = map uuserIdent currentUsers
+ currentIds = map uuserId currentUsers
+ case (userId' `elem` currentIds, userIdent' `elem` currentIdents) of
+ (True, _) -> return $ Left "User already exists maybe with a different identifier"
+ (False, True) -> return $ Left "User Identifier already exists"
+ (False, False) -> do
+ res <- addNewOwner mode userDump $ collabFilePath <.> "comments"
+ case res of
+ Left err -> return $ Left err
+ Right _ -> do
+ B.writeFile (collabFilePath <.> "users") $
+ LB.toStrict . encode $ userDump : currentUsers
+ createDirectoryIfMissing False (takeDirectory projectFilePath)
+ B.writeFile projectFilePath $ BC.pack collabFilePath
+ B.writeFile (projectFilePath <.> "info") name
+ return $ Right ()
+
+removeProjectIfExists :: BuildMode -> Text -> FilePath -> IO ()
+removeProjectIfExists mode userId' userPath = do
+ projectContentPath <- BC.unpack <$> B.readFile userPath
+ _ <- removeUserFromCollaboration mode userId' projectContentPath
+ removeFileIfExists userPath
+ removeFileIfExists $ userPath <.> "info"
+ cleanBaseDirectory userPath
+
+removeUserFromCollaboration :: BuildMode -> Text -> FilePath -> IO (Either String ())
+removeUserFromCollaboration mode userId' projectContentPath = do
+ Just (currentUsers :: [UserDump]) <- decodeStrict <$>
+ B.readFile (projectContentPath <.> "users")
+ case userId' `elem` (map uuserId currentUsers) of
+ False -> do
+ return $ Left "User does not exists in the project which is being tried to be deleted"
+ True -> do
+ let newUsers = filter (\x -> uuserId x /= userId') currentUsers
+ case length newUsers of
+ 0 -> do
+ removeCollaboratedProject projectContentPath
+ removeCommentUtils $ projectContentPath <.> "comments"
+ cleanBaseDirectory projectContentPath
+ cleanCommentHashPath mode userId' $ projectContentPath <.> "comments"
+ _ -> do
+ -- update hash path to one of existing users path since this users filepath may contain different project
+ B.writeFile (projectContentPath <.> "users") $
+ LB.toStrict . encode $ newUsers
+ removeOwnerPathInComments mode userId' $ projectContentPath <.> "comments"
+ modifyCollabPath mode projectContentPath
+ return $ Right ()
+
+modifyCollabPath :: BuildMode -> FilePath -> IO ()
+modifyCollabPath mode projectContentPath = do
+ Just (currentUsers :: [UserDump]) <- decodeStrict <$>
+ B.readFile (projectContentPath <.> "users")
+ let newCollabHash = nameToCollabHash . T.unpack . upath $ currentUsers !! 0
+ newCollabHashPath = collabHashRootDir mode </> collabHashLink newCollabHash <.> "cw"
+ forM_ currentUsers $ \u -> do
+ B.writeFile (T.unpack $ upath u) $ BC.pack newCollabHashPath
+ createDirectoryIfMissing False $ takeDirectory newCollabHashPath
+ mapM_ (\x -> renameDirectory (projectContentPath <.> x) $ newCollabHashPath <.> x)
+ ["comments", "comments" <.> "users", "comments" <.> "versions"]
+ mapM_ (\x -> renameFile (projectContentPath <.> x) $ newCollabHashPath <.> x)
+ ["", "users"]
+ cleanBaseDirectory projectContentPath
+ updateSharedCommentPath mode (projectContentPath <.> "comments") $ newCollabHashPath <.> "comments"
+
+modifyCollabPathIfReq :: BuildMode -> Text -> FilePath -> FilePath -> IO ()
+modifyCollabPathIfReq mode userId' fromFile toFile = do
+ let collabHash = nameToCollabHash fromFile
+ collabHashPath = collabHashRootDir mode </> collabHashLink collabHash <.> "cw"
+ projectContentPath <- BC.unpack <$> B.readFile toFile
+ Just (currentUsers :: [UserDump]) <- decodeStrict <$>
+ B.readFile (projectContentPath <.> "users")
+ B.writeFile (projectContentPath <.> "users") $
+ LB.toStrict . encode $ map (\x -> if userId' == uuserId x
+ then x { upath = T.pack toFile }
+ else x) currentUsers
+ correctOwnerPathInComments mode userId' toFile $ projectContentPath <.> "comments"
+ case projectContentPath == collabHashPath of
+ True -> modifyCollabPath mode projectContentPath
+ False -> return ()
+
+removeCommentUtils :: FilePath -> IO ()
+removeCommentUtils commentFolder = do
+ mapM_ (\x -> removeDirectoryIfExists $ commentFolder <.> x) ["", "users", "versions"]
+
+removeCollaboratedProject :: FilePath -> IO ()
+removeCollaboratedProject projectContentPath = do
+ removeFileIfExists projectContentPath
+ removeFileIfExists $ projectContentPath <.> "users"
+ cleanBaseDirectory projectContentPath
diff --git a/codeworld-server/src/Comment.hs b/codeworld-server/src/Comment.hs
new file mode 100644
index 000000000..10f871f19
--- /dev/null
+++ b/codeworld-server/src/Comment.hs
@@ -0,0 +1,493 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+{-
+ Copyright 2017 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 Comment (
+ -- routes for comment handling
+ commentRoutes
+ ) where
+
+import Control.Monad.Trans
+import Data.Aeson
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Char8 as BC
+import Data.List
+import Data.Maybe (fromJust)
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
+import Data.Time.Clock (UTCTime)
+import Snap.Core
+import System.Directory
+import System.FilePath
+
+import CommentUtil
+import DataUtil
+import Model
+import SnapUtil
+
+commentRoutes :: ClientId -> [(B.ByteString, Snap ())]
+commentRoutes clientId =
+ [ ("addSharedComment", addSharedCommentHandler clientId)
+ , ("commentShare", commentShareHandler clientId)
+ , ("deleteComment", deleteCommentHandler clientId)
+ , ("deleteOwnerComment", deleteOwnerCommentHandler clientId)
+ , ("deleteOwnerReply", deleteOwnerReplyHandler clientId)
+ , ("deleteReply", deleteReplyHandler clientId)
+ , ("getUserIdent", getUserIdentHandler clientId)
+ , ("getOwnerUserIdent", getOwnerUserIdentHandler clientId)
+ , ("listComments", listCommentsHandler clientId)
+ , ("listOwnerComments", listOwnerCommentsHandler clientId)
+ , ("listOwnerVersions", listOwnerVersionsHandler clientId)
+ , ("listUnreadComments", listUnreadCommentsHandler clientId) -- to be integrated
+ , ("listUnreadOwnerComments", listUnreadOwnerCommentsHandler clientId) -- to be integrated
+ , ("listVersions", listVersionsHandler clientId)
+ , ("readComment", readCommentHandler clientId)
+ , ("readOwnerComment", readOwnerCommentHandler clientId)
+ , ("viewCommentSource", viewCommentSourceHandler clientId)
+ , ("viewOwnerCommentSource", viewOwnerCommentSourceHandler clientId)
+ , ("writeComment", writeCommentHandler clientId)
+ , ("writeOwnerComment", writeOwnerCommentHandler clientId)
+ , ("writeOwnerReply", writeOwnerReplyHandler clientId)
+ , ("writeReply", writeReplyHandler clientId)
+ ]
+
+data ParamsGetType = GetFromHash | InCommentables | NotInCommentables Bool deriving (Eq)
+
+getFrequentParams :: ParamsGetType -> ClientId -> Snap (User, BuildMode, FilePath)
+getFrequentParams getType clientId = do
+ user <- getUser clientId
+ mode <- getBuildMode
+ case getType of
+ GetFromHash -> do
+ Just commentHash <- fmap (CommentId . T.decodeUtf8) <$> getParam "chash"
+ commentFolder <- liftIO $
+ BC.unpack <$> B.readFile (commentHashRootDir mode </> commentHashLink commentHash)
+ return (user, mode, commentFolder)
+ InCommentables -> do
+ Just path' <- fmap (splitDirectories . BC.unpack) <$> getParam "path"
+ Just name <- getParam "name"
+ let projectId = nameToProjectId $ T.decodeUtf8 name
+ cDir = joinPath $ map (dirBase . nameToDirId . T.pack) $ tail path'
+ case path' !! 0 of
+ "commentables" -> liftIO $ do
+ commentHashFile <- BC.unpack <$> B.readFile
+ (sharedCommentsDir mode (userId user) </> cDir </> commentProjectLink projectId)
+ commentFolder <- BC.unpack <$> B.readFile commentHashFile
+ return (user, mode, commentFolder)
+ NotInCommentables x -> do
+ Just path' <- fmap (splitDirectories . BC.unpack) <$> getParam "path"
+ Just name <- getParam "name"
+ let projectId = nameToProjectId $ T.decodeUtf8 name
+ finalDir = joinPath $ map (dirBase . nameToDirId . T.pack) path'
+ file = userProjectDir mode (userId user) </> finalDir </> projectFile projectId
+ case (length path', path' !! 0, x) of
+ (0, _, True) -> do
+ commentFolder <- liftIO $ (<.> "comments") . BC.unpack <$> B.readFile file
+ return (user, mode, commentFolder)
+ (0, _, False) -> return (user, mode, file)
+ (_, x', True) | x' /= "commentables" -> do
+ commentFolder <- liftIO $ (<.> "comments") . BC.unpack <$> B.readFile file
+ return (user, mode, commentFolder)
+ (_, x', False) | x' /= "commentables" -> return (user, mode, file)
+
+addSharedCommentHandler :: ClientId -> Snap ()
+addSharedCommentHandler clientId = do
+ (user, mode, commentFolder) <- getFrequentParams GetFromHash clientId
+ Just path' <- fmap (splitDirectories . BC.unpack) <$> getParam "path"
+ case path' !! 0 of
+ "commentables" -> do
+ liftIO $ ensureUserProjectDir mode (userId user)
+ liftIO $ ensureSharedCommentsDir mode (userId user)
+ Just name <- getParam "name"
+ Just userIdent' <- fmap (T.decodeUtf8) <$> getParam "userIdent"
+ let pathDir = joinPath $ map (dirBase . nameToDirId . T.pack) $ tail path'
+ projectId = nameToProjectId $ T.decodeUtf8 name
+ finalDir = sharedCommentsDir mode (userId user) </> pathDir
+ commentHash = nameToCommentHash commentFolder
+ res <- liftIO $ do
+ addNewUser (userId user) userIdent' (BC.unpack name)
+ (finalDir </> commentProjectLink projectId)
+ (commentHashRootDir mode </> commentHashLink commentHash)
+ case res of
+ Left err -> do
+ modifyResponse $ setContentType "text/plain"
+ modifyResponse $ setResponseCode 404
+ writeBS . BC.pack $ err
+ Right _ -> return ()
+ _ -> do
+ modifyResponse $ setContentType "text/plain"
+ modifyResponse $ setResponseCode 404
+ writeBS . BC.pack $ "Shared Comments Should Be In `commentables` Directory"
+
+commentShareHandler :: ClientId -> Snap ()
+commentShareHandler clientId = do
+ (_, _, commentFolder) <- getFrequentParams (NotInCommentables True) clientId
+ modifyResponse $ setContentType "text/plain"
+ writeBS . T.encodeUtf8 . unCommentId . nameToCommentHash $ commentFolder
+
+deleteCommentHandler :: ClientId -> Snap ()
+deleteCommentHandler clientId = do
+ (user, mode, commentFolder) <- getFrequentParams InCommentables clientId
+ Just (versionNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "versionNo"
+ Just (lineNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo"
+ Just (comment' :: CommentDesc) <- (decodeStrict =<<) <$> getParam "comment"
+ let commentHash = nameToCommentHash commentFolder
+ commentHashPath = commentHashRootDir mode </> commentHashLink commentHash
+ Just (currentUsers :: [UserDump]) <- liftIO $
+ decodeStrict <$> B.readFile (commentHashPath <.> "users")
+ let (currUserInd :: Int) = fromJust $ userId user `elemIndex` (map uuserId currentUsers)
+ currentUser = currentUsers !! currUserInd
+ case (uuserId currentUser == userId user,
+ uuserIdent currentUser == cuserIdent comment',
+ utype currentUser == "not_owner") of
+ (True, True, True) -> liftIO $ do
+ deleteCommentFromFile commentFolder lineNo' versionNo' comment'
+ (True, False, True) -> do
+ modifyResponse $ setContentType "text/plain"
+ modifyResponse $ setResponseCode 404
+ writeBS . BC.pack $ "User Identifier Not Allowed To Delete This Comment"
+ (_, _, _) -> do
+ modifyResponse $ setContentType "text/plain"
+ modifyResponse $ setResponseCode 404
+ writeBS . BC.pack $ "User Identifier Not Found"
+
+deleteOwnerCommentHandler :: ClientId -> Snap ()
+deleteOwnerCommentHandler clientId = do
+ (user, mode, commentFolder) <- getFrequentParams (NotInCommentables True) clientId
+ Just (versionNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "versionNo"
+ Just (lineNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo"
+ Just (comment' :: CommentDesc) <- (decodeStrict =<<) <$> getParam "comment"
+ let commentHashPath = commentHashRootDir mode </> commentHashLink (nameToCommentHash commentFolder)
+ Just (currentUsers :: [UserDump]) <- liftIO $
+ decodeStrict <$> B.readFile (commentHashPath <.> "users")
+ let (currUserInd :: Int) = fromJust $ userId user `elemIndex` (map uuserId currentUsers)
+ currentUser = currentUsers !! currUserInd
+ case (uuserId currentUser == userId user,
+ uuserIdent currentUser == cuserIdent comment',
+ utype currentUser == "owner") of
+ (True, True, True) -> liftIO $ do
+ deleteCommentFromFile commentFolder lineNo' versionNo' comment'
+ (True, False, True) -> do
+ modifyResponse $ setContentType "text/plain"
+ modifyResponse $ setResponseCode 404
+ writeBS . BC.pack $ "User Identifier Not Allowed To Delete This Comment"
+ (_, _, _) -> do
+ modifyResponse $ setContentType "text/plain"
+ modifyResponse $ setResponseCode 404
+ writeBS . BC.pack $ "User Identifier Not Found"
+
+deleteOwnerReplyHandler :: ClientId -> Snap ()
+deleteOwnerReplyHandler clientId = do
+ (user, mode, commentFolder) <- getFrequentParams (NotInCommentables True) clientId
+ Just (versionNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "versionNo"
+ Just (lineNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo"
+ Just (comment' :: CommentDesc) <- (decodeStrict =<<) <$> getParam "comment"
+ Just (reply' :: ReplyDesc) <- (decodeStrict =<<) <$> getParam "reply"
+ let commentHashPath = commentHashRootDir mode </> commentHashLink (nameToCommentHash commentFolder)
+ Just (currentUsers :: [UserDump]) <- liftIO $
+ decodeStrict <$> B.readFile (commentHashPath <.> "users")
+ let (currUserInd :: Int) = fromJust $ userId user `elemIndex` (map uuserId currentUsers)
+ currentUser = currentUsers !! currUserInd
+ case (uuserId currentUser == userId user,
+ uuserIdent currentUser == ruserIdent reply',
+ utype currentUser == "owner") of
+ (True, True, True) -> liftIO $ do
+ deleteReplyFromComment commentFolder lineNo' versionNo' comment' reply'
+ (True, False, True) -> do
+ modifyResponse $ setContentType "text/plain"
+ modifyResponse $ setResponseCode 404
+ writeBS . BC.pack $ "User Identifier Not Allowed To Delete This Reply"
+ (_, _, _) -> do
+ modifyResponse $ setContentType "text/plain"
+ modifyResponse $ setResponseCode 404
+ writeBS . BC.pack $ "User Identifier Not Found"
+
+deleteReplyHandler :: ClientId -> Snap ()
+deleteReplyHandler clientId = do
+ (user, mode, commentFolder) <- getFrequentParams InCommentables clientId
+ Just (versionNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "versionNo"
+ Just (lineNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo"
+ Just (comment' :: CommentDesc) <- (decodeStrict =<<) <$> getParam "comment"
+ Just (reply' :: ReplyDesc) <- (decodeStrict =<<) <$> getParam "reply"
+ let commentHash = nameToCommentHash commentFolder
+ commentHashPath = commentHashRootDir mode </> commentHashLink commentHash
+ Just (currentUsers :: [UserDump]) <- liftIO $
+ decodeStrict <$> B.readFile (commentHashPath <.> "users")
+ let (currUserInd :: Int) = fromJust $ userId user `elemIndex` (map uuserId currentUsers)
+ currentUser = currentUsers !! currUserInd
+ case (uuserId currentUser == userId user,
+ uuserIdent currentUser == ruserIdent reply',
+ utype currentUser == "not_owner") of
+ (True, True, True) -> liftIO $ do
+ deleteReplyFromComment commentFolder lineNo' versionNo' comment' reply'
+ (True, False, True) -> do
+ modifyResponse $ setContentType "text/plain"
+ modifyResponse $ setResponseCode 404
+ writeBS . BC.pack $ "User Identifier Not Allowed To Delete This Comment"
+ (_, _, _) -> do
+ modifyResponse $ setContentType "text/plain"
+ modifyResponse $ setResponseCode 404
+ writeBS . BC.pack $ "User Identifier Not Found"
+
+getUserIdentHandler :: ClientId -> Snap ()
+getUserIdentHandler clientId = do
+ (user, mode, commentFolder) <- getFrequentParams InCommentables clientId
+ let commentHash = nameToCommentHash commentFolder
+ commentHashPath = commentHashRootDir mode </> commentHashLink commentHash
+ Just (currentUsers :: [UserDump]) <- liftIO $
+ decodeStrict <$> B.readFile (commentHashPath <.> "users")
+ let currentUserIds = map uuserId currentUsers
+ case (userId user) `elemIndex` currentUserIds of
+ Just ind -> do
+ modifyResponse $ setContentType "text/plain"
+ writeBS . T.encodeUtf8 . uuserIdent $ currentUsers !! ind
+ Nothing -> do
+ modifyResponse $ setContentType "text/plain"
+ modifyResponse $ setResponseCode 404
+ writeBS . BC.pack $ "User Identifier Not Found"
+
+getOwnerUserIdentHandler :: ClientId -> Snap ()
+getOwnerUserIdentHandler clientId = do
+ (user, _, commentFolder) <- getFrequentParams (NotInCommentables True) clientId
+ let projectPath = take (length commentFolder - 9) commentFolder
+ Just (currentUsers :: [UserDump]) <- liftIO $
+ decodeStrict <$> B.readFile (projectPath <.> "users")
+ let currentUserIds = map uuserId currentUsers
+ case (userId user) `elemIndex` currentUserIds of
+ Just ind -> do
+ modifyResponse $ setContentType "text/plain"
+ writeBS . T.encodeUtf8 . uuserIdent $ currentUsers !! ind
+ Nothing -> do
+ modifyResponse $ setContentType "text/plain"
+ modifyResponse $ setResponseCode 404
+ writeBS . BC.pack $ "User Identifier Not Found"
+
+listCommentsHandler :: ClientId -> Snap ()
+listCommentsHandler clientId = do
+ (_, _, commentFolder) <- getFrequentParams InCommentables clientId
+ modifyResponse $ setContentType "application/json"
+ writeLBS =<< (liftIO $ encode <$> listDirectory commentFolder)
+
+listOwnerCommentsHandler :: ClientId -> Snap ()
+listOwnerCommentsHandler clientId = do
+ (_, _, commentFolder) <- getFrequentParams (NotInCommentables True) clientId
+ modifyResponse $ setContentType "application/json"
+ writeLBS =<< (liftIO $ encode <$> listDirectory commentFolder)
+
+listOwnerVersionsHandler :: ClientId -> Snap ()
+listOwnerVersionsHandler clientId = do
+ (_, _, commentFolder) <- getFrequentParams (NotInCommentables True) clientId
+ modifyResponse $ setContentType "application/json"
+ writeLBS =<< (liftIO $ encode <$> listDirectory (commentFolder <.> "versions"))
+
+listUnreadCommentsHandler :: ClientId -> Snap ()
+listUnreadCommentsHandler clientId = do
+ (user, mode, commentFolder) <- getFrequentParams InCommentables clientId
+ Just (versionNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "versionNo"
+ let commentHash = nameToCommentHash commentFolder
+ commentHashPath = commentHashRootDir mode </> commentHashLink commentHash
+ Just (currentUsers :: [UserDump]) <- liftIO $
+ decodeStrict <$> B.readFile (commentHashPath <.> "users")
+ let currentUserIds = map uuserId currentUsers
+ case (userId user) `elemIndex` currentUserIds of
+ Just ind -> do
+ let userIdent' = uuserIdent (currentUsers !! ind)
+ unreadComments <- liftIO $ listUnreadComments userIdent' commentFolder versionNo'
+ modifyResponse $ setContentType "application/json"
+ writeLBS . encode $ unreadComments
+ Nothing -> do
+ modifyResponse $ setContentType "text/plain"
+ modifyResponse $ setResponseCode 500
+ writeBS . BC.pack $ "User Identifier Not Found"
+
+listUnreadOwnerCommentsHandler :: ClientId -> Snap ()
+listUnreadOwnerCommentsHandler clientId = do
+ (user, _, commentFolder) <- getFrequentParams (NotInCommentables True) clientId
+ let projectPath = take (length commentFolder - 9) commentFolder
+ Just (currentUsers :: [UserDump]) <- liftIO $
+ decodeStrict <$> B.readFile (projectPath <.> "users")
+ let currentUserIds = map uuserId currentUsers
+ case (userId user) `elemIndex` currentUserIds of
+ Just ind -> do
+ Just (versionNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "versionNo"
+ unreadComments <- liftIO $ listUnreadComments
+ (uuserIdent $ currentUsers !! ind) commentFolder versionNo'
+ modifyResponse $ setContentType "application/json"
+ writeLBS . encode $ unreadComments
+ Nothing -> do
+ modifyResponse $ setContentType "text/plain"
+ modifyResponse $ setResponseCode 404
+ writeBS . BC.pack $ "User Identifier Not Found"
+
+listVersionsHandler :: ClientId -> Snap ()
+listVersionsHandler clientId = do
+ (_, _, commentFolder) <- getFrequentParams InCommentables clientId
+ modifyResponse $ setContentType "application/json"
+ writeLBS =<< (liftIO $ encode <$> listDirectory (commentFolder <.> "versions"))
+
+readCommentHandler :: ClientId -> Snap ()
+readCommentHandler clientId = do
+ (user, mode, commentFolder) <- getFrequentParams InCommentables clientId
+ Just (versionNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "versionNo"
+ Just (lineNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo"
+ let commentHash = nameToCommentHash commentFolder
+ commentHashPath = commentHashRootDir mode </> commentHashLink commentHash
+ Just (currentUsers :: [UserDump]) <- liftIO $
+ decodeStrict <$> B.readFile (commentHashPath <.> "users")
+ let currentUserIds = map uuserId currentUsers
+ case (userId user) `elemIndex` currentUserIds of
+ Just ind -> do
+ let userIdent' = uuserIdent (currentUsers !! ind)
+ comments' <- liftIO $ getLineComment commentFolder lineNo' versionNo'
+ liftIO $ markReadComments userIdent' commentFolder lineNo' versionNo'
+ modifyResponse $ setContentType "application/json"
+ writeLBS (encode comments')
+ Nothing -> do
+ modifyResponse $ setContentType "text/plain"
+ modifyResponse $ setResponseCode 404
+ writeBS . BC.pack $ "User Identifier Not Found"
+
+readOwnerCommentHandler :: ClientId -> Snap ()
+readOwnerCommentHandler clientId = do
+ (user, _, commentFolder) <- getFrequentParams (NotInCommentables True) clientId
+ let projectPath = take (length commentFolder - 9) commentFolder
+ Just (currentUsers :: [UserDump]) <- liftIO $
+ decodeStrict <$> B.readFile (projectPath <.> "users")
+ let currentUserIds = map uuserId currentUsers
+ case (userId user) `elemIndex` currentUserIds of
+ Just ind -> do
+ Just (versionNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "versionNo"
+ Just (lineNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo"
+ comments' <- liftIO $ getLineComment commentFolder lineNo' versionNo'
+ liftIO $ markReadComments (uuserIdent $ currentUsers !! ind)
+ commentFolder lineNo' versionNo'
+ modifyResponse $ setContentType "application/json"
+ writeLBS (encode comments')
+ Nothing -> do
+ modifyResponse $ setContentType "text/plain"
+ modifyResponse $ setResponseCode 404
+ writeBS . BC.pack $ "User Identifier Not Found"
+
+viewCommentSourceHandler :: ClientId -> Snap ()
+viewCommentSourceHandler clientId = do
+ (_, _, commentFolder) <- getFrequentParams InCommentables clientId
+ Just (versionNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "versionNo"
+ currentSource <- liftIO $ B.readFile (commentFolder <.> "versions" </> show versionNo')
+ modifyResponse $ setContentType "text/x-haskell"
+ writeBS currentSource
+
+viewOwnerCommentSourceHandler :: ClientId -> Snap()
+viewOwnerCommentSourceHandler clientId = do
+ (_, _, commentFolder) <- getFrequentParams (NotInCommentables True) clientId
+ Just (versionNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "versionNo"
+ currentSource <- liftIO $ B.readFile (commentFolder <.> "versions" </> show versionNo')
+ modifyResponse $ setContentType "text/x-haskell"
+ writeBS currentSource
+
+writeCommentHandler :: ClientId -> Snap ()
+writeCommentHandler clientId = do
+ (user, mode, commentFolder) <- getFrequentParams InCommentables clientId
+ Just (versionNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "versionNo"
+ Just (lineNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo"
+ Just (comment' :: Text) <- fmap (T.decodeUtf8) <$> getParam "comment"
+ Just (dateTime' :: UTCTime) <- (decodeStrict =<<) <$> getParam "dateTime"
+ let commentHash = nameToCommentHash commentFolder
+ commentHashPath = commentHashRootDir mode </> commentHashLink commentHash
+ Just (currentUsers :: [UserDump]) <- liftIO $
+ decodeStrict <$> B.readFile (commentHashPath <.> "users")
+ let currentUserIds = map uuserId currentUsers
+ case (userId user) `elemIndex` currentUserIds of
+ Just ind -> liftIO $ do
+ let userIdent' = uuserIdent (currentUsers !! ind)
+ commentDesc = CommentDesc userIdent' dateTime' "present" comment' []
+ addCommentToFile commentFolder lineNo' versionNo' commentDesc
+ markUnreadComments userIdent' commentFolder lineNo' versionNo'
+ Nothing -> do
+ modifyResponse $ setContentType "text/plain"
+ modifyResponse $ setResponseCode 404
+ writeBS . BC.pack $ "User Does Not Exists"
+
+writeOwnerCommentHandler :: ClientId -> Snap ()
+writeOwnerCommentHandler clientId = do
+ (user, _, commentFolder) <- getFrequentParams (NotInCommentables True) clientId
+ let projectPath = take (length commentFolder - 9) commentFolder
+ Just (currentUsers :: [UserDump]) <- liftIO $
+ decodeStrict <$> B.readFile (projectPath <.> "users")
+ let currentUserIds = map uuserId currentUsers
+ case (userId user) `elemIndex` currentUserIds of
+ Just ind -> do
+ Just (versionNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "versionNo"
+ Just (lineNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo"
+ Just (comment' :: Text) <- fmap (T.decodeUtf8) <$> getParam "comment"
+ Just (dateTime' :: UTCTime) <- (decodeStrict =<<) <$> getParam "dateTime"
+ let userIdent' = uuserIdent $ currentUsers !! ind
+ commentDesc = CommentDesc userIdent' dateTime' "present" comment' []
+ liftIO $ do
+ addCommentToFile commentFolder lineNo' versionNo' commentDesc
+ markUnreadComments userIdent' commentFolder lineNo' versionNo'
+ Nothing -> do
+ modifyResponse $ setContentType "text/plain"
+ modifyResponse $ setResponseCode 404
+ writeBS . BC.pack $ "User Identifier Not Found"
+
+writeOwnerReplyHandler :: ClientId -> Snap ()
+writeOwnerReplyHandler clientId = do
+ (user, _, commentFolder) <- getFrequentParams (NotInCommentables True) clientId
+ let projectPath = take (length commentFolder - 9) commentFolder
+ Just (currentUsers :: [UserDump]) <- liftIO $
+ decodeStrict <$> B.readFile (projectPath <.> "users")
+ let currentUserIds = map uuserId currentUsers
+ case (userId user) `elemIndex` currentUserIds of
+ Just ind -> do
+ Just (versionNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "versionNo"
+ Just (lineNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo"
+ Just (comment' :: CommentDesc) <- (decodeStrict =<<) <$> getParam "comment"
+ Just (reply' :: Text) <- fmap (T.decodeUtf8) <$> getParam "reply"
+ Just (dateTime' :: UTCTime) <- (decodeStrict =<<) <$> getParam "dateTime"
+ let userIdent' = uuserIdent $ currentUsers !! ind
+ replyDesc = ReplyDesc userIdent' dateTime' "present" reply'
+ liftIO $ do
+ addReplyToComment commentFolder lineNo' versionNo' comment' replyDesc
+ Nothing -> do
+ modifyResponse $ setContentType "text/plain"
+ modifyResponse $ setResponseCode 404
+ writeBS . BC.pack $ "User Identifier Not Found"
+
+writeReplyHandler :: ClientId -> Snap ()
+writeReplyHandler clientId = do
+ (user, mode, commentFolder) <- getFrequentParams InCommentables clientId
+ Just (versionNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "versionNo"
+ Just (lineNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo"
+ Just (comment' :: CommentDesc) <- (decodeStrict =<<) <$> getParam "comment"
+ Just (reply' :: Text) <- fmap (T.decodeUtf8) <$> getParam "reply"
+ Just (dateTime' :: UTCTime) <- (decodeStrict =<<) <$> getParam "dateTime"
+ let commentHash = nameToCommentHash commentFolder
+ commentHashPath = commentHashRootDir mode </> commentHashLink commentHash
+ Just (currentUsers :: [UserDump]) <- liftIO $
+ decodeStrict <$> B.readFile (commentHashPath <.> "users")
+ let currentUserIds = map uuserId currentUsers
+ case (userId user) `elemIndex` currentUserIds of
+ Just ind -> liftIO $ do
+ let userIdent' = uuserIdent (currentUsers !! ind)
+ replyDesc = ReplyDesc userIdent' dateTime' "present" reply'
+ addReplyToComment commentFolder lineNo' versionNo' comment' replyDesc
+ Nothing -> do
+ modifyResponse $ setContentType "text/plain"
+ modifyResponse $ setResponseCode 404
+ writeBS . BC.pack $ "User Identifier Not Found"
diff --git a/codeworld-server/src/CommentFolder.hs b/codeworld-server/src/CommentFolder.hs
new file mode 100644
index 000000000..d88cdce09
--- /dev/null
+++ b/codeworld-server/src/CommentFolder.hs
@@ -0,0 +1,223 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-
+ Copyright 2017 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.
+-}
+
+-- this separate module was required because of cyclic dependency between CommentUtil and CollaborationUtil
+module CommentFolder where
+
+import Control.Monad
+import Data.Aeson
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Char8 as BC
+import qualified Data.ByteString.Lazy as LB
+import Data.List
+import Data.Maybe (fromJust)
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
+import System.Directory
+import System.FilePath
+
+import CollaborationUtil
+import DataUtil
+import Model
+
+cleanCommentPaths :: BuildMode -> Text -> FilePath -> IO ()
+cleanCommentPaths mode userId' file = do
+ fileBool <- doesFileExist file
+ case fileBool of
+ True -> removeProjectIfExists mode userId' file
+ False -> return ()
+
+deleteFolderWithComments :: BuildMode -> Text -> FilePath -> IO (Either String ())
+deleteFolderWithComments mode userId' finalDir = do
+ let dir' = userProjectDir mode userId' </> finalDir
+ dirBool <- doesDirectoryExist dir'
+ case dirBool of
+ True -> do
+ case finalDir == "commentables" of
+ True -> return $ Left "`commentables` Directory Cannot Be Deleted"
+ False -> do
+ allFilePaths <- getFilesRecursive dir'
+ case length (splitDirectories finalDir) of
+ x | x == 0 -> return $ Left "Root Directory Cannot Be Deleted"
+ | (x /= 0) && ((splitDirectories finalDir) !! 0 == "commentables") -> do
+ mapM_ (removeUserFromComments userId') allFilePaths
+ removeDirectoryIfExists dir'
+ cleanBaseDirectory dir'
+ return $ Right ()
+ | otherwise -> do
+ mapM_ (cleanCommentPaths mode userId') allFilePaths
+ removeDirectoryIfExists dir'
+ cleanBaseDirectory dir'
+ return $ Right ()
+ False -> return $ Left "Directory Does Not Exists"
+
+removeUserFromComments :: Text -> FilePath -> IO ()
+removeUserFromComments userId' userPath = do
+ fileBool <- doesFileExist userPath
+ case fileBool of
+ True -> do
+ commentHashFile <- BC.unpack <$> B.readFile userPath
+ commentFolder <- BC.unpack <$> B.readFile commentHashFile
+ Just (currentUsers :: [UserDump]) <- decodeStrict <$>
+ B.readFile (commentHashFile <.> "users")
+ let currentUserIds = map uuserId currentUsers
+ currentUser = currentUsers !! (fromJust $ userId' `elemIndex` currentUserIds)
+ removeFileIfExists $ commentFolder <.> "users" </> T.unpack (uuserIdent currentUser)
+ B.writeFile (commentHashFile <.> "users") $
+ LB.toStrict $ encode (delete currentUser currentUsers)
+ removeFileIfExists userPath
+ removeFileIfExists $ userPath <.> "info"
+ cleanBaseDirectory userPath
+ False -> return ()
+
+copyFileFromCommentables :: BuildMode -> Text -> Text -> FilePath -> FilePath -> ByteString -> Value -> IO ()
+copyFileFromCommentables mode userId' userIdent' fromFile toFile name emptyPH = do
+ cleanCommentPaths mode userId' toFile
+ createDirectoryIfMissing False $ takeDirectory toFile
+ commentHashFile <- BC.unpack <$> B.readFile fromFile
+ commentFolder <- BC.unpack <$> B.readFile commentHashFile
+ Just (project :: Project) <- decodeStrict <$>
+ B.readFile (take (length commentFolder - 9) commentFolder)
+ _ <- newCollaboratedProject mode userId' userIdent' name toFile $
+ Project (projectSource project) emptyPH
+ return ()
+
+copyFolderFromCommentables :: BuildMode -> Text -> Text -> FilePath -> FilePath -> Text -> Value -> IO ()
+copyFolderFromCommentables mode userId' userIdent' fromDir toDir name emptyPH = do
+ createNewFolder mode userId' toDir $ T.unpack name
+ dirList <- listDirectoryWithPrefix fromDir
+ dirFiles <- dirFilter dirList 'S'
+ forM_ dirFiles $ \ f -> do
+ let file = takeFileName f
+ case isSuffixOf ".info" file of
+ True -> return ()
+ False -> do
+ let toFile = toDir </> take 3 file </> file
+ fileName <- B.readFile (f <.> "info")
+ copyFileFromCommentables mode userId' userIdent' f toFile fileName emptyPH
+ dirDirs <- dirFilter dirList 'D'
+ forM_ dirDirs $ \d -> do
+ dirName <- T.decodeUtf8 <$> B.readFile (d </> "dir.info")
+ let newToDir = toDir </> (dirBase . nameToDirId $ dirName)
+ copyFolderFromCommentables mode userId' userIdent' d newToDir dirName emptyPH
+
+copyFileFromSelf :: BuildMode -> Text -> Text -> FilePath -> FilePath -> ByteString -> IO ()
+copyFileFromSelf mode userId' userIdent' fromFile toFile name = do
+ cleanCommentPaths mode userId' toFile
+ createDirectoryIfMissing False $ takeDirectory toFile
+ collabPath <- BC.unpack <$> B.readFile fromFile
+ Just (project :: Project) <- decodeStrict <$> B.readFile collabPath
+ _ <- newCollaboratedProject mode userId' userIdent' name toFile project
+ return ()
+
+copyFolderFromSelf :: BuildMode -> Text -> Text -> FilePath -> FilePath -> Text -> IO ()
+copyFolderFromSelf mode userId' userIdent' fromDir toDir name = do
+ createNewFolder mode userId' toDir $ T.unpack name
+ dirList <- listDirectoryWithPrefix fromDir
+ dirFiles <- dirFilter dirList 'S'
+ forM_ dirFiles $ \f -> do
+ let file = takeFileName f
+ fileBool <- doesFileExist f
+ case (fileBool, isSuffixOf ".cw" file) of
+ (True, True) -> do
+ let toFile = toDir </> take 3 file </> file
+ name' <- B.readFile $ f <.> "info"
+ copyFileFromSelf mode userId' userIdent' f toFile name'
+ (_, _) -> return ()
+ dirDirs <- dirFilter dirList 'D'
+ forM_ dirDirs $ \d -> do
+ dirName <- T.decodeUtf8 <$> B.readFile (d </> "dir.info")
+ let newToDir = toDir </> (dirBase . nameToDirId $ dirName)
+ copyFolderFromSelf mode userId' userIdent' d newToDir dirName
+
+moveFileFromCommentables :: Text -> FilePath -> FilePath -> Text -> IO ()
+moveFileFromCommentables userId' fromFile toFile name = do
+ removeUserFromComments userId' toFile
+ createDirectoryIfMissing False $ takeDirectory toFile
+ mapM_ (\x -> renameFile (fromFile <.> x) (toFile <.> x)) ["", "info"]
+ cleanBaseDirectory fromFile
+ correctUserPathInComments userId' toFile
+ B.writeFile (toFile <.> "info") $ T.encodeUtf8 name
+
+moveFolderFromCommentables :: BuildMode -> Text -> FilePath -> FilePath -> Text -> IO ()
+moveFolderFromCommentables mode userId' fromDir toDir name = do
+ createNewFolder mode userId' toDir $ T.unpack name
+ dirList <- listDirectoryWithPrefix fromDir
+ dirFiles <- dirFilter dirList 'S'
+ forM_ dirFiles $ \f -> do
+ let file = takeFileName f
+ case isSuffixOf ".info" file of
+ True -> return ()
+ False -> do
+ let toFile = toDir </> take 3 file </> file
+ fileName <- T.decodeUtf8 <$> B.readFile (f <.> "info")
+ moveFileFromCommentables userId' f toFile fileName
+ dirDirs <- dirFilter dirList 'D'
+ forM_ dirDirs $ \ d -> do
+ dirName <- T.decodeUtf8 <$> B.readFile (d </> "dir.info")
+ let newToDir = toDir </> (dirBase . nameToDirId $ dirName)
+ moveFolderFromCommentables mode userId' d newToDir dirName
+ removeDirectoryIfExists fromDir
+ cleanBaseDirectory fromDir
+
+moveFileFromSelf :: BuildMode -> Text -> FilePath -> FilePath -> Text -> IO ()
+moveFileFromSelf mode userId' fromFile toFile name = do
+ cleanCommentPaths mode userId' toFile
+ createDirectoryIfMissing False $ takeDirectory toFile
+ mapM_ (\x -> renameFile (fromFile <.> x) (toFile <.> x)) ["", "info"]
+ cleanBaseDirectory fromFile
+ B.writeFile (toFile <.> "info") $ T.encodeUtf8 name
+ modifyCollabPathIfReq mode userId' fromFile toFile
+
+moveFolderFromSelf :: BuildMode -> Text -> FilePath -> FilePath -> Text -> IO ()
+moveFolderFromSelf mode userId' fromDir toDir name = do
+ createNewFolder mode userId' toDir $ T.unpack name
+ dirList <- listDirectoryWithPrefix fromDir
+ dirFiles <- dirFilter dirList 'S'
+ forM_ dirFiles $ \ f -> do
+ let file = takeFileName f
+ fileBool <- doesFileExist f
+ case (fileBool, isSuffixOf ".cw" file) of
+ (True, True) -> do
+ let toFile = toDir </> take 3 file </> file
+ name' <- T.decodeUtf8 <$> B.readFile (f <.> "info")
+ moveFileFromSelf mode userId' f toFile name'
+ (_, _) -> return ()
+ dirDirs <- dirFilter dirList 'D'
+ forM_ dirDirs $ \d -> do
+ dirName <- T.decodeUtf8 <$> B.readFile (d </> "dir.info")
+ let newToDir = toDir </> (dirBase . nameToDirId $ dirName)
+ moveFolderFromSelf mode userId' d newToDir dirName
+ removeDirectoryIfExists fromDir
+ cleanBaseDirectory fromDir
+
+correctUserPathInComments :: Text -> FilePath -> IO ()
+correctUserPathInComments userId' userPath = do
+ fileBool <- doesFileExist userPath
+ case fileBool of
+ True -> do
+ commentHashFile <- BC.unpack <$> B.readFile userPath
+ Just (currentUsers :: [UserDump]) <- decodeStrict <$>
+ B.readFile (commentHashFile <.> "users")
+ let newUsr usr = usr { upath = T.pack userPath }
+ newUsers = map (\usr -> if uuserId usr /= userId' then usr
+ else newUsr usr) currentUsers
+ B.writeFile (commentHashFile <.> "users") $
+ LB.toStrict . encode $ newUsers
+ False -> return ()
diff --git a/codeworld-server/src/CommentUtil.hs b/codeworld-server/src/CommentUtil.hs
new file mode 100644
index 000000000..5545a6a87
--- /dev/null
+++ b/codeworld-server/src/CommentUtil.hs
@@ -0,0 +1,351 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-
+ Copyright 2017 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 CommentUtil where
+
+import Control.Monad
+import Data.Aeson
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Char8 as BC
+import qualified Data.ByteString.Lazy as LB
+import Data.List
+import Data.Maybe (fromJust)
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
+import System.Directory
+import System.FilePath
+
+import DataUtil
+import Model
+
+newtype CommentId = CommentId { unCommentId :: Text } deriving Eq
+
+commentHashRootDir :: BuildMode -> FilePath
+commentHashRootDir (BuildMode m) = "data" </> m </> "commentHash"
+
+commentRootDir :: BuildMode -> Text -> FilePath -> ProjectId -> FilePath
+commentRootDir mode userId' path projectId =
+ userProjectDir mode userId' </> path </> projectFile projectId <.> "comments"
+
+sharedCommentsDir :: BuildMode -> Text -> FilePath
+sharedCommentsDir mode userId' = userProjectDir mode userId' </> "commentables"
+
+commentHashLink :: CommentId -> FilePath
+commentHashLink (CommentId c) = let s = T.unpack c in take 3 s </> s
+
+commentProjectLink :: ProjectId -> FilePath
+commentProjectLink projectId = take (length file - 3) file
+ where file = projectFile projectId
+
+nameToCommentHash :: FilePath -> CommentId
+nameToCommentHash = CommentId . hashToId "C" . BC.pack
+
+ensureCommentHashDir :: BuildMode -> CommentId -> IO ()
+ensureCommentHashDir mode (CommentId c) = createDirectoryIfMissing True dir
+ where dir = commentHashRootDir mode </> take 3 (T.unpack c)
+
+ensureSharedCommentsDir :: BuildMode -> Text -> IO ()
+ensureSharedCommentsDir mode userId' = createDirectoryIfMissing True dir
+ where dir = sharedCommentsDir mode userId'
+
+cleanCommentHashPath :: BuildMode -> Text -> FilePath -> IO ()
+cleanCommentHashPath mode userId' commentFolder = do
+ dirBool <- doesDirectoryExist commentFolder
+ case dirBool of
+ True -> do
+ let commentHash = nameToCommentHash commentFolder
+ commentHashPath = commentHashRootDir mode </> commentHashLink commentHash
+ removeFileIfExists commentHashPath
+ Just (currentUsers :: [UserDump]) <- decodeStrict <$>
+ B.readFile (commentHashPath <.> "users")
+ forM_ currentUsers $ \u -> do
+ case uuserId u == userId' of
+ True -> return ()
+ False -> do
+ removeFileIfExists . T.unpack $ upath u
+ removeFileIfExists $ (T.unpack . upath $ u) <.> "info"
+ cleanBaseDirectory . T.unpack $ upath u
+ removeFileIfExists $ commentHashPath <.> "users"
+ cleanBaseDirectory commentHashPath
+ False -> return ()
+
+correctOwnerPathInComments :: BuildMode -> Text -> FilePath -> FilePath -> IO ()
+correctOwnerPathInComments mode userId' userPath commentFolder = do
+ let commentHash = nameToCommentHash commentFolder
+ commentHashPath = commentHashRootDir mode </> commentHashLink commentHash
+ Just (currentUsers :: [UserDump]) <- decodeStrict <$>
+ B.readFile (commentHashPath <.> "users")
+ let newUsr usr = usr { upath = T.pack userPath }
+ newUsers = map (\usr -> if uuserId usr /= userId' then usr
+ else newUsr usr) currentUsers
+ B.writeFile (commentHashPath <.> "users") $
+ LB.toStrict . encode $ newUsers
+
+removeOwnerPathInComments :: BuildMode -> Text -> FilePath -> IO ()
+removeOwnerPathInComments mode userId' commentFolder = do
+ let commentHash = nameToCommentHash commentFolder
+ commentHashPath = commentHashRootDir mode </> commentHashLink commentHash
+ Just (currentUsers :: [UserDump]) <- decodeStrict <$>
+ B.readFile (commentHashPath <.> "users")
+ B.writeFile (commentHashPath <.> "users") $
+ LB.toStrict . encode $ filter (\x -> uuserId x /= userId') currentUsers
+
+updateSharedCommentPath :: BuildMode -> FilePath -> FilePath -> IO ()
+updateSharedCommentPath mode oldCommentFolder commentFolder = do
+ let oldCommentHash = nameToCommentHash oldCommentFolder
+ oldCommentHashPath = commentHashRootDir mode </> commentHashLink oldCommentHash
+ commentHash = nameToCommentHash commentFolder
+ commentHashPath = commentHashRootDir mode </> commentHashLink commentHash
+ createDirectoryIfMissing False $ takeDirectory commentHashPath
+ mapM_ (\x -> renameFile (oldCommentHashPath <.> x) $ commentHashPath <.> x)
+ ["", "users"]
+ cleanBaseDirectory oldCommentHashPath
+ B.writeFile commentHashPath $ BC.pack commentFolder
+ Just (currentUsers :: [UserDump]) <- decodeStrict <$>
+ B.readFile (commentHashPath <.> "users")
+ forM_ currentUsers $ \u -> do
+ case utype u of
+ "owner" -> return ()
+ _ -> B.writeFile (T.unpack . upath $ u) $ BC.pack commentHashPath
+
+createNewVersionIfReq :: Text -> Int -> FilePath -> IO (Either String ())
+createNewVersionIfReq latestSource versionNo' commentFolder = do
+ currentVersions :: [Int] <- reverse . sort . map read <$>
+ listDirectory (commentFolder <.> "versions")
+ let currentVersion = currentVersions !! 0
+ currentSource <- T.decodeUtf8 <$>
+ B.readFile (commentFolder <.> "versions" </> show currentVersion)
+ case (currentSource == latestSource, currentVersion > versionNo') of
+ (_, True) -> return $ Left "Cannot Edit A Previous Version."
+ (True, _) -> return $ Right ()
+ (False, _) -> do
+ currentLines :: [Int] <- delete 0 . fmap read <$> listDirectory commentFolder
+ commentVersionLists :: [[[CommentDesc]]] <- mapM (\x -> versions . fromJust . decodeStrict <$>
+ B.readFile (commentFolder </> show x)) currentLines
+ let hasComments = foldr (\l acc ->
+ if (l !! currentVersion /= []) then True else acc
+ ) False commentVersionLists
+ case hasComments of
+ True -> do
+ B.writeFile (commentFolder <.> "versions" </> show (currentVersion + 1)) $
+ T.encodeUtf8 latestSource
+ ensureVersionLines (currentVersion + 1) commentFolder
+ return $ Right ()
+ False -> do
+ B.writeFile (commentFolder <.> "versions" </> show currentVersion) $
+ T.encodeUtf8 latestSource
+ ensureVersionLines currentVersion commentFolder
+ return $ Right ()
+
+updateUserVersionLS :: Text -> FilePath -> IO ()
+updateUserVersionLS userIdent' commentFolder = do
+ currentLines :: [Int] <- delete 0 . fmap read <$> listDirectory commentFolder
+ currentVersions :: [Int] <- fmap read <$> (listDirectory $ commentFolder <.> "versions")
+ commentVersionLists :: [[[CommentDesc]]] <- mapM (\x -> versions . fromJust . decodeStrict <$>
+ B.readFile (commentFolder </> show x)) currentLines
+ let versionLS = map (\v -> VersionLS v . LineStatuses $ foldr (\l acc ->
+ LineStatus (currentLines !! (fromJust $
+ l `elemIndex` commentVersionLists))
+ (if (l !! v /= []) then "unread" else "read") : acc
+ ) [] commentVersionLists
+ ) currentVersions
+ B.writeFile (commentFolder <.> "users" </> T.unpack userIdent') $
+ LB.toStrict . encode $ VersionLS_ versionLS
+
+ensureVersionLines :: Int -> FilePath -> IO ()
+ensureVersionLines versionNo' commentFolder = do
+ totalLines <- (length . lines . BC.unpack) <$>
+ (B.readFile $ commentFolder <.> "versions" </> show versionNo')
+ currentLines :: [Int] <- delete 0 . fmap read <$> listDirectory commentFolder
+ mapM_ (\x -> do
+ fileBool <- doesFileExist $ commentFolder </> show x
+ case fileBool of
+ True -> do
+ Just (currentLC :: LineComment) <- decodeStrict <$>
+ B.readFile (commentFolder </> show x)
+ let currLength = length . versions $ currentLC
+ let newLC = LineComment x (versions currentLC ++
+ replicate (versionNo' - currLength + 1) [])
+ B.writeFile (commentFolder </> show x) $ LB.toStrict . encode $ newLC
+ False -> do
+ let newLC = LineComment x (replicate (versionNo' + 1) [])
+ B.writeFile (commentFolder </> show x) $ LB.toStrict . encode $ newLC
+ )[1..totalLines `max` length currentLines]
+ currentUsers <- map T.pack <$> listDirectory (commentFolder <.> "users")
+ forM_ currentUsers $ \u -> do
+ Just (versionLS :: [VersionLS]) <- fmap getVersionLS <$> decodeStrict <$>
+ B.readFile (commentFolder <.> "users" </> T.unpack u)
+ let newVersionLS = versionLS ++ if (length versionLS == versionNo' + 1) then []
+ else [VersionLS versionNo' (LineStatuses [])]
+ B.writeFile (commentFolder <.> "users" </> T.unpack u) $
+ LB.toStrict . encode . VersionLS_ $ newVersionLS
+
+addNewUser :: Text -> Text -> FilePath -> FilePath -> FilePath -> IO (Either String ())
+addNewUser userId' userIdent' name userPath commentHashPath = do
+ let identAllowed = foldl (\acc l -> if l `elem` (T.unpack userIdent')
+ then False else acc) True ['/', '.', '+']
+ fileBool <- doesFileExist commentHashPath
+ -- make user id unique instead of user identifier only
+ case (identAllowed, fileBool) of
+ (_, False) -> return $ Left "File Does Not Exists"
+ (False, _) -> return $ Left "User Identifier Has Unallowed Char(/+.)"
+ (True, True) -> do
+ Just (currentUsers :: [UserDump]) <- decodeStrict <$>
+ B.readFile (commentHashPath <.> "users")
+ let currentIdents = map uuserIdent currentUsers
+ currentIds = map uuserId currentUsers
+ case (userId' `elem` currentIds, userIdent' `elem` currentIdents) of
+ (False, False) -> do
+ createDirectoryIfMissing False $ takeDirectory userPath
+ B.writeFile userPath $ BC.pack commentHashPath
+ B.writeFile (userPath <.> "info") $ BC.pack name
+ B.writeFile (commentHashPath <.> "users") $
+ LB.toStrict . encode $ UserDump
+ userId' userIdent' (T.pack userPath) "not_owner" : currentUsers
+ commentFolder <- BC.unpack <$> B.readFile commentHashPath
+ updateUserVersionLS userIdent' commentFolder
+ return $ Right ()
+ (False, True) -> return $ Left "User Identifier Already Exists"
+ (True, _) -> return $ Left "You already have access to comment in this file"
+
+addNewOwner :: BuildMode -> UserDump -> FilePath -> IO (Either String ())
+addNewOwner mode userDump commentFolder = do
+ let commentHash = nameToCommentHash commentFolder
+ commentHashPath = commentHashRootDir mode </> commentHashLink commentHash
+ Just (currentUsers :: [UserDump]) <- decodeStrict <$>
+ B.readFile (commentHashPath <.> "users")
+ let currentIdents = map uuserIdent currentUsers
+ currentIds = map uuserId currentUsers
+ case (uuserId userDump `elem` currentIds, uuserIdent userDump `elem` currentIdents) of
+ (True, _) -> return $ Left "User already exists for commenting maybe with a different identifier."
+ (False, True) -> return $ Left "User Identifier Already Exists"
+ (False, False) -> do
+ B.writeFile (commentHashPath <.> "users") $
+ LB.toStrict . encode $ userDump : currentUsers
+ updateUserVersionLS (uuserIdent userDump) commentFolder
+ return $ Right ()
+
+addCommentFunc :: BuildMode -> UserDump -> Project -> FilePath -> IO ()
+addCommentFunc mode userDump project commentFolder = do
+ let commentHash = nameToCommentHash commentFolder
+ commentHashPath = commentHashRootDir mode </> commentHashLink commentHash
+ createDirectoryIfMissing False commentFolder
+ ensureCommentHashDir mode commentHash
+ B.writeFile commentHashPath $ BC.pack commentFolder
+ B.writeFile (commentHashPath <.> "users") $
+ LB.toStrict . encode $ userDump : []
+ createDirectoryIfMissing False $ commentFolder <.> "users"
+ createDirectoryIfMissing False $ commentFolder <.> "versions"
+ B.writeFile (commentFolder <.> "versions" </> "0") $ T.encodeUtf8 . projectSource $ project
+ ensureVersionLines 0 commentFolder
+ updateUserVersionLS (uuserIdent userDump) commentFolder
+
+listUnreadComments :: Text -> FilePath -> Int -> IO [Int]
+listUnreadComments userIdent' commentFolder versionNo' = do
+ Just (versionLS :: VersionLS_) <- decodeStrict <$>
+ B.readFile (commentFolder <.> "users" </> T.unpack userIdent')
+ let currentLineList = listStatuses . versionStatus $ (getVersionLS versionLS) !! versionNo'
+ unreadLineList = foldr (\l acc ->
+ if ((T.unpack . lstatus $ l) == "unread") then (llineNo l) : acc
+ else acc)
+ [] currentLineList
+ return unreadLineList
+
+getLineComment :: FilePath -> Int -> Int -> IO [CommentDesc]
+getLineComment commentFolder lineNo' versionNo' = do
+ Just (lc :: LineComment) <- decodeStrict <$> B.readFile (commentFolder </> show lineNo')
+ return $ (versions lc) !! versionNo'
+
+markReadComments :: Text -> FilePath -> Int -> Int -> IO ()
+markReadComments userIdent' commentFolder lineNo' versionNo' = do
+ Just (versionLS :: VersionLS_) <- decodeStrict <$>
+ B.readFile (commentFolder <.> "users" </> T.unpack userIdent')
+ let currentLineList = listStatuses . versionStatus $ (getVersionLS versionLS) !! versionNo'
+ newLineList = VersionLS versionNo' . LineStatuses . map (\x ->
+ if llineNo x == lineNo' then LineStatus lineNo' "read"
+ else x) $ currentLineList
+ spnll = splitAt versionNo' (getVersionLS versionLS)
+ B.writeFile (commentFolder <.> "users" </> T.unpack userIdent') $
+ LB.toStrict . encode . VersionLS_ $ fst spnll ++ (newLineList : (tail $ snd spnll))
+
+addCommentToFile :: FilePath -> Int -> Int -> CommentDesc -> IO ()
+addCommentToFile commentFolder lineNo' versionNo' comment' = do
+ Just (lc :: LineComment) <- decodeStrict <$> B.readFile (commentFolder </> show lineNo')
+ let newComments = ((versions lc) !! versionNo') ++ [comment']
+ spvn = splitAt versionNo' (versions lc)
+ B.writeFile (commentFolder </> show lineNo') $ LB.toStrict . encode $ LineComment lineNo' $
+ fst spvn ++ (newComments : (tail $ snd spvn))
+
+markUnreadComments :: Text -> FilePath -> Int -> Int -> IO ()
+markUnreadComments userIdent' commentFolder lineNo' versionNo' = do
+ currentUsers <- delete (T.unpack userIdent') <$> listDirectory (commentFolder <.> "users")
+ forM_ currentUsers $ \u -> do
+ Just (versionLS :: VersionLS_) <- decodeStrict <$>
+ B.readFile (commentFolder <.> "users" </> u)
+ let currentLineList = listStatuses . versionStatus $
+ (getVersionLS versionLS) !! versionNo'
+ newLineList = VersionLS versionNo' . LineStatuses . map (\x ->
+ if llineNo x == lineNo' then LineStatus lineNo' "unread"
+ else x) $ currentLineList
+ spnll = splitAt versionNo' (getVersionLS versionLS)
+ B.writeFile (commentFolder <.> "users" </> T.unpack userIdent') $
+ LB.toStrict . encode . VersionLS_ $ fst spnll ++ (newLineList : (tail $ snd spnll))
+
+addReplyToComment :: FilePath -> Int -> Int -> CommentDesc -> ReplyDesc -> IO ()
+addReplyToComment commentFolder lineNo' versionNo' cd rd = do
+ Just (lc :: LineComment) <- decodeStrict <$> B.readFile (commentFolder </> show lineNo')
+ let Just ind = elemIndex cd ((versions lc) !! versionNo')
+ newcd = CommentDesc (cuserIdent cd) (cdateTime cd) (cstatus cd)
+ (comment cd) (replies cd ++ [rd])
+ splc = splitAt versionNo' $ versions lc
+ spvn = splitAt ind ((versions lc) !! versionNo')
+ newvn = fst spvn ++ (newcd : (tail $ snd spvn))
+ newlc = LineComment lineNo' $ fst splc ++ (newvn : (tail $ snd splc))
+ B.writeFile (commentFolder </> show lineNo') $ LB.toStrict . encode $ newlc
+
+deleteCommentFromFile :: FilePath -> Int -> Int -> CommentDesc -> IO ()
+deleteCommentFromFile commentFolder lineNo' versionNo' cd = do
+ Just (lc :: LineComment) <- decodeStrict <$> B.readFile (commentFolder </> show lineNo')
+ let Just ind = elemIndex cd ((versions lc) !! versionNo')
+ newcd = CommentDesc "none" (cdateTime cd) "deleted" "none" (replies cd)
+ splc = splitAt versionNo' $ versions lc
+ spvn = splitAt ind ((versions lc) !! versionNo')
+ newvn = fst spvn ++ (if (length $ replies cd) /= 0
+ then newcd : (tail $ snd spvn)
+ else tail $ snd spvn)
+ newlc = LineComment lineNo' $ fst splc ++ (newvn : (tail $ snd splc))
+ B.writeFile (commentFolder </> show lineNo') $ LB.toStrict . encode $ newlc
+
+deleteReplyFromComment :: FilePath -> Int -> Int -> CommentDesc -> ReplyDesc -> IO ()
+deleteReplyFromComment commentFolder lineNo' versionNo' cd rd = do
+ Just (lc :: LineComment) <- decodeStrict <$> B.readFile (commentFolder </> show lineNo')
+ let Just cdInd = elemIndex cd ((versions lc) !! versionNo')
+ Just rdInd = elemIndex rd (replies cd)
+ spvn = splitAt cdInd $ (versions lc) !! versionNo'
+ splc = splitAt versionNo' $ versions lc
+ spcd = splitAt rdInd $ replies cd
+ newcd = CommentDesc (cuserIdent cd) (cdateTime cd) (cstatus cd) (comment cd) $
+ (fst spcd) ++ (tail $ snd spcd)
+ newvn = fst spvn ++ (if (length $ replies newcd) /= 0
+ then newcd : (tail $ snd spvn)
+ else if cstatus newcd == "deleted"
+ then (tail $ snd spvn)
+ else newcd : (tail $ snd spvn))
+ newlc = LineComment lineNo' $ fst splc ++ (newvn : (tail $ snd splc))
+ B.writeFile (commentFolder </> show lineNo') $ LB.toStrict . encode $ newlc
diff --git a/codeworld-server/src/DataUtil.hs b/codeworld-server/src/DataUtil.hs
new file mode 100644
index 000000000..b8ac903ff
--- /dev/null
+++ b/codeworld-server/src/DataUtil.hs
@@ -0,0 +1,274 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+{-
+ Copyright 2017 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 DataUtil where
+
+import Control.Exception
+import Control.Monad
+import qualified Crypto.Hash as Crypto
+import Data.ByteArray (convert)
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Char8 as BC
+import qualified Data.ByteString.Base64 as B64
+import Data.List
+import Data.Maybe
+import Data.Monoid
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
+import System.Directory
+import System.IO.Error
+import System.FilePath
+import System.File.Tree (getDirectory, copyTo_)
+import System.Posix.Files
+
+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
+
+autocompletePath :: FilePath
+autocompletePath = "web/codeworld-base.txt"
+
+clientIdPath :: FilePath
+clientIdPath = "web/clientId.txt"
+
+buildRootDir :: BuildMode -> FilePath
+buildRootDir (BuildMode m) = "data" </> m </> "user"
+
+shareRootDir :: BuildMode -> FilePath
+shareRootDir (BuildMode m) = "data" </> m </> "share"
+
+projectRootDir :: BuildMode -> FilePath
+projectRootDir (BuildMode m) = "data" </> m </> "projects"
+
+deployRootDir :: BuildMode -> FilePath
+deployRootDir (BuildMode m) = "data" </> m </> "deploy"
+
+sourceBase :: ProgramId -> FilePath
+sourceBase (ProgramId p) = let s = T.unpack p in take 3 s </> s
+
+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"
+
+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
+
+userProjectDir :: BuildMode -> Text -> FilePath
+userProjectDir mode userId' = projectRootDir mode </> T.unpack userId'
+
+projectBase :: ProjectId -> FilePath
+projectBase (ProjectId p) = let s = T.unpack p in take 3 s </> s
+
+projectFile :: ProjectId -> FilePath
+projectFile projectId = projectBase projectId <.> "cw"
+
+sourceToProgramId :: ByteString -> ProgramId
+sourceToProgramId = ProgramId . hashToId "P"
+
+sourceToDeployId :: ByteString -> DeployId
+sourceToDeployId = DeployId . hashToId "D" . ("DEPLOY_ID" <>)
+
+nameToProjectId :: Text -> ProjectId
+nameToProjectId = ProjectId . hashToId "S" . T.encodeUtf8
+
+dirBase :: DirId -> FilePath
+dirBase (DirId d) = let s = T.unpack d in take 3 s </> s
+
+nameToDirId :: Text -> DirId
+nameToDirId = DirId . hashToId "D" . T.encodeUtf8
+
+ensureProgramDir :: BuildMode -> ProgramId -> IO ()
+ensureProgramDir mode (ProgramId p) = createDirectoryIfMissing True dir
+ where dir = buildRootDir mode </> take 3 (T.unpack p)
+
+ensureShareDir :: BuildMode -> ShareId -> IO ()
+ensureShareDir mode (ShareId s) = createDirectoryIfMissing True dir
+ where dir = shareRootDir mode </> take 3 (T.unpack s)
+
+ensureUserProjectDir :: BuildMode -> Text -> IO ()
+ensureUserProjectDir mode userId' =
+ createDirectoryIfMissing True (userProjectDir mode userId')
+
+ensureUserBaseDir :: BuildMode -> Text -> FilePath -> IO ()
+ensureUserBaseDir mode userId' path = do
+ ensureUserProjectDir mode userId'
+ createDirectoryIfMissing False (userProjectDir mode userId' </> takeDirectory path)
+
+ensureUserDir :: BuildMode -> Text -> FilePath -> IO ()
+ensureUserDir mode userId' path = do
+ ensureUserProjectDir mode userId'
+ createDirectoryIfMissing False (userProjectDir mode userId' </> path)
+
+ensureProjectDir :: BuildMode -> Text -> FilePath -> ProjectId -> IO ()
+ensureProjectDir mode userId' path projectId = do
+ ensureUserProjectDir mode userId'
+ createDirectoryIfMissing False (dropFileName f)
+ where f = userProjectDir mode userId' </> path </> projectFile projectId
+
+createNewFolder :: BuildMode -> Text -> FilePath -> FilePath -> IO ()
+createNewFolder mode userId' finalDir name = do
+ ensureUserBaseDir mode userId' finalDir
+ ensureUserDir mode userId' finalDir
+ B.writeFile (userProjectDir mode userId' </> finalDir </> "dir.info") $ BC.pack name
+
+listDirectoryWithPrefix :: FilePath -> IO [FilePath]
+listDirectoryWithPrefix filePath = map (filePath </>) <$> listDirectory filePath
+
+dirFilter :: [FilePath] -> Char -> IO [FilePath]
+dirFilter dirs' char = fmap concat $ mapM listDirectoryWithPrefix $
+ filter (\x -> head (takeBaseName x) == char) dirs'
+
+projectFileNames :: [FilePath] -> IO [Text]
+projectFileNames subHashedDirs = do
+ hashedFiles <- dirFilter subHashedDirs 'S'
+ projects <- fmap catMaybes $ forM hashedFiles $ \f -> do
+ exists <- doesFileExist f
+ case reverse f of
+ x | take 5 x == "ofni." ->
+ if exists then Just . T.decodeUtf8 <$> B.readFile f else return Nothing
+ _ -> return Nothing
+ return projects
+
+projectDirNames :: [FilePath] -> IO [Text]
+projectDirNames subHashedDirs = do
+ hashedDirs <- dirFilter subHashedDirs 'D'
+ dirs' <- mapM (\x -> B.readFile $ x </> "dir.info") hashedDirs
+ return $ map T.decodeUtf8 dirs'
+
+writeDeployLink :: BuildMode -> DeployId -> ProgramId -> IO ()
+writeDeployLink mode deployId (ProgramId p) = do
+ createDirectoryIfMissing True (dropFileName f)
+ B.writeFile f (T.encodeUtf8 p)
+ where f = deployRootDir mode </> deployLink deployId
+
+resolveDeployId :: BuildMode -> DeployId -> IO ProgramId
+resolveDeployId mode deployId = ProgramId . T.decodeUtf8 <$> B.readFile f
+ where f = deployRootDir mode </> deployLink deployId
+
+isDir :: FilePath -> IO Bool
+isDir path = do
+ status <- getFileStatus path
+ return $ isDirectory status
+
+migrateUser :: FilePath -> IO ()
+migrateUser userRoot = do
+ prevContent <- filter (\x -> (take 3 (reverse x) == "wc.") && (length x == 26)) <$>
+ listDirectory userRoot
+ mapM_ (\x -> createDirectoryIfMissing False $ userRoot </> take 3 x) prevContent
+ mapM_ (\x -> renameFile (userRoot </> x) $ userRoot </> take 3 x </> x) prevContent
+
+cleanBaseDirectory :: FilePath -> IO ()
+cleanBaseDirectory dir' = do
+ empty <- fmap (\ l -> length l == 2 && sort l == sort [".", ".."])
+ (getDirectoryContents (takeDirectory dir'))
+ if empty then removeDirectoryIfExists (takeDirectory dir')
+ else return ()
+
+getFilesRecursive :: FilePath -> IO [FilePath]
+getFilesRecursive path = do
+ dirBool <- isDir path
+ case dirBool of
+ True -> do
+ contents <- listDirectory path
+ concat <$> mapM (getFilesRecursive . (path </>)) contents
+ False -> case takeFileName path of
+ x | isSuffixOf ".info" (drop 23 x) -> return []
+ | x == "dir.info" -> return []
+ | otherwise -> 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.decodeUtf8
+ . BC.takeWhile (/= '=')
+ . BC.map toWebSafe
+ . B64.encode
+ . convert
+ . Crypto.hashFinalize
+ . Crypto.hashUpdates cryptoContext $ fileContents
+ where toWebSafe '/' = '_'
+ toWebSafe '+' = '-'
+ toWebSafe c = c
+
+hashToId :: Text -> ByteString -> Text
+hashToId pfx = (pfx <>)
+ . T.decodeUtf8
+ . BC.takeWhile (/= '=')
+ . BC.map toWebSafe
+ . B64.encode
+ . convert
+ . Crypto.hashWith Crypto.MD5
+ where toWebSafe '/' = '_'
+ toWebSafe '+' = '-'
+ toWebSafe c = c
+
+copyDirIfExists :: FilePath -> FilePath -> IO ()
+copyDirIfExists folder1 folder2 = (getDirectory folder1 >>= copyTo_ folder2) `catch` handleExists
+ where handleExists e
+ | isDoesNotExistError e = return ()
+ | otherwise = throwIO e
+
+moveDirIfExists :: FilePath -> FilePath -> IO ()
+moveDirIfExists folder1 folder2 = do
+ removeDirectoryIfExists folder2
+ copyDirIfExists folder1 folder2
+ removeDirectoryIfExists folder1
+
+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
diff --git a/codeworld-server/src/Folder.hs b/codeworld-server/src/Folder.hs
new file mode 100644
index 000000000..765cfb391
--- /dev/null
+++ b/codeworld-server/src/Folder.hs
@@ -0,0 +1,363 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+{-
+ Copyright 2017 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 Folder (
+ -- routes for file handling
+ folderRoutes
+ ) where
+
+import Control.Monad.Trans
+import Data.Aeson
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Char8 as BC
+import qualified Data.ByteString.Lazy as LB
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
+import Data.List
+import Data.Maybe (fromJust)
+import Snap.Core
+import Snap.Util.FileServe
+import System.Directory
+import System.FilePath
+
+import CollaborationUtil
+import CommentFolder
+import CommentUtil
+import DataUtil
+import Model
+import SnapUtil
+
+folderRoutes :: ClientId -> [(B.ByteString, Snap ())]
+folderRoutes clientId =
+ [ ("copyProject", copyProjectHandler clientId)
+ , ("createFolder", createFolderHandler clientId)
+ , ("deleteFolder", deleteFolderHandler clientId)
+ , ("deleteProject", deleteProjectHandler clientId)
+ , ("listFolder", listFolderHandler clientId)
+ , ("loadProject", loadProjectHandler clientId)
+ , ("moveProject", moveProjectHandler clientId)
+ , ("newProject", newProjectHandler clientId)
+ , ("shareContent", shareContentHandler clientId)
+ , ("shareFolder", shareFolderHandler clientId)
+ , ("saveProject", saveProjectHandler clientId)
+ ]
+
+data ParamsGetType = IsFile | IsDirectory deriving (Eq)
+
+getFrequentParams :: ParamsGetType -> ClientId -> Snap (User, BuildMode, FilePath, Maybe ProjectId)
+getFrequentParams getType clientId = do
+ user <- getUser clientId
+ mode <- getBuildMode
+ Just path' <- fmap (splitDirectories . BC.unpack) <$> getParam "path"
+ let finalDir = case (length path', path' !! 0) of
+ (0, _) -> ""
+ (_, "commentables") -> "commentables" </> (joinPath $
+ map (dirBase . nameToDirId . T.pack) $ tail path')
+ (_, _) -> joinPath $ map (dirBase . nameToDirId . T.pack) path'
+ case getType of
+ IsFile -> do
+ Just name <- getParam "name"
+ let projectId = nameToProjectId $ T.decodeUtf8 name
+ return (user, mode, finalDir, Just projectId)
+ IsDirectory -> return (user, mode, finalDir, Nothing)
+
+copyProjectHandler :: ClientId -> Snap ()
+copyProjectHandler clientId = do
+ mode <- getBuildMode
+ user <- getUser clientId
+ Just copyTo <- fmap (splitDirectories . BC.unpack) <$> getParam "copyTo"
+ Just copyFrom <- fmap (splitDirectories . BC.unpack) <$> getParam "copyFrom"
+ let projectDir = userProjectDir mode (userId user)
+ toType = (length copyTo > 0) && copyTo !! 0 == "commentables"
+ fromType = (length copyFrom > 0) && copyFrom !! 0 == "commentables"
+ copyToDir = case toType of
+ True -> "commentables" </> (joinPath $
+ map (dirBase . nameToDirId . T.pack) $ tail copyTo)
+ False -> joinPath $ map (dirBase . nameToDirId . T.pack) copyTo
+ copyFromDir = case fromType of
+ True -> "commentables" </> (joinPath $
+ map (dirBase . nameToDirId . T.pack) $ tail copyFrom)
+ False -> joinPath $ map (dirBase . nameToDirId . T.pack) copyFrom
+ case toType of
+ True -> do
+ modifyResponse $ setContentType "text/plain"
+ modifyResponse $ setResponseCode 404
+ writeBS . BC.pack $ "Cannot Copy Something Into `commentables` Directory"
+ False -> do
+ Just isFile <- getParam "isFile"
+ Just name <- fmap BC.unpack <$> getParam "name"
+ Just fromName <- fmap BC.unpack <$> getParam "fromName"
+ Just (emptyPH :: Value) <- decode . LB.fromStrict . fromJust <$> getParam "empty"
+ Just userIdent' <- fmap T.decodeUtf8 <$> getParam "userIdent"
+ let name' = if name == "commentables" then "commentables'" else name
+ fromName' = if fromName == "commentables" then "commentables'" else fromName
+ case (copyTo == copyFrom && fromName' == name', isFile) of
+ (False, "true") -> do
+ let projectId = nameToProjectId . T.pack $ name'
+ fromProjectId = nameToProjectId . T.pack $ fromName'
+ toFile = projectDir </> copyToDir </> projectFile projectId
+ case fromType of
+ True -> liftIO $ do
+ let fromFile = projectDir </> copyFromDir </> commentProjectLink fromProjectId
+ copyFileFromCommentables mode (userId user) userIdent'
+ fromFile toFile (BC.pack name') emptyPH
+ False -> liftIO $ do
+ let fromFile = projectDir </> copyFromDir </> projectFile fromProjectId
+ copyFileFromSelf mode (userId user) userIdent' fromFile toFile $ BC.pack name'
+ (False, "false") -> do
+ let toDir = copyToDir </> (dirBase . nameToDirId . T.pack $ name')
+ fromDir = copyFromDir </> (dirBase . nameToDirId . T.pack $ fromName')
+ _ <- liftIO $ deleteFolderWithComments mode (userId user) toDir
+ case fromType of
+ True -> liftIO $ do
+ copyFolderFromCommentables mode (userId user) userIdent' (projectDir </> fromDir)
+ (projectDir </> toDir) (T.pack name') emptyPH
+ False -> liftIO $ do
+ copyFolderFromSelf mode (userId user) userIdent' (projectDir </> fromDir)
+ (projectDir </> toDir) $ T.pack name'
+ (_, _) -> return ()
+
+createFolderHandler :: ClientId -> Snap ()
+createFolderHandler clientId = do
+ (user, mode, finalDir, _) <- getFrequentParams IsDirectory clientId
+ case finalDir == "commentables" of
+ True -> do
+ modifyResponse $ setContentType "text/plain"
+ modifyResponse $ setResponseCode 404
+ writeBS . BC.pack $
+ "`commentables` Hash Directory Is Forbidden In Root Folder For User Use"
+ False -> do
+ Just path' <- fmap (splitDirectories . BC.unpack) <$> getParam "path"
+ dirBool <- liftIO $ doesDirectoryExist finalDir
+ case dirBool of
+ True -> do
+ res <- liftIO $ deleteFolderWithComments mode (userId user) finalDir
+ case res of
+ Left err -> do
+ modifyResponse $ setContentType "text/plain"
+ modifyResponse $ setResponseCode 404
+ writeBS . BC.pack $ err
+ Right _ -> liftIO $ do
+ createNewFolder mode (userId user) finalDir (last path')
+ False -> liftIO $ do
+ createNewFolder mode (userId user) finalDir (last path')
+
+deleteFolderHandler :: ClientId -> Snap ()
+deleteFolderHandler clientId = do
+ (user, mode, finalDir, _) <- getFrequentParams IsDirectory clientId
+ res <- liftIO $ deleteFolderWithComments mode (userId user) finalDir
+ case res of
+ Left err -> do
+ modifyResponse $ setContentType "text/plain"
+ modifyResponse $ setResponseCode 404
+ writeBS . BC.pack $ err
+ Right _ -> return ()
+
+deleteProjectHandler :: ClientId -> Snap ()
+deleteProjectHandler clientId = do
+ (user, mode, finalDir, Just projectId) <- getFrequentParams IsFile clientId
+ case length (splitDirectories finalDir) of
+ x | (x /= 0) && ((splitDirectories finalDir) !! 0 == "commentables") -> do
+ let file = userProjectDir mode (userId user) </>
+ finalDir </> commentProjectLink projectId
+ liftIO $ removeUserFromComments (userId user) file
+ | otherwise -> do
+ let file = userProjectDir mode (userId user) </> finalDir </> projectFile projectId
+ liftIO $ cleanCommentPaths mode (userId user) file
+
+listFolderHandler :: ClientId -> Snap ()
+listFolderHandler clientId = do
+ (user, mode, finalDir, _) <- getFrequentParams IsDirectory clientId
+ liftIO $ do
+ ensureUserProjectDir mode (userId user)
+-- migrateUser $ userProjectDir mode (userId user)
+-- TODO: new migrate handler required.
+ ensureSharedCommentsDir mode (userId user)
+ let projectDir = userProjectDir mode (userId user)
+ subHashedDirs <- liftIO $ listDirectoryWithPrefix $ projectDir </> finalDir
+ let subHashedDirs' = case finalDir == "" of
+ True -> delete (projectDir </> "commentables") subHashedDirs
+ False -> subHashedDirs
+ files' <- liftIO $ projectFileNames subHashedDirs'
+ dirs' <- liftIO $ projectDirNames subHashedDirs'
+ modifyResponse $ setContentType "application/json"
+ case finalDir == "" of
+ True -> writeLBS (encode (Directory files' ("commentables" : dirs')))
+ False -> writeLBS (encode (Directory files' dirs'))
+
+loadProjectHandler :: ClientId -> Snap ()
+loadProjectHandler clientId = do
+ (user, mode, finalDir, Just projectId) <- getFrequentParams IsFile clientId
+ case length (splitDirectories finalDir) of
+ x | (x /= 0) && ((splitDirectories finalDir) !! 0 == "commentables") -> do
+ modifyResponse $ setContentType "text/plain"
+ modifyResponse $ setResponseCode 404
+ writeBS . BC.pack $ "Wrong Route To View A Source In `commentables` Directory"
+ | otherwise -> do
+ let file = userProjectDir mode (userId user) </> finalDir </> projectFile projectId
+ collabHashPath <- liftIO $ BC.unpack <$> B.readFile file
+ modifyResponse $ setContentType "application/json"
+ serveFile collabHashPath
+
+moveProjectHandler :: ClientId -> Snap ()
+moveProjectHandler clientId = do
+ mode <- getBuildMode
+ user <- getUser clientId
+ Just moveTo <- fmap (splitDirectories . BC.unpack) <$> getParam "moveTo"
+ Just moveFrom <- fmap (splitDirectories . BC.unpack) <$> getParam "moveFrom"
+ let projectDir = userProjectDir mode (userId user)
+ toType = (length moveTo > 0) && moveTo !! 0 == "commentables"
+ fromType = (length moveFrom > 0) && moveFrom !! 0 == "commentables"
+ moveToDir = case toType of
+ True -> "commentables" </> (joinPath $
+ map (dirBase . nameToDirId . T.pack) $ tail moveTo)
+ False -> joinPath $ map (dirBase . nameToDirId . T.pack) moveTo
+ moveFromDir = case fromType of
+ True -> "commentables" </> (joinPath $
+ map (dirBase . nameToDirId . T.pack) $ tail moveFrom)
+ False -> joinPath $ map (dirBase . nameToDirId . T.pack) moveFrom
+ case (toType && fromType) || (not $ toType || fromType) of
+ True -> do
+ Just isFile <- getParam "isFile"
+ Just name <- fmap BC.unpack <$> getParam "name"
+ Just fromName <- fmap BC.unpack <$> getParam "fromName"
+ let name' = if name == "commentables" then "commentables'" else name
+ fromName' = if fromName == "commentables" then "commentables'" else fromName
+ case (moveTo == moveFrom && fromName' == name', isFile) of
+ (False, "true") -> do
+ let projectId = nameToProjectId . T.pack $ name'
+ fromProjectId = nameToProjectId . T.pack $ fromName'
+ case toType of
+ True -> liftIO $ do
+ let fromFile = projectDir </> moveFromDir </> commentProjectLink fromProjectId
+ toFile = projectDir </> moveToDir </> commentProjectLink projectId
+ moveFileFromCommentables (userId user) fromFile toFile $ T.pack name'
+ False -> liftIO $ do
+ let fromFile = projectDir </> moveFromDir </> projectFile fromProjectId
+ toFile = projectDir </> moveToDir </> projectFile projectId
+ moveFileFromSelf mode (userId user) fromFile toFile $ T.pack name'
+ (False, "false") -> do
+ let toDir = moveToDir </> (dirBase . nameToDirId . T.pack $ name')
+ fromDir = moveFromDir </> (dirBase . nameToDirId . T.pack $ fromName')
+ _ <- liftIO $ deleteFolderWithComments mode (userId user) toDir
+ case toType of
+ True -> liftIO $ do
+ moveFolderFromCommentables mode (userId user) (projectDir </> fromDir)
+ (projectDir </> toDir) $ T.pack name'
+ False -> liftIO $ do
+ moveFolderFromSelf mode (userId user) (projectDir </> fromDir)
+ (projectDir </> toDir) $ T.pack name'
+ (_, _) -> return ()
+ False -> do
+ modifyResponse $ setContentType "text/plain"
+ modifyResponse $ setResponseCode 404
+ writeBS . BC.pack $ "Cannot Move From `commentables` to Normal and vice-versa"
+
+newProjectHandler :: ClientId -> Snap ()
+newProjectHandler clientId = do
+ (user, mode, finalDir, _) <- getFrequentParams IsDirectory clientId
+ case length (splitDirectories finalDir) of
+ x | (x /= 0) && ((splitDirectories finalDir) !! 0 == "commentables") -> do
+ modifyResponse $ setContentType "text/plain"
+ modifyResponse $ setResponseCode 404
+ writeBS . BC.pack $ "`commentables` Directory Does Not Allows New Projects"
+ | otherwise -> do
+ Just (project :: Project) <- decode . LB.fromStrict . fromJust <$> getParam "project"
+ Just userIdent' <- getParam "userIdent"
+ Just name <- getParam "name"
+ let projectId = nameToProjectId $ T.decodeUtf8 name
+ file = userProjectDir mode (userId user) </> finalDir </> projectFile projectId
+ liftIO $ do
+ cleanCommentPaths mode (userId user) file
+ ensureProjectDir mode (userId user) finalDir projectId
+ _ <- newCollaboratedProject mode (userId user) (T.decodeUtf8 userIdent')
+ name file project
+ return ()
+
+shareContentHandler :: ClientId -> Snap ()
+shareContentHandler clientId = do
+ (user, mode, finalDir, _) <- getFrequentParams IsDirectory clientId
+ case length (splitDirectories finalDir) of
+ x | (x /= 0) && ((splitDirectories finalDir) !! 0 == "commentables") -> do
+ modifyResponse $ setContentType "text/plain"
+ modifyResponse $ setResponseCode 404
+ writeBS . BC.pack $ "Cannot copy a shared folder into `commentables` directory."
+ | otherwise -> do
+ Just shash <- getParam "shash"
+ sharingFolder <- liftIO $ BC.unpack <$>
+ B.readFile (shareRootDir mode </> shareLink (ShareId $ T.decodeUtf8 shash))
+ Just name <- fmap T.decodeUtf8 <$> getParam "name"
+ Just userIdent' <- fmap T.decodeUtf8 <$> getParam "userIdent"
+ let toDir = finalDir </> (dirBase . nameToDirId $ name)
+ projectDir = userProjectDir mode $ userId user
+ liftIO $ do
+ _ <- liftIO $ deleteFolderWithComments mode (userId user) toDir
+ copyFolderFromSelf mode (userId user) userIdent' sharingFolder (projectDir </> toDir) name
+ B.writeFile (userProjectDir mode (userId user) </> toDir </> "dir.info") $ T.encodeUtf8 name
+
+shareFolderHandler :: ClientId -> Snap ()
+shareFolderHandler clientId = do
+ (user, mode, finalDir, _) <- getFrequentParams IsDirectory clientId
+ case length (splitDirectories finalDir) of
+ x | (x /= 0) && ((splitDirectories finalDir) !! 0 == "commentables") -> do
+ modifyResponse $ setContentType "text/plain"
+ modifyResponse $ setResponseCode 500
+ writeBS . BC.pack $ "Contents In `commentables` Directory Cannot Be Shared"
+ | otherwise -> do
+ checkSum <- liftIO $ dirToCheckSum $ userProjectDir mode (userId user) </> finalDir
+ liftIO $ ensureShareDir mode $ ShareId checkSum
+ liftIO $ B.writeFile (shareRootDir mode </> shareLink (ShareId checkSum)) $
+ BC.pack (userProjectDir mode (userId user) </> finalDir)
+ modifyResponse $ setContentType "text/plain"
+ writeBS $ T.encodeUtf8 checkSum
+
+saveProjectHandler :: ClientId -> Snap ()
+saveProjectHandler clientId = do
+ (user, mode, finalDir, _) <- getFrequentParams IsDirectory clientId
+ case length (splitDirectories finalDir) of
+ x | (x /= 0) && ((splitDirectories finalDir) !! 0 == "commentables") -> do
+ modifyResponse $ setContentType "text/plain"
+ modifyResponse $ setResponseCode 404
+ writeBS . BC.pack $ "`commentables` Directory Does Not Allows Editing Projects"
+ | otherwise -> do
+ Just (project :: Project) <- decodeStrict . fromJust <$> getParam "project"
+ Just name <- getParam "name"
+ Just (versionNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "versionNo"
+ let projectId = nameToProjectId $ T.decodeUtf8 name
+ file = userProjectDir mode (userId user) </> finalDir </> projectFile projectId
+ checkName <- liftIO $ B.readFile $ file <.> "info"
+ case checkName == name of
+ False -> do
+ modifyResponse $ setContentType "text/plain"
+ modifyResponse $ setResponseCode 404
+ writeBS . BC.pack $ "File does not matches the file present at the server"
+ True -> do
+ -- no need to ensure a project file as
+ -- constrained to create a new project before editing.
+ projectContentPath <- liftIO $ BC.unpack <$> B.readFile file
+ liftIO $ B.writeFile projectContentPath $ LB.toStrict . encode $ project
+ res <- liftIO $ createNewVersionIfReq (projectSource project) versionNo' $
+ projectContentPath <.> "comments"
+ case res of
+ Left err -> do
+ modifyResponse $ setContentType "text/plain"
+ modifyResponse $ setResponseCode 404
+ writeBS . BC.pack $ err
+ Right _ -> return ()
diff --git a/codeworld-server/src/Main.hs b/codeworld-server/src/Main.hs
index 9f03ad557..61f64fb1d 100644
--- a/codeworld-server/src/Main.hs
+++ b/codeworld-server/src/Main.hs
@@ -1,7 +1,5 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE CPP #-}
-
{-
Copyright 2017 The CodeWorld Authors. All rights reserved.
@@ -30,27 +28,23 @@ import qualified Data.ByteString as B
import Data.ByteString.Builder (toLazyByteString)
import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString.Lazy as LB
-import Data.Char (isSpace)
-import Data.List
-import Data.Maybe
-import Data.Monoid
import qualified Data.Text as T
import qualified Data.Text.IO as T
-import qualified Data.Text.Encoding as T
import HIndent (reformat)
import HIndent.Types (defaultConfig)
-import Network.HTTP.Conduit
import Snap.Core
import Snap.Http.Server (quickHttpServe)
import Snap.Util.FileServe
-import Snap.Util.FileUploads
import System.Directory
import System.FilePath
-import Model
-import Util
-
-newtype ClientId = ClientId (Maybe T.Text) deriving (Eq)
+import Collaboration
+import Comment
+import DataUtil
+import Folder
+import qualified Funblocks as FB
+import Model
+import SnapUtil
main :: IO ()
main = do
@@ -67,245 +61,25 @@ main = do
quickHttpServe $ (processBody >> site clientId) <|> site clientId
--- Retrieves the user for the current request. The request should have an
--- id_token parameter with an id token retrieved from the Google
--- authentication API. The user is returned if the id token is valid.
-getUser :: ClientId -> Snap User
-getUser clientId = getParam "id_token" >>= \ case
- Nothing -> pass
- Just id_token -> do
- let url = "https://www.googleapis.com/oauth2/v1/tokeninfo?id_token=" ++ BC.unpack id_token
- decoded <- fmap decode $ liftIO $ simpleHttp url
- case decoded of
- Nothing -> pass
- Just user -> do
- when (clientId /= ClientId (Just (audience user))) pass
- return user
-
--- A revised upload policy that allows up to 4 MB of uploaded data in a
--- request. This is needed to handle uploads of projects including editor
--- history.
-codeworldUploadPolicy :: UploadPolicy
-codeworldUploadPolicy = setMaximumFormInputSize (2^(22 :: Int)) defaultUploadPolicy
-
--- Processes the body of a multipart request.
-#if MIN_VERSION_snap_core(1,0,0)
-processBody :: Snap ()
-processBody = do
- handleMultipart codeworldUploadPolicy (\x y -> return ())
- return ()
-#else
-processBody :: Snap ()
-processBody = do
- handleMultipart codeworldUploadPolicy (\x -> return ())
- return ()
-#endif
-
-getBuildMode :: Snap BuildMode
-getBuildMode = getParam "mode" >>= \ case
- Just "haskell" -> return (BuildMode "haskell")
- Just "blocklyXML" -> return (BuildMode "blocklyXML")
- _ -> return (BuildMode "codeworld")
-
site :: ClientId -> Snap ()
site clientId =
- route [
- ("loadProject", loadProjectHandler clientId),
- ("saveProject", saveProjectHandler clientId),
- ("deleteProject", deleteProjectHandler clientId),
- ("listFolder", listFolderHandler clientId),
- ("createFolder", createFolderHandler clientId),
- ("deleteFolder", deleteFolderHandler clientId),
- ("shareFolder", shareFolderHandler clientId),
- ("shareContent", shareContentHandler clientId),
- ("moveProject", moveProjectHandler clientId),
- ("compile", compileHandler),
- ("saveXMLhash", saveXMLHashHandler),
- ("loadXML", loadXMLHandler),
- ("loadSource", loadSourceHandler),
- ("run", runHandler),
- ("runJS", runHandler),
- ("runMsg", runMessageHandler),
- ("haskell", serveFile "web/env.html"),
- ("blocks", serveFile "web/blocks.html"),
- ("funblocks", serveFile "web/blocks.html"),
- ("indent", indentHandler)
- ] <|>
- serveDirectory "web"
-
--- 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")
-
-createFolderHandler :: ClientId -> Snap ()
-createFolderHandler clientId = do
- mode <- getBuildMode
- user <- getUser clientId
- Just path <- fmap (splitDirectories . BC.unpack) <$> getParam "path"
- let dirIds = map (nameToDirId . T.pack) path
- let finalDir = joinPath $ map dirBase dirIds
- liftIO $ ensureUserBaseDir mode (userId user) finalDir
- liftIO $ createDirectory $ userProjectDir mode (userId user) </> finalDir
- modifyResponse $ setContentType "text/plain"
- liftIO $ B.writeFile (userProjectDir mode (userId user) </> finalDir </> "dir.info") $ BC.pack $ last path
-
-deleteFolderHandler :: ClientId -> Snap ()
-deleteFolderHandler clientId = do
- mode <- getBuildMode
- user <- getUser clientId
- Just path <- fmap (splitDirectories . BC.unpack) <$> getParam "path"
- let dirIds = map (nameToDirId . T.pack) path
- let finalDir = joinPath $ map dirBase dirIds
- liftIO $ ensureUserDir mode (userId user) finalDir
- let dir = userProjectDir mode (userId user) </> finalDir
- empty <- liftIO $ fmap
- (\ l1 ->
- length l1 == 3 && sort l1 == sort [".", "..", takeFileName dir])
- (getDirectoryContents (takeDirectory dir))
- liftIO $ removeDirectoryIfExists $ if empty then takeDirectory dir else dir
-
-loadProjectHandler :: ClientId -> Snap ()
-loadProjectHandler clientId = do
- mode <- getBuildMode
- user <- getUser clientId
- Just name <- getParam "name"
- let projectName = T.decodeUtf8 name
- let projectId = nameToProjectId projectName
- Just path <- fmap (splitDirectories . BC.unpack) <$> getParam "path"
- let dirIds = map (nameToDirId . T.pack) path
- let finalDir = joinPath $ map dirBase dirIds
- liftIO $ ensureProjectDir mode (userId user) finalDir projectId
- let file = userProjectDir mode (userId user) </> finalDir </> projectFile projectId
- modifyResponse $ setContentType "application/json"
- serveFile file
-
-saveProjectHandler :: ClientId -> Snap ()
-saveProjectHandler clientId = do
- mode <- getBuildMode
- user <- getUser clientId
- Just path <- fmap (splitDirectories . BC.unpack) <$> getParam "path"
- let dirIds = map (nameToDirId . T.pack) path
- let finalDir = joinPath $ map dirBase dirIds
- Just project <- decode . LB.fromStrict . fromJust <$> getParam "project"
- let projectId = nameToProjectId (projectName project)
- liftIO $ ensureProjectDir mode (userId user) finalDir projectId
- let file = userProjectDir mode (userId user) </> finalDir </> projectFile projectId
- liftIO $ LB.writeFile file $ encode project
-
-deleteProjectHandler :: ClientId -> Snap ()
-deleteProjectHandler clientId = do
- mode <- getBuildMode
- user <- getUser clientId
- Just name <- getParam "name"
- let projectName = T.decodeUtf8 name
- let projectId = nameToProjectId projectName
- Just path <- fmap (splitDirectories . BC.unpack) <$> getParam "path"
- let dirIds = map (nameToDirId . T.pack) path
- let finalDir = joinPath $ map dirBase dirIds
- liftIO $ ensureProjectDir mode (userId user) finalDir projectId
- let file = userProjectDir mode (userId user) </> finalDir </> projectFile projectId
- empty <- liftIO $ fmap
- (\ l1 ->
- length l1 == 3 && sort l1 == sort [".", "..", takeFileName file])
- (getDirectoryContents (dropFileName file))
- liftIO $ if empty then removeDirectoryIfExists (dropFileName file)
- else removeFileIfExists file
-
-listFolderHandler :: ClientId -> Snap ()
-listFolderHandler clientId = do
- mode <- getBuildMode
- user <- getUser clientId
- Just path <- fmap (splitDirectories . BC.unpack) <$> getParam "path"
- let dirIds = map (nameToDirId . T.pack) path
- let finalDir = joinPath $ map dirBase dirIds
- liftIO $ ensureUserBaseDir mode (userId user) finalDir
- liftIO $ ensureUserDir mode (userId user) finalDir
- liftIO $ migrateUser $ userProjectDir mode (userId user)
- let projectDir = userProjectDir mode (userId user)
- subHashedDirs <- liftIO $ listDirectoryWithPrefix $ projectDir </> finalDir
- files <- liftIO $ projectFileNames subHashedDirs
- dirs <- liftIO $ projectDirNames subHashedDirs
- modifyResponse $ setContentType "application/json"
- writeLBS (encode (Directory files dirs))
-
-shareFolderHandler :: ClientId -> Snap ()
-shareFolderHandler clientId = do
- mode <- getBuildMode
- user <- getUser clientId
- Just path <- fmap (splitDirectories . BC.unpack) <$> getParam "path"
- let dirIds = map (nameToDirId . T.pack) path
- let finalDir = joinPath $ map dirBase dirIds
- checkSum <- liftIO $ dirToCheckSum $ userProjectDir mode (userId user) </> finalDir
- liftIO $ ensureShareDir mode $ ShareId checkSum
- liftIO $ B.writeFile (shareRootDir mode </> shareLink (ShareId checkSum)) $ BC.pack (userProjectDir mode (userId user) </> finalDir)
- modifyResponse $ setContentType "text/plain"
- writeBS $ T.encodeUtf8 checkSum
-
-shareContentHandler :: ClientId -> Snap ()
-shareContentHandler clientId = do
- mode <- getBuildMode
- Just shash <- getParam "shash"
- sharingFolder <- liftIO $ B.readFile (shareRootDir mode </> shareLink (ShareId $ T.decodeUtf8 shash))
- user <- getUser clientId
- Just name <- getParam "name"
- let dirPath = dirBase $ nameToDirId $ T.decodeUtf8 name
- liftIO $ ensureUserBaseDir mode (userId user) dirPath
- liftIO $ copyDirIfExists (BC.unpack sharingFolder) $ userProjectDir mode (userId user) </> dirPath
- liftIO $ B.writeFile (userProjectDir mode (userId user) </> dirPath </> "dir.info") name
-
-moveProjectHandler :: ClientId -> Snap ()
-moveProjectHandler clientId = do
- mode <- getBuildMode
- user <- getUser clientId
- Just moveTo <- fmap (splitDirectories . BC.unpack) <$> getParam "moveTo"
- let moveToDir = joinPath $ map (dirBase . nameToDirId . T.pack) moveTo
- Just moveFrom <- fmap (splitDirectories . BC.unpack) <$> getParam "moveFrom"
- let projectDir = userProjectDir mode (userId user)
- let moveFromDir = projectDir </> joinPath (map (dirBase . nameToDirId . T.pack) moveFrom)
- let parentFrom = if moveFrom == [] then [] else init moveFrom
- Just isFile <- getParam "isFile"
- case (moveTo == moveFrom, moveTo == parentFrom, isFile) of
- (False, _, "true") -> do
- Just name <- getParam "name"
- let projectId = nameToProjectId $ T.decodeUtf8 name
- file = moveFromDir </> projectFile projectId
- toFile = projectDir </> moveToDir </> projectFile projectId
- liftIO $ ensureProjectDir mode (userId user) moveToDir projectId
- liftIO $ copyFile file toFile
- empty <- liftIO $ fmap
- (\ l1 ->
- length l1 == 3 &&
- sort l1 == sort [".", "..", takeFileName $ projectFile projectId])
- (getDirectoryContents
- (dropFileName $ moveFromDir </> projectFile projectId))
- liftIO $ if empty then removeDirectoryIfExists (dropFileName $ moveFromDir </> projectFile projectId)
- else removeFileIfExists $ moveFromDir </> projectFile projectId
- (_, False, "false") -> do
- let dirName = last $ splitDirectories moveFromDir
- let dir = moveToDir </> take 3 dirName </> dirName
- liftIO $ ensureUserBaseDir mode (userId user) dir
- liftIO $ copyDirIfExists moveFromDir $ projectDir </> dir
- empty <- liftIO $
- fmap
- (\ l1 ->
- length l1 == 3 &&
- sort l1 == sort [".", "..", takeFileName moveFromDir])
- (getDirectoryContents (takeDirectory moveFromDir))
- liftIO $ removeDirectoryIfExists $ if empty then takeDirectory moveFromDir else moveFromDir
- (_, _, _) -> return ()
-
-saveXMLHashHandler :: Snap ()
-saveXMLHashHandler = do
- mode <- getBuildMode
- unless (mode==BuildMode "blocklyXML") $ modifyResponse $ setResponseCode 500
- Just source <- getParam "source"
- let programId = sourceToProgramId source
- liftIO $ ensureProgramDir mode programId
- liftIO $ B.writeFile (buildRootDir mode </> sourceXML programId) source
- modifyResponse $ setContentType "text/plain"
- writeBS (T.encodeUtf8 (unProgramId programId))
+ route ([
+ ("compile", compileHandler),
+ ("loadSource", loadSourceHandler),
+ ("run", runHandler),
+ ("runJS", runHandler),
+ ("runMsg", runMessageHandler),
+ ("haskell", serveFile "web/env.html"),
+ ("indent", indentHandler)
+ ] ++
+ (collabRoutes clientId) ++
+ (commentRoutes clientId) ++
+ (folderRoutes clientId) ++
+ (FB.funblockRoutes $ currToFB clientId)) <|>
+ serveDirectory "web"
+ where
+ currToFB clientId' = case clientId' of
+ ClientId a -> FB.ClientId a
compileHandler :: Snap ()
compileHandler = do
@@ -323,22 +97,6 @@ compileHandler = do
let result = CompileResult (unProgramId programId) (unDeployId deployId)
writeLBS (encode result)
-getHashParam :: Bool -> BuildMode -> Snap ProgramId
-getHashParam allowDeploy mode = getParam "hash" >>= \case
- Just h -> return (ProgramId (T.decodeUtf8 h))
- Nothing | allowDeploy -> do
- Just dh <- getParam "dhash"
- let deployId = DeployId (T.decodeUtf8 dh)
- liftIO $ resolveDeployId mode deployId
-
-loadXMLHandler :: Snap ()
-loadXMLHandler = do
- mode <- getBuildMode
- unless (mode==BuildMode "blocklyXML") $ modifyResponse $ setResponseCode 500
- programId <- getHashParam False mode
- modifyResponse $ setContentType "text/plain"
- serveFile (buildRootDir mode </> sourceXML programId)
-
loadSourceHandler :: Snap ()
loadSourceHandler = do
mode <- getBuildMode
@@ -363,7 +121,6 @@ runMessageHandler = do
indentHandler :: Snap ()
indentHandler = do
- mode <- getBuildMode
Just source <- getParam "source"
case reformat defaultConfig Nothing source of
Left err -> do
diff --git a/codeworld-server/src/Model.hs b/codeworld-server/src/Model.hs
index 6ed97fb93..9423833da 100644
--- a/codeworld-server/src/Model.hs
+++ b/codeworld-server/src/Model.hs
@@ -18,11 +18,12 @@
module Model where
-import Control.Applicative
import Control.Monad
import Data.Aeson
-import Data.Text (Text)
-import System.FilePath (FilePath)
+import Data.Aeson.Types
+import Data.HashMap.Strict (toList)
+import Data.Text (Text, pack)
+import Data.Time.Clock (UTCTime)
data User = User { userId :: Text, audience :: Text }
@@ -32,26 +33,23 @@ instance FromJSON User where
parseJSON _ = mzero
data Project = Project {
- projectName :: Text,
projectSource :: Text,
projectHistory :: Value
}
instance FromJSON Project where
- parseJSON (Object v) = Project <$> v .: "name"
- <*> v .: "source"
+ parseJSON (Object v) = Project <$> v .: "source"
<*> v .: "history"
parseJSON _ = mzero
instance ToJSON Project where
- toJSON p = object [ "name" .= projectName p,
- "source" .= projectSource p,
+ toJSON p = object [ "source" .= projectSource p,
"history" .= projectHistory p ]
data Directory = Directory {
files :: [Text],
dirs :: [Text]
- } deriving Show
+ }
instance ToJSON Directory where
toJSON dir = object [ "files" .= files dir,
@@ -65,3 +63,114 @@ data CompileResult = CompileResult {
instance ToJSON CompileResult where
toJSON cr = object [ "hash" .= compileHash cr,
"dhash" .= compileDeployHash cr ]
+
+data ReplyDesc = ReplyDesc {
+ ruserIdent :: Text,
+ rdateTime :: UTCTime,
+ rstatus :: Text,
+ reply :: Text
+ } deriving (Eq)
+
+instance FromJSON ReplyDesc where
+ parseJSON (Object o) = ReplyDesc <$> o .: "userIdent"
+ <*> o .: "dateTime"
+ <*> o .: "status"
+ <*> o .: "reply"
+ parseJSON _ = mzero
+
+instance ToJSON ReplyDesc where
+ toJSON rd = object [ "userIdent" .= ruserIdent rd,
+ "dateTime" .= rdateTime rd,
+ "status" .= rstatus rd, --present or deleted
+ "reply" .= reply rd ]
+
+data CommentDesc = CommentDesc {
+ cuserIdent :: Text,
+ cdateTime :: UTCTime,
+ cstatus :: Text,
+ comment :: Text,
+ replies :: [ReplyDesc]
+ } deriving (Eq)
+
+instance FromJSON CommentDesc where
+ parseJSON (Object o) = CommentDesc <$> o .: "userIdent"
+ <*> o .: "dateTime"
+ <*> o .: "status"
+ <*> o .: "comment"
+ <*> o .: "replies"
+ parseJSON _ = mzero
+
+instance ToJSON CommentDesc where
+ toJSON cd = object [ "userIdent" .= cuserIdent cd,
+ "dateTime" .= cdateTime cd,
+ "status" .= cstatus cd,
+ "comment" .= comment cd,
+ "replies" .= replies cd ]
+
+data LineComment = LineComment {
+ lineNo :: Int, -- 0 for global
+ versions :: [[CommentDesc]]
+ }
+
+instance FromJSON LineComment where
+ parseJSON (Object o) = LineComment <$> o .: "lineNo"
+ <*> o .: "versions"
+ parseJSON _ = mzero
+
+instance ToJSON LineComment where
+ toJSON lc = object [ "lineNo" .= lineNo lc,
+ "versions" .= versions lc ]
+
+data LineStatus = LineStatus {
+ llineNo :: Int,
+ lstatus :: Text -- "read" or "unread"
+ }
+
+newtype LineStatuses = LineStatuses { listStatuses :: [LineStatus] }
+
+instance FromJSON LineStatuses where
+ parseJSON x = LineStatuses <$> (parseJSON x >>= mapM parseLineStatus . toList)
+
+parseLineStatus :: (String, Value) -> Parser LineStatus
+parseLineStatus (k, v) = LineStatus (read k :: Int) <$> parseJSON v
+
+instance ToJSON LineStatuses where
+ toJSON lss = object $
+ map (\ls -> (pack . show $ llineNo ls) .= lstatus ls) $ listStatuses lss
+
+data UserDump = UserDump {
+ uuserId :: Text,
+ uuserIdent :: Text,
+ upath :: Text,
+ utype :: Text
+ } deriving (Eq)
+
+instance FromJSON UserDump where
+ parseJSON (Object o) = UserDump <$> o .: "userId"
+ <*> o .: "userIdent"
+ <*> o .: "path"
+ <*> o .: "type"
+ parseJSON _ = mzero
+
+instance ToJSON UserDump where
+ toJSON ud = object [ "userId" .= uuserId ud,
+ "userIdent" .= uuserIdent ud,
+ "path" .= upath ud,
+ "type" .= utype ud ]
+
+data VersionLS = VersionLS {
+ versionNo :: Int,
+ versionStatus :: LineStatuses
+ }
+
+newtype VersionLS_ = VersionLS_ { getVersionLS :: [VersionLS] }
+
+instance FromJSON VersionLS_ where
+ parseJSON x = VersionLS_ <$> (parseJSON x >>= mapM parseVersionLS . toList)
+
+parseVersionLS :: (String, Value) -> Parser VersionLS
+parseVersionLS (k, v) = VersionLS (read k :: Int) <$> parseJSON v
+
+instance ToJSON VersionLS_ where
+ toJSON vls = object $
+ map (\x -> (pack . show $ versionNo x) .= versionStatus x) $ getVersionLS vls
diff --git a/codeworld-server/src/SnapUtil.hs b/codeworld-server/src/SnapUtil.hs
new file mode 100644
index 000000000..bce7432fc
--- /dev/null
+++ b/codeworld-server/src/SnapUtil.hs
@@ -0,0 +1,91 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE CPP #-}
+
+{-
+ Copyright 2017 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 SnapUtil where
+
+import Control.Monad
+import Control.Monad.Trans
+import Data.Aeson
+import qualified Data.ByteString.Char8 as BC
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
+import Network.HTTP.Conduit
+import Snap.Core
+import Snap.Util.FileServe
+import Snap.Util.FileUploads
+
+import DataUtil
+import Model
+
+newtype ClientId = ClientId (Maybe T.Text) deriving (Eq)
+
+-- Retrieves the user for the current request. The request should have an
+-- id_token parameter with an id token retrieved from the Google
+-- authentication API. The user is returned if the id token is valid.
+getUser :: ClientId -> Snap User
+getUser clientId = getParam "id_token" >>= \ case
+ Nothing -> pass
+ Just id_token -> do
+ let url = "https://www.googleapis.com/oauth2/v1/tokeninfo?id_token=" ++ BC.unpack id_token
+ decoded <- fmap decode $ liftIO $ simpleHttp url
+ case decoded of
+ Nothing -> pass
+ Just user -> do
+ when (clientId /= ClientId (Just (audience user))) pass
+ return user
+
+-- A revised upload policy that allows up to 4 MB of uploaded data in a
+-- request. This is needed to handle uploads of projects including editor
+-- history.
+codeworldUploadPolicy :: UploadPolicy
+codeworldUploadPolicy = setMaximumFormInputSize (2^(22 :: Int)) defaultUploadPolicy
+
+-- Processes the body of a multipart request.
+#if MIN_VERSION_snap_core(1,0,0)
+processBody :: Snap ()
+processBody = do
+ handleMultipart codeworldUploadPolicy (\_ _ -> return ())
+ return ()
+#else
+processBody :: Snap ()
+processBody = do
+ handleMultipart codeworldUploadPolicy (\_ -> return ())
+ return ()
+#endif
+
+getBuildMode :: Snap BuildMode
+getBuildMode = getParam "mode" >>= \ case
+ Just "haskell" -> return (BuildMode "haskell")
+ Just "blocklyXML" -> return (BuildMode "blocklyXML")
+ _ -> return (BuildMode "codeworld")
+
+-- 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")
+
+getHashParam :: Bool -> BuildMode -> Snap ProgramId
+getHashParam allowDeploy mode = getParam "hash" >>= \case
+ Just h -> return (ProgramId (T.decodeUtf8 h))
+ Nothing | allowDeploy -> do
+ Just dh <- getParam "dhash"
+ let deployId = DeployId (T.decodeUtf8 dh)
+ liftIO $ resolveDeployId mode deployId
diff --git a/funblocks-server/.ghci b/funblocks-server/.ghci
new file mode 100644
index 000000000..0bfc9da17
--- /dev/null
+++ b/funblocks-server/.ghci
@@ -0,0 +1,2 @@
+:set -isrc
+:set -XOverloadedStrings
diff --git a/funblocks-server/.gitignore b/funblocks-server/.gitignore
new file mode 100644
index 000000000..849ddff3b
--- /dev/null
+++ b/funblocks-server/.gitignore
@@ -0,0 +1 @@
+dist/
diff --git a/funblocks-server/LICENSE b/funblocks-server/LICENSE
new file mode 100644
index 000000000..d64569567
--- /dev/null
+++ b/funblocks-server/LICENSE
@@ -0,0 +1,202 @@
+
+ Apache License
+ Version 2.0, January 2004
+ http://www.apache.org/licenses/
+
+ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION
+
+ 1. Definitions.
+
+ "License" shall mean the terms and conditions for use, reproduction,
+ and distribution as defined by Sections 1 through 9 of this document.
+
+ "Licensor" shall mean the copyright owner or entity authorized by
+ the copyright owner that is granting the License.
+
+ "Legal Entity" shall mean the union of the acting entity and all
+ other entities that control, are controlled by, or are under common
+ control with that entity. For the purposes of this definition,
+ "control" means (i) the power, direct or indirect, to cause the
+ direction or management of such entity, whether by contract or
+ otherwise, or (ii) ownership of fifty percent (50%) or more of the
+ outstanding shares, or (iii) beneficial ownership of such entity.
+
+ "You" (or "Your") shall mean an individual or Legal Entity
+ exercising permissions granted by this License.
+
+ "Source" form shall mean the preferred form for making modifications,
+ including but not limited to software source code, documentation
+ source, and configuration files.
+
+ "Object" form shall mean any form resulting from mechanical
+ transformation or translation of a Source form, including but
+ not limited to compiled object code, generated documentation,
+ and conversions to other media types.
+
+ "Work" shall mean the work of authorship, whether in Source or
+ Object form, made available under the License, as indicated by a
+ copyright notice that is included in or attached to the work
+ (an example is provided in the Appendix below).
+
+ "Derivative Works" shall mean any work, whether in Source or Object
+ form, that is based on (or derived from) the Work and for which the
+ editorial revisions, annotations, elaborations, or other modifications
+ represent, as a whole, an original work of authorship. For the purposes
+ of this License, Derivative Works shall not include works that remain
+ separable from, or merely link (or bind by name) to the interfaces of,
+ the Work and Derivative Works thereof.
+
+ "Contribution" shall mean any work of authorship, including
+ the original version of the Work and any modifications or additions
+ to that Work or Derivative Works thereof, that is intentionally
+ submitted to Licensor for inclusion in the Work by the copyright owner
+ or by an individual or Legal Entity authorized to submit on behalf of
+ the copyright owner. For the purposes of this definition, "submitted"
+ means any form of electronic, verbal, or written communication sent
+ to the Licensor or its representatives, including but not limited to
+ communication on electronic mailing lists, source code control systems,
+ and issue tracking systems that are managed by, or on behalf of, the
+ Licensor for the purpose of discussing and improving the Work, but
+ excluding communication that is conspicuously marked or otherwise
+ designated in writing by the copyright owner as "Not a Contribution."
+
+ "Contributor" shall mean Licensor and any individual or Legal Entity
+ on behalf of whom a Contribution has been received by Licensor and
+ subsequently incorporated within the Work.
+
+ 2. Grant of Copyright License. Subject to the terms and conditions of
+ this License, each Contributor hereby grants to You a perpetual,
+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable
+ copyright license to reproduce, prepare Derivative Works of,
+ publicly display, publicly perform, sublicense, and distribute the
+ Work and such Derivative Works in Source or Object form.
+
+ 3. Grant of Patent License. Subject to the terms and conditions of
+ this License, each Contributor hereby grants to You a perpetual,
+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable
+ (except as stated in this section) patent license to make, have made,
+ use, offer to sell, sell, import, and otherwise transfer the Work,
+ where such license applies only to those patent claims licensable
+ by such Contributor that are necessarily infringed by their
+ Contribution(s) alone or by combination of their Contribution(s)
+ with the Work to which such Contribution(s) was submitted. If You
+ institute patent litigation against any entity (including a
+ cross-claim or counterclaim in a lawsuit) alleging that the Work
+ or a Contribution incorporated within the Work constitutes direct
+ or contributory patent infringement, then any patent licenses
+ granted to You under this License for that Work shall terminate
+ as of the date such litigation is filed.
+
+ 4. Redistribution. You may reproduce and distribute copies of the
+ Work or Derivative Works thereof in any medium, with or without
+ modifications, and in Source or Object form, provided that You
+ meet the following conditions:
+
+ (a) You must give any other recipients of the Work or
+ Derivative Works a copy of this License; and
+
+ (b) You must cause any modified files to carry prominent notices
+ stating that You changed the files; and
+
+ (c) You must retain, in the Source form of any Derivative Works
+ that You distribute, all copyright, patent, trademark, and
+ attribution notices from the Source form of the Work,
+ excluding those notices that do not pertain to any part of
+ the Derivative Works; and
+
+ (d) If the Work includes a "NOTICE" text file as part of its
+ distribution, then any Derivative Works that You distribute must
+ include a readable copy of the attribution notices contained
+ within such NOTICE file, excluding those notices that do not
+ pertain to any part of the Derivative Works, in at least one
+ of the following places: within a NOTICE text file distributed
+ as part of the Derivative Works; within the Source form or
+ documentation, if provided along with the Derivative Works; or,
+ within a display generated by the Derivative Works, if and
+ wherever such third-party notices normally appear. The contents
+ of the NOTICE file are for informational purposes only and
+ do not modify the License. You may add Your own attribution
+ notices within Derivative Works that You distribute, alongside
+ or as an addendum to the NOTICE text from the Work, provided
+ that such additional attribution notices cannot be construed
+ as modifying the License.
+
+ You may add Your own copyright statement to Your modifications and
+ may provide additional or different license terms and conditions
+ for use, reproduction, or distribution of Your modifications, or
+ for any such Derivative Works as a whole, provided Your use,
+ reproduction, and distribution of the Work otherwise complies with
+ the conditions stated in this License.
+
+ 5. Submission of Contributions. Unless You explicitly state otherwise,
+ any Contribution intentionally submitted for inclusion in the Work
+ by You to the Licensor shall be under the terms and conditions of
+ this License, without any additional terms or conditions.
+ Notwithstanding the above, nothing herein shall supersede or modify
+ the terms of any separate license agreement you may have executed
+ with Licensor regarding such Contributions.
+
+ 6. Trademarks. This License does not grant permission to use the trade
+ names, trademarks, service marks, or product names of the Licensor,
+ except as required for reasonable and customary use in describing the
+ origin of the Work and reproducing the content of the NOTICE file.
+
+ 7. Disclaimer of Warranty. Unless required by applicable law or
+ agreed to in writing, Licensor provides the Work (and each
+ Contributor provides its Contributions) on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
+ implied, including, without limitation, any warranties or conditions
+ of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A
+ PARTICULAR PURPOSE. You are solely responsible for determining the
+ appropriateness of using or redistributing the Work and assume any
+ risks associated with Your exercise of permissions under this License.
+
+ 8. Limitation of Liability. In no event and under no legal theory,
+ whether in tort (including negligence), contract, or otherwise,
+ unless required by applicable law (such as deliberate and grossly
+ negligent acts) or agreed to in writing, shall any Contributor be
+ liable to You for damages, including any direct, indirect, special,
+ incidental, or consequential damages of any character arising as a
+ result of this License or out of the use or inability to use the
+ Work (including but not limited to damages for loss of goodwill,
+ work stoppage, computer failure or malfunction, or any and all
+ other commercial damages or losses), even if such Contributor
+ has been advised of the possibility of such damages.
+
+ 9. Accepting Warranty or Additional Liability. While redistributing
+ the Work or Derivative Works thereof, You may choose to offer,
+ and charge a fee for, acceptance of support, warranty, indemnity,
+ or other liability obligations and/or rights consistent with this
+ License. However, in accepting such obligations, You may act only
+ on Your own behalf and on Your sole responsibility, not on behalf
+ of any other Contributor, and only if You agree to indemnify,
+ defend, and hold each Contributor harmless for any liability
+ incurred by, or claims asserted against, such Contributor by reason
+ of your accepting any such warranty or additional liability.
+
+ END OF TERMS AND CONDITIONS
+
+ APPENDIX: How to apply the Apache License to your work.
+
+ To apply the Apache License to your work, attach the following
+ boilerplate notice, with the fields enclosed by brackets "[]"
+ replaced with your own identifying information. (Don't include
+ the brackets!) The text should be enclosed in the appropriate
+ comment syntax for the file format. We also recommend that a
+ file or class name and description of purpose be included on the
+ same "printed page" as the copyright notice for easier
+ identification within third-party archives.
+
+ Copyright [yyyy] [name of copyright owner]
+
+ 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.
diff --git a/codeworld-game-server/src/Main.hs b/funblocks-server/Setup.hs
similarity index 55%
rename from codeworld-game-server/src/Main.hs
rename to funblocks-server/Setup.hs
index 64bef0bea..51c7b3500 100644
--- a/codeworld-game-server/src/Main.hs
+++ b/funblocks-server/Setup.hs
@@ -1,14 +1,9 @@
-{-# LANGUAGE OverloadedStrings #-}
-
{-
Copyright 2017 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.
@@ -16,22 +11,5 @@
limitations under the License.
-}
-import CodeWorld.GameServer
-
-import Snap.Core
-import Snap.Http.Server
-import Control.Applicative
-
-main :: IO ()
-main = do
- state <- initGameServer
- config <- commandLineConfig $
- setPort 9160 $
- setErrorLog (ConfigFileLog "log/game-error.log") $
- setAccessLog (ConfigFileLog "log/game-access.log") $
- mempty
- httpServe config $
- ifTop (gameStats state) <|>
- route [ ("gameserver", gameServer state) ]
-
-
+import Distribution.Simple
+main = defaultMain
diff --git a/funblocks-server/funblocks-server.cabal b/funblocks-server/funblocks-server.cabal
new file mode 100644
index 000000000..0ea198edc
--- /dev/null
+++ b/funblocks-server/funblocks-server.cabal
@@ -0,0 +1,45 @@
+Name: funblocks-server
+Version: 0.1
+Synopsis: Web framework for Funblocks in CodeWorld
+License-file: LICENSE
+Author: The CodeWorld Authors
+Maintainer: Chris Smith <cdsmith@gmail.com>
+Copyright: (c) 2017, The CodeWorld Authors
+Build-type: Simple
+Cabal-version: >=1.2
+
+Description:
+ The web framework for the CodeWorld's funblock programming environment.
+
+Library
+ Exposed-modules: Funblocks
+ Other-modules: Model, Util
+
+ Build-depends:
+ aeson,
+ base,
+ base64-bytestring,
+ bytestring,
+ cryptonite,
+ data-default,
+ directory,
+ filepath,
+ filesystem-trees,
+ hindent >= 5 && < 5.2.3,
+ http-conduit,
+ memory,
+ mtl,
+ process,
+ regex-compat,
+ regex-tdfa,
+ snap-core,
+ snap-server,
+ temporary,
+ text,
+ unix
+
+ Hs-source-dirs: src
+ Exposed: True
+
+ Ghc-options: -threaded -Wall -funbox-strict-fields -O2
+ -fno-warn-unused-do-bind
diff --git a/funblocks-server/src/Funblocks.hs b/funblocks-server/src/Funblocks.hs
new file mode 100644
index 000000000..dcd5544e1
--- /dev/null
+++ b/funblocks-server/src/Funblocks.hs
@@ -0,0 +1,261 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE CPP #-}
+{-
+ Copyright 2017 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 Funblocks (funblockRoutes, ClientId(..)) where
+
+import Control.Monad
+import Control.Monad.Trans
+import Data.Aeson
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Char8 as BC
+import qualified Data.ByteString.Lazy as LB
+import Data.List
+import Data.Maybe
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
+import Network.HTTP.Conduit
+import Snap.Core
+import Snap.Util.FileServe
+import System.Directory
+import System.FilePath
+
+import Model
+import Util
+
+newtype ClientId = ClientId (Maybe T.Text) deriving (Eq)
+
+-- Retrieves the user for the current request. The request should have an
+-- id_token parameter with an id token retrieved from the Google
+-- authentication API. The user is returned if the id token is valid.
+getUser :: ClientId -> Snap User
+getUser clientId = getParam "id_token" >>= \ case
+ Nothing -> pass
+ Just id_token -> do
+ let url = "https://www.googleapis.com/oauth2/v1/tokeninfo?id_token=" ++ BC.unpack id_token
+ decoded <- fmap decode $ liftIO $ simpleHttp url
+ case decoded of
+ Nothing -> pass
+ Just user -> do
+ when (clientId /= ClientId (Just (audience user))) pass
+ return user
+
+getBuildMode :: Snap BuildMode
+getBuildMode = getParam "mode" >>= \ case
+ Just "blocklyXML" -> return (BuildMode "blocklyXML")
+
+funblockRoutes :: ClientId -> [(B.ByteString, Snap ())]
+funblockRoutes clientId =
+ [ ("floadProject", loadProjectHandler clientId)
+ , ("fsaveProject", saveProjectHandler clientId)
+ , ("fdeleteProject", deleteProjectHandler clientId)
+ , ("flistFolder", listFolderHandler clientId)
+ , ("fcreateFolder", createFolderHandler clientId)
+ , ("fdeleteFolder", deleteFolderHandler clientId)
+ , ("fshareFolder", shareFolderHandler clientId)
+ , ("fshareContent", shareContentHandler clientId)
+ , ("fmoveProject", moveProjectHandler clientId)
+ , ("fsaveXMLhash", saveXMLHashHandler)
+ , ("floadXML", loadXMLHandler)
+ , ("blocks", serveFile "web/blocks.html")
+ , ("funblocks", serveFile "web/blocks.html")
+ ]
+
+createFolderHandler :: ClientId -> Snap ()
+createFolderHandler clientId = do
+ mode <- getBuildMode
+ user <- getUser clientId
+ Just path <- fmap (splitDirectories . BC.unpack) <$> getParam "path"
+ let dirIds = map (nameToDirId . T.pack) path
+ let finalDir = joinPath $ map dirBase dirIds
+ liftIO $ ensureUserBaseDir mode (userId user) finalDir
+ liftIO $ createDirectory $ userProjectDir mode (userId user) </> finalDir
+ modifyResponse $ setContentType "text/plain"
+ liftIO $ B.writeFile (userProjectDir mode (userId user) </> finalDir </> "dir.info") $ BC.pack $ last path
+
+deleteFolderHandler :: ClientId -> Snap ()
+deleteFolderHandler clientId = do
+ mode <- getBuildMode
+ user <- getUser clientId
+ Just path <- fmap (splitDirectories . BC.unpack) <$> getParam "path"
+ let dirIds = map (nameToDirId . T.pack) path
+ let finalDir = joinPath $ map dirBase dirIds
+ liftIO $ ensureUserDir mode (userId user) finalDir
+ let dir = userProjectDir mode (userId user) </> finalDir
+ empty <- liftIO $ fmap
+ (\ l1 ->
+ length l1 == 3 && sort l1 == sort [".", "..", takeFileName dir])
+ (getDirectoryContents (takeDirectory dir))
+ liftIO $ removeDirectoryIfExists $ if empty then takeDirectory dir else dir
+
+loadProjectHandler :: ClientId -> Snap ()
+loadProjectHandler clientId = do
+ mode <- getBuildMode
+ user <- getUser clientId
+ Just name <- getParam "name"
+ let projectName = T.decodeUtf8 name
+ let projectId = nameToProjectId projectName
+ Just path <- fmap (splitDirectories . BC.unpack) <$> getParam "path"
+ let dirIds = map (nameToDirId . T.pack) path
+ let finalDir = joinPath $ map dirBase dirIds
+ liftIO $ ensureProjectDir mode (userId user) finalDir projectId
+ let file = userProjectDir mode (userId user) </> finalDir </> projectFile projectId
+ modifyResponse $ setContentType "application/json"
+ serveFile file
+
+saveProjectHandler :: ClientId -> Snap ()
+saveProjectHandler clientId = do
+ mode <- getBuildMode
+ user <- getUser clientId
+ Just path <- fmap (splitDirectories . BC.unpack) <$> getParam "path"
+ let dirIds = map (nameToDirId . T.pack) path
+ let finalDir = joinPath $ map dirBase dirIds
+ Just project <- decode . LB.fromStrict . fromJust <$> getParam "project"
+ let projectId = nameToProjectId (projectName project)
+ liftIO $ ensureProjectDir mode (userId user) finalDir projectId
+ let file = userProjectDir mode (userId user) </> finalDir </> projectFile projectId
+ liftIO $ LB.writeFile file $ encode project
+
+deleteProjectHandler :: ClientId -> Snap ()
+deleteProjectHandler clientId = do
+ mode <- getBuildMode
+ user <- getUser clientId
+ Just name <- getParam "name"
+ let projectName = T.decodeUtf8 name
+ let projectId = nameToProjectId projectName
+ Just path <- fmap (splitDirectories . BC.unpack) <$> getParam "path"
+ let dirIds = map (nameToDirId . T.pack) path
+ let finalDir = joinPath $ map dirBase dirIds
+ liftIO $ ensureProjectDir mode (userId user) finalDir projectId
+ let file = userProjectDir mode (userId user) </> finalDir </> projectFile projectId
+ empty <- liftIO $ fmap
+ (\ l1 ->
+ length l1 == 3 && sort l1 == sort [".", "..", takeFileName file])
+ (getDirectoryContents (dropFileName file))
+ liftIO $ if empty then removeDirectoryIfExists (dropFileName file)
+ else removeFileIfExists file
+
+listFolderHandler :: ClientId -> Snap ()
+listFolderHandler clientId = do
+ mode <- getBuildMode
+ user <- getUser clientId
+ Just path <- fmap (splitDirectories . BC.unpack) <$> getParam "path"
+ let dirIds = map (nameToDirId . T.pack) path
+ let finalDir = joinPath $ map dirBase dirIds
+ liftIO $ ensureUserBaseDir mode (userId user) finalDir
+ liftIO $ ensureUserDir mode (userId user) finalDir
+ liftIO $ migrateUser $ userProjectDir mode (userId user)
+ let projectDir = userProjectDir mode (userId user)
+ subHashedDirs <- liftIO $ listDirectoryWithPrefix $ projectDir </> finalDir
+ files <- liftIO $ projectFileNames subHashedDirs
+ dirs <- liftIO $ projectDirNames subHashedDirs
+ modifyResponse $ setContentType "application/json"
+ writeLBS (encode (Directory files dirs))
+
+shareFolderHandler :: ClientId -> Snap ()
+shareFolderHandler clientId = do
+ mode <- getBuildMode
+ user <- getUser clientId
+ Just path <- fmap (splitDirectories . BC.unpack) <$> getParam "path"
+ let dirIds = map (nameToDirId . T.pack) path
+ let finalDir = joinPath $ map dirBase dirIds
+ checkSum <- liftIO $ dirToCheckSum $ userProjectDir mode (userId user) </> finalDir
+ liftIO $ ensureShareDir mode $ ShareId checkSum
+ liftIO $ B.writeFile (shareRootDir mode </> shareLink (ShareId checkSum)) $ BC.pack (userProjectDir mode (userId user) </> finalDir)
+ modifyResponse $ setContentType "text/plain"
+ writeBS $ T.encodeUtf8 checkSum
+
+shareContentHandler :: ClientId -> Snap ()
+shareContentHandler clientId = do
+ mode <- getBuildMode
+ Just shash <- getParam "shash"
+ sharingFolder <- liftIO $ B.readFile (shareRootDir mode </> shareLink (ShareId $ T.decodeUtf8 shash))
+ user <- getUser clientId
+ Just name <- getParam "name"
+ let dirPath = dirBase $ nameToDirId $ T.decodeUtf8 name
+ liftIO $ ensureUserBaseDir mode (userId user) dirPath
+ liftIO $ copyDirIfExists (BC.unpack sharingFolder) $ userProjectDir mode (userId user) </> dirPath
+ liftIO $ B.writeFile (userProjectDir mode (userId user) </> dirPath </> "dir.info") name
+
+moveProjectHandler :: ClientId -> Snap ()
+moveProjectHandler clientId = do
+ mode <- getBuildMode
+ user <- getUser clientId
+ Just moveTo <- fmap (splitDirectories . BC.unpack) <$> getParam "moveTo"
+ let moveToDir = joinPath $ map (dirBase . nameToDirId . T.pack) moveTo
+ Just moveFrom <- fmap (splitDirectories . BC.unpack) <$> getParam "moveFrom"
+ let projectDir = userProjectDir mode (userId user)
+ let moveFromDir = projectDir </> joinPath (map (dirBase . nameToDirId . T.pack) moveFrom)
+ let parentFrom = if moveFrom == [] then [] else init moveFrom
+ Just isFile <- getParam "isFile"
+ case (moveTo == moveFrom, moveTo == parentFrom, isFile) of
+ (False, _, "true") -> do
+ Just name <- getParam "name"
+ let projectId = nameToProjectId $ T.decodeUtf8 name
+ file = moveFromDir </> projectFile projectId
+ toFile = projectDir </> moveToDir </> projectFile projectId
+ liftIO $ ensureProjectDir mode (userId user) moveToDir projectId
+ liftIO $ copyFile file toFile
+ empty <- liftIO $ fmap
+ (\ l1 ->
+ length l1 == 3 &&
+ sort l1 == sort [".", "..", takeFileName $ projectFile projectId])
+ (getDirectoryContents
+ (dropFileName $ moveFromDir </> projectFile projectId))
+ liftIO $ if empty then removeDirectoryIfExists (dropFileName $ moveFromDir </> projectFile projectId)
+ else removeFileIfExists $ moveFromDir </> projectFile projectId
+ (_, False, "false") -> do
+ let dirName = last $ splitDirectories moveFromDir
+ let dir = moveToDir </> take 3 dirName </> dirName
+ liftIO $ ensureUserBaseDir mode (userId user) dir
+ liftIO $ copyDirIfExists moveFromDir $ projectDir </> dir
+ empty <- liftIO $
+ fmap
+ (\ l1 ->
+ length l1 == 3 &&
+ sort l1 == sort [".", "..", takeFileName moveFromDir])
+ (getDirectoryContents (takeDirectory moveFromDir))
+ liftIO $ removeDirectoryIfExists $ if empty then takeDirectory moveFromDir else moveFromDir
+ (_, _, _) -> return ()
+
+saveXMLHashHandler :: Snap ()
+saveXMLHashHandler = do
+ mode <- getBuildMode
+ unless (mode==BuildMode "blocklyXML") $ modifyResponse $ setResponseCode 500
+ Just source <- getParam "source"
+ let programId = sourceToProgramId source
+ liftIO $ ensureProgramDir mode programId
+ liftIO $ B.writeFile (buildRootDir mode </> sourceXML programId) source
+ modifyResponse $ setContentType "text/plain"
+ writeBS (T.encodeUtf8 (unProgramId programId))
+
+getHashParam :: Bool -> BuildMode -> Snap ProgramId
+getHashParam allowDeploy mode = getParam "hash" >>= \case
+ Just h -> return (ProgramId (T.decodeUtf8 h))
+ Nothing | allowDeploy -> do
+ Just dh <- getParam "dhash"
+ let deployId = DeployId (T.decodeUtf8 dh)
+ liftIO $ resolveDeployId mode deployId
+
+loadXMLHandler :: Snap ()
+loadXMLHandler = do
+ mode <- getBuildMode
+ unless (mode==BuildMode "blocklyXML") $ modifyResponse $ setResponseCode 500
+ programId <- getHashParam False mode
+ modifyResponse $ setContentType "text/plain"
+ serveFile (buildRootDir mode </> sourceXML programId)
+
+getMode :: BuildMode -> String
+getMode (BuildMode m) = m
diff --git a/funblocks-server/src/Model.hs b/funblocks-server/src/Model.hs
new file mode 100644
index 000000000..abe203b0d
--- /dev/null
+++ b/funblocks-server/src/Model.hs
@@ -0,0 +1,62 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+{-
+ Copyright 2017 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.Monad
+import Data.Aeson
+import Data.Text (Text)
+
+data User = User { userId :: Text, audience :: Text }
+
+instance FromJSON User where
+ parseJSON (Object v) = User <$> v .: "user_id"
+ <*> v .: "audience"
+ parseJSON _ = mzero
+
+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 ]
+
+data Directory = Directory {
+ files :: [Text],
+ dirs :: [Text]
+ } deriving Show
+
+instance ToJSON Directory where
+ toJSON dir = object [ "files" .= files dir,
+ "dirs" .= dirs dir ]
+
+data CompileResult = CompileResult {
+ compileHash :: Text,
+ compileDeployHash :: Text
+ }
+
+instance ToJSON CompileResult where
+ toJSON cr = object [ "hash" .= compileHash cr,
+ "dhash" .= compileDeployHash cr ]
diff --git a/codeworld-server/src/Util.hs b/funblocks-server/src/Util.hs
similarity index 99%
rename from codeworld-server/src/Util.hs
rename to funblocks-server/src/Util.hs
index 69c3a706c..5fa505f52 100644
--- a/codeworld-server/src/Util.hs
+++ b/funblocks-server/src/Util.hs
@@ -2,13 +2,10 @@
{-
Copyright 2017 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.
diff --git a/install.sh b/install.sh
index b8069bcac..d427b1a87 100755
--- a/install.sh
+++ b/install.sh
@@ -173,6 +173,16 @@ run . ghcjs-boot --dev --ghcjs-boot-dev-branch ghc-8.0 --shims-dev-branch ghc-8.
run $BUILD rm -rf downloads
+# Install ot.hs
+
+run $BUILD git clone https://github.com/Operational-Transformation/ot.hs
+run $BUILD cabal install --force-reinstalls --global --prefix=$BUILD --allow-newer ./ot.hs
+run $BUILD rm -rf ot.hs
+
+# Install ot.js
+
+run $BUILD git clone https://github.com/Operational-Transformation/ot.js
+
# Install and build CodeMirror editor.
run $BUILD git clone https://github.com/codemirror/CodeMirror.git
diff --git a/run.sh b/run.sh
index 41697a72d..0e2d522cc 100755
--- a/run.sh
+++ b/run.sh
@@ -23,5 +23,5 @@ rm -rf data/*/user/???/*.err.txt
mkdir -p log
-codeworld-game-server +RTS -T &
+codeworld-collab-server +RTS -T &
run . codeworld-server -p 8080
diff --git a/web/blocks.html b/web/blocks.html
index 6ce1cb813..410a406a2 100644
--- a/web/blocks.html
+++ b/web/blocks.html
@@ -61,10 +61,10 @@
<script src="blockly/blocks/procedures.js"></script>
<script src="blockly/blocks/funblocks-procedures.js"></script>
<script src="blockly/msg/js/en.js"></script>
-
+
<!-- Initialization in JS -->
- <script src="js/codeworld_shared.js"></script>
- <script src="js/funblocks.js"></script>
+ <script src="js/funblocks_requests.js"></script>
+ <script src="js/funblocks.js"></script>
</head>
<body>
@@ -110,7 +110,7 @@
<span><a type="button" style="margin-top:5px;" id="editButton" target="_blank" class="cw-button blue">
<span>Edit code</span>
- </a>
+ </a>
</span>
<pre id="genCode" class="dropbox cm-s-default CodeMirror"
style="width:100%; height:100%; padding:10px;">
diff --git a/web/css/codeworld-cm.css b/web/css/codeworld-cm.css
index f1fae3f88..d46504471 100644
--- a/web/css/codeworld-cm.css
+++ b/web/css/codeworld-cm.css
@@ -47,6 +47,13 @@ div.CodeMirror span.CodeMirror-nonmatchingbracket { outline: solid rgba(255,0,0,
color: #999;
}
+.CodeMirror-linewidget {
+ background: white;
+ border-style: solid;
+ border-width: 5px;
+ border-color: #e5eff9;
+}
+
/* Style overrides for the autocomplete box. */
.CodeMirror-hint {
diff --git a/web/css/codeworld.css b/web/css/codeworld.css
index ccf232820..9e8f0e4df 100644
--- a/web/css/codeworld.css
+++ b/web/css/codeworld.css
@@ -88,6 +88,94 @@ body {
margin: 0px;
}
+.comments h2 {
+ margin-top: 1px;
+ margin-left: 5px;
+ color: #535456;
+}
+
+.replies div {
+ margin-left: 10px;
+}
+
+.replies {
+ border-style: solid;
+ border-width: 0px;
+ border-left-width: 2px;
+ border-left-color: #6495ed;
+}
+
+.commentBlock, .replyBlock {
+ margin-left: 10px;
+ background: #f7f7f7;
+ display: flex;
+ display: -webkit-flex;
+ display: -ms-flex;
+ flex-direction: column;
+ -webkit-flex-direction: column;
+ -ms-flex-direction: column;
+ margin-bottom: 2px;
+ border-radius : 5px;
+}
+
+.comment, .reply {
+ word-wrap: break-word;
+ margin-left:5px;
+ margin-bottom: 3px;
+ color: #2a2a2b;
+ font-weight: 700;
+}
+
+.user {
+ font-weight: 900;
+ color: #22334f;
+ margin-left: 5px;
+}
+
+.commentInfo, .replyInfo {
+ margin-top: 4px;
+}
+
+time {
+ font-style: italic;
+ font-weight: 300;
+ color: #000000;
+}
+
+.commentField, .replyField {
+ width: 90%;
+ height: 90px;
+ margin-left: 10px;
+ margin-top: 10px;
+ border-radius: 5px;
+ border: 1px solid #aaaaaa;
+ padding: 8px;
+ font-weight: 400;
+ box-shadow: 1px 1px 5px #cccccc;
+}
+
+.deleteTheComment, .deleteTheReply {
+ margin-right: 10px;
+ float: right;
+ font-weight: 600;
+ cursor: pointer;
+}
+
+.deleteTheComment:hover, .deleteTheReply:hover {
+ color: darkred;
+}
+
+.showTheReplies {
+ margin-left: 10px;
+ margin-bottom: 5px;
+ color: #004d90;
+ cursor: pointer;
+}
+
+.showTheReplies:hover {
+ color: #000000;
+}
+
#keyboard-shortcuts {
text-align: center;
height: 50vh;
@@ -231,6 +319,11 @@ body {
.cw-button:focus { outline: none; }
::-moz-focus-inner { border:0; }
+.writeTheComment, .writeTheReply {
+ margin-left: 10px;
+ margin-bottom: 10px;
+}
+
.dropbox {
background-color: white;
border: solid #cccccc 1px;
diff --git a/web/doc.html b/web/doc.html
index d6fc8b797..a0e63c966 100644
--- a/web/doc.html
+++ b/web/doc.html
@@ -27,7 +27,7 @@
<link rel="stylesheet" href="//cdn.materialdesignicons.com/1.6.50/css/materialdesignicons.min.css">
<script type="text/javascript" src="js/codemirror-compressed.js" charset="UTF-8"></script>
<script type="text/javascript" src="js/codeworld-mode.js"></script>
- <script type="text/javascript" src="js/codeworld_shared.js"></script>
+ <script type="text/javascript" src="js/codeworld_requests.js"></script>
<script type="text/javascript" src="js/doc.js"></script>
</head>
<body>
diff --git a/web/env.html b/web/env.html
index 8c2f4502f..d23bf28c3 100644
--- a/web/env.html
+++ b/web/env.html
@@ -28,13 +28,13 @@
<link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/sweetalert/1.1.0/sweetalert.min.css">
<script type="text/template" id="projectTemplate">
- <a class="cw-button green {{ifactive project-active}}"><i class="mdi mdi-18px mdi-cube"></i> {{label}}</a>
+ <a class="cw-button green {{ifactive project-active}}"><i class="mdi mdi-18px mdi-cube"></i> {{label}}</a>
</script>
<script type="text/template" id="folderTemplate">
<a class="cw-button green"><i class="mdi mdi-18px mdi-chevron-right"></i> <i class="mdi mdi-18px mdi-folder"></i> {{label}}</a>
</script>
<script type="text/template" id="openFolderTemplate">
- <a class="cw-button yellow"><i class="mdi mdi-18px mdi-chevron-down"></i> <i class="mdi mdi-18px mdi-folder-outline"></i> {{label}}</a>
+ <a class="cw-button yellow"><i class="mdi mdi-18px mdi-chevron-down"></i> <i class="mdi mdi-18px mdi-folder-outline"></i> {{label}}</a>
</script>
</head>
<body>
@@ -49,8 +49,8 @@
<a id="saveButton" class="cw-button blue" style="display:none" onclick="saveProject()">
<i class="mdi mdi-18px mdi-cloud-upload"></i> Save
</a>
- <a id="saveAsButton" class="cw-button blue" onclick="saveProjectAs()">
- <i class="mdi mdi-18px mdi-dots-horizontal"></i> Save As
+ <a id="testButton" class="cw-button blue" style="display:none;" onclick="generateTestEnv()">
+ <i class="mdi mdi-18px mdi-code-tags"></i> Test Code
</a>
<a id="deleteButton" class="cw-button red" style="display:none" onclick="deleteProject()">
<i class="mdi mdi-18px mdi-delete"></i> Delete
@@ -58,15 +58,27 @@
<a id="downloadButton" class="cw-button blue" onclick="downloadProject()">
<i class="mdi mdi-18px mdi-download"></i> Download
</a>
+ <a id="copyButton" class="cw-button blue" style="display:none" onclick="copyProject()">
+ <i class="mdi mdi-18px mdi-dots-horizontal"></i> Copy
+ </a>
+ <a id="copyHereButton" class="cw-button blue" style="display:none" onclick="copyHere()">
+ <i class="mdi mdi-18px mdi-content-copy"></i> Copy Here
+ </a>
<a id="moveButton" class="cw-button blue" style="display:none" onclick="moveProject()">
<i class="mdi mdi-18px mdi-folder-move"></i> Move
</a>
<a id="moveHereButton" class="cw-button blue" style="display:none" onclick="moveHere()">
<i class="mdi mdi-18px mdi-folder-download"></i> Move Here
</a>
- <a id="cancelMoveButton" class="cw-button red" style="display:none" onclick="cancelMove()">
+ <a id="cancelButton" class="cw-button red" style="display:none" onclick="cancel()">
<i class="mdi mdi-18px mdi-close-circle"></i> Cancel
</a>
+ <a id="listCurrentOwners" class="cw-button blue" style="display:none" onclick="listCurrentOwners()">
+ <i class="mdi mdi-18px mdi-account-key"></i> Current Owners
+ </a>
+ <a id="viewCommentVersions" class="cw-button blue" style="display:none" onclick="viewCommentVersions()">
+ <i class="mdi mdi-18px mdi-comment-multiple-outline"></i> Comment Versions
+ </a>
</div>
<div class="nav_items" id="nav_mine"></div>
</div>
@@ -91,13 +103,15 @@
<span></span>
<div id="runButtons">
<a id="shareFolderButton" class="cw-button yellow" style="display:none" onclick="shareFolder()"><i class="mdi mdi-18px mdi-folder-outline"></i> Share Folder</a>
+ <a id="askFeedbackButton" class="cw-button yellow" style="display:none" onclick="shareForFeedback()"><i class="mdi mdi-18px mdi-comment-text-outline"></i> Ask Feedback</a>
+ <a id="collaborateButton" class="cw-button yellow" style="display:none" onclick="shareForCollaboration()"><i class="mdi mdi-18px mdi-share-variant"></i> Collaborate</a>
<span><i class="mdi mdi-24px mdi-record" style="display:none" id="recordIcon"><!--Recording Icon--></i></span>
<a id="startRecButton" style="display:none" class="cw-button red" onclick="captureStart()"><i class="mdi mdi-18px mdi-record"></i> Start Recording</a>
<a id="stopRecButton" style="display:none" class="cw-button yellow" onclick="stopRecording()"><i class="mdi mdi-18px mdi-stop"></i> Stop Recording</a>
<a id="shareButton" class="cw-button yellow" style="display:none" onclick="share()"><i class="mdi mdi-18px mdi-share"></i> Share</a>
<a id="inspectButton" class="cw-button cyan" style="display:none" onclick="inspect()"><i class="mdi mdi-18px mdi-magnify"></i> Inspect</a>
- <a class="cw-button red" onclick="stop()"><i class="mdi mdi-18px mdi-stop"></i> Stop</a>
- <a class="cw-button green" onclick="compile()"><i class="mdi mdi-18px mdi-play"></i> Run</a>
+ <a id="stopButton" class="cw-button red" onclick="stop()"><i class="mdi mdi-18px mdi-stop"></i> Stop</a>
+ <a id="compileButton" class="cw-button green" onclick="compile()"><i class="mdi mdi-18px mdi-play"></i> Run</a>
</div>
</div>
</div>
@@ -127,11 +141,15 @@
});
</script>
<script type="text/javascript" src="https://cdnjs.cloudflare.com/ajax/libs/sweetalert/1.1.0/sweetalert.min.js"></script>
+ <script type="text/javascript" src="https://cdnjs.cloudflare.com/ajax/libs/socket.io/2.0.3/socket.io.js"></script>
<script type="text/javascript" src="//wurfl.io/wurfl.js"></script>
+ <script type="text/javascript" src="js/ot-min.js"></script>
<script type="text/javascript" src="js/codemirror-compressed.js" charset="UTF-8"></script>
<script type="text/javascript" src="js/function-highlight-addon.js"></script>
<script type="text/javascript" src="js/codeworld-mode.js"></script>
- <script type="text/javascript" src="js/codeworld_shared.js"></script>
+ <script type="text/javascript" src="js/codeworld_requests.js"></script>
+ <script type="text/javascript" src="js/codeworld_comments.js"></script>
+ <script type="text/javascript" src="js/codeworld_collaborate.js"></script>
<script type="text/javascript" src="js/codeworld.js"></script>
<script type="text/javascript" src="https://apis.google.com/js/platform.js?onload=handleGAPILoad" async defer></script>
<script type="text/javascript">init();</script>
diff --git a/web/js/codeworld.js b/web/js/codeworld.js
index 634e712b0..8f29b0603 100644
--- a/web/js/codeworld.js
+++ b/web/js/codeworld.js
@@ -36,13 +36,14 @@ function init() {
hash = hash.slice(0, -2);
}
if(hash[0] == 'F') {
- function go(folderName) {
+ function go(folderName, userIdent) {
var id_token = auth2.currentUser.get().getAuthResponse().id_token;
var data = new FormData();
data.append('id_token', id_token);
data.append('mode', window.buildMode);
data.append('shash', hash);
data.append('name', folderName);
+ data.append('userIdent', userIdent);
sendHttp('POST', 'shareContent', data, function(request) {
window.location.hash = '';
@@ -66,7 +67,29 @@ function init() {
confirmButtonText: 'Save',
showCancelButton: false,
closeOnConfirm: false
- }, go);
+ }, function(folderName) {
+ if (folderName == '' || folderName == null) {
+ return;
+ }
+ sweetAlert({
+ html: true,
+ title: '<i class="mdi mdi-72px mdi-cloud-upload"></i> Save As',
+ text: 'Enter an identifier for the shared folder:',
+ type: 'input',
+ confirmButtonText: 'Save',
+ showCancelButton: false,
+ closeOnConfirm: false
+ }, function(userIdent) {
+ if (userIdent == '' || userIdent == null) {
+ return;
+ }
+ go(folderName, userIdent);
+ });
+ });
+ } else if (hash[0] == 'C') {
+ addSharedComment(hash);
+ } else if (hash[0] == 'H') {
+ addToCollaborate(hash);
} else {
initCodeworld();
registerStandardHints(function(){setMode(true);});
@@ -77,7 +100,7 @@ function init() {
registerStandardHints(function(){setMode(true);});
updateUI();
}
-
+
if (hash.length > 0) {
if (hash.slice(-2) == '==') {
hash = hash.slice(0, -2);
@@ -88,7 +111,7 @@ function init() {
setCode(request.responseText, null, null, true);
}
});
- } else if (hash[0] != 'F') {
+ } else if (hash[0] != 'F' && hash[0] !='C' && hash[0] != 'H') {
setCode('');
if (!signedIn()) help();
}
@@ -134,13 +157,13 @@ function initCodeworld() {
window.codeworldEditor.refresh();
CodeMirror.commands.save = function(cm) {
- saveProject();
- }
- document.onkeydown = function(e) {
- if (e.ctrlKey && e.keyCode === 83) { // Ctrl+S
+ if (window.openProjectName == '' || window.openProjectName == undefined) {
+ newProject();
+ } else {
saveProject();
- return false;
}
+ }
+ document.onkeydown = function(e) {
if (e.ctrlKey && e.keyCode === 73) { // Ctrl+I
formatSource();
return false;
@@ -148,6 +171,7 @@ function initCodeworld() {
};
window.codeworldEditor.on('changes', window.updateUI);
+ window.codeworldEditor.on('gutterClick', window.toggleUserComments);
window.onbeforeunload = function(event) {
if (!isEditorClean()) {
@@ -267,7 +291,7 @@ function folderHandler(folderName, index, state) {
allFolderNames.push([]);
discoverProjects(nestedDirs.slice(1).join('/'), index + 1);
}
- if (window.move == undefined) {
+ if (window.move == undefined && window.copy == undefined) {
setCode('');
updateUI();
} else {
@@ -282,7 +306,13 @@ function folderHandler(folderName, index, state) {
* to get the visual presentation to match.
*/
function updateUI() {
+ if (window.testEnv != undefined) {
+ return;
+ }
var isSignedIn = signedIn();
+ window.inCommentables = window.nestedDirs != undefined &&
+ window.nestedDirs.length > 0 &&
+ window.nestedDirs[1] == 'commentables';
if (isSignedIn) {
if (document.getElementById('signout').style.display == 'none') {
document.getElementById('signin').style.display = 'none';
@@ -293,7 +323,11 @@ function updateUI() {
}
if (window.openProjectName) {
- document.getElementById('saveButton').style.display = '';
+ if (window.inCommentables == true) {
+ document.getElementById('saveButton').style.display = 'none';
+ } else {
+ document.getElementById('saveButton').style.display = '';
+ }
document.getElementById('deleteButton').style.display = '';
} else {
document.getElementById('saveButton').style.display = 'none';
@@ -329,13 +363,16 @@ function updateUI() {
}
window.move = undefined;
- document.getElementById('newButton').style.display = '';
- document.getElementById('saveAsButton').style.display = '';
- document.getElementById('downloadButton').style.display = '';
- document.getElementById('runButtons').style.display = '';
+ window.copy = undefined;
+ if (window.inCommentables == true) {
+ document.getElementById('newButton').style.display = 'none';
+ } else {
+ document.getElementById('newButton').style.display = '';
+ }
+ document.getElementById('newFolderButton').style.display = '';
+ document.getElementById('runButtons').style.display = '';
- updateNavBar();
var NDlength = nestedDirs.length;
if (NDlength != 1 && (openProjectName == null || openProjectName == '')) {
@@ -343,13 +380,59 @@ function updateUI() {
} else {
document.getElementById('shareFolderButton').style.display = 'none';
}
+ if (openProjectName == null || openProjectName == '') {
+ document.getElementById('viewCommentVersions').style.display = 'none';
+ document.getElementById('listCurrentOwners').style.display = 'none';
+ window.currentVersion = undefined;
+ window.maxVersion = undefined;
+ window.userIdent = undefined;
+ window.project = undefined;
+ if (window.socket != undefined) {
+ window.socket.disconnect(true);
+ window.socket = undefined;
+ window.cmClient = undefined;
+ }
+ window.owners = undefined;
+ window.activeOwner = undefined;
+ document.getElementById('testButton').style.display = 'none';
+ document.getElementById('askFeedbackButton').style.display = 'none';
+ document.getElementById('collaborateButton').style.display = 'none';
+ } else {
+ document.getElementById('viewCommentVersions').style.display = '';
+ if (window.inCommentables == true) {
+ if (window.socket != undefined) {
+ window.socket.disconnect(true);
+ window.socket = undefined;
+ window.cmClient = undefined;
+ }
+ window.owners = undefined;
+ window.activeOwner = undefined;
+ document.getElementById('listCurrentOwners').style.display = 'none';
+ document.getElementById('askFeedbackButton').style.display = 'none';
+ document.getElementById('collaborateButton').style.display = 'none';
+ document.getElementById('testButton').style.display = '';
+ } else {
+ document.getElementById('listCurrentOwners').style.display = '';
+ document.getElementById('askFeedbackButton').style.display = '';
+ document.getElementById('collaborateButton').style.display = '';
+ if (window.currentVersion != window.maxVersion) {
+ document.getElementById('testButton').style.display = '';
+ } else {
+ document.getElementById('testButton').style.display = 'none';
+ }
+ }
+ }
+ updateNavBar();
document.getElementById('moveHereButton').style.display = 'none';
- document.getElementById('cancelMoveButton').style.display = 'none';
+ document.getElementById('copyHereButton').style.display = 'none';
+ document.getElementById('cancelButton').style.display = 'none';
if((openProjectName != null && openProjectName != '') || NDlength != 1) {
document.getElementById('moveButton').style.display = '';
+ document.getElementById('copyButton').style.display = '';
} else {
document.getElementById('moveButton').style.display = 'none';
+ document.getElementById('copyButton').style.display = 'none';
}
var title;
@@ -367,24 +450,23 @@ function updateUI() {
}
function updateNavBar() {
+ window.inCommentables = window.nestedDirs != undefined &&
+ window.nestedDirs.length > 0 &&
+ window.nestedDirs[1] == 'commentables';
var projects = document.getElementById('nav_mine');
-
while (projects.lastChild) {
projects.removeChild(projects.lastChild);
}
-
allProjectNames.forEach(function(projectNames) {
projectNames.sort(function(a, b) {
return a.localeCompare(b);
});
});
-
allFolderNames.forEach(function(folderNames) {
folderNames.sort(function(a, b) {
return a.localeCompare(b);
});
});
-
var NDlength = nestedDirs.length;
for(let i = 0; i < NDlength; i++) {
var tempProjects;
@@ -460,6 +542,29 @@ function updateNavBar() {
projects = tempProjects;
}
}
+ if (window.openProjectName == null || window.openProjectName == '') {
+ window.codeworldEditor.setOption('readOnly', true);
+ document.getElementById('downloadButton').style.display = 'none';
+ document.getElementById('compileButton').style.display = 'none';
+ document.getElementById('stopButton').style.display = 'none';
+ } else {
+ if (window.inCommentables == true) {
+ window.codeworldEditor.setOption('readOnly', true);
+ } else {
+ if (window.currentVersion == window.maxVersion) {
+ if (window.socket != undefined) {
+ window.codeworldEditor.setOption('readOnly', false);
+ } else {
+ window.codeworldEditor.setOption('readOnly', true);
+ }
+ } else {
+ window.codeworldEditor.setOption('readOnly', true);
+ }
+ }
+ document.getElementById('downloadButton').style.display = '';
+ document.getElementById('compileButton').style.display = '';
+ document.getElementById('stopButton').style.display = '';
+ }
}
function moveProject() {
@@ -489,15 +594,16 @@ function moveProject() {
document.getElementById('newFolderButton').style.display = '';
document.getElementById('newButton').style.display = 'none';
document.getElementById('saveButton').style.display = 'none';
- document.getElementById('saveAsButton').style.display = 'none';
document.getElementById('deleteButton').style.display = 'none';
document.getElementById('downloadButton').style.display = 'none';
document.getElementById('moveButton').style.display = 'none';
document.getElementById('moveHereButton').style.display = '';
- document.getElementById('cancelMoveButton').style.display = '';
+ document.getElementById('cancelButton').style.display = '';
+ document.getElementById('copyButton').style.display = 'none';
+ document.getElementById('copyHereButton').style.display = 'none';
document.getElementById('runButtons').style.display = 'none';
- window.move = Object();
+ window.move = new Object();
window.move.path = tempPath;
if (tempOpen != null && tempOpen != '') {
window.move.file = tempOpen;
@@ -505,6 +611,50 @@ function moveProject() {
}, false);
}
+function copyProject() {
+ warnIfUnsaved(function() {
+ if (!signedIn()) {
+ sweetAlert('Oops!', 'You must sign in to copy this project or folder.', 'error');
+ updateUI();
+ return;
+ }
+
+ if ((openProjectName == null || openProjectName == '') && nestedDirs.length == 1) {
+ sweetAlert('Oops!', 'You must select a project or folder to copy.', 'error');
+ updateUI();
+ return;
+ }
+
+ var tempOpen = openProjectName;
+ var tempPath = nestedDirs.slice(1).join('/');
+ setCode('');
+ if (tempOpen == null || tempOpen == '') {
+ nestedDirs.splice(-1);
+ allProjectNames.splice(-1);
+ allFolderNames.splice(-1);
+ }
+ updateNavBar();
+ discoverProjects("", 0);
+ document.getElementById('newFolderButton').style.display = '';
+ document.getElementById('newButton').style.display = 'none';
+ document.getElementById('saveButton').style.display = 'none';
+ document.getElementById('deleteButton').style.display = 'none';
+ document.getElementById('downloadButton').style.display = 'none';
+ document.getElementById('copyButton').style.display = 'none';
+ document.getElementById('copyHereButton').style.display = '';
+ document.getElementById('cancelButton').style.display = '';
+ document.getElementById('moveButton').style.display = 'none';
+ document.getElementById('moveHereButton').style.display = 'none';
+ document.getElementById('runButtons').style.display = 'none';
+
+ window.copy = Object();
+ window.copy.path = tempPath;
+ if (tempOpen != null && tempOpen != '') {
+ window.copy.file = tempOpen;
+ }
+ }, false);
+}
+
function moveHere() {
function successFunc() {
nestedDirs = [""];
@@ -516,6 +666,17 @@ function moveHere() {
moveHere_(nestedDirs.slice(1).join('/'), window.buildMode, successFunc);
}
+function copyHere() {
+ function successFunc() {
+ nestedDirs = [""];
+ allProjectNames = [[]];
+ allFolderNames = [[]];
+ discoverProjects("", 0);
+ updateUI();
+ }
+ copyHere_(nestedDirs.slice(1).join('/'), window.buildMode, successFunc);
+}
+
function changeFontSize(incr) {
return function() {
var elem = window.codeworldEditor.getWrapperElement();
@@ -624,25 +785,23 @@ function loadSample(code) {
}
function newProject() {
- warnIfUnsaved(function() {
- setCode('');
- }, false);
+ newProject_(nestedDirs.slice(1).join('/'));
}
function newFolder() {
- function successFunc() {
- if (window.move == undefined)
- setCode('');
- }
- createFolder(nestedDirs.slice(1).join('/'), window.buildMode, successFunc);
+ createFolder(nestedDirs.slice(1).join('/'), window.buildMode);
}
function loadProject(name, index) {
- if(window.move != undefined) {
+ if(window.move != undefined || window.copy != undefined) {
return;
}
- function successFunc(project){
+ function successFunc(project) {
+ window.project = project
setCode(project.source, project.history, name);
+ getCommentVersions();
+ getUserIdent();
+ initializeCollaboration();
}
loadProject_(index, name, window.buildMode, successFunc);
}
@@ -786,14 +945,13 @@ function discoverProjects(path, index){
discoverProjects_(path, window.buildMode, index);
}
-function saveProjectBase(path, projectName) {
+function saveProjectBase(path, projectName, type = 'save') {
function successFunc() {
window.openProjectName = projectName;
var doc = window.codeworldEditor.getDoc();
window.savedGeneration = doc.changeGeneration(true);
}
-
- saveProjectBase_(path, projectName, window.buildMode, successFunc);
+ saveProjectBase_(path, projectName, window.buildMode, successFunc, type);
}
function deleteFolder() {
diff --git a/web/js/codeworld_collaborate.js b/web/js/codeworld_collaborate.js
new file mode 100644
index 000000000..53ce6ec7d
--- /dev/null
+++ b/web/js/codeworld_collaborate.js
@@ -0,0 +1,303 @@
+/*
+ * Copyright 2017 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://w...content-available-to-author-only...e.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.
+ */
+
+function shareForCollaboration() {
+ if (!signedIn()) {
+ sweetAlert('Oops!', 'You must sign in to collaborate with others!', 'error');
+ updateUI();
+ return;
+ }
+ if (window.openProjectName == '' || window.openProjectName == null) {
+ sweetAlert('Oops!', 'You must select a project for collaboration!', 'error');
+ updateUI();
+ return;
+ }
+ if (window.nestedDirs.length > 1 && window.nestedDirs[1] == 'commentables') {
+ sweetAlert('Oops!', 'Cannot collaborate on a project in `commentables` directory.');
+ updateUI();
+ return;
+ }
+ var path = nestedDirs.slice(1).join('/');
+ var msg = 'Copy this link to collaborate with others!';
+ var id_token = auth2.currentUser.get().getAuthResponse().id_token;
+ var data = new FormData();
+ data.append('id_token', id_token);
+ data.append('mode', window.buildMode);
+ data.append('path', path);
+ data.append('name', window.openProjectName);
+
+ sendHttp('POST', 'collabShare', data, function(request) {
+ if (request.status != 200) {
+ sweetAlert('Oops!', 'Could not generate link for collaboration! Please try again.', 'error');
+ return;
+ }
+
+ var a = document.createElement('a');
+ a.href = window.location.href;
+ a.hash = '#' + request.responseText;
+ sweetAlert({
+ html: true,
+ title: '<i class="mdi mdi-72px mdi-account-multiple-plus"></i> Collaborate',
+ text: msg,
+ type: 'input',
+ inputValue: a.href,
+ showConfirmButton: false,
+ showCancelButton: true,
+ cancelButtonText: 'Done',
+ animation: 'slide-from-bottom'
+ });
+ });
+}
+
+function addToCollaborate(hash) {
+ var data = new FormData();
+ data.append('mode', window.buildMode);
+ data.append('collabHash', hash);
+
+ function go() {
+ var id_token = auth2.currentUser.get().getAuthResponse().id_token;
+ data.append('id_token', id_token);
+ sendHttp('POST', 'addToCollaborate', data, function(request) {
+ if(request.status == 200) {
+ initCodeworld();
+ registerStandardHints(function(){setMode(true);});
+ setCode('');
+ nestedDirs = [""];
+ allProjectNames = [[]];
+ allFolderNames = [[]];
+ discoverProjects("", 0);
+ updateUI();
+ sweetAlert('Success!', 'The commentable folder is moved into the specifed directory.', 'success');
+ return;
+ } else {
+ if (request.status == 404) {
+ sweetAlert('Oops!', request.responseText, 'error');
+ } else {
+ sweetAlert('Oops!', 'Could not add you to the file. Please try again!', 'error');
+ }
+ initCodeworld();
+ registerStandardHints(function(){setMode(true);});
+ discoverProjects("", 0);
+ updateUI();
+ }
+ });
+ }
+ sweetAlert({
+ title: 'Directory to store to:',
+ type: 'input',
+ showCancelButton: true,
+ chowConfirmButton:true,
+ confirmButtonText: 'Next',
+ inputValue: '',
+ closeOnConfirm: false
+ }, function (path) {
+ if ((path.startsWith('/commentables/') || path.startsWith('commentables/') || path == '/commentables' || path == 'commentables')) {
+ return;
+ }
+ if (path[0] == '/') {
+ path = path.slice(1);
+ }
+ data.append('path', path);
+ sweetAlert({
+ title: 'Name of the file',
+ type: 'input',
+ showCancelButton: true,
+ showConfirmButton: true,
+ confirmButtonText: 'Next',
+ closeOnConfirm: false
+ }, function (name) {
+ if (name == undefined || name == '') {
+ return;
+ }
+ data.append('name', name);
+ sweetAlert({
+ title: 'Choose a user name for this file:',
+ type: 'input',
+ showCancelButton: true,
+ showConfirmButton: true,
+ confirmButtonText: 'Add',
+ closeOnConfirm: true
+ }, function (userIdent) {
+ if (userIdent == '' || userIdent == undefined) {
+ return;
+ }
+ data.append('userIdent', userIdent);
+ go();
+ });
+ });
+ });
+}
+
+function listCurrentOwners() {
+ if (!signedIn()) {
+ sweetAlert('Oops!', 'You must sign in to see owners of this project!', 'error');
+ updateUI();
+ return;
+ }
+ if (window.openProjectName == '' || window.openProjectName == null) {
+ sweetAlert('Oops!', 'You must select a project for seeing owners of this project!', 'error');
+ updateUI();
+ return;
+ }
+ if (window.nestedDirs.length > 1 && window.nestedDirs[1] == 'commentables') {
+ sweetAlert('Oops!', 'No owner exists in a project in `commentables` directory.');
+ updateUI();
+ return;
+ }
+ var data = new FormData();
+ data.append('id_token', auth2.currentUser.get().getAuthResponse().id_token);
+ data.append('mode', window.buildMode);
+ data.append('name', window.openProjectName);
+ data.append('path', window.nestedDirs.slice(1).join('/'));
+
+ sendHttp('POST', 'listCurrentOwners', data, function(request) {
+ if (request.status != 200) {
+ sweetAlert('Oops!', 'Could not load owners of the the file! Please try again.', 'error');
+ return;
+ }
+ window.owners = JSON.parse(request.responseText);
+
+ document.getElementById('newFolderButton').style.display = 'none';
+ document.getElementById('newButton').style.display = 'none';
+ document.getElementById('saveButton').style.display = 'none';
+ document.getElementById('deleteButton').style.display = 'none';
+ document.getElementById('downloadButton').style.display = 'none';
+ document.getElementById('moveButton').style.display = 'none';
+ document.getElementById('moveHereButton').style.display = 'none';
+ document.getElementById('cancelButton').style.display = '';
+ document.getElementById('copyButton').style.display = 'none';
+ document.getElementById('copyHereButton').style.display = 'none';
+ document.getElementById('runButtons').style.display = 'none';
+ document.getElementById('testButton').style.display = 'none';
+ document.getElementById('viewCommentVersions').style.display = 'none';
+ document.getElementById('listCurrentOwners').style.display = 'none';
+
+ var projects = document.getElementById('nav_mine');
+ while (projects.lastChild) {
+ projects.removeChild(projects.lastChild);
+ }
+
+ function isActiveUser(a) {
+ if (window.activeOwners == undefined) {
+ return a == window.userIdent;
+ }
+ return window.activeOwners.find(function(b) {
+ return b == a;
+ }) != undefined;
+ }
+
+ for(let i = 0; i < window.owners.length; i++) {
+ var template = document.getElementById('projectTemplate').innerHTML;
+ template = template.replace('{{label}}', window.owners[i]);
+ template = template.replace(/{{ifactive ([^}]*)}}/, (!(isActiveUser(window.owners[i])) ? "$1" : ""));
+ var span = document.createElement('span');
+ span.innerHTML = template;
+ var elem = span.getElementsByTagName('a')[0];
+ projects.appendChild(span);
+ }
+ });
+}
+
+function initializeCollaboration() {
+ if (!signedIn()) {
+ sweetAlert('Oops!', 'Please sign in to open the file properly!', 'error');
+ updateUI();
+ return;
+ }
+ if (window.openProjectName == '' || window.openProjectName == null) {
+ sweetAlert('Oops!', 'Please select a project to continue!', 'error');
+ updateUI();
+ return;
+ }
+ if (window.nestedDirs.length > 1 && window.nestedDirs[1] == "commentables") {
+ sweetAlert('Oops!', 'An error occured. Please reload to fix it.', 'error');
+ updateUI();
+ return;
+ }
+ var id_token = auth2.currentUser.get().getAuthResponse().id_token;
+ var url = window.location.hostname +
+ ((window.location.port == '') ? ':9160' : (':9160')) +
+ window.location.pathname +
+ '?id_token=' + id_token +
+ '&mode=' + window.buildMode +
+ '&path=' + window.nestedDirs.slice(1).join('/') +
+ '&name=' + window.openProjectName;
+
+ var EditorClient = ot.EditorClient;
+ var SocketIOAdapter = ot.SocketIOAdapter;
+ var CodeMirrorAdapter = ot.CodeMirrorAdapter;
+
+ window.socket = io.connect(url);
+
+ socket.on('doc', function (obj) {
+ go(obj.str, obj.revision, obj.clients, new SocketIOAdapter(socket));
+ });
+
+ socket.on('add_user', function(obj) {
+ flag = 0;
+ for (i = 0; i < window.activeOwners.length; i++) {
+ if (window.activeOwners[i] == obj) {
+ flag = 1;
+ break;
+ }
+ }
+ if (flag == 0) {
+ window.activeOwners.push(obj);
+ }
+ });
+
+ socket.on('delete_user', function(obj) {
+ var temp = new Array();
+ for (i = 0; i < window.activeOwners.length; i++) {
+ if (window.activeOwners[i] == obj) {
+ continue;
+ } else {
+ temp.push(window.activeOwners[i]);
+ }
+ }
+ window.activeOwners = temp;
+ });
+
+ (function () {
+ if (window.socket == undefined) {
+ return;
+ }
+ var emit = socket.emit;
+ var queue = [];
+ socket.emit = function () {
+ queue.push(arguments);
+ return socket;
+ };
+ setInterval(function () {
+ if (window.socket == undefined) {
+ return;
+ }
+ if (queue.length) {
+ emit.apply(socket, queue.shift());
+ }
+ }, 800);
+ })();
+
+ function go(str, revision, clients, serverAdapter) {
+ window.codeworldEditor.setValue(str);
+ window.cmClient = new EditorClient(
+ revision, clients,
+ serverAdapter, new CodeMirrorAdapter(window.codeworldEditor)
+ );
+ window.cmClient.serverAdapter.ownUserName = window.userIdent;
+ window.activeOwners = clients;
+ }
+}
diff --git a/web/js/codeworld_comments.js b/web/js/codeworld_comments.js
new file mode 100644
index 000000000..fafba2c8d
--- /dev/null
+++ b/web/js/codeworld_comments.js
@@ -0,0 +1,852 @@
+/*
+ * Copyright 2017 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.
+ */
+
+function getCommentVersions() {
+ if (!signedIn()) {
+ sweetAlert('Oops!', 'Could not load previous comment versions.', 'error');
+ updateUI();
+ return;
+ }
+ var id_token = auth2.currentUser.get().getAuthResponse().id_token;
+ var data = new FormData();
+ data.append('id_token', id_token);
+ data.append('mode', window.buildMode);
+ data.append('path', window.nestedDirs.slice(1).join('/'));
+ data.append('name', window.openProjectName);
+ var handler = (window.nestedDirs.length > 1 && window.nestedDirs[1] == "commentables") ? 'listVersions' : 'listOwnerVersions';
+
+ sendHttp('POST', handler, data, function(request) {
+ if (request.status != 200) {
+ sweetAlert('Oops!', 'Could not load previous comment versions', 'error');
+ return;
+ }
+ var versions = JSON.parse(request.responseText);
+ function sortNumber(a, b) {
+ return parseInt(b) - parseInt(a);
+ }
+ addCommentVersions(versions.sort(sortNumber));
+ updateUI();
+ addPresentCommentInd();
+ });
+}
+
+function getUserIdent() {
+ if (!signedIn()) {
+ sweetAlert('Oops!', 'Could not get user identifier.', 'error');
+ updateUI();
+ return;
+ }
+ var id_token = auth2.currentUser.get().getAuthResponse().id_token;
+ var data = new FormData();
+ data.append('id_token', id_token);
+ data.append('mode', window.buildMode);
+ data.append('path', window.nestedDirs.slice(1).join('/'));
+ data.append('name', window.openProjectName);
+ var handler = (window.nestedDirs.length > 1 && window.nestedDirs[1] == "commentables") ? 'getUserIdent' : 'getOwnerUserIdent';
+ sendHttp('POST', handler, data, function (request) {
+ if (request.status != 200) {
+ if (request.status == 404) {
+ sweetAlert("Oops!", request.responseText, 'error');
+ } else {
+ sweetAlert('Oops!', 'Could not get user identifier.', 'error');
+ }
+ updateUI();
+ return;
+ }
+ window.userIdent = request.responseText;
+ });
+}
+
+function addCommentVersions(versions) {
+ document.getElementById('viewCommentVersions').style.display = '';
+ window.maxVersion = parseInt(versions[0]);
+ window.currentVersion = parseInt(versions[0]);
+ return;
+}
+
+function viewCommentVersions() {
+ if (window.openProjectName == '' || window.openProjectName == null) {
+ updateUI();
+ return;
+ }
+ if (window.currentVersion == undefined || window.maxVersion == undefined) {
+ updateUI();
+ return;
+ }
+ document.getElementById('newFolderButton').style.display = 'none';
+ document.getElementById('newButton').style.display = 'none';
+ document.getElementById('saveButton').style.display = 'none';
+ document.getElementById('deleteButton').style.display = 'none';
+ document.getElementById('downloadButton').style.display = 'none';
+ document.getElementById('moveButton').style.display = 'none';
+ document.getElementById('moveHereButton').style.display = 'none';
+ document.getElementById('cancelButton').style.display = '';
+ document.getElementById('copyButton').style.display = 'none';
+ document.getElementById('copyHereButton').style.display = 'none';
+ document.getElementById('runButtons').style.display = 'none';
+ document.getElementById('testButton').style.display = 'none';
+ document.getElementById('viewCommentVersions').style.display = 'none';
+ document.getElementById('listCurrentOwners').style.display = 'none';
+
+ var projects = document.getElementById('nav_mine');
+ while (projects.lastChild) {
+ projects.removeChild(projects.lastChild);
+ }
+
+ for(let i = 0; i <= window.maxVersion; i++) {
+ var template = document.getElementById('projectTemplate').innerHTML;
+ template = template.replace('{{label}}', 'Version ' + i + ((i != window.maxVersion) ? ' (ReadOnly)' : ''));
+ template = template.replace(/{{ifactive ([^}]*)}}/, (i == window.currentVersion ? "$1" : ""));
+ var span = document.createElement('span');
+ span.innerHTML = template;
+ var elem = span.getElementsByTagName('a')[0];
+ elem.onclick = function() {
+ loadCommentVersionSource(i);
+ };
+ projects.appendChild(span);
+ }
+}
+
+function loadCommentVersionSource(idx) {
+ warnIfUnsaved(function () {
+ if (!signedIn()) {
+ sweetALert('Oops!', 'You must sign in to see the source!', 'error');
+ updateUI();
+ return;
+ }
+ if (window.currentVersion == undefined) {
+ return;
+ }
+ var data = new FormData();
+ var id_token = auth2.currentUser.get().getAuthResponse().id_token;
+ data.append('id_token', id_token);
+ data.append('mode', window.buildMode);
+ data.append('name', window.openProjectName);
+ data.append('path', window.nestedDirs.slice(1).join('/'));
+ data.append('versionNo', idx);
+ var handler = (window.nestedDirs.length > 1 && window.nestedDirs[1] == "commentables") ? 'viewCommentSource' : 'viewOwnerCommentSource';
+ sendHttp('POST', handler, data, function (request) {
+ if (request.status != 200) {
+ sweetAlert('Oops!', 'Could not load the source of this version. Please try again!', 'error');
+ updateUI();
+ return;
+ }
+ var doc = codeworldEditor.getDoc();
+ window.currentVersion = idx;
+ if (window.currentVersion == window.maxVersion) {
+ window.codeworldEditor.setOption('readOnly', false);
+ } else {
+ window.codeworldEditor.setOption('readOnly', true);
+ }
+ doc.setValue(request.responseText);
+ updateUI();
+ });
+ return;
+ }, false);
+}
+
+function loadProjectForComments(index, name, buildMode, successFunc) {
+ var data = new FormData();
+ data.append('id_token', auth2.currentUser.get().getAuthResponse().id_token);
+ data.append('name', name);
+ data.append('mode', buildMode);
+ data.append('path', window.nestedDirs.slice(1, index + 1).join('/'));
+ sendHttp('POST', 'listVersions', data, function(request) {
+ if (request.status != 200) {
+ sweetAlert('Oops!', 'Something went wrong. Please try again!', 'error');
+ return;
+ }
+ var versions = JSON.parse(request.responseText);
+ function sortNumber(a,b) {
+ return parseInt(b) - parseInt(a);
+ }
+ versions.sort(sortNumber);
+ data.append('versionNo', versions[0]);
+ sendHttp('POST', 'viewCommentSource', data, function(request) {
+ if (request.status != 200) {
+ sweetAlert('Oops!', 'Something went wrong. Please try again!', 'error');
+ return;
+ }
+ window.project = {
+ 'source': request.responseText,
+ 'name': name
+ };
+ window.nestedDirs = window.nestedDirs.slice(0, index + 1);
+ window.allProjectNames = window.allProjectNames.slice(0, index + 1);
+ window.allFolderNames = window.allFolderNames.slice(0, index + 1);
+ setCode(project.source, project.history, name);
+ updateUI();
+ addCommentVersions(versions);
+ getUserIdent();
+ addPresentCommentInd();
+ });
+ });
+}
+
+function addSharedComment(hash) {
+ var data = new FormData();
+ data.append('mode', window.buildMode);
+ data.append('chash', hash);
+
+ function go() {
+ var id_token = auth2.currentUser.get().getAuthResponse().id_token;
+ data.append('id_token', id_token);
+ sendHttp('POST', 'addSharedComment', data, function(request) {
+ if(request.status == 200) {
+ initCodeworld();
+ registerStandardHints(function(){setMode(true);});
+ setCode('');
+ nestedDirs = [""];
+ allProjectNames = [[]];
+ allFolderNames = [[]];
+ discoverProjects("", 0);
+ updateUI();
+ sweetAlert('Success!', 'The commentable folder is moved into the specifed directory.', 'success');
+ return;
+ } else {
+ if (request.status == 404) {
+ sweetAlert('Oops!', request.responseText, 'error');
+ } else {
+ sweetAlert('Oops!', 'Could not add you to the file. Please try again!', 'error');
+ }
+ initCodeworld();
+ registerStandardHints(function(){setMode(true);});
+ discoverProjects("", 0);
+ updateUI();
+ }
+ });
+ }
+
+ // improve upon this UI
+ sweetAlert({
+ title: 'Path to store to(relative with respect to commentables):',
+ type: 'input',
+ showCancelButton: true,
+ showConfirmButton: true,
+ comfirmButtonText: 'Next',
+ inputValue: '/commentables/',
+ closeOnConfirm: false
+ }, function (path) {
+ if (path == undefined || path == '') {
+ return;
+ }
+ if (!(path.startsWith('/commentables/') || path.startsWith('commentables/') || path == '/commentables' || path == 'commentables')) {
+ if (path[0] == '/') {
+ path = 'commentables' + path;
+ } else {
+ path = 'commentables/' + path;
+ }
+ }
+ if (path[0] == '/') {
+ path = path.slice(1);
+ }
+ data.append('path', path);
+ sweetAlert({
+ title: 'Name of the file',
+ type: 'input',
+ showCancelButton: true,
+ showConfirmButton: true,
+ confirmButtonText: 'Next',
+ closeOnConfirm: false
+ }, function (name) {
+ if (name == undefined || name == '') {
+ return;
+ }
+ data.append('name', name);
+ sweetAlert({
+ title: 'Choose a user name for this file:',
+ type: 'input',
+ showCancelButton: true,
+ showConfirmButton: true,
+ confirmButtonText: 'Add',
+ closeOnConfirm: true
+ }, function (userIdent) {
+ if (userIdent == '' || userIdent == undefined) {
+ return;
+ }
+ data.append('userIdent', userIdent);
+ go();
+ });
+ });
+ });
+}
+
+function shareForFeedback() {
+ if (!signedIn()) {
+ sweetAlert('Oops!', 'You must sign in to ask for feedback!', 'error');
+ updateUI();
+ return;
+ }
+ if (openProjectName == '' || openProjectName == null) {
+ sweetAlert('Oops!', 'You must select a project for feedback!', 'error');
+ updateUI();
+ return;
+ }
+ var path = nestedDirs.slice(1).join('/');
+ var msg = 'Copy this link to ask for feedback from others!';
+ var id_token = auth2.currentUser.get().getAuthResponse().id_token;
+ var data = new FormData();
+ data.append('id_token', id_token);
+ data.append('mode', window.buildMode);
+ data.append('path', path);
+ data.append('name', openProjectName);
+
+ sendHttp('POST', 'commentShare', data, function(request) {
+ if (request.status != 200) {
+ sweetAlert('Oops!', 'Could not generate link for feedback! Please try again.', 'error');
+ return;
+ }
+
+ var a = document.createElement('a');
+ a.href = window.location.href;
+ a.hash = '#' + request.responseText;
+ sweetAlert({
+ html: true,
+ title: '<i class="mdi mdi-72px mdi-comment-text-outline"></i> Ask Feedback',
+ text: msg,
+ type: 'input',
+ inputValue: a.href,
+ showConfirmButton: false,
+ showCancelButton: true,
+ cancelButtonText: 'Done',
+ animation: 'slide-from-bottom'
+ });
+ });
+}
+
+function addPresentCommentInd() {
+ if (!signedIn()) {
+ sweelAlert('Oops!', 'You must sign in to see and write comments!', 'error');
+ return;
+ }
+ if (window.openProjectName == '' || window.openProjectName == null) {
+ sweetAlert('Oops!', 'You must select a project to continue!', 'error');
+ updateUI();
+ return;
+ }
+ if (window.currentVersion == undefined || window.maxVersion == undefined) {
+ sweetAlert('Oops!', 'Something went wrong! Please reload to fix it.', 'error');
+ updateUI();
+ return;
+ }
+
+ var data = new FormData();
+ data.append('mode', window.buildMode);
+ data.append('id_token', auth2.currentUser.get().getAuthResponse().id_token);
+ data.append('path', nestedDirs.slice(1).join('/'));
+ data.append('name', openProjectName);
+ data.append('versionNo', currentVersion);
+ var handler = (window.nestedDirs.length > 1 && window.nestedDirs[1] == "commentables") ? 'listUnreadComments' : 'listUnreadOwnerComments';
+ sendHttp('POST', handler, data, function(request) {
+ if (request.status != 200) {
+ if (request.status == 404) {
+ sweetAlert('Oops!', request.responseText, 'error');
+ } else {
+ sweetAlert('Oops!', 'Sorry! Could not load an indicator of where comments are present.', 'error');
+ }
+ updateUI();
+ return;
+ }
+ window.lineSet = new Set(JSON.parse(request.responseText));
+ for (i of lineSet) {
+ document.getElementsByClassName('CodeMirror-gutter-elt')[Number(i)].innerHTML = '<i style="color: #8642f4;"><b>!</b></i> ' + i;
+ }
+ if (window.lineSet.size !== 0) {
+ var w = document.getElementsByClassName('CodeMirror-gutter')[0].style.width.slice(0, -2);
+ document.getElementsByClassName('CodeMirror-gutter')[0].style.width = (Number(w) + 2) + 'px';
+ }
+ });
+}
+
+function toggleUserComments(cm, line, gutter) {
+ if (window.openProjectName == null || window.openProjectName == '') {
+ return;
+ }
+ doc = window.codeworldEditor.getDoc();
+ if (window.openCommentLines == undefined) {
+ window.openCommentLines = new Object();
+ window.openComments = new Object();
+ }
+ if (window.openCommentLines[line + 1] != undefined) {
+ if (window.openProjectName == window.openCommentLines[line + 1].currentProject) {
+ if (window.nestedDirs.join('/') == window.openCommentLines[line + 1].currentDir) {
+ window.openCommentLines[line + 1].clear();
+ window.openCommentLines[line + 1] = undefined;
+ window.openComments[line + 1] = undefined;
+ return;
+ }
+ }
+ }
+ generateComments(line + 1);
+}
+
+function generateComments(line) {
+ if (!signedIn()) {
+ sweetAlert('Oops!', 'You must sign in to see comments.', 'error');
+ updateUI();
+ return;
+ }
+ if (window.currentVersion == undefined) {
+ sweetAlert('Oops!', 'Something went wrong. Please try again!', 'error');
+ updateUI();
+ return;
+ }
+ let comments = document.createElement('div');
+ comments.classList.add('comments');
+ let header = document.createElement('h2');
+ header.innerText = 'Comments at Line ' + line;
+ comments.appendChild(header);
+
+ function go(request) {
+ if (request.status != 200) {
+ if (request.status == 404) {
+ sweetAlert('Oops!', request.responseText, 'error');
+ } else {
+ sweetAlert('Oops!', 'Something went wrong. Please try again!', 'error');
+ }
+ return;
+ }
+ var commentData = JSON.parse(request.responseText);
+ window.openComments[line] = new Array();
+ for (i in commentData) {
+ window.openComments[line].push(commentData[i]);
+ comments.appendChild(generateCommentBlock(i, line));
+ }
+ comments.appendChild(generateCommentArea(line));
+ $(comments).fadeIn('slow');
+ window.openCommentLines[line] = doc.addLineWidget(line - 1, comments, {
+ coverGutter: true
+ });
+ window.openCommentLines[line].currentProject = window.openProjectName;
+ window.openCommentLines[line].currentDir = window.nestedDirs.join('/');
+ }
+
+ var data = new FormData();
+ data.append('id_token', auth2.currentUser.get().getAuthResponse().id_token);
+ data.append('mode', window.buildMode);
+ data.append('lineNo', line);
+ data.append('versionNo', window.currentVersion);
+ data.append('path', nestedDirs.slice(1).join('/'));
+ data.append('name', openProjectName);
+ var handler = (window.nestedDirs.length > 1 && window.nestedDirs[1] == 'commentables') ? 'readComment' : 'readOwnerComment';
+ sendHttp('POST', handler, data, go);
+}
+
+function toggleReplies(ind, line) {
+ var commentBlock = window.openCommentLines[line].node.getElementsByClassName('commentBlock')[ind];
+ if (commentBlock.getElementsByClassName('showTheReplies')[0].innerHTML == 'show replies...') {
+ commentBlock.getElementsByClassName('showTheReplies')[0].innerHTML = 'hide replies...';
+ replies = document.createElement('div');
+ replies.classList.add('replies');
+ for (i in window.openComments[line][ind]['replies']) {
+ replies.appendChild(generateReplyBlock(i, ind, line));
+ }
+ replies.appendChild(generateReplyArea(ind, line));
+ commentBlock.appendChild(replies);
+ } else {
+ commentBlock.removeChild(commentBlock.lastChild);
+ commentBlock.getElementsByClassName('showTheReplies')[0].innerHTML = 'show replies...';
+ }
+}
+
+function generateCommentBlock(ind, line) {
+ let commentBlock = document.createElement('div');
+ commentBlock.classList.add('commentBlock');
+ commentBlock.appendChild(generateCommentDiv(ind, line));
+ let showRepliesButton = document.createElement('span');
+ showRepliesButton.classList.add('showTheReplies');
+ showRepliesButton.setAttribute('onclick', 'toggleReplies(' + ind + ', ' + line + ')');
+ showRepliesButton.innerHTML = 'show replies...';
+ commentBlock.appendChild(showRepliesButton);
+ return commentBlock;
+}
+
+function generateCommentDiv(ind, line) {
+ let commentDiv = document.createElement('div');
+ let info = document.createElement('p');
+ info.classList.add('commentInfo');
+ info.innerHTML = '<span class="user">' + window.openComments[line][ind]['userIdent'] + '</span>';
+ let timeInfo = document.createElement('time');
+ timeInfo.setAttribute('datetime', window.openComments[line][ind]['dateTime']);
+ timeInfo.innerHTML = ' ' + (new Date(window.openComments[line][ind]['dateTime'])).toString();
+ info.appendChild(timeInfo);
+ let deleteButton = document.createElement('span');
+ deleteButton.setAttribute('onclick', 'deleteComment(' + ind + ', ' + line + ', ' + ')');
+ deleteButton.classList.add('deleteTheComment');
+ deleteButton.innerHTML = 'delete';
+ info.appendChild(deleteButton);
+ commentDiv.appendChild(info);
+ let commentInfo = document.createElement('div');
+ commentInfo.classList.add('markdown');
+ commentInfo.classList.add('comment');
+ commentInfo.innerHTML = ' ' + window.openComments[line][ind]['comment'];
+ commentDiv.appendChild(commentInfo);
+ return commentDiv;
+}
+
+function generateReplyBlock(ind, commentIdx, line) {
+ let replyBlock = document.createElement('div');
+ replyBlock.classList.add('replyBlock');
+ replyBlock.appendChild(generateReplyDiv(ind, commentIdx, line));
+ return replyBlock;
+}
+
+function generateReplyDiv(ind, commentIdx, line) {
+ let replyDiv = document.createElement('div');
+ let info = document.createElement('p');
+ info.classList.add('replyInfo');
+ info.innerHTML = '<span class="user">' + window.openComments[line][commentIdx]['replies'][ind]['userIdent'] + '</span>';
+ let timeInfo = document.createElement('time');
+ timeInfo.setAttribute('datetime', window.openComments[line][commentIdx]['replies'][ind]['dateTime']);
+ timeInfo.innerHTML = ' ' + (new Date(window.openComments[line][commentIdx]['replies'][ind]['dateTime'])).toString();
+ info.appendChild(timeInfo);
+ let deleteButton = document.createElement('span');
+ deleteButton.setAttribute('onclick', 'deleteReply(' + ind + ', ' + commentIdx + ', ' + line + ')');
+ deleteButton.classList.add('deleteTheReply');
+ deleteButton.innerHTML = 'delete';
+ info.appendChild(deleteButton);
+ replyDiv.appendChild(info);
+ let replyInfo = document.createElement('div');
+ replyInfo.classList.add('markdown');
+ replyInfo.classList.add('reply');
+ replyInfo.innerHTML = ' ' + window.openComments[line][commentIdx]['replies'][ind]['reply'];
+ replyDiv.appendChild(replyInfo);
+ return replyDiv;
+}
+
+function generateCommentArea(line) {
+ let commentArea = document.createElement('div');
+ commentArea.innerHTML = '<textarea class="commentField"></textarea>';
+ let submitArea = document.createElement('div');
+ let submitButton = document.createElement('a');
+ submitButton.classList.add('cw-button');
+ submitButton.classList.add('blue');
+ submitButton.classList.add('writeTheComment');
+ submitButton.setAttribute('onclick', 'writeComment(' + line + ')');
+ submitButton.innerText = 'Write Comment';
+ submitArea.appendChild(submitButton);
+ commentArea.appendChild(submitArea);
+ return commentArea;
+}
+
+function generateReplyArea(commentIdx, line) {
+ let replyArea = document.createElement('div');
+ replyArea.innerHTML = '<textarea class="replyField"></textarea>';
+ let submitArea = document.createElement('div');
+ let submitButton = document.createElement('a');
+ submitButton.classList.add('cw-button');
+ submitButton.classList.add('blue');
+ submitButton.classList.add('writeTheReply');
+ submitButton.setAttribute('onclick', 'writeReply(' + commentIdx + ', ' + line + ')');
+ submitButton.innerText = 'Write Reply';
+ submitArea.appendChild(submitButton);
+ replyArea.appendChild(submitArea);
+ return replyArea;
+}
+
+function writeComment(line) {
+ if (!signedIn()) {
+ sweetAlert('Oops!', 'You must sign in to write a comment.', 'error');
+ updateUI();
+ return;
+ }
+ if (window.currentVersion == undefined || window.maxVersion == undefined) {
+ updateUI();
+ return;
+ }
+ if (window.userIdent == undefined) {
+ return;
+ }
+
+ function go(request, comment, dateTime) {
+ if (request.status != 200) {
+ if (request.status == 404) {
+ sweetAlert('Oops!', request.responseText, 'error');
+ } else {
+ sweetAlert('Oops!', 'Could not comment. Please try again!', 'error');
+ }
+ return;
+ }
+ function goAgain(userIdent) {
+ var comments = window.openCommentLines[line].node;
+ comments.getElementsByClassName('commentField')[0].value = '';
+ window.openComments[line].push({
+ 'comment': comment,
+ 'replies': [],
+ 'userIdent': userIdent,
+ 'dateTime': dateTime,
+ 'status': 'present'
+ });
+ comments.insertBefore(generateCommentBlock(comments.getElementsByClassName('commentBlock').length, line), comments.lastChild);
+ }
+ goAgain(window.userIdent);
+ }
+
+ var data = new FormData();
+ data.append('id_token', auth2.currentUser.get().getAuthResponse().id_token);
+ data.append('mode', window.buildMode);
+ data.append('path', window.nestedDirs.slice(1).join('/'));
+ data.append('name', window.openProjectName);
+ data.append('lineNo', line);
+ data.append('versionNo', window.currentVersion);
+ var comment = window.openCommentLines[line].node.getElementsByClassName('commentField')[0].value;
+ var dateTime = (new Date()).toJSON();
+ if (comment == '') {
+ return;
+ }
+ data.append('comment', comment);
+ data.append('dateTime', JSON.stringify(dateTime));
+ var handler = (window.nestedDirs.length > 1 && window.nestedDirs[1] == 'commentables') ? 'writeComment' : 'writeOwnerComment';
+ sendHttp('POST', handler, data, function(request) {
+ go(request, comment, dateTime);
+ });
+}
+
+function writeReply(commentIdx, line) {
+ if (!signedIn()) {
+ sweetAlert('Oops!', 'You must sign in to write a reply.', 'error');
+ updateUI();
+ return;
+ }
+ if (window.currentVersion == undefined || window.maxVersion == undefined) {
+ updateUI();
+ return;
+ }
+
+ function go(request, reply, dateTime) {
+ if (request.status != 200) {
+ if (request.status == 404) {
+ sweetAlert('Oops!', request.responseText, 'error');
+ } else {
+ sweetAlert('Oops!', 'Could not reply. Please try again!', 'error');
+ }
+ return;
+ }
+ function goAgain(userIdent) {
+ var commentBlock = window.openCommentLines[line].node.getElementsByClassName('commentBlock')[commentIdx];
+ commentBlock.getElementsByClassName('replyField')[0].value = '';
+ window.openComments[line][commentIdx]['replies'].push({
+ 'reply': reply,
+ 'dateTime': dateTime,
+ 'userIdent': userIdent,
+ 'status': 'present'
+ });
+ var replies = commentBlock.getElementsByClassName('replies')[0];
+ replies.insertBefore(generateReplyBlock(replies.getElementsByClassName('replyBlock').length, commentIdx, line), replies.lastChild);
+ }
+ goAgain(window.userIdent);
+ }
+
+ var data = new FormData();
+ data.append('id_token', auth2.currentUser.get().getAuthResponse().id_token);
+ data.append('mode', window.buildMode);
+ data.append('lineNo', line);
+ data.append('versionNo', window.currentVersion);
+ data.append('path', window.nestedDirs.slice(1).join('/'));
+ data.append('name', window.openProjectName);
+ data.append('comment', JSON.stringify(window.openComments[line][commentIdx]));
+ var reply = window.openCommentLines[line].node.getElementsByClassName('commentBlock')[commentIdx].getElementsByClassName('replyField')[0].value;
+ var dateTime = (new Date()).toJSON();
+ if (reply == '') {
+ return;
+ }
+ data.append('reply', reply);
+ data.append('dateTime', JSON.stringify(dateTime));
+ var handler = (window.nestedDirs.length > 1 && window.nestedDirs[1] == 'commentables') ? 'writeReply' : 'writeOwnerReply';
+ sendHttp('POST', handler, data, function(request) {
+ go(request, reply, dateTime);
+ });
+}
+
+function deleteComment(ind, line) {
+ if (!signedIn()) {
+ sweetAlert('Oops!', 'You must sign in to delete a comment.', 'error');
+ updateUI();
+ return;
+ }
+ if (window.currentVersion == undefined || window.maxVersion == undefined) {
+ updateUI();
+ return;
+ }
+
+ function go(request) {
+ if (request.status != 200) {
+ if (request.status == 404) {
+ sweetAlert('Oops!', request.responseText, 'error');
+ }else {
+ sweetAlert('Oops!', 'Could not delete the comment. Please try again!', 'error');
+ }
+ return;
+ }
+ var comments = window.openCommentLines[line].node;
+ var commentBlocks = comments.getElementsByClassName('commentBlock');
+ var l = window.openComments[line][ind]['replies'].length;
+ if (l == 0) {
+ var l = commentBlocks.length;
+ for (let i = l - 1; i >= ind; i--) {
+ comments.removeChild(commentBlocks[i]);
+ }
+ window.openComments[line].splice(ind, 1);
+ for (let i = ind; i < l; i++) {
+ if (i != ind) {
+ comments.insertBefore(generateCommentBlock(i - 1, line), comments.lastChild);
+ }
+ }
+ } else {
+ commentBlocks[ind].getElementsByClassName('user')[0].innerHTML = 'none';
+ commentBlocks[ind].getElementsByClassName('comment')[0].innerHTML = ' deleted';
+ window.openComments[line][ind]['userIdent'] = 'none';
+ window.openComments[line][ind]['comment'] = 'deleted';
+ window.openComments[line][ind]['status'] = 'deleted';
+ }
+ }
+
+ var data = new FormData();
+ data.append('id_token', auth2.currentUser.get().getAuthResponse().id_token);
+ data.append('mode', window.buildMode);
+ data.append('lineNo', line);
+ data.append('versionNo', window.currentVersion);
+ data.append('path', window.nestedDirs.slice(1).join('/'));
+ data.append('name', window.openProjectName);
+ data.append('comment', JSON.stringify(window.openComments[line][ind]));
+ var handler = (window.nestedDirs.length > 1 && window.nestedDirs[1] == 'commentables') ? 'deleteComment' : 'deleteOwnerComment';
+ sendHttp('POST', handler, data, function(request) {
+ go(request);
+ });
+}
+
+function deleteReply(ind, commentIdx, line) {
+ if (!signedIn()) {
+ sweetAlert('Oops!', 'You must sign in to delete a reply.', 'error');
+ updateUI();
+ return;
+ }
+ if (window.currentVersion == undefined || window.maxVersion == undefined) {
+ updateUI();
+ return;
+ }
+
+ function go(request) {
+ if (request.status != 200) {
+ if (request.status == 404) {
+ sweetAlert('Oops!', request.responseText, 'error');
+ } else {
+ sweetAlert('Oops!', 'Could not delete the reply. Please try again!', 'error');
+ }
+ return;
+ }
+ var comments = window.openCommentLines[line].node;
+ var commentBlocks = comments.getElementsByClassName('commentBlock');
+ var replies = commentBlocks[commentIdx].getElementsByClassName('replies')[0];
+ var l = replies.getElementsByClassName('replyBlock').length;
+ for (let i = l - 1; i >= ind; i--) {
+ replies.removeChild(replies.getElementsByClassName('replyBlock')[i]);
+ }
+ window.openComments[line][commentIdx]['replies'][ind]['status'] = 'deleted';
+ window.openComments[line][commentIdx]['replies'].splice(ind, 1);
+ for (let i = ind; i < l; i++) {
+ if (i != ind)
+ replies.insertBefore(generateReplyBlock(i - 1, commentIdx, line), replies.lastChild);
+ }
+ if (l == 1) {
+ if (window.openComments[line][commentIdx]['userIdent'] == 'none') {
+ var l1 = commentBlocks.length;
+ for (let i = l1 - 1; i >= commentIdx; i--) {
+ comments.removeChild(commentBlocks[i]);
+ }
+ window.openComments[line].splice(commentIdx, 1);
+ for (let i = commentIdx; i < l1; i++) {
+ if (i != commentIdx) {
+ comments.insertBefore(generateCommentBlock(i - 1, line), comments.lastChild);
+ }
+ }
+ }
+ }
+ }
+
+ var data = new FormData();
+ data.append('id_token', auth2.currentUser.get().getAuthResponse().id_token);
+ data.append('mode', window.buildMode);
+ data.append('lineNo', line);
+ data.append('versioNo', window.currentVersion);
+ data.append('comment', JSON.stringify(window.openComments[line][commentIdx]));
+ data.append('reply', JSON.stringify(window.openComments[line][commentIdx]['replies'][ind]));
+ data.append('path', nestedDirs.slice(1).join('/'));
+ data.append('name', openProjectName);
+ var handler = (window.nestedDirs.length > 1 && window.nestedDirs[1] == 'commentables') ? 'deleteReply' : 'deleteOwnerReply';
+ sendHttp('POST', handler, data, function(request) {
+ go(request);
+ });
+}
+
+function generateTestEnv() {
+ warnIfUnsaved(function() {
+ if (!signedIn()) {
+ sweetAlert('Oops!', 'You need to login to test the code.', 'error');
+ updateUI();
+ return;
+ }
+ if (window.currentVersion == undefined || window.maxVersion == undefined) {
+ updateUI();
+ return;
+ }
+ if (!(window.nestedDirs.length > 1 && window.nestedDirs[1] == 'commentables')) {
+ if (window.currentVersion == window.maxVersion) {
+ updateUI();
+ return;
+ }
+ }
+ if (openProjectName == '' || openProjectName == null) {
+ updateUI();
+ return;
+ }
+ window.testEnv = new Object();
+ window.testEnv.project = getCurrentProject()['source'];
+ window.testEnv.prevName = window.openProjectName;
+ window.openProjectName = null;
+ document.getElementById('newFolderButton').style.display = 'none';
+ document.getElementById('newButton').style.display = 'none';
+ document.getElementById('saveButton').style.display = 'none';
+ document.getElementById('testButton').style.display = 'none';
+ document.getElementById('deleteButton').style.display = 'none';
+ document.getElementById('downloadButton').style.display = '';
+ document.getElementById('copyButton').style.display = 'none';
+ document.getElementById('copyHereButton').style.display = 'none';
+ document.getElementById('moveButton').style.display = 'none';
+ document.getElementById('moveHereButton').style.display = 'none';
+ document.getElementById('cancelButton').style.display = '';
+ document.getElementById('viewCommentVersions').style.display = 'none';
+ var projects = document.getElementById('nav_mine');
+ while (projects.lastChild) {
+ projects.removeChild(projects.lastChild);
+ }
+ document.getElementById('cancelButton').onclick = function() {
+ document.getElementById('cancelButton').onclick = function() {
+ updateUI();
+ };
+ window.openProjectName = window.testEnv.prevName;
+ var doc = window.codeworldEditor.getDoc();
+ doc.setValue(window.testEnv.project);
+ window.testEnv = undefined;
+ window.location.hash = '#';
+ updateUI();
+ };
+ var doc = window.codeworldEditor.getDoc();
+ doc.setValue(window.testEnv.project);
+ window.codeworldEditor.setOption('readOnly', false);
+ doc.clearHistory();
+ }, false);
+}
diff --git a/web/js/codeworld_requests.js b/web/js/codeworld_requests.js
new file mode 100644
index 000000000..27517dd6d
--- /dev/null
+++ b/web/js/codeworld_requests.js
@@ -0,0 +1,1000 @@
+/*
+ * Copyright 2017 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.
+ */
+
+/*
+ * Utility function for sending an HTTP request to fetch a resource.
+ *
+ * Args:
+ * - method: The HTTP method to use, such as 'GET'
+ * - url: The URL to fetch, whether absolute or relative.
+ * - body: The request body to send. Use null for no body.
+ * - callback: A callback function to send when complete. (optional)
+ *
+ * If provided, the callback will be given the XmlHttpRequest object, so
+ * it can inspect the response code and headers as well as the contents.
+ */
+function sendHttp(method, url, body, callback) {
+ var request = new XMLHttpRequest();
+
+ if (callback) {
+ request.onreadystatechange = function() {
+ if (request.readyState == 4) callback(request);
+ };
+ }
+
+ request.open(method, url, true);
+ request.send(body);
+}
+
+function registerStandardHints(successFunc)
+{
+ function createHint(line, wordStart, wordEnd, cname) {
+ var word = line.slice(wordStart, wordEnd);
+ if (!cname) cname = 'hint-word';
+
+ function renderer(elem, data, cur) {
+ if (wordStart > 0) {
+ elem.appendChild(document.createTextNode(line.slice(0, wordStart)));
+ }
+ var wordElem = document.createElement("span");
+ wordElem.className = cname;
+ wordElem.appendChild(document.createTextNode(word));
+ elem.appendChild(wordElem);
+ if (wordEnd < line.length) {
+ elem.appendChild(document.createTextNode(line.slice(wordEnd)));
+ }
+ }
+ return {
+ text: word,
+ render: renderer,
+ source: line
+ };
+ }
+
+ // Add hint highlighting
+ var hints = [
+ createHint("main :: Program", 0, 4),
+ createHint("program :: Program", 0, 7),
+ createHint("-- single line comment", 0, 2, 'hint-keyword'),
+ createHint("{- start a multi-line comment", 0, 2, 'hint-keyword'),
+ createHint("-} end a multi-line comment", 0, 2, 'hint-keyword'),
+ createHint(":: write a type annotation", 0, 2, 'hint-keyword'),
+ createHint("-> declare a function type or case branch", 0, 2, 'hint-keyword'),
+ createHint("<- list comprehension index", 0, 2, 'hint-keyword'),
+ createHint(".. list range", 0, 2, 'hint-keyword'),
+ createHint("case decide between many options", 0, 4, 'hint-keyword'),
+ createHint("of finish a case statement", 0, 2, 'hint-keyword'),
+ createHint("if decide between two choices", 0, 2, 'hint-keyword'),
+ createHint("then 1st choice of an if statement", 0, 4, 'hint-keyword'),
+ createHint("else 2nd choice of an if statement", 0, 4, 'hint-keyword'),
+ createHint("data define a new data type", 0, 4, 'hint-keyword'),
+ createHint("let define local variables", 0, 3, 'hint-keyword'),
+ createHint("in finish a let statement", 0, 2, 'hint-keyword'),
+ createHint("where define local variables", 0, 5, 'hint-keyword'),
+ createHint("type define a type synonym", 0, 4, 'hint-keyword'),
+ createHint("(:) :: a -> [a] -> [a]", 1, 2)
+ ];
+
+ CodeMirror.registerHelper('hint', 'codeworld', function(cm) {
+ var cur = cm.getCursor();
+ var token = cm.getTokenAt(cur);
+ var to = CodeMirror.Pos(cur.line, token.end);
+
+ //To check for the case of insertion in between two parameters
+ r = new RegExp("^\\s+$");
+ // If string is completely made of spaces
+ if (r.test(token.string)) {
+ token.string = token.string.substr(0, cur.ch - token.start);
+ token.end = cur.ch;
+ to = CodeMirror.Pos(cur.line, token.end);
+ }
+
+ if (token.string && /\w/.test(token.string[token.string.length - 1])) {
+ var term = token.string,
+ from = CodeMirror.Pos(cur.line, token.start);
+ } else {
+ var term = "",
+ from = to;
+ }
+ var found = [];
+ for (var i = 0; i < hints.length; i++) {
+ var hint = hints[i];
+ if (hint.text.slice(0, term.length) == term)
+ found.push(hint);
+ }
+
+ if (found.length) return {
+ list: found,
+ from: from,
+ to: to
+ };
+ });
+
+ sendHttp('GET', 'codeworld-base.txt', null, function(request) {
+ var lines = [];
+ if (request.status != 200) {
+ console.log('Failed to load autocomplete word list.');
+ } else {
+ lines = request.responseText.split('\n');
+ }
+
+ var startLine = lines.indexOf('module Prelude') + 1;
+ var endLine = startLine;
+ while (endLine < lines.length) {
+ if (lines[endLine].startsWith("module ")) {
+ break;
+ }
+ endLine++;
+ }
+ lines = lines.slice(startLine, endLine);
+
+ // Special case for "main" and "program", since they are morally
+ // built-in names.
+ codeworldKeywords['main'] = 'builtin';
+ codeworldKeywords['program'] = 'builtin';
+
+ lines = lines.sort().filter(function(item, pos, array) {
+ return !pos || item != array[pos - 1];
+ });
+
+ var hintBlacklist = [
+ // Symbols that only exist to implement RebindableSyntax, map to
+ // built-in Haskell types, or maintain backward compatibility.
+ "Bool",
+ "IO",
+ "fail",
+ "fromCWText",
+ "fromDouble",
+ "fromHSL",
+ "fromInt",
+ "fromInteger",
+ "fromRandomSeed",
+ "fromRational",
+ "fromString",
+ "ifThenElse",
+ "line",
+ "negate",
+ "pictureOf",
+ "randomsFrom",
+ "thickLine",
+ "toCWText",
+ "toDouble",
+ "toInt",
+ ];
+
+ lines.forEach(function(line) {
+ if (line.startsWith("type Program")) {
+ // We must intervene to hide the IO type.
+ line = "data Program";
+ } else if (line.startsWith("type Truth")) {
+ line = "data Truth";
+ } else if (line.startsWith("True ::")) {
+ line = "True :: Truth";
+ } else if (line.startsWith("False ::")) {
+ line = "False :: Truth";
+ } else if (line.startsWith("newtype ")) {
+ // Hide the distinction between newtype and data.
+ line = "data " + line.substr(8);
+ } else if (line.startsWith("pattern ")) {
+ // Hide the distinction between patterns and constructors.
+ line = line.substr(8);
+ } else if (line.startsWith("class ")) {
+ return;
+ } else if (line.startsWith("instance ")) {
+ return;
+ } else if (line.startsWith("-- ")) {
+ return;
+ } else if (line.startsWith("infix ")) {
+ return;
+ } else if (line.startsWith("infixl ")) {
+ return;
+ } else if (line.startsWith("infixr ")) {
+ return;
+ }
+
+ // Filter out strictness annotations.
+ line = line.replace(/(\s)!([A-Za-z\(\[])/g, '$1$2');
+
+ // Filter out CallStack constraints.
+ line = line.replace(/:: HasCallStack =>/g, '::');
+
+ var wordStart = 0;
+ if (line.startsWith("type ") || line.startsWith("data ")) {
+ wordStart += 5;
+
+ // Hide kind annotations.
+ var kindIndex = line.indexOf(" ::");
+ if (kindIndex != -1) {
+ line = line.substr(0, kindIndex);
+ }
+ }
+
+ var wordEnd = line.indexOf(" ", wordStart);
+ if (wordEnd == -1) {
+ wordEnd = line.length;
+ }
+ if (wordStart == wordEnd) {
+ return;
+ }
+
+ if (line[wordStart] == "(" && line[wordEnd - 1] == ")") {
+ wordStart++;
+ wordEnd--;
+ }
+
+ var word = line.substr(wordStart, wordEnd - wordStart);
+
+ if (hintBlacklist.indexOf(word) >= 0) {
+ codeworldKeywords[word] = 'deprecated';
+ } else if (/^[A-Z:]/.test(word)) {
+ codeworldKeywords[word] = 'builtin-2';
+ hints.push(createHint(line, wordStart, wordEnd));
+ } else {
+ codeworldKeywords[word] = 'builtin';
+ hints.push(createHint(line, wordStart, wordEnd));
+ }
+
+ });
+
+ hints.sort(function(a, b) {
+ return a.source < b.source ? -1 : 1
+ });
+ CodeMirror.registerHelper('hintWords', 'codeworld', hints);
+ successFunc();
+ });
+}
+
+function addToMessage(msg) {
+ while (msg.match(/(\r\n|[^\x08]|)\x08/)) {
+ msg = msg.replace(/(\r\n|[^\x08])\x08/g, "");
+ }
+
+ msg = msg
+ .replace(/&/g, '&')
+ .replace(/</g, '<')
+ .replace(/>/g, '>')
+ .replace(/program\.hs:(\d+):((\d+)(-\d+)?)/g,
+ '<a href="#" onclick="goto($1, $3);">Line $1, Column $2</a>')
+ .replace(/program\.hs:\((\d+),(\d+)\)-\((\d+),(\d+)\)/g,
+ '<a href="#" onclick="goto($1, $2);">Line $1-$3, Column $2-$4</a>');
+
+ var message = document.getElementById('message');
+ message.innerHTML += msg
+}
+
+function signin() {
+ if (window.auth2) auth2.signIn({prompt: 'login'});
+}
+
+function signout() {
+ if (window.auth2) auth2.signOut();
+}
+
+function signedIn() {
+ return window.auth2 && auth2.isSignedIn.get();
+}
+
+//signinCallback must be defined
+function handleGAPILoad() {
+ gapi.load('auth2', function() {
+ withClientId(function(clientId) {
+ window.auth2 = gapi.auth2.init({
+ client_id: clientId,
+ scope: 'profile',
+ fetch_basic_profile: false
+ });
+
+ auth2.isSignedIn.listen(signinCallback);
+ auth2.currentUser.listen(signinCallback);
+
+ if (auth2.isSignedIn.get() == true) auth2.signIn();
+ });
+ });
+
+ discoverProjects("", 0);
+ updateUI();
+}
+
+function withClientId(f) {
+ if (window.clientId) return f(window.clientId);
+
+ sendHttp('GET', 'clientId.txt', null, function(request) {
+ if (request.status != 200 || request.responseText == '') {
+ sweetAlert('Oops!', 'Missing API client key. You will not be able to sign in.', 'warning');
+ return null;
+ }
+
+ window.clientId = request.responseText.trim();
+ return f(window.clientId);
+ });
+}
+
+function discoverProjects_(path, buildMode, index) {
+ if (!signedIn()) {
+ allProjectNames = window.openProjectName ? [[window.openProjectName]] : [[]];
+ allFolderNames = [[]];
+ nestedDirs = [""];
+ updateUI();
+ return;
+ }
+
+ var data = new FormData();
+ data.append('id_token', auth2.currentUser.get().getAuthResponse().id_token);
+ data.append('mode', buildMode);
+ data.append('path', path);
+
+ sendHttp('POST', 'listFolder', data, function(request) {
+ if (request.status != 200) {
+ return;
+ }
+ var allContents = JSON.parse(request.responseText);
+ allProjectNames[index] = allContents['files'];
+ allFolderNames[index] = allContents['dirs'];
+ updateNavBar();
+ });
+}
+
+function cancel() {
+ updateUI();
+}
+
+function moveHere_(path, buildMode, successFunc) {
+ if (!signedIn()) {
+ sweetAlert('Oops!', 'You must sign in before moving.', 'error');
+ cancel();
+ return;
+ }
+
+ if (window.move == undefined) {
+ sweetAlert('Oops!', 'You must first select something to move.', 'error');
+ cancel();
+ return;
+ }
+ function go() {
+ sendHttp('POST', 'moveProject', data, function(request) {
+ if (request.status != 200) {
+ if (request.status == 404) {
+ sweetAlert('Oops!', request.responseText, 'error');
+ } else {
+ sweetAlert('Oops!', 'Could not move your project! Please try again.', 'error');
+ }
+ cancel();
+ return;
+ }
+ successFunc();
+ });
+ }
+
+ var data = new FormData();
+ data.append('id_token', auth2.currentUser.get().getAuthResponse().id_token);
+ data.append('mode', buildMode);
+ data.append('moveTo', path);
+ if (window.move.file != undefined) {
+ data.append('moveFrom', window.move.path);
+ data.append('fromName', window.move.file);
+ data.append('isFile', 'true');
+ } else {
+ data.append('moveFrom', window.move.path.split('/').slice(0,-1).join('/'));
+ data.append('fromName', window.move.path.split('/').slice(-1)[0]);
+ data.append('isFile', 'false');
+ }
+ sweetAlert({
+ html: true,
+ title: '<i class="mdi mdi-72px mdi-folder-move"></i> Move File',
+ text: 'Enter a name for your file/folder to be created at /' + path + ':',
+ type: 'input',
+ inputValue: '',
+ confirmButtonText: 'Next',
+ showCancelButton: true,
+ closeOnConfirm: false
+ }, function (name) {
+ if (name == '' || name == null) {
+ return;
+ }
+ data.append('name', name);
+ sweetAlert({
+ html: true,
+ title: '<i class="mdi mdi-72px mdi-folder-move"></i> Move File',
+ text: 'Enter a user name to be associated with your file/s:',
+ type: 'input',
+ inputValue: '',
+ confirmButton: 'Move',
+ showCancelButton: true,
+ closeOnConfirm: false
+ }, function(userIdent) {
+ if (userIdent == '' || userIdent == null) {
+ return;
+ }
+ data.append('userIdent', userIdent);
+ sweetAlert.close();
+ go();
+ });
+ });
+}
+
+function copyHere_(path, buildMode, successFunc) {
+ if (!signedIn()) {
+ sweetAlert('Oops!', 'You must sign in before copying.', 'error');
+ cancel();
+ return;
+ }
+
+ if (window.copy == undefined) {
+ sweetAlert('Oops!', 'You must first select something to copy.', 'error');
+ cancel();
+ return;
+ }
+ function go() {
+ sendHttp('POST', 'copyProject', data, function(request) {
+ if (request.status != 200) {
+ if (request.status == 404) {
+ sweetAlert('Oops!', request.responseText, 'error');
+ } else {
+ sweetAlert('Oops!', 'Could not copy your project! Please try again.', 'error');
+ }
+ cancel();
+ return;
+ }
+ successFunc();
+ });
+ }
+
+ var data = new FormData();
+ data.append('id_token', auth2.currentUser.get().getAuthResponse().id_token);
+ data.append('mode', buildMode);
+ data.append('copyTo', path);
+ data.append('empty', JSON.stringify(getCurrentProject()['history']));
+ if (window.copy.file != undefined) {
+ data.append('copyFrom', window.copy.path)
+ data.append('fromName', window.copy.file);
+ data.append('isFile', 'true');
+ } else {
+ data.append('copyFrom', window.copy.path.split('/').slice(0,-1).join('/'));
+ data.append('fromName', window.copy.path.split('/').slice(-1)[0]);
+ data.append('isFile', 'false');
+ }
+ sweetAlert({
+ html: true,
+ title: '<i class="mdi mdi-72px mdi-content-copy"></i> Copy File',
+ text: 'Enter a name for your file/folder to be created at /' + path + ':',
+ type: 'input',
+ inputValue: '',
+ confirmButtonText: 'Next',
+ showCancelButton: true,
+ closeOnConfirm: false
+ }, function (name) {
+ if (name == '' || name == null) {
+ return;
+ }
+ data.append('name', name);
+ sweetAlert({
+ html: true,
+ title: '<i class="mdi mdi-72px mdi-content-copy"></i> Copy File',
+ text: 'Enter a user name to be associated with your file/s:',
+ type: 'input',
+ inputValue: '',
+ confirmButton: 'Copy',
+ showCancelButton: true,
+ closeOnConfirm: false
+ }, function(userIdent) {
+ if (userIdent == '' || userIdent == null) {
+ return;
+ }
+ data.append('userIdent', userIdent);
+ sweetAlert.close();
+ go();
+ });
+ });
+}
+
+function warnIfUnsaved(action, showAnother) {
+ if (isEditorClean() || window.currentVersion != window.maxVersion) {
+ action();
+ } else {
+ var msg = 'There are unsaved changes to your project. ' + 'Continue and throw away your changes?';
+ sweetAlert({
+ title: 'Warning',
+ text: msg,
+ type: 'warning',
+ showCancelButton: true,
+ confirmButtonColor: '#DD6B55',
+ confirmButtonText: 'Yes, discard my changes!',
+ closeOnConfirm: !showAnother
+ }, action);
+ }
+}
+
+function saveProject() {
+ if (!signedIn()) {
+ sweetAlert('Oops!', 'You must sign in to save files.', 'error');
+ updateUI();
+ return;
+ }
+
+ if (window.openProjectName) {
+ saveProjectBase(nestedDirs.slice(1).join('/'), openProjectName);
+ } else {
+ sweetAlert('Oops!', 'You need to create a project to save it!', 'error');
+ }
+}
+
+function saveProjectBase_(path, projectName, mode, successFunc, type) {
+ if (projectName == null || projectName == '') return;
+
+ if (!signedIn()) {
+ sweetAlert('Oops!', 'You must sign in to ' + type + ' files.', 'error');
+ updateUI();
+ return;
+ }
+ if (window.currentVersion == undefined || window.maxVersion == undefined) {
+ sweetAlert('Oops!', 'Something went wrong. Please try again!', 'error');
+ updateUI();
+ return;
+ }
+ if (window.currentVersion != window.maxVersion) {
+ sweetAlert('Oops!', 'Not allowed to save into a previous version! Sorry for the inconvenience!', 'error');
+ updateUI();
+ return;
+ }
+ function go() {
+ sweetAlert.close();
+ var project = getCurrentProject();
+
+ var data = new FormData();
+ data.append('id_token', auth2.currentUser.get().getAuthResponse().id_token);
+ data.append('project', JSON.stringify({
+ source: project['source'],
+ history: project['history']
+ }));
+ data.append('mode', mode);
+ data.append('path', path);
+ data.append('name', projectName);
+ data.append('versionNo', window.currentVersion);
+ sendHttp('POST', 'saveProject', data, function(request) {
+ if (request.status != 200) {
+ if (request.status == 404) {
+ sweetAlert('Oops!', request.responseText, 'error');
+ } else {
+ sweetAlert('Oops!', 'Could not ' + type + ' your project!!! Please try again.', 'error');
+ }
+ updateUI();
+ return;
+ }
+ window.project['source'] = project['source'];
+ getCommentVersions();
+ successFunc();
+ if (allProjectNames[allProjectNames.length - 1].indexOf(projectName) == -1) {
+ discoverProjects(path, allProjectNames.length - 1);
+ }
+ });
+ }
+
+ if (allProjectNames[allProjectNames.length - 1].indexOf(projectName) == -1 || projectName == openProjectName) {
+ go();
+ } else {
+ var msg = 'Are you sure you want to ' + type + ' over another project?\n\n' +
+ 'The previous contents of ' + projectName + ' will be permanently destroyed!';
+ sweetAlert({
+ title: 'Warning',
+ text: msg,
+ type: 'warning',
+ showCancelButton: true,
+ confirmButtonColor: '#DD6B55',
+ confirmButtonText: 'Yes, overwrite it!'
+ }, go);
+ }
+}
+
+function deleteProject_(path, buildMode, successFunc) {
+ if (!window.openProjectName) return;
+
+ if (!signedIn()) {
+ sweetAlert('Oops', 'You must sign in to delete a project.', 'error');
+ updateUI();
+ return;
+ }
+
+ function go() {
+ var data = new FormData();
+ data.append('id_token', auth2.currentUser.get().getAuthResponse().id_token);
+ data.append('name', window.openProjectName);
+ data.append('mode', buildMode);
+ data.append('path', path);
+
+ sendHttp('POST', 'deleteProject', data, function(request) {
+ if (request.status == 200) {
+ successFunc();
+ discoverProjects(path, allProjectNames.length - 1);
+ } else {
+ if (request.status == 404) {
+ sweetAlert('Oops!', request.responseText, 'error');
+ } else {
+ sweetAlert('Oops!', 'Unable to delete the file. Please, try again!', 'error');
+ }
+ updateUI();
+ return;
+ }
+ });
+ }
+
+ var msg = 'Deleting a project will throw away all work, and cannot be undone. ' + 'Are you sure?';
+ sweetAlert({
+ title: 'Warning',
+ text: msg,
+ type: 'warning',
+ showCancelButton: true,
+ confirmButtonColor: '#DD6B55',
+ confirmButtonText: 'Yes, delete it!'
+ }, go);
+}
+
+function deleteFolder_(path, buildMode, successFunc) {
+ if(path == "" || window.openProjectName != null) {
+ return;
+ }
+ if(!signedIn()) {
+ sweetAlert('Oops', 'You must sign in to delete a folder.', 'error');
+ updateUI();
+ return;
+ }
+
+ function go() {
+ var data = new FormData();
+ data.append('id_token', auth2.currentUser.get().getAuthResponse().id_token);
+ data.append('mode', buildMode);
+ data.append('path', path);
+
+ sendHttp('POST', 'deleteFolder', data, function(request) {
+ if (request.status == 200) {
+ successFunc();
+ nestedDirs.pop();
+ allProjectNames.pop();
+ allFolderNames.pop();
+ discoverProjects(nestedDirs.slice(1).join('/'), allProjectNames.length - 1);
+ } else {
+ if (request.status == 404) {
+ sweetAlert('Oops!', request.responseText, 'error');
+ } else {
+ sweetAlert('Oops!', 'Unable to delete the folder. Please, try again!', 'error');
+ }
+ updateUI();
+ return;
+ }
+ });
+ }
+
+ var msg = 'Deleting a folder will throw away all of its content, cannot be undone. ' + 'Are you sure?';
+ sweetAlert({
+ title: 'Warning',
+ text: msg,
+ type: 'warning',
+ showCancelButton: true,
+ confirmButtonColor: '#DD6B55',
+ confirmButtonText: 'Yes, delete it!'
+ }, go);
+}
+
+function createFolder(path, buildMode) {
+ warnIfUnsaved(function() {
+ if(!signedIn()) {
+ sweetAlert('Oops!', 'You must sign in to create a folder.', 'error');
+ updateUI();
+ return;
+ }
+
+ function go(folderName) {
+ if(folderName == null || folderName == '') {
+ return;
+ }
+ sweetAlert.close();
+ var data = new FormData();
+ data.append('id_token', auth2.currentUser.get().getAuthResponse().id_token);
+ data.append('mode', buildMode);
+ if (path == "")
+ data.append('path', folderName);
+ else
+ data.append('path', path + '/' + folderName);
+ sendHttp('POST', 'createFolder', data, function(request) {
+ if (request.status != 200) {
+ if (request.status == 404) {
+ sweetAlert('Oops!', request.responseText, 'error');
+ } else {
+ sweetAlert('Oops', 'Could not create your directory! Please try again.', 'error');
+ }
+ updateUI();
+ return;
+ }
+ allFolderNames[allFolderNames.length - 1].push(folderName);
+ nestedDirs.push(folderName);
+ allFolderNames.push([]);
+ allProjectNames.push([]);
+ if (window.move == undefined && window.copy == undefined) {
+ setCode('');
+ }
+ updateNavBar();
+ });
+ }
+
+ sweetAlert({
+ html: true,
+ title: '<i class="mdi mdi72px mdi-folder-plus"></i> Create Folder',
+ text: 'Enter a name for your folder to be created at /' + path + ':',
+ type: 'input',
+ inputValue: '',
+ confirmButtonText: 'Create',
+ showCancelButton: true,
+ closeOnConfirm: false
+ }, go);
+ }, true);
+}
+
+function newProject_(path) {
+ warnIfUnsaved(function () {
+ if (!signedIn()) {
+ sweetAlert('Oops!', 'You must sign in to create a new project.', 'error');
+ updateUI();
+ return;
+ }
+ if (path.length > 1 && path[1] == 'commentables') {
+ sweetAlert('error', 'Cannot create a project in commentables directory!', 'error');
+ updateUI();
+ return;
+ }
+
+ function go(fileName, userIdent) {
+ if (fileName == null || fileName == '') {
+ return;
+ }
+ if (userIdent == null || userIdent == '') {
+ return;
+ }
+ sweetAlert.close();
+ setCode('');
+
+ function go_() {
+ sweetAlert.close();
+ var project = getCurrentProject();
+ var data = new FormData();
+ data.append('id_token', auth2.currentUser.get().getAuthResponse().id_token);
+ data.append('project', JSON.stringify({
+ source: project['source'],
+ history: project['history']
+ }));
+ data.append('mode', window.buildMode);
+ data.append('path', path);
+ data.append('name', fileName);
+ data.append('userIdent', userIdent);
+
+ sendHttp('POST', 'newProject', data, function (request) {
+ if (request.status != 200) {
+ if (request.status != 404) {
+ sweetAlert('Oops!', 'Could not create your project!!! Please try, again', 'error');
+ } else {
+ sweetAlert('Oops!', request.responseText, 'error');
+ }
+ return;
+ }
+
+ window.openProjectName = fileName;
+ updateUI();
+
+ if (allProjectNames[allProjectNames.length - 1].indexOf(fileName) == -1) {
+ discoverProjects(path, allProjectNames.length - 1);
+ }
+
+ window.userIdent = userIdent;
+ window.project = {
+ 'name': fileName,
+ 'source': ''
+ };
+ window.currentVersion = 0;
+ window.maxVersion = 0;
+ initializeCollaboration();
+ });
+ }
+
+ if (allProjectNames[allProjectNames.length - 1].indexOf(fileName) == -1) {
+ go_();
+ } else {
+ var msg = 'Are you sure you want to create new project over another one?\n\n' +
+ 'The previous contents of ' + fileName + ' will be permanently destroyed!';
+ sweetAlert({
+ title: 'warning',
+ text: msg,
+ showCancelButton: true,
+ confirmButtonColor: '#DD6B55',
+ confirmButtonText: 'Yes, overwrite it!'
+ }, go_);
+ }
+ }
+
+ sweetAlert({
+ html: true,
+ title: '<i class="mdi mdi-72px mdi-note-plus"></i> Create File',
+ text: 'Enter a name for your file to be created at /' + path + ':',
+ type: 'input',
+ inputValue: '',
+ confirmButtonText: 'Next',
+ showCancelButton: true,
+ closeOnConfirm: false
+ }, function(fileName) {
+ sweetAlert({
+ html: true,
+ title: '<i class="mdi mdi-72px mdi-note-plus"></i> Create File',
+ text: 'Enter a user name to be associated with your file:',
+ type: 'input',
+ inputValue: '',
+ confirmButton: 'Create',
+ showCancelButton: true,
+ closeOnConfirm: false
+ }, function(userIdent) {
+ go(fileName, userIdent);
+ });
+ });
+ }, true);
+}
+
+function loadProject_(index, name, buildMode, successFunc) {
+ warnIfUnsaved(function(){
+ if (!signedIn()) {
+ sweetAlert('Oops!', 'You must sign in to open or close projects.', 'error');
+ updateUI();
+ return;
+ }
+ if (window.openProjectName != '' && window.openProjectName != null) {
+ if (window.openProjectName == name && index == window.nestedDirs.length - 1) {
+ setCode('');
+ updateUI();
+ return;
+ }
+ }
+ if (index != 0 && window.nestedDirs.length > 1 && window.nestedDirs[1] == 'commentables') {
+ loadProjectForComments(index, name, buildMode, successFunc);
+ return;
+ }
+ var data = new FormData();
+ data.append('id_token', auth2.currentUser.get().getAuthResponse().id_token);
+ data.append('name', name);
+ data.append('mode', buildMode);
+ data.append('path', nestedDirs.slice(1, index + 1).join('/'));
+
+ sendHttp('POST', 'loadProject', data, function(request) {
+ if (request.status == 200) {
+ var project = JSON.parse(request.responseText);
+ window.nestedDirs = nestedDirs.slice(0, index + 1);
+ window.allProjectNames = allProjectNames.slice(0, index + 1);
+ window.allFolderNames = allFolderNames.slice(0, index + 1);
+ updateUI();
+ successFunc(project);
+ } else {
+ if (request.status == 404) {
+ sweetAlert('Oops!', request.responseText, 'error');
+ } else {
+ sweetAlert('Oops!', 'Could not load the project. Please try again!', 'error');
+ }
+ updateUI();
+ return;
+ }
+ });
+ }, false);
+}
+
+function share() {
+ var offerSource = true;
+
+ function go() {
+ var url;
+ var msg;
+ var showConfirm;
+ var confirmText;
+
+ if (!window.deployHash) {
+ url = window.location.href;
+ msg = 'Copy this link to share your program and source code with others!';
+ showConfirm = false;
+ } else if (offerSource) {
+ url = window.location.href;
+ msg = 'Copy this link to share your program and source code with others!';
+ showConfirm = true;
+ confirmText = 'Remove Source Code';
+ } else {
+ var a = document.createElement('a');
+ a.href = window.location.href;
+ a.hash = '';
+ a.pathname = '/run.html'
+ a.search = '?mode=' + window.buildMode + '&dhash=' + window.deployHash;
+
+ url = a.href;
+ msg = 'Copy this link to share your program (not source code) with others!';
+ showConfirm = true;
+ confirmText = 'Share Source Code';
+ }
+
+ sweetAlert({
+ html: true,
+ title: '<i class="mdi mdi-72px mdi-share"></i> Share',
+ text: msg,
+ type: 'input',
+ inputValue: url,
+ showConfirmButton: showConfirm,
+ confirmButtonText: confirmText,
+ closeOnConfirm: false,
+ showCancelButton: true,
+ cancelButtonText: 'Done',
+ animation: 'slide-from-bottom'
+ }, function() {
+ offerSource = !offerSource;
+ go();
+ });
+ }
+
+ go();
+}
+
+function inspect() {
+ document.getElementById('runner').contentWindow.toggleDebugMode();
+ updateUI();
+}
+
+function shareFolder_(mode) {
+ if(!signedIn()) {
+ sweetAlert('Oops!', 'You must sign in to share your folder.', 'error');
+ updateUI();
+ return;
+ }
+ if(nestedDirs.length == 1 || (openProjectName != null && openProjectName != '')) {
+ sweetAlert('Oops!', 'You must select a folder to share!', 'error');
+ updateUI();
+ return;
+ }
+ var path = nestedDirs.slice(1).join('/');
+
+ function go() {
+ var msg = 'Copy this link to share your folder with others!';
+
+ var id_token = auth2.currentUser.get().getAuthResponse().id_token;
+ var data = new FormData();
+ data.append('id_token', id_token);
+ data.append('mode', mode);
+ data.append('path', path);
+
+ sendHttp('POST', 'shareFolder', data, function(request) {
+ if(request.status != 200) {
+ sweetAlert('Oops!', 'Could not share your folder! Please try again.', 'error');
+ return;
+ }
+
+ var shareHash = request.responseText;
+ var a = document.createElement('a');
+ a.href = window.location.href;
+ a.hash = '#' + shareHash;
+ var url = a.href;
+ sweetAlert({
+ html: true,
+ title: '<i class="mdi mdi-72px mdi-folder-outline"></i> Share Folder',
+ text: msg,
+ type: 'input',
+ inputValue: url,
+ showConfirmButton: false,
+ showCancelButton: true,
+ cancelButtonText: 'Done',
+ animation: 'slide-from-bottom'
+ });
+ });
+ }
+
+ go();
+}
diff --git a/web/js/funblocks.js b/web/js/funblocks.js
index fc6ef36fd..f462965f0 100644
--- a/web/js/funblocks.js
+++ b/web/js/funblocks.js
@@ -34,7 +34,7 @@ function loadWorkspace(text)
function loadXmlHash(hash, autostart)
{
- sendHttp('GET', 'loadXML?hash=' + hash + '&mode=blocklyXML', null, function(request) {
+ sendHttp('GET', 'floadXML?hash=' + hash + '&mode=blocklyXML', null, function(request) {
if (request.status == 200) {
loadWorkspace(request.responseText);
if(autostart){
@@ -71,8 +71,9 @@ function init()
data.append('mode', 'blocklyXML');
data.append('shash', hash);
data.append('name', folderName);
+ data.append('userIdent', 'none');
- sendHttp('POST', 'shareContent', data, function(request) {
+ sendHttp('POST', 'fshareContent', data, function(request) {
window.location.hash = '';
if (request.status == 200) {
sweetAlert('Success!', 'The shared folder is moved into your root directory.', 'success');
@@ -105,7 +106,7 @@ function init()
function initCodeworld() {
codeworldKeywords = {};
registerStandardHints( function(){} );
-
+
window.onbeforeunload = function(event) {
if (containsUnsavedChanges()) {
var msg = 'There are unsaved changes to your project. ' + 'If you continue, they will be lost!';
@@ -226,7 +227,7 @@ function compile(src,silent) {
data.append('source', xml_text);
data.append('mode', 'blocklyXML');
- sendHttp('POST', 'saveXMLhash', data, function(request) {
+ sendHttp('POST', 'fsaveXMLhash', data, function(request) {
// XML Hash
var xmlHash = request.responseText;
@@ -346,7 +347,7 @@ function updateUI() {
}
document.getElementById('moveHereButton').style.display = 'none';
- document.getElementById('cancelMoveButton').style.display = 'none';
+ document.getElementById('cancelButton').style.display = 'none';
if ((openProjectName != null && openProjectName != '') || NDlength != 1) {
document.getElementById('moveButton').style.display = '';
} else {
@@ -491,7 +492,7 @@ function moveProject() {
document.getElementById('deleteButton').style.display = 'none';
document.getElementById('moveButton').style.display = 'none';
document.getElementById('moveHereButton').style.display = '';
- document.getElementById('cancelMoveButton').style.display = '';
+ document.getElementById('cancelButton').style.display = '';
document.getElementById('runButtons').style.display = 'none';
window.move = Object();
diff --git a/web/js/codeworld_shared.js b/web/js/funblocks_requests.js
similarity index 97%
rename from web/js/codeworld_shared.js
rename to web/js/funblocks_requests.js
index 66911fe87..2104f49af 100644
--- a/web/js/codeworld_shared.js
+++ b/web/js/funblocks_requests.js
@@ -303,7 +303,7 @@ function handleGAPILoad() {
if (auth2.isSignedIn.get() == true) auth2.signIn();
});
});
-
+
discoverProjects("", 0);
updateUI();
}
@@ -336,7 +336,7 @@ function discoverProjects_(path, buildMode, index) {
data.append('mode', buildMode);
data.append('path', path);
- sendHttp('POST', 'listFolder', data, function(request) {
+ sendHttp('POST', 'flistFolder', data, function(request) {
if (request.status != 200) {
return;
}
@@ -376,7 +376,7 @@ function moveHere_(path, buildMode, successFunc) {
data.append('isFile', "false");
}
- sendHttp('POST', 'moveProject', data, function(request) {
+ sendHttp('POST', 'fmoveProject', data, function(request) {
if (request.status != 200) {
sweetAlert('Oops', 'Could not move your project! Please try again.', 'error');
cancelMove();
@@ -470,7 +470,7 @@ function saveProjectBase_(path, projectName, mode, successFunc) {
data.append('mode', mode);
data.append('path', path);
- sendHttp('POST', 'saveProject', data, function(request) {
+ sendHttp('POST', 'fsaveProject', data, function(request) {
if (request.status != 200) {
sweetAlert('Oops!', 'Could not save your project!!! Please try again.', 'error');
return;
@@ -518,7 +518,7 @@ function deleteProject_(path, buildMode, successFunc) {
data.append('mode', buildMode);
data.append('path', path);
- sendHttp('POST', 'deleteProject', data, function(request) {
+ sendHttp('POST', 'fdeleteProject', data, function(request) {
if (request.status == 200) {
successFunc();
discoverProjects(path, allProjectNames.length - 1);
@@ -553,7 +553,7 @@ function deleteFolder_(path, buildMode, successFunc) {
data.append('mode', buildMode);
data.append('path', path);
- sendHttp('POST', 'deleteFolder', data, function(request) {
+ sendHttp('POST', 'fdeleteFolder', data, function(request) {
if (request.status == 200) {
successFunc();
nestedDirs.pop();
@@ -597,7 +597,7 @@ function createFolder(path, buildMode, successFunc) {
else
data.append('path', path + '/' + folderName);
- sendHttp('POST', 'createFolder', data, function(request) {
+ sendHttp('POST', 'fcreateFolder', data, function(request) {
if (request.status != 200) {
sweetAlert('Oops', 'Could not create your directory! Please try again.', 'error');
return;
@@ -626,7 +626,7 @@ function createFolder(path, buildMode, successFunc) {
}
function loadProject_(index, name, buildMode, successFunc) {
-
+
warnIfUnsaved(function(){
if (!signedIn()) {
sweetAlert('Oops!', 'You must sign in to open projects.', 'error');
@@ -640,7 +640,7 @@ function loadProject_(index, name, buildMode, successFunc) {
data.append('mode', buildMode);
data.append('path', nestedDirs.slice(1, index + 1).join('/'));
- sendHttp('POST', 'loadProject', data, function(request) {
+ sendHttp('POST', 'floadProject', data, function(request) {
if (request.status == 200) {
var project = JSON.parse(request.responseText);
@@ -732,8 +732,8 @@ function shareFolder_(mode) {
data.append('id_token', id_token);
data.append('mode', mode);
data.append('path', path);
-
- sendHttp('POST', 'shareFolder', data, function(request) {
+
+ sendHttp('POST', 'fshareFolder', data, function(request) {
if(request.status != 200) {
sweetAlert('Oops!', 'Could not share your folder! Please try again.', 'error');
return;
diff --git a/web/js/ot-min.js b/web/js/ot-min.js
new file mode 120000
index 000000000..8f24449f1
--- /dev/null
+++ b/web/js/ot-min.js
@@ -0,0 +1 @@
+../../build/ot.js/dist/ot-min.js
\ No newline at end of file