From 5a77d2067f8de70d8ed94a283680ee4e933f67a1 Mon Sep 17 00:00:00 2001 From: Parv Mor Date: Tue, 27 Jun 2017 23:15:53 +0530 Subject: [PATCH 01/28] allows reorganizing of files and folders --- codeworld-server/src/Main.hs | 29 +++++++++ web/env.html | 9 +++ web/js/codeworld.js | 117 +++++++++++++++++++++++++++++------ web/js/codeworld_shared.js | 43 ++++++++++++- 4 files changed, 177 insertions(+), 21 deletions(-) diff --git a/codeworld-server/src/Main.hs b/codeworld-server/src/Main.hs index f21cf357a..f2881bc07 100644 --- a/codeworld-server/src/Main.hs +++ b/codeworld-server/src/Main.hs @@ -117,6 +117,7 @@ site clientId = ("deleteFolder", deleteFolderHandler clientId), ("shareFolder", shareFolderHandler clientId), ("shareContent", shareContentHandler clientId), + ("moveProject", moveProjectHandler clientId), ("compile", compileHandler), ("saveXMLhash", saveXMLHashHandler), ("loadXML", loadXMLHandler), @@ -245,6 +246,34 @@ shareContentHandler clientId = do 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 (fmap $ splitDirectories . BC.unpack) $ getParam "moveTo" + let moveToDir = joinPath $ map dirBase $ map (nameToDirId . T.pack) moveTo + Just moveFrom <- fmap (fmap $ splitDirectories . BC.unpack) $ getParam "moveFrom" + let projectDir = userProjectDir mode (userId user) + let moveFromDir = projectDir (joinPath $ map dirBase $ map (nameToDirId . T.pack) moveFrom) + Just isFile <- getParam "isFile" + case isFile of + "true" -> do + Just name <- getParam "name" + let projectId = nameToProjectId $ T.decodeUtf8 name + liftIO $ ensureProjectDir mode (userId user) moveToDir projectId + liftIO $ copyDirIfExists (dropFileName $ moveFromDir projectFile projectId) $ dropFileName $ projectDir moveToDir projectFile projectId + empty <- liftIO $ getDirectoryContents (dropFileName $ moveFromDir projectFile projectId) >>= + return . (\l1 -> length l1 == 3 && sort l1 == sort [".", "..", takeFileName $ projectFile projectId]) + liftIO $ if empty then removeDirectoryIfExists (dropFileName $ moveFromDir projectFile projectId) + else removeFileIfExists $ moveFromDir projectFile projectId + "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 $ getDirectoryContents (takeDirectory $ moveFromDir) >>= return . (\l1 -> length l1 == 3 && sort l1 == sort [".", "..", takeFileName moveFromDir]) + liftIO $ removeDirectoryIfExists $ if empty then (takeDirectory $ moveFromDir) else moveFromDir + saveXMLHashHandler :: Snap () saveXMLHashHandler = do mode <- getBuildMode diff --git a/web/env.html b/web/env.html index 7f209d51f..df27586da 100644 --- a/web/env.html +++ b/web/env.html @@ -58,6 +58,15 @@   Download + + + diff --git a/web/js/codeworld.js b/web/js/codeworld.js index c66164059..cfea61b9a 100644 --- a/web/js/codeworld.js +++ b/web/js/codeworld.js @@ -194,8 +194,12 @@ function folderHandler(folderName, index, state) { allFolderNames.push([]); discoverProjects(nestedDirs.slice(1).join('/'), index + 1); } - setCode(''); - updateUI(); + if (window.move == undefined) { + setCode(''); + updateUI(); + } else { + updateNavBar(); + } }, false); } @@ -236,7 +240,46 @@ function updateUI() { document.getElementById('navButton').style.display = 'none'; document.getElementById('deleteButton').style.display = 'none'; } + + window.move = undefined; + document.getElementById('newButton').style.display = ''; + document.getElementById('saveAsButton').style.display = ''; + document.getElementById('downloadButton').style.display = ''; + document.getElementById('runButtons').style.display = ''; + + + updateNavBar(); + var NDlength = nestedDirs.length; + if (NDlength != 1 && (openProjectName == null || openProjectName == '')) { + document.getElementById('shareFolderButton').style.display = ''; + } else { + document.getElementById('shareFolderButton').style.display = 'none'; + } + + document.getElementById('moveHereButton').style.display = 'none'; + document.getElementById('cancelMoveButton').style.display = 'none'; + if((openProjectName != null && openProjectName != '') || NDlength != 1) { + document.getElementById('moveButton').style.display = ''; + } else { + document.getElementById('moveButton').style.display = 'none'; + } + + var title; + if (window.openProjectName) { + title = window.openProjectName; + } else { + title = "(new)"; + } + + if (!isEditorClean()) { + title = "* " + title; + } + + document.title = title + " - CodeWorld" +} + +function updateNavBar() { var projects = document.getElementById('nav_mine'); while (projects.lastChild) { @@ -301,7 +344,7 @@ function updateUI() { }); allProjectNames[i].forEach(function(projectName) { var active = (window.openProjectName == projectName) && (i == NDlength - 1); - if(!isSignedIn && !active) { + if(!signedIn() && !active) { return; } @@ -330,25 +373,57 @@ function updateUI() { projects = tempProjects; } } +} - if (NDlength != 1 && (openProjectName == null || openProjectName == '')) { - document.getElementById('shareFolderButton').style.display = ''; - } else { - document.getElementById('shareFolderButton').style.display = 'none'; - } +function moveProject() { + warnIfUnsaved(function() { + if (!signedIn()) { + sweetAlert('Oops!', 'You must sign in to move this project or folder.', 'error'); + updateUI(); + return; + } - var title; - if (window.openProjectName) { - title = window.openProjectName; - } else { - title = "(new)"; - } + if ((openProjectName == null || openProjectName == '') && nestedDirs.length == 1) { + sweetAlert('Oops!', 'You must select a project or folder to move.', 'error'); + updateUI(); + return; + } - if (!isEditorClean()) { - title = "* " + title; - } + var tempOpen = openProjectName; + var tempPath = nestedDirs.slice(1).join('/'); + setCode(''); + nestedDirs = [""]; + allProjectNames = [[]]; + allFolderNames = [[]]; + discoverProjects("", 0); + 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('runButtons').style.display = 'none'; + + window.move = Object(); + window.move.path = tempPath; + if (tempOpen != null && tempOpen != '') { + window.move.file = tempOpen; + } + }, false); +} - document.title = title + " - CodeWorld" +function moveHere() { + function successFunc() { + nestedDirs = [""]; + allProjectNames = [[]]; + allFolderNames = [[]]; + discoverProjects("", 0); + updateUI(); + } + moveHere_(nestedDirs.slice(1).join('/'), window.buildMode, successFunc); } function changeFontSize(incr) { @@ -466,12 +541,16 @@ function newProject() { function newFolder() { function successFunc() { - setCode(''); + if (window.move == undefined) + setCode(''); } createFolder(nestedDirs.slice(1).join('/'), window.buildMode, successFunc); } function loadProject(name, index) { + if(window.move != undefined) { + return; + } function successFunc(project){ setCode(project.source, project.history, name); } diff --git a/web/js/codeworld_shared.js b/web/js/codeworld_shared.js index 5c09f528e..e1bad9381 100644 --- a/web/js/codeworld_shared.js +++ b/web/js/codeworld_shared.js @@ -332,7 +332,46 @@ function discoverProjects_(path, buildMode, index) { var allContents = JSON.parse(request.responseText); allProjectNames[index] = allContents['files']; allFolderNames[index] = allContents['dirs']; - updateUI(); + updateNavBar(); + }); +} + +function cancelMove() { + updateUI(); +} + +function moveHere_(path, buildMode, successFunc) { + if (!signedIn()) { + sweetAlert('Oops!', 'You must sign in before moving.', 'error'); + cancelMove(); + return; + } + + if (window.move == undefined) { + sweetAlert('Oops!', 'You must first select something to move.', 'error'); + cancelMove(); + return; + } + + var data = new FormData(); + data.append('id_token', auth2.currentUser.get().getAuthResponse().id_token); + data.append('mode', buildMode); + data.append('moveTo', path); + data.append('moveFrom', window.move.path); + if (window.move.file != undefined) { + data.append('isFile', "true"); + data.append('name', window.move.file); + } else { + data.append('isFile', "false"); + } + + sendHttp('POST', 'moveProject', data, function(request) { + if (request.status != 200) { + sweetAlert('Oops', 'Could not move your project! Please try again.', 'error'); + cancelMove(); + return; + } + successFunc(); }); } @@ -555,7 +594,7 @@ function createFolder(path, buildMode, successFunc) { allFolderNames[allFolderNames.length - 1].push(folderName); successFunc(); - updateUI(); + updateNavBar(); }); } From c1155bd9e42761272790a0c43bc0dba516743de6 Mon Sep 17 00:00:00 2001 From: Parv Mor Date: Wed, 28 Jun 2017 00:03:26 +0530 Subject: [PATCH 02/28] reorganizing for funblocks --- web/blocks.html | 9 +++ web/js/codeworld.js | 2 +- web/js/codeworld_shared.js | 2 +- web/js/funblocks.js | 127 +++++++++++++++++++++++++++++-------- 4 files changed, 113 insertions(+), 27 deletions(-) diff --git a/web/blocks.html b/web/blocks.html index c2ee14f41..6ce1cb813 100644 --- a/web/blocks.html +++ b/web/blocks.html @@ -85,6 +85,15 @@ + + + diff --git a/web/js/codeworld.js b/web/js/codeworld.js index cfea61b9a..f0a9a364c 100644 --- a/web/js/codeworld.js +++ b/web/js/codeworld.js @@ -240,7 +240,7 @@ function updateUI() { document.getElementById('navButton').style.display = 'none'; document.getElementById('deleteButton').style.display = 'none'; } - + window.move = undefined; document.getElementById('newButton').style.display = ''; document.getElementById('saveAsButton').style.display = ''; diff --git a/web/js/codeworld_shared.js b/web/js/codeworld_shared.js index e1bad9381..84d19c315 100644 --- a/web/js/codeworld_shared.js +++ b/web/js/codeworld_shared.js @@ -346,7 +346,7 @@ function moveHere_(path, buildMode, successFunc) { cancelMove(); return; } - + if (window.move == undefined) { sweetAlert('Oops!', 'You must first select something to move.', 'error'); cancelMove(); diff --git a/web/js/funblocks.js b/web/js/funblocks.js index de49a559d..488f810ec 100644 --- a/web/js/funblocks.js +++ b/web/js/funblocks.js @@ -283,9 +283,13 @@ function folderHandler(folderName, index, state) { allFolderNames.push([]); discoverProjects(nestedDirs.slice(1).join('/'), index + 1); } - clearWorkspace(); - openProjectName = null; - updateUI(); + if (window.move == undefined) { + clearWorkspace(); + openProjectName = null; + updateUI(); + } else { + updateNavBar(); + } }, false); } @@ -327,6 +331,43 @@ function updateUI() { document.getElementById('deleteButton').style.display = 'none'; } + window.move = undefined; + document.getElementById('newButton').style.display = ''; + document.getElementById('saveAsButton').style.display = ''; + document.getElementById('runButtons').style.display = ''; + + updateNavBar(); + var NDlength = nestedDirs.length; + + if (NDlength != 1 && (openProjectName == null || openProjectName == '')) { + document.getElementById('shareFolderButton').style.display = ''; + } else { + document.getElementById('shareFolderButton').style.display = 'none'; + } + + document.getElementById('moveHereButton').style.display = 'none'; + document.getElementById('cancelMoveButton').style.display = 'none'; + if ((openProjectName != null && openProjectName != '') || NDlength != 1) { + document.getElementById('moveButton').style.display = ''; + } else { + document.getElementById('moveButton').style.display = 'none'; + } + + var title; + if (window.openProjectName) { + title = window.openProjectName; + } else { + title = "(new)"; + } + + if (!isEditorClean()) { + title = "* " + title; + } + + document.title = title + " - CodeWorld" +} + +function updateNavBar() { var projects = document.getElementById('nav_mine'); while (projects.lastChild) { @@ -393,7 +434,7 @@ function updateUI() { }); allProjectNames[i].forEach(function(projectName) { var active = (window.openProjectName == projectName) && (i == NDlength - 1); - if(!isSignedIn && !active) { + if(!signedIn() && !active) { return; } @@ -423,25 +464,57 @@ function updateUI() { projects = tempProjects; } } +} - if (NDlength != 1 && (openProjectName == null || openProjectName == '')) { - document.getElementById('shareFolderButton').style.display = ''; - } else { - document.getElementById('shareFolderButton').style.display = 'none'; - } +function moveProject() { + warnIfUnsaved(function() { + if (!signedIn()) { + sweetAlert('Oops!', 'You must sign in to move this project or folder.', 'error'); + updateUI(); + return; + } - var title; - if (window.openProjectName) { - title = window.openProjectName; - } else { - title = "(new)"; - } + if ((openProjectName == null || openProjectName == '') && nestedDirs.length == 1) { + sweetAlert('Oops!', 'You must select a project or folder to move.', 'error'); + updateUI(); + return; + } - if (!isEditorClean()) { - title = "* " + title; + var tempOpen = openProjectName; + var tempPath = nestedDirs.slice(1).join('/'); + clearWorkspace(); + nestedDirs = [""]; + allProjectNames = [[]]; + allFolderNames = [[]]; + discoverProjects("", 0); + 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('moveButton').style.display = 'none'; + document.getElementById('moveHereButton').style.display = ''; + document.getElementById('cancelMoveButton').style.display = ''; + document.getElementById('runButtons').style.display = 'none'; + + window.move = Object(); + window.move.path = tempPath; + if (tempOpen != null && tempOpen != '') { + window.move.file = tempOpen; + } + }, false); +} + +function moveHere() { + function successFunc() { + nestedDirs = [""]; + allProjectNames = [[]]; + allFolderNames = [[]]; + discoverProjects("", 0); + updateUI(); } - document.title = title + " - CodeWorld" + moveHere_(nestedDirs.slice(1).join('/'), 'blocklyXML', successFunc); } function help(doc) { @@ -482,7 +555,9 @@ function discoverProjects(path, index){ } function loadProject(name, index) { - + if (window.move != undefined) { + return; + } function successFunc(project){ openProjectName = name; clearRunCode(); @@ -538,12 +613,14 @@ function deleteProject() { function newFolder() { function successFunc() { - clearWorkspace(); - openProjectName = null; - clearRunCode(); - lastXML = getWorkspaceXMLText(); - Blockly.getMainWorkspace().clearUndo(); - window.location.hash = ''; + if (window.move == undefined) { + clearWorkspace(); + openProjectName = null; + clearRunCode(); + lastXML = getWorkspaceXMLText(); + Blockly.getMainWorkspace().clearUndo(); + window.location.hash = ''; + } } createFolder(nestedDirs.slice(1).join('/'), 'blocklyXML', successFunc); } From 282accf08f28e5e0332509a0bde82f9510ea1d80 Mon Sep 17 00:00:00 2001 From: Parv Mor Date: Thu, 6 Jul 2017 10:19:30 +0530 Subject: [PATCH 03/28] constraints user to create new files before starting to code --- web/env.html | 4 ++-- web/js/codeworld.js | 24 ++++++++++++++-------- web/js/codeworld_shared.js | 42 ++++++++++++++++++++++++++++++++------ 3 files changed, 54 insertions(+), 16 deletions(-) diff --git a/web/env.html b/web/env.html index df27586da..f1ebb8dbc 100644 --- a/web/env.html +++ b/web/env.html @@ -92,8 +92,8 @@ diff --git a/web/js/codeworld.js b/web/js/codeworld.js index f0a9a364c..a8ea3a044 100644 --- a/web/js/codeworld.js +++ b/web/js/codeworld.js @@ -243,11 +243,8 @@ 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 = ''; - updateNavBar(); var NDlength = nestedDirs.length; @@ -373,6 +370,19 @@ function updateNavBar() { projects = tempProjects; } } + if (window.openProjectName == null || window.openProjectName == '') { + window.codeworldEditor.setOption('readOnly', true); + document.getElementById('saveAsButton').style.display = 'none'; + document.getElementById('downloadButton').style.display = 'none'; + document.getElementById('compileButton').style.display = 'none'; + document.getElementById('stopButton').style.display = 'none'; + } else { + window.codeworldEditor.setOption('readOnly', false); + document.getElementById('saveAsButton').style.display = ''; + document.getElementById('downloadButton').style.display = ''; + document.getElementById('compileButton').style.display = ''; + document.getElementById('stopButton').style.display = ''; + } } function moveProject() { @@ -534,9 +544,7 @@ function loadSample(code) { } function newProject() { - warnIfUnsaved(function() { - setCode(''); - }, false); + newProject_(nestedDirs.slice(1).join('/')); } function newFolder() { @@ -685,14 +693,14 @@ 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_shared.js b/web/js/codeworld_shared.js index 84d19c315..9624cd6c5 100644 --- a/web/js/codeworld_shared.js +++ b/web/js/codeworld_shared.js @@ -416,7 +416,7 @@ function saveProjectAs() { sweetAlert({ html: true, title: '  Save As', - text: 'Enter a name for your project:', + text: 'Enter a name for your project to created at /' + nestedDirs.slice(1).join('/') + ':', type: 'input', inputValue: defaultName, confirmButtonText: 'Save', @@ -439,11 +439,11 @@ function saveProject() { } } -function saveProjectBase_(path, projectName, mode, successFunc) { +function saveProjectBase_(path, projectName, mode, successFunc, type) { if (projectName == null || projectName == '') return; if (!signedIn()) { - sweetAlert('Oops!', 'You must sign in to save files.', 'error'); + sweetAlert('Oops!', 'You must sign in to ' + type + ' files.', 'error'); updateUI(); return; } @@ -461,7 +461,7 @@ function saveProjectBase_(path, projectName, mode, successFunc) { sendHttp('POST', 'saveProject', data, function(request) { if (request.status != 200) { - sweetAlert('Oops!', 'Could not save your project!!! Please try again.', 'error'); + sweetAlert('Oops!', 'Could not ' + type + ' your project!!! Please try again.', 'error'); return; } @@ -478,7 +478,7 @@ function saveProjectBase_(path, projectName, mode, successFunc) { if (allProjectNames[allProjectNames.length - 1].indexOf(projectName) == -1 || projectName == openProjectName) { go(); } else { - var msg = 'Are you sure you want to save over another project?\n\n' + + 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', @@ -601,7 +601,37 @@ function createFolder(path, buildMode, successFunc) { sweetAlert({ html: true, title: '  Create Folder', - text: 'Enter a name for your 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; + } + + function go(fileName) { + if (fileName == null || fileName == '') { + return; + } + + sweetAlert.close(); + saveProjectBase(path, fileName, 'create'); + } + + sweetAlert({ + html: true, + title: '  Create File', + text: 'Enter a name for your file to be created at /' + path + ':', type: 'input', inputValue: '', confirmButtonText: 'Create', From 5559b03af7363e90a4d1fbe0858dd811cf6c21d8 Mon Sep 17 00:00:00 2001 From: Parv Mor Date: Sat, 8 Jul 2017 11:38:48 +0530 Subject: [PATCH 04/28] added some handlers for comments --- codeworld-server/codeworld-server.cabal | 1 + codeworld-server/src/CommentUtil.hs | 101 ++++++++++++ codeworld-server/src/Main.hs | 198 +++++++++++++++++++++--- codeworld-server/src/Model.hs | 52 +++++++ 4 files changed, 332 insertions(+), 20 deletions(-) create mode 100644 codeworld-server/src/CommentUtil.hs diff --git a/codeworld-server/codeworld-server.cabal b/codeworld-server/codeworld-server.cabal index 86a1d2709..2f836b712 100644 --- a/codeworld-server/codeworld-server.cabal +++ b/codeworld-server/codeworld-server.cabal @@ -36,6 +36,7 @@ Executable codeworld-server snap-server, temporary, text, + time, unix Ghc-options: -threaded -Wall -funbox-strict-fields -O2 diff --git a/codeworld-server/src/CommentUtil.hs b/codeworld-server/src/CommentUtil.hs new file mode 100644 index 000000000..db26a33a7 --- /dev/null +++ b/codeworld-server/src/CommentUtil.hs @@ -0,0 +1,101 @@ +{-# 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 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 (elemIndex, splitAt) +import Data.Text (Text) +import qualified Data.Text as T +import System.Directory +import System.FilePath +import System.IO + +import Model +import Util + +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" + +commentHashLink :: CommentId -> FilePath +commentHashLink (CommentId c) = let s = T.unpack c in take 3 s s + +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) + +getLineComment :: FilePath -> Int -> IO (Maybe LineComment) +getLineComment commentFolder lineNo = do + fileBool <- doesFileExist (commentFolder show lineNo) + case fileBool of + True -> decode <$> LB.readFile (commentFolder show lineNo) + False -> return (Just $ LineComment lineNo []) + +addCommentToFile :: FilePath -> Int -> CommentDesc -> IO () +addCommentToFile commentFolder lineNo comment = do + fileBool <- doesFileExist (commentFolder show lineNo) + lc <- case fileBool of + True -> do + Just (lc :: LineComment) <- decode <$> LB.readFile (commentFolder show lineNo) + return lc + False -> return (LineComment lineNo []) + LB.writeFile (commentFolder show lineNo) $ encode (LineComment lineNo $ comments lc ++ [comment]) + +addReplyToComment :: FilePath -> Int -> CommentDesc -> ReplyDesc -> IO () +addReplyToComment commentFolder lineNo cd rd = do + Just (lc :: LineComment) <- decode <$> LB.readFile (commentFolder show lineNo) + let Just ind = elemIndex cd (comments lc) + newcd = CommentDesc (userIdent cd) (dateTime cd) (comment cd) (replies cd ++ [rd]) + splc = splitAt ind $ comments lc + newlc = LineComment lineNo $ (fst splc) ++ (newcd : (tail $ snd splc)) + LB.writeFile (commentFolder show lineNo) $ encode newlc + +deleteCommentFromFile :: FilePath -> Int -> CommentDesc -> IO () +deleteCommentFromFile commentFolder lineNo cd = do + Just (lc :: LineComment) <- decode <$> LB.readFile (commentFolder show lineNo) + let Just ind = elemIndex cd (comments lc) + newcd = CommentDesc "none" (dateTime cd) "deleted" (replies cd) + splc = splitAt ind $ comments lc + newlc = LineComment lineNo $ (fst splc) ++ (if (length $ replies cd) /= 0 + then newcd : (tail $ snd splc) + else tail $ snd splc) + LB.writeFile (commentFolder show lineNo) $ encode newlc + +deleteReplyFromComment :: FilePath -> Int -> CommentDesc -> ReplyDesc -> IO () +deleteReplyFromComment commentFolder lineNo cd rd = do + Just (lc :: LineComment) <- decode <$> LB.readFile (commentFolder show lineNo) + let Just cdInd = elemIndex cd (comments lc) + Just rdInd = elemIndex rd (replies cd) + splc = splitAt cdInd $ comments lc + spcd = splitAt rdInd $ replies cd + newcd = CommentDesc (userIdent cd) (dateTime cd) (comment cd) $ (fst spcd) ++ (tail $ snd spcd) + newlc = LineComment lineNo $ (fst splc) ++ (newcd : (tail $ snd splc)) + LB.writeFile (commentFolder show lineNo) $ encode newlc diff --git a/codeworld-server/src/Main.hs b/codeworld-server/src/Main.hs index e3fb612c5..c8305c5f7 100644 --- a/codeworld-server/src/Main.hs +++ b/codeworld-server/src/Main.hs @@ -1,6 +1,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} +{-# LANGUAGE ScopedTypeVariables #-} {- Copyright 2017 The CodeWorld Authors. All rights reserved. @@ -35,6 +36,7 @@ import Data.Monoid import qualified Data.Text as T import qualified Data.Text.IO as T import qualified Data.Text.Encoding as T +import Data.Time.Clock (UTCTime) import HIndent (reformat) import HIndent.Types (defaultConfig) import Network.HTTP.Conduit @@ -48,6 +50,7 @@ import System.FilePath import Build import Model import Util +import CommentUtil newtype ClientId = ClientId (Maybe T.Text) deriving (Eq) @@ -109,26 +112,37 @@ getBuildMode = getParam "mode" >>= \ case 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) + ("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), + ("commentShare", commentShareHandler clientId), + ("writeComment", writeCommentHandler clientId), + ("writeReply", writeReplyHandler clientId), + ("deleteComment", deleteCommentHandler clientId), + ("deleteReply", deleteReplyHandler clientId), + ("writeOwnerComment", writeOwnerCommentHandler clientId), + ("writeOwnerReply", writeOwnerReplyHandler clientId), + ("deleteOwnerComment", deleteOwnerCommentHandler clientId), + ("deleteOwnerReply", deleteOwnerReplyHandler clientId), + ("readComment", readCommentHandler), + ("viewCommentSource", viewCommentSourceHandler), + ("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" @@ -252,6 +266,150 @@ shareContentHandler clientId = do liftIO $ copyDirIfExists (BC.unpack sharingFolder) $ userProjectDir mode (userId user) dirPath liftIO $ B.writeFile (userProjectDir mode (userId user) dirPath "dir.info") name +commentShareHandler :: ClientId -> Snap () +commentShareHandler 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 name <- getParam "name" + let projectId = nameToProjectId $ T.decodeUtf8 name + let commentFolder = commentRootDir mode (userId user) finalDir projectId + liftIO $ createDirectoryIfMissing False commentFolder + let commentHash = nameToCommentHash commentFolder + liftIO $ ensureCommentHashDir mode commentHash + liftIO $ B.writeFile (commentHashRootDir mode commentHashLink commentHash) $ BC.pack commentFolder + writeBS $ T.encodeUtf8 $ unCommentId commentHash + +writeCommentHandler :: ClientId -> Snap () +writeCommentHandler clientId = do + mode <- getBuildMode + user <- getUser clientId + Just commentHash <- fmap (CommentId . T.decodeUtf8) <$> getParam "chash" + commentFolder <- liftIO $ BC.unpack <$> B.readFile (commentHashRootDir mode commentHashLink commentHash) + Just (lineNo :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo" + Just (comment :: CommentDesc) <- (decodeStrict =<<) <$> getParam "comment" + liftIO $ addCommentToFile commentFolder lineNo comment + +writeReplyHandler :: ClientId -> Snap () +writeReplyHandler clientId = do + mode <- getBuildMode + user <- getUser clientId + Just commentHash <- fmap (CommentId . T.decodeUtf8) <$> getParam "chash" + commentFolder <- liftIO $ BC.unpack <$> B.readFile (commentHashRootDir mode commentHashLink commentHash) + Just (lineNo :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo" + Just (comment :: CommentDesc) <- (decodeStrict =<<) <$> getParam "comment" + Just (reply :: ReplyDesc) <- (decodeStrict =<<) <$> getParam "reply" + liftIO $ addReplyToComment commentFolder lineNo comment reply + +writeOwnerCommentHandler :: ClientId -> Snap () +writeOwnerCommentHandler clientId = do + user <- getUser clientId + mode <- getBuildMode + Just path <- fmap (splitDirectories . BC.unpack) <$> getParam "path" + let finalDir = joinPath $ map (dirBase . nameToDirId . T.pack) path + Just name <- getParam "name" + let projectId = nameToProjectId $ T.decodeUtf8 name + let commentFolder = commentRootDir mode (userId user) finalDir projectId + liftIO $ createDirectoryIfMissing False commentFolder + Just (lineNo :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo" + Just (comment :: CommentDesc) <- (decodeStrict =<<) <$> getParam "comment" + liftIO $ addCommentToFile commentFolder lineNo comment + +writeOwnerReplyHandler :: ClientId -> Snap () +writeOwnerReplyHandler clientId = do + user <- getUser clientId + mode <- getBuildMode + Just path <- fmap (splitDirectories . BC.unpack) <$> getParam "path" + let finalDir = joinPath $ map (dirBase . nameToDirId . T.pack) path + Just name <- getParam "name" + let projectId = nameToProjectId $ T.decodeUtf8 name + let commentFolder = commentRootDir mode (userId user) finalDir projectId + Just (lineNo :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo" + Just (comment :: CommentDesc) <- (decodeStrict =<<) <$> getParam "comment" + Just (reply :: ReplyDesc) <- (decodeStrict =<<) <$> getParam "reply" + liftIO $ addReplyToComment commentFolder lineNo comment reply + +deleteCommentHandler :: ClientId -> Snap () +deleteCommentHandler clientId = do + mode <- getBuildMode + user <- getUser clientId + Just commentHash <- fmap (CommentId . T.decodeUtf8) <$> getParam "chash" + commentFolder <- liftIO $ BC.unpack <$> B.readFile (commentHashRootDir mode commentHashLink commentHash) + Just (lineNo :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo" + Just (comment :: CommentDesc) <- (decodeStrict =<<) <$> getParam "comment" + liftIO $ deleteCommentFromFile commentFolder lineNo comment + +deleteReplyHandler :: ClientId -> Snap () +deleteReplyHandler clientId = do + mode <- getBuildMode + user <- getUser clientId + Just commentHash <- fmap (CommentId . T.decodeUtf8) <$> getParam "chash" + commentFolder <- liftIO $ BC.unpack <$> B.readFile (commentHashRootDir mode commentHashLink commentHash) + Just (lineNo :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo" + Just (comment :: CommentDesc) <- (decodeStrict =<<) <$> getParam "comment" + Just (reply :: ReplyDesc) <- (decodeStrict =<<) <$> getParam "reply" + liftIO $ deleteReplyFromComment commentFolder lineNo comment reply + +deleteOwnerCommentHandler :: ClientId -> Snap () +deleteOwnerCommentHandler clientId = do + user <- getUser clientId + mode <- getBuildMode + Just path <- fmap (splitDirectories . BC.unpack) <$> getParam "path" + let finalDir = joinPath $ map (dirBase . nameToDirId . T.pack) path + Just name <- getParam "name" + let projectId = nameToProjectId $ T.decodeUtf8 name + let commentFolder = commentRootDir mode (userId user) finalDir projectId + Just (lineNo :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo" + Just (comment :: CommentDesc) <- (decodeStrict =<<) <$> getParam "comment" + liftIO $ deleteCommentFromFile commentFolder lineNo comment + +deleteOwnerReplyHandler :: ClientId -> Snap () +deleteOwnerReplyHandler clientId = do + user <- getUser clientId + mode <- getBuildMode + Just path <- fmap (splitDirectories . BC.unpack) <$> getParam "path" + let finalDir = joinPath $ map (dirBase . nameToDirId . T.pack) path + Just name <- getParam "name" + let projectId = nameToProjectId $ T.decodeUtf8 name + let commentFolder = commentRootDir mode (userId user) finalDir projectId + Just (lineNo :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo" + Just (comment :: CommentDesc) <- (decodeStrict =<<) <$> getParam "comment" + Just (reply :: ReplyDesc) <- (decodeStrict =<<) <$> getParam "reply" + liftIO $ deleteReplyFromComment commentFolder lineNo comment reply + +readCommentHandler :: Snap () +readCommentHandler = do + mode <- getBuildMode + Just commentHash <- fmap (CommentId . T.decodeUtf8) <$> getParam "chash" + commentFolder <- liftIO $ BC.unpack <$> B.readFile (commentHashRootDir mode commentHashLink commentHash) + Just (lineNo :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo" + Just comments <- liftIO $ getLineComment commentFolder lineNo + writeLBS (encode comments) + +readOwnerCommentHandler :: ClientId -> Snap () +readOwnerCommentHandler clientId = do + user <- getUser clientId + mode <- getBuildMode + Just path <- fmap (splitDirectories . BC.unpack) <$> getParam "path" + let finalDir = joinPath $ map (dirBase . nameToDirId . T.pack) path + Just name <- getParam "name" + let projectId = nameToProjectId $ T.decodeUtf8 name + let commentFolder = commentRootDir mode (userId user) finalDir projectId + liftIO $ createDirectoryIfMissing False commentFolder + Just (lineNo :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo" + Just comments <- liftIO $ getLineComment commentFolder lineNo + writeLBS (encode comments) + +viewCommentSourceHandler :: Snap () +viewCommentSourceHandler = do + mode <- getBuildMode + Just commentHash <- fmap (CommentId . T.decodeUtf8) <$> getParam "chash" + commentFolder <- liftIO $ BC.unpack <$> B.readFile (commentHashRootDir mode commentHashLink commentHash) + modifyResponse $ setContentType "text/x-haskell" + serveFile $ take (length commentFolder - 9) commentFolder + moveProjectHandler :: ClientId -> Snap () moveProjectHandler clientId = do mode <- getBuildMode diff --git a/codeworld-server/src/Model.hs b/codeworld-server/src/Model.hs index 6ed97fb93..8284471d4 100644 --- a/codeworld-server/src/Model.hs +++ b/codeworld-server/src/Model.hs @@ -22,6 +22,7 @@ import Control.Applicative import Control.Monad import Data.Aeson import Data.Text (Text) +import Data.Time.Clock (UTCTime) import System.FilePath (FilePath) data User = User { userId :: Text, audience :: Text } @@ -65,3 +66,54 @@ data CompileResult = CompileResult { instance ToJSON CompileResult where toJSON cr = object [ "hash" .= compileHash cr, "dhash" .= compileDeployHash cr ] + +data ReplyDesc = ReplyDesc { + ruserIdent :: Text, + rdateTime :: UTCTime, + reply :: Text + } deriving (Eq) + +instance FromJSON ReplyDesc where + parseJSON (Object o) = ReplyDesc <$> o .: "userIdent" + <*> o .: "dateTime" + <*> o .: "reply" + parseJSON _ = mzero + +instance ToJSON ReplyDesc where + toJSON rd = object [ "userIdent" .= ruserIdent rd, + "dateTime" .= rdateTime rd, + "reply" .= reply rd ] + +data CommentDesc = CommentDesc { + userIdent :: Text, + dateTime :: UTCTime, + comment :: Text, + replies :: [ReplyDesc] + } deriving (Eq) + +instance FromJSON CommentDesc where + parseJSON (Object o) = CommentDesc <$> o .: "userIdent" + <*> o .: "dateTime" + <*> o .: "comment" + <*> o .: "replies" + parseJSON _ = mzero + +instance ToJSON CommentDesc where + toJSON cd = object [ "userIdent" .= userIdent cd, + "dateTime" .= dateTime cd, + "comment" .= comment cd, + "replies" .= replies cd ] + +data LineComment = LineComment { + lineNo :: Int, -- 0 for global + comments :: [CommentDesc] + } + +instance FromJSON LineComment where + parseJSON (Object o) = LineComment <$> o .: "lineNo" + <*> o .: "comments" + parseJSON _ = mzero + +instance ToJSON LineComment where + toJSON lc = object [ "lineNo" .= lineNo lc, + "comments" .= comments lc ] From 42b87ff4402ae308fceebdbec9730e0eccab4e53 Mon Sep 17 00:00:00 2001 From: Parv Mor Date: Fri, 14 Jul 2017 23:03:36 +0530 Subject: [PATCH 05/28] Added a basic frontend for feedback --- codeworld-server/src/Main.hs | 4 +- web/css/codeworld-cm.css | 7 + web/css/codeworld.css | 95 ++++++- web/env.html | 2 + web/js/codeworld.js | 18 +- web/js/codeworld_comments.js | 487 +++++++++++++++++++++++++++++++++++ web/js/codeworld_shared.js | 2 +- 7 files changed, 611 insertions(+), 4 deletions(-) create mode 100644 web/js/codeworld_comments.js diff --git a/codeworld-server/src/Main.hs b/codeworld-server/src/Main.hs index c8305c5f7..dc11684cc 100644 --- a/codeworld-server/src/Main.hs +++ b/codeworld-server/src/Main.hs @@ -131,6 +131,7 @@ site clientId = ("deleteOwnerComment", deleteOwnerCommentHandler clientId), ("deleteOwnerReply", deleteOwnerReplyHandler clientId), ("readComment", readCommentHandler), + ("readOwnerComment", readOwnerCommentHandler clientId), ("viewCommentSource", viewCommentSourceHandler), ("compile", compileHandler), ("saveXMLhash", saveXMLHashHandler), @@ -408,7 +409,8 @@ viewCommentSourceHandler = do Just commentHash <- fmap (CommentId . T.decodeUtf8) <$> getParam "chash" commentFolder <- liftIO $ BC.unpack <$> B.readFile (commentHashRootDir mode commentHashLink commentHash) modifyResponse $ setContentType "text/x-haskell" - serveFile $ take (length commentFolder - 9) commentFolder + Just (project :: Project) <- liftIO $ decode <$> (LB.readFile $ take (length commentFolder - 9) commentFolder) + writeBS (T.encodeUtf8 $ projectSource project) moveProjectHandler :: ClientId -> Snap () moveProjectHandler clientId = do diff --git a/web/css/codeworld-cm.css b/web/css/codeworld-cm.css index d98b85537..1cdd85082 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 a55a21523..58f374e7a 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; @@ -223,6 +311,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; @@ -279,4 +372,4 @@ body { .function-name-highlight { border-bottom: solid ; border-color: #888888; font-style: italic; -} \ No newline at end of file +} diff --git a/web/env.html b/web/env.html index f1ebb8dbc..6a52b097b 100644 --- a/web/env.html +++ b/web/env.html @@ -91,6 +91,7 @@
+   Stop   Run @@ -128,6 +129,7 @@ + diff --git a/web/js/codeworld.js b/web/js/codeworld.js index a8ea3a044..2b4e8e008 100644 --- a/web/js/codeworld.js +++ b/web/js/codeworld.js @@ -88,6 +88,15 @@ function init() { setCode(request.responseText, null, null, true); } }); + } else if (hash[0] == 'C') { + sendHttp('GET', 'viewCommentSource?chash=' + hash + '&mode=' + window.buildMode, null, function(request) { + if(request.status == 200) { + setCode(request.responseText, null, null, false); + window.location.hash = '#' + hash; + checkForCommentHash(); + window.chash = hash; + } + }); } else if (hash[0] != 'F') { setCode(''); if (!signedIn()) help(); @@ -148,6 +157,7 @@ function initCodeworld() { }; window.codeworldEditor.on('changes', window.updateUI); + window.codeworldEditor.on('gutterClick', window.toggleUserComments); window.onbeforeunload = function(event) { if (!isEditorClean()) { @@ -245,7 +255,6 @@ function updateUI() { document.getElementById('newButton').style.display = ''; document.getElementById('runButtons').style.display = ''; - updateNavBar(); var NDlength = nestedDirs.length; if (NDlength != 1 && (openProjectName == null || openProjectName == '')) { @@ -253,7 +262,13 @@ function updateUI() { } else { document.getElementById('shareFolderButton').style.display = 'none'; } + if (openProjectName == null || openProjectName == '') { + document.getElementById('askFeedbackButton').style.display = 'none'; + } else { + document.getElementById('askFeedbackButton').style.display = ''; + } + updateNavBar(); document.getElementById('moveHereButton').style.display = 'none'; document.getElementById('cancelMoveButton').style.display = 'none'; if((openProjectName != null && openProjectName != '') || NDlength != 1) { @@ -383,6 +398,7 @@ function updateNavBar() { document.getElementById('compileButton').style.display = ''; document.getElementById('stopButton').style.display = ''; } + checkForCommentHash(); } function moveProject() { diff --git a/web/js/codeworld_comments.js b/web/js/codeworld_comments.js new file mode 100644 index 000000000..57a94fc7e --- /dev/null +++ b/web/js/codeworld_comments.js @@ -0,0 +1,487 @@ +/* + * 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 checkForCommentHash() { + var hash = window.location.hash.slice(1); + if (hash.length > 0) { + if (hash.slice(-2) == '==') { + hash = hash.slice(0, -2); + } + if (hash[0] == 'C') { + document.getElementById('askFeedbackButton').style.display = ''; + document.getElementById('stopButton').style.display = ''; + document.getElementById('compileButton').style.display = ''; + } + } + return; +} + +function shareForFeedback() { + if (!signedIn()) { + sweetAlert('Oops!', 'You must sign in to ask for feedback!', 'error'); + updateUI(); + return; + } + if (openProjectName == '' || openProjectName == null) { + var hash = window.location.hash.slice(1); + if (hash.length > 0) { + if (hash.slice(-2) == '==') { + hash = hash.slice(0, -2); + } + if (hash[0] == 'C') { + sweetAlert({ + html: true, + title: '  Ask Feedback', + text: msg, + type: 'input', + inputValue: window.location.href, + showConfirmButton: false, + showCancelButton: true, + cancelButtonText: 'Done', + animation: 'slide-from-bottom' + }); + } else { + sweetAlert('Oops!', 'You must select your project for feedback!', 'error'); + updateUI(); + } + } else { + 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: '  Ask Feedback', + text: msg, + type: 'input', + inputValue: a.href, + showConfirmButton: false, + showCancelButton: true, + cancelButtonText: 'Done', + animation: 'slide-from-bottom' + }); + }); +} + +function toggleUserComments(cm, line, gutter) { + var hash = window.location.hash.slice(1); + if (hash.length > 0) { + if (hash.slice(-2) == '==') { + hash = hash.slice(0, -2); + } + if (hash.length > 0 && hash[0] != 'C') { + return; + } + } else if (openProjectName == null || openProjectName == '') { + return; + } + doc = codeworldEditor.getDoc(); + if (window.openCommentLines == undefined) { + window.openCommentLines = new Object(); + window.openComments = new Object(); + } + if (window.openCommentLines[line + 1] != undefined) { + 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'); + 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) { + return; + } + var commentData = JSON.parse(request.responseText); + if (commentData['lineNo'] !== line) { + return; + } + window.openComments[line] = new Array(); + for (i in commentData['comments']) { + window.openComments[line].push(commentData['comments'][i]); + comments.appendChild(generateCommentBlock(i, line)); + } + comments.appendChild(generateCommentArea(line)); + $(comments).fadeIn('slow'); + window.openCommentLines[line] = doc.addLineWidget(line - 1, comments, { + coverGutter: true + }); + } + + var data = new FormData(); + data.append('mode', window.buildMode); + data.append('lineNo', line); + if (window.chash != undefined) { + data.append('chash', window.chash); + sendHttp('POST', 'readComment', data, go); + } else { + data.append('id_token', auth2.currentUser.get().getAuthResponse().id_token); + data.append('path', nestedDirs.slice(1).join('/')); + data.append('name', openProjectName); + sendHttp('POST', 'readOwnerComment', 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 = '' + window.openComments[line][ind]['userIdent'] + ''; + 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 = '' + window.openComments[line][commentIdx]['replies'][ind]['userIdent'] + ''; + 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 = ''; + 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 = ''; + 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'); + return; + } + + function go(request, commentDesc) { + if (request.status != 200) { + sweetAlert('Oops!', 'Could not comment. Please try again!', 'error'); + return; + } + var comments = window.openCommentLines[line].node; + comments.getElementsByClassName('commentField')[0].value = ''; + window.openComments[line].push(commentDesc); + comments.insertBefore(generateCommentBlock(comments.getElementsByClassName('commentBlock').length, line), comments.lastChild); + } + + var data = new FormData(); + data.append('id_token', auth2.currentUser.get().getAuthResponse().id_token); + data.append('lineNo', line); + data.append('mode', window.buildMode); + var commentDesc = new Object(); + commentDesc.comment = window.openCommentLines[line].node.getElementsByClassName('commentField')[0].value; + if (commentDesc.comment == '') { + return; + } + commentDesc.replies = []; + commentDesc.userIdent = randomString(); + commentDesc.dateTime = (new Date()).toJSON(); + data.append('comment', JSON.stringify(commentDesc)); + if (window.chash != undefined){ + data.append('chash', window.chash); + sendHttp('POST', 'writeComment', data, function(request) { + go(request, commentDesc); + }); + } else { + data.append('path', nestedDirs.slice(1).join('/')); + data.append('name', openProjectName); + sendHttp('POST', 'writeOwnerComment', data, function(request) { + go(request, commentDesc); + }); + } +} + +function writeReply(commentIdx, line) { + if (!signedIn()) { + sweetAlert('Oops!', 'You must sign in to write a reply.', 'error'); + return; + } + + function go(request, replyDesc) { + if (request.status != 200) { + sweetAlert('Oops!', 'Could not reply. Please try again!', 'error'); + return; + } + var commentBlock = window.openCommentLines[line].node.getElementsByClassName('commentBlock')[commentIdx]; + commentBlock.getElementsByClassName('replyField')[0].value = ''; + window.openComments[line][commentIdx]['replies'].push(replyDesc); + var replies = commentBlock.getElementsByClassName('replies')[0]; + replies.insertBefore(generateReplyBlock(replies.getElementsByClassName('replyBlock').length, commentIdx, line), replies.lastChild); + } + + var data = new FormData(); + data.append('id_token', auth2.currentUser.get().getAuthResponse().id_token); + data.append('lineNo', line); + data.append('mode', window.buildMode); + data.append('comment', JSON.stringify(window.openComments[line][commentIdx])); + var replyDesc = new Object(); + replyDesc.reply = window.openCommentLines[line].node.getElementsByClassName('commentBlock')[commentIdx].getElementsByClassName('replyField')[0].value; + if (replyDesc.reply == '') { + return; + } + replyDesc.userIdent = randomString(); + replyDesc.dateTime = (new Date()).toJSON(); + data.append('reply', JSON.stringify(replyDesc)); + if (window.chash != undefined){ + data.append('chash', window.chash); + sendHttp('POST', 'writeReply', data, function(request) { + go(request, replyDesc); + }); + } else { + data.append('path', nestedDirs.slice(1).join('/')); + data.append('name', openProjectName); + sendHttp('POST', 'writeOwnerReply', data, function(request) { + go(request, replyDesc); + }); + } +} + +function deleteComment(ind, line) { + if (!signedIn()) { + sweetAlert('Oops!', 'You must sign in to delete a comment.', 'error'); + return; + } + + function go(request) { + if (request.status != 200) { + 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'; + } + } + + var data = new FormData(); + data.append('id_token', auth2.currentUser.get().getAuthResponse().id_token); + data.append('lineNo', line); + data.append('mode', window.buildMode); + data.append('comment', JSON.stringify(window.openComments[line][ind])); + if (window.chash != undefined){ + data.append('chash', window.chash); + sendHttp('POST', 'deleteComment', data, function(request) { + go(request); + }); + } else { + data.append('path', nestedDirs.slice(1).join('/')); + data.append('name', openProjectName); + sendHttp('POST', 'deleteOwnerComment', data, function(request) { + go(request); + }); + } +} + +function deleteReply(ind, commentIdx, line) { + if (!signedIn()) { + sweetAlert('Oops!', 'You must sign in to delete a reply.', 'error'); + return; + } + + function go(request) { + if (request.status != 200) { + 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'].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('lineNo', line); + data.append('mode', window.buildMode); + data.append('comment', JSON.stringify(window.openComments[line][commentIdx])); + data.append('reply', JSON.stringify(window.openComments[line][commentIdx]['replies'][ind])); + if (window.chash != undefined){ + data.append('chash', window.chash); + sendHttp('POST', 'deleteReply', data, function(request) { + go(request); + }); + } else { + data.append('path', nestedDirs.slice(1).join('/')); + data.append('name', openProjectName); + sendHttp('POST', 'deleteOwnerReply', data, function(request) { + go(request); + }); + } +} + +function randomString(length = 32, chars = '0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ') { + var result = ''; + for (var i = length; i > 0; i--) { + result += chars[Math.floor(Math.random() * chars.length)]; + } + return result; +} diff --git a/web/js/codeworld_shared.js b/web/js/codeworld_shared.js index 9624cd6c5..4578fc970 100644 --- a/web/js/codeworld_shared.js +++ b/web/js/codeworld_shared.js @@ -729,7 +729,7 @@ function shareFolder_(mode) { return; } if(nestedDirs.length == 1 || (openProjectName != null && openProjectName != '')) { - sweetAlert('Oops!', 'YOu must select a folder to share!', 'error'); + sweetAlert('Oops!', 'You must select a folder to share!', 'error'); updateUI(); return; } From cc4c713f67666ba16297c9a0c07bcf9dd0a44462 Mon Sep 17 00:00:00 2001 From: Parv Mor Date: Sat, 15 Jul 2017 05:36:20 +0530 Subject: [PATCH 06/28] Rearranges the code to make it more readable. Fixes the warnings of GHC i.e. remove unused libraries and overshadowing of variables Rearranges the code to make it more readable. Fixes the warnings of GHC i.e. remove unused libraries and overshadowing of variables --- codeworld-server/src/Comment.hs | 178 +++++++ codeworld-server/src/CommentUtil.hs | 55 ++- codeworld-server/src/{Util.hs => DataUtil.hs} | 38 +- codeworld-server/src/Folder.hs | 189 ++++++++ codeworld-server/src/Main.hs | 435 +----------------- codeworld-server/src/Model.hs | 2 - codeworld-server/src/SnapUtil.hs | 91 ++++ web/js/codeworld.js | 2 +- web/js/codeworld_shared.js | 7 +- 9 files changed, 534 insertions(+), 463 deletions(-) create mode 100644 codeworld-server/src/Comment.hs rename codeworld-server/src/{Util.hs => DataUtil.hs} (89%) create mode 100644 codeworld-server/src/Folder.hs create mode 100644 codeworld-server/src/SnapUtil.hs diff --git a/codeworld-server/src/Comment.hs b/codeworld-server/src/Comment.hs new file mode 100644 index 000000000..ab3bf4a73 --- /dev/null +++ b/codeworld-server/src/Comment.hs @@ -0,0 +1,178 @@ +{-# 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 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 Snap.Core +import System.Directory +import System.FilePath + +import CommentUtil +import DataUtil +import Model +import SnapUtil + +commentRoutes :: ClientId -> [(B.ByteString, Snap ())] +commentRoutes clientId = + [ ("commentShare", commentShareHandler clientId) + , ("deleteComment", deleteCommentHandler clientId) + , ("deleteOwnerComment", deleteOwnerCommentHandler clientId) + , ("deleteOwnerReply", deleteOwnerReplyHandler clientId) + , ("deleteReply", deleteReplyHandler clientId) + , ("readComment", readCommentHandler) + , ("readOwnerComment", readOwnerCommentHandler clientId) + , ("viewCommentSource", viewCommentSourceHandler) + , ("writeComment", writeCommentHandler clientId) + , ("writeOwnerComment", writeOwnerCommentHandler clientId) + , ("writeOwnerReply", writeOwnerReplyHandler clientId) + , ("writeReply", writeReplyHandler clientId) + ] + +getFrequentParams :: Bool -> ClientId -> Snap (User, BuildMode, FilePath, Maybe ProjectId) +getFrequentParams owner clientId = do + user <- getUser clientId + mode <- getBuildMode + case owner of + True -> do + Just path' <- fmap (splitDirectories . BC.unpack) <$> getParam "path" + let finalDir = joinPath $ map (dirBase . nameToDirId . T.pack) path' + Just name <- getParam "name" + let projectId = nameToProjectId $ T.decodeUtf8 name + return (user, mode, finalDir, Just projectId) + False -> do + Just commentHash <- fmap (CommentId . T.decodeUtf8) <$> getParam "chash" + commentFolder <- liftIO $ + BC.unpack <$> B.readFile (commentHashRootDir mode commentHashLink commentHash) + return (user, mode, commentFolder, Nothing) + +commentShareHandler :: ClientId -> Snap () +commentShareHandler clientId = do + (user, mode, finalDir, Just projectId) <- getFrequentParams True clientId + let commentFolder = commentRootDir mode (userId user) finalDir projectId + liftIO $ createDirectoryIfMissing False commentFolder + let commentHash = nameToCommentHash commentFolder + liftIO $ ensureCommentHashDir mode commentHash + liftIO $ B.writeFile (commentHashRootDir mode commentHashLink commentHash) $ + BC.pack commentFolder + modifyResponse $ setContentType "text/plain" + writeBS $ T.encodeUtf8 $ unCommentId commentHash + +deleteCommentHandler :: ClientId -> Snap () +deleteCommentHandler clientId = do + (_, _, commentFolder, _) <- getFrequentParams False clientId + Just (lineNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo" + Just (comment' :: CommentDesc) <- (decodeStrict =<<) <$> getParam "comment" + liftIO $ deleteCommentFromFile commentFolder lineNo' comment' + +deleteOwnerCommentHandler :: ClientId -> Snap () +deleteOwnerCommentHandler clientId = do + (user, mode, finalDir, Just projectId) <- getFrequentParams True clientId + let commentFolder = commentRootDir mode (userId user) finalDir projectId + Just (lineNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo" + Just (comment' :: CommentDesc) <- (decodeStrict =<<) <$> getParam "comment" + liftIO $ deleteCommentFromFile commentFolder lineNo' comment' + +deleteOwnerReplyHandler :: ClientId -> Snap () +deleteOwnerReplyHandler clientId = do + (user, mode, finalDir, Just projectId) <- getFrequentParams True clientId + let commentFolder = commentRootDir mode (userId user) finalDir projectId + Just (lineNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo" + Just (comment' :: CommentDesc) <- (decodeStrict =<<) <$> getParam "comment" + Just (reply' :: ReplyDesc) <- (decodeStrict =<<) <$> getParam "reply" + liftIO $ deleteReplyFromComment commentFolder lineNo' comment' reply' + +deleteReplyHandler :: ClientId -> Snap () +deleteReplyHandler clientId = do + (_, _, commentFolder, _) <- getFrequentParams False clientId + Just (lineNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo" + Just (comment' :: CommentDesc) <- (decodeStrict =<<) <$> getParam "comment" + Just (reply' :: ReplyDesc) <- (decodeStrict =<<) <$> getParam "reply" + liftIO $ deleteReplyFromComment commentFolder lineNo' comment' reply' + +readCommentHandler :: Snap () +readCommentHandler = do + mode <- getBuildMode + Just commentHash <- fmap (CommentId . T.decodeUtf8) <$> getParam "chash" + commentFolder <- liftIO $ + BC.unpack <$> B.readFile (commentHashRootDir mode commentHashLink commentHash) + Just (lineNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo" + Just comments' <- liftIO $ getLineComment commentFolder lineNo' + modifyResponse $ setContentType "application/json" + writeLBS (encode comments') + +readOwnerCommentHandler :: ClientId -> Snap () +readOwnerCommentHandler clientId = do + (user, mode, finalDir, Just projectId) <- getFrequentParams True clientId + let commentFolder = commentRootDir mode (userId user) finalDir projectId + liftIO $ createDirectoryIfMissing False commentFolder + Just (lineNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo" + Just comments' <- liftIO $ getLineComment commentFolder lineNo' + modifyResponse $ setContentType "application/json" + writeLBS (encode comments') + +viewCommentSourceHandler :: Snap () +viewCommentSourceHandler = do + mode <- getBuildMode + Just commentHash <- fmap (CommentId . T.decodeUtf8) <$> getParam "chash" + commentFolder <- liftIO $ + BC.unpack <$> B.readFile (commentHashRootDir mode commentHashLink commentHash) + Just (project :: Project) <- liftIO $ + decode <$> (LB.readFile $ take (length commentFolder - 9) commentFolder) + modifyResponse $ setContentType "text/x-haskell" + writeBS (T.encodeUtf8 $ projectSource project) + +writeCommentHandler :: ClientId -> Snap () +writeCommentHandler clientId = do + (_, _, commentFolder, _) <- getFrequentParams False clientId + Just (lineNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo" + Just (comment' :: CommentDesc) <- (decodeStrict =<<) <$> getParam "comment" + liftIO $ addCommentToFile commentFolder lineNo' comment' + +writeOwnerCommentHandler :: ClientId -> Snap () +writeOwnerCommentHandler clientId = do + (user, mode, finalDir, Just projectId) <- getFrequentParams True clientId + let commentFolder = commentRootDir mode (userId user) finalDir projectId + liftIO $ createDirectoryIfMissing False commentFolder + Just (lineNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo" + Just (comment' :: CommentDesc) <- (decodeStrict =<<) <$> getParam "comment" + liftIO $ addCommentToFile commentFolder lineNo' comment' + +writeOwnerReplyHandler :: ClientId -> Snap () +writeOwnerReplyHandler clientId = do + (user, mode, finalDir, Just projectId) <- getFrequentParams True clientId + let commentFolder = commentRootDir mode (userId user) finalDir projectId + Just (lineNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo" + Just (comment' :: CommentDesc) <- (decodeStrict =<<) <$> getParam "comment" + Just (reply' :: ReplyDesc) <- (decodeStrict =<<) <$> getParam "reply" + liftIO $ addReplyToComment commentFolder lineNo' comment' reply' + +writeReplyHandler :: ClientId -> Snap () +writeReplyHandler clientId = do + (_, _, commentFolder, _) <- getFrequentParams False clientId + Just (lineNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo" + Just (comment' :: CommentDesc) <- (decodeStrict =<<) <$> getParam "comment" + Just (reply' :: ReplyDesc) <- (decodeStrict =<<) <$> getParam "reply" + liftIO $ addReplyToComment commentFolder lineNo' comment' reply' diff --git a/codeworld-server/src/CommentUtil.hs b/codeworld-server/src/CommentUtil.hs index db26a33a7..3ae721244 100644 --- a/codeworld-server/src/CommentUtil.hs +++ b/codeworld-server/src/CommentUtil.hs @@ -18,10 +18,7 @@ module CommentUtil 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 (elemIndex, splitAt) @@ -29,10 +26,9 @@ import Data.Text (Text) import qualified Data.Text as T import System.Directory import System.FilePath -import System.IO import Model -import Util +import DataUtil newtype CommentId = CommentId { unCommentId :: Text } deriving Eq @@ -40,7 +36,8 @@ 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" +commentRootDir mode userId' path projectId = + userProjectDir mode userId' path projectFile projectId <.> "comments" commentHashLink :: CommentId -> FilePath commentHashLink (CommentId c) = let s = T.unpack c in take 3 s s @@ -53,49 +50,51 @@ ensureCommentHashDir mode (CommentId c) = createDirectoryIfMissing True dir where dir = commentHashRootDir mode take 3 (T.unpack c) getLineComment :: FilePath -> Int -> IO (Maybe LineComment) -getLineComment commentFolder lineNo = do - fileBool <- doesFileExist (commentFolder show lineNo) +getLineComment commentFolder lineNo' = do + fileBool <- doesFileExist (commentFolder show lineNo') case fileBool of - True -> decode <$> LB.readFile (commentFolder show lineNo) - False -> return (Just $ LineComment lineNo []) + True -> decode <$> LB.readFile (commentFolder show lineNo') + False -> return (Just $ LineComment lineNo' []) addCommentToFile :: FilePath -> Int -> CommentDesc -> IO () -addCommentToFile commentFolder lineNo comment = do - fileBool <- doesFileExist (commentFolder show lineNo) +addCommentToFile commentFolder lineNo' comment' = do + fileBool <- doesFileExist (commentFolder show lineNo') lc <- case fileBool of True -> do - Just (lc :: LineComment) <- decode <$> LB.readFile (commentFolder show lineNo) + Just (lc :: LineComment) <- decode <$> LB.readFile (commentFolder show lineNo') return lc - False -> return (LineComment lineNo []) - LB.writeFile (commentFolder show lineNo) $ encode (LineComment lineNo $ comments lc ++ [comment]) + False -> return (LineComment lineNo' []) + LB.writeFile (commentFolder show lineNo') $ encode (LineComment lineNo' $ + comments lc ++ [comment']) addReplyToComment :: FilePath -> Int -> CommentDesc -> ReplyDesc -> IO () -addReplyToComment commentFolder lineNo cd rd = do - Just (lc :: LineComment) <- decode <$> LB.readFile (commentFolder show lineNo) +addReplyToComment commentFolder lineNo' cd rd = do + Just (lc :: LineComment) <- decode <$> LB.readFile (commentFolder show lineNo') let Just ind = elemIndex cd (comments lc) newcd = CommentDesc (userIdent cd) (dateTime cd) (comment cd) (replies cd ++ [rd]) splc = splitAt ind $ comments lc - newlc = LineComment lineNo $ (fst splc) ++ (newcd : (tail $ snd splc)) - LB.writeFile (commentFolder show lineNo) $ encode newlc + newlc = LineComment lineNo' $ (fst splc) ++ (newcd : (tail $ snd splc)) + LB.writeFile (commentFolder show lineNo') $ encode newlc deleteCommentFromFile :: FilePath -> Int -> CommentDesc -> IO () -deleteCommentFromFile commentFolder lineNo cd = do - Just (lc :: LineComment) <- decode <$> LB.readFile (commentFolder show lineNo) +deleteCommentFromFile commentFolder lineNo' cd = do + Just (lc :: LineComment) <- decode <$> LB.readFile (commentFolder show lineNo') let Just ind = elemIndex cd (comments lc) newcd = CommentDesc "none" (dateTime cd) "deleted" (replies cd) splc = splitAt ind $ comments lc - newlc = LineComment lineNo $ (fst splc) ++ (if (length $ replies cd) /= 0 + newlc = LineComment lineNo' $ (fst splc) ++ (if (length $ replies cd) /= 0 then newcd : (tail $ snd splc) else tail $ snd splc) - LB.writeFile (commentFolder show lineNo) $ encode newlc + LB.writeFile (commentFolder show lineNo') $ encode newlc deleteReplyFromComment :: FilePath -> Int -> CommentDesc -> ReplyDesc -> IO () -deleteReplyFromComment commentFolder lineNo cd rd = do - Just (lc :: LineComment) <- decode <$> LB.readFile (commentFolder show lineNo) +deleteReplyFromComment commentFolder lineNo' cd rd = do + Just (lc :: LineComment) <- decode <$> LB.readFile (commentFolder show lineNo') let Just cdInd = elemIndex cd (comments lc) Just rdInd = elemIndex rd (replies cd) splc = splitAt cdInd $ comments lc spcd = splitAt rdInd $ replies cd - newcd = CommentDesc (userIdent cd) (dateTime cd) (comment cd) $ (fst spcd) ++ (tail $ snd spcd) - newlc = LineComment lineNo $ (fst splc) ++ (newcd : (tail $ snd splc)) - LB.writeFile (commentFolder show lineNo) $ encode newlc + newcd = CommentDesc (userIdent cd) (dateTime cd) (comment cd) $ + (fst spcd) ++ (tail $ snd spcd) + newlc = LineComment lineNo' $ (fst splc) ++ (newcd : (tail $ snd splc)) + LB.writeFile (commentFolder show lineNo') $ encode newlc diff --git a/codeworld-server/src/Util.hs b/codeworld-server/src/DataUtil.hs similarity index 89% rename from codeworld-server/src/Util.hs rename to codeworld-server/src/DataUtil.hs index 69c3a706c..a4b644f6f 100644 --- a/codeworld-server/src/Util.hs +++ b/codeworld-server/src/DataUtil.hs @@ -16,7 +16,7 @@ limitations under the License. -} -module Util where +module DataUtil where import Control.Exception import Control.Monad @@ -101,7 +101,7 @@ 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 +userProjectDir mode userId' = projectRootDir mode T.unpack userId' projectBase :: ProjectId -> FilePath projectBase (ProjectId p) = let s = T.unpack p in take 3 s s @@ -133,31 +133,31 @@ 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) +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) +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) +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 +ensureProjectDir mode userId' path projectId = do + ensureUserProjectDir mode userId' createDirectoryIfMissing False (dropFileName f) - where f = userProjectDir mode userId path projectFile projectId + where f = userProjectDir mode userId' path projectFile projectId 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 +dirFilter dirs' char = fmap concat $ mapM listDirectoryWithPrefix $ + filter (\x -> head (takeBaseName x) == char) dirs' projectFileNames :: [FilePath] -> IO [Text] projectFileNames subHashedDirs = do @@ -170,8 +170,8 @@ projectFileNames subHashedDirs = do 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 + 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 @@ -205,8 +205,8 @@ getFilesRecursive path = do dirToCheckSum :: FilePath -> IO Text dirToCheckSum path = do - files <- getFilesRecursive path - fileContents <- mapM B.readFile files + files' <- getFilesRecursive path + fileContents <- mapM B.readFile files' let cryptoContext = Crypto.hashInitWith Crypto.MD5 return $ (T.pack "F" <>) . T.decodeUtf8 diff --git a/codeworld-server/src/Folder.hs b/codeworld-server/src/Folder.hs new file mode 100644 index 000000000..f9b27a2e7 --- /dev/null +++ b/codeworld-server/src/Folder.hs @@ -0,0 +1,189 @@ +{-# 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 Folder 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 (sort) +import Data.Maybe (fromJust) +import Snap.Core +import Snap.Util.FileServe +import System.Directory +import System.FilePath + +import DataUtil +import Model +import SnapUtil + +folderRoutes :: ClientId -> [(B.ByteString, Snap ())] +folderRoutes clientId = + [ ("createFolder", createFolderHandler clientId) + , ("deleteFolder", deleteFolderHandler clientId) + , ("deleteProject", deleteProjectHandler clientId) + , ("listFolder", listFolderHandler clientId) + , ("loadProject", loadProjectHandler clientId) + , ("moveProject", moveProjectHandler clientId) + , ("shareContent", shareContentHandler clientId) + , ("shareFolder", shareFolderHandler clientId) + , ("saveProject", saveProjectHandler clientId) + ] + +getFrequentParams :: Bool -> ClientId -> Snap (User, BuildMode, FilePath, Maybe ProjectId) +getFrequentParams file clientId = do + user <- getUser clientId + mode <- getBuildMode + Just path' <- fmap (splitDirectories . BC.unpack) <$> getParam "path" + let finalDir = joinPath $ map (dirBase . nameToDirId . T.pack) path' + case file of + True -> do + Just name <- getParam "name" + let projectId = nameToProjectId $ T.decodeUtf8 name + return (user, mode, finalDir, Just projectId) + False -> return (user, mode, finalDir, Nothing) + +createFolderHandler :: ClientId -> Snap () +createFolderHandler clientId = do + (user, mode, finalDir, _) <- getFrequentParams False clientId + Just path' <- fmap (splitDirectories . BC.unpack) <$> getParam "path" + liftIO $ ensureUserBaseDir mode (userId user) finalDir + liftIO $ createDirectory $ userProjectDir mode (userId user) finalDir + liftIO $ B.writeFile (userProjectDir mode (userId user) finalDir "dir.info") $ + BC.pack $ last path' + +deleteFolderHandler :: ClientId -> Snap () +deleteFolderHandler clientId = do + (user, mode, finalDir, _) <- getFrequentParams False clientId + 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' + +deleteProjectHandler :: ClientId -> Snap () +deleteProjectHandler clientId = do + (user, mode, finalDir, Just projectId) <- getFrequentParams True clientId + 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 + (user, mode, finalDir, _) <- getFrequentParams False clientId + 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')) + +loadProjectHandler :: ClientId -> Snap () +loadProjectHandler clientId = do + (user, mode, finalDir, Just projectId) <- getFrequentParams True clientId + liftIO $ ensureProjectDir mode (userId user) finalDir projectId + let file = userProjectDir mode (userId user) finalDir projectFile projectId + modifyResponse $ setContentType "application/json" + serveFile file + +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) + Just isFile <- getParam "isFile" + case (moveTo == moveFrom, isFile) of + (False, "true") -> do + Just name <- getParam "name" + let projectId = nameToProjectId $ T.decodeUtf8 name + liftIO $ ensureProjectDir mode (userId user) moveToDir projectId + liftIO $ copyDirIfExists (dropFileName $ moveFromDir projectFile projectId) + (dropFileName $ projectDir moveToDir projectFile projectId) + 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 () + +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 + +shareFolderHandler :: ClientId -> Snap () +shareFolderHandler clientId = do + (user, mode, finalDir, _) <- getFrequentParams False clientId + 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 False clientId + 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 diff --git a/codeworld-server/src/Main.hs b/codeworld-server/src/Main.hs index 49559b303..092077955 100644 --- a/codeworld-server/src/Main.hs +++ b/codeworld-server/src/Main.hs @@ -1,8 +1,5 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE ScopedTypeVariables #-} - {- Copyright 2017 The CodeWorld Authors. All rights reserved. @@ -31,29 +28,22 @@ 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 Data.Time.Clock (UTCTime) 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 Comment +import DataUtil +import Folder import Model -import Util -import CommentUtil - -newtype ClientId = ClientId (Maybe T.Text) deriving (Eq) +import SnapUtil main :: IO () main = do @@ -70,390 +60,24 @@ 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), - ("commentShare", commentShareHandler clientId), - ("writeComment", writeCommentHandler clientId), - ("writeReply", writeReplyHandler clientId), - ("deleteComment", deleteCommentHandler clientId), - ("deleteReply", deleteReplyHandler clientId), - ("writeOwnerComment", writeOwnerCommentHandler clientId), - ("writeOwnerReply", writeOwnerReplyHandler clientId), - ("deleteOwnerComment", deleteOwnerCommentHandler clientId), - ("deleteOwnerReply", deleteOwnerReplyHandler clientId), - ("readComment", readCommentHandler), - ("readOwnerComment", readOwnerCommentHandler clientId), - ("viewCommentSource", viewCommentSourceHandler), - ("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)) - let sharingUserRoot = joinPath $ take 3 $ splitDirectories $ BC.unpack sharingFolder - 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 - -commentShareHandler :: ClientId -> Snap () -commentShareHandler 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 name <- getParam "name" - let projectId = nameToProjectId $ T.decodeUtf8 name - let commentFolder = commentRootDir mode (userId user) finalDir projectId - liftIO $ createDirectoryIfMissing False commentFolder - let commentHash = nameToCommentHash commentFolder - liftIO $ ensureCommentHashDir mode commentHash - liftIO $ B.writeFile (commentHashRootDir mode commentHashLink commentHash) $ BC.pack commentFolder - writeBS $ T.encodeUtf8 $ unCommentId commentHash - -writeCommentHandler :: ClientId -> Snap () -writeCommentHandler clientId = do - mode <- getBuildMode - user <- getUser clientId - Just commentHash <- fmap (CommentId . T.decodeUtf8) <$> getParam "chash" - commentFolder <- liftIO $ BC.unpack <$> B.readFile (commentHashRootDir mode commentHashLink commentHash) - Just (lineNo :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo" - Just (comment :: CommentDesc) <- (decodeStrict =<<) <$> getParam "comment" - liftIO $ addCommentToFile commentFolder lineNo comment - -writeReplyHandler :: ClientId -> Snap () -writeReplyHandler clientId = do - mode <- getBuildMode - user <- getUser clientId - Just commentHash <- fmap (CommentId . T.decodeUtf8) <$> getParam "chash" - commentFolder <- liftIO $ BC.unpack <$> B.readFile (commentHashRootDir mode commentHashLink commentHash) - Just (lineNo :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo" - Just (comment :: CommentDesc) <- (decodeStrict =<<) <$> getParam "comment" - Just (reply :: ReplyDesc) <- (decodeStrict =<<) <$> getParam "reply" - liftIO $ addReplyToComment commentFolder lineNo comment reply - -writeOwnerCommentHandler :: ClientId -> Snap () -writeOwnerCommentHandler clientId = do - user <- getUser clientId - mode <- getBuildMode - Just path <- fmap (splitDirectories . BC.unpack) <$> getParam "path" - let finalDir = joinPath $ map (dirBase . nameToDirId . T.pack) path - Just name <- getParam "name" - let projectId = nameToProjectId $ T.decodeUtf8 name - let commentFolder = commentRootDir mode (userId user) finalDir projectId - liftIO $ createDirectoryIfMissing False commentFolder - Just (lineNo :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo" - Just (comment :: CommentDesc) <- (decodeStrict =<<) <$> getParam "comment" - liftIO $ addCommentToFile commentFolder lineNo comment - -writeOwnerReplyHandler :: ClientId -> Snap () -writeOwnerReplyHandler clientId = do - user <- getUser clientId - mode <- getBuildMode - Just path <- fmap (splitDirectories . BC.unpack) <$> getParam "path" - let finalDir = joinPath $ map (dirBase . nameToDirId . T.pack) path - Just name <- getParam "name" - let projectId = nameToProjectId $ T.decodeUtf8 name - let commentFolder = commentRootDir mode (userId user) finalDir projectId - Just (lineNo :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo" - Just (comment :: CommentDesc) <- (decodeStrict =<<) <$> getParam "comment" - Just (reply :: ReplyDesc) <- (decodeStrict =<<) <$> getParam "reply" - liftIO $ addReplyToComment commentFolder lineNo comment reply - -deleteCommentHandler :: ClientId -> Snap () -deleteCommentHandler clientId = do - mode <- getBuildMode - user <- getUser clientId - Just commentHash <- fmap (CommentId . T.decodeUtf8) <$> getParam "chash" - commentFolder <- liftIO $ BC.unpack <$> B.readFile (commentHashRootDir mode commentHashLink commentHash) - Just (lineNo :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo" - Just (comment :: CommentDesc) <- (decodeStrict =<<) <$> getParam "comment" - liftIO $ deleteCommentFromFile commentFolder lineNo comment - -deleteReplyHandler :: ClientId -> Snap () -deleteReplyHandler clientId = do - mode <- getBuildMode - user <- getUser clientId - Just commentHash <- fmap (CommentId . T.decodeUtf8) <$> getParam "chash" - commentFolder <- liftIO $ BC.unpack <$> B.readFile (commentHashRootDir mode commentHashLink commentHash) - Just (lineNo :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo" - Just (comment :: CommentDesc) <- (decodeStrict =<<) <$> getParam "comment" - Just (reply :: ReplyDesc) <- (decodeStrict =<<) <$> getParam "reply" - liftIO $ deleteReplyFromComment commentFolder lineNo comment reply - -deleteOwnerCommentHandler :: ClientId -> Snap () -deleteOwnerCommentHandler clientId = do - user <- getUser clientId - mode <- getBuildMode - Just path <- fmap (splitDirectories . BC.unpack) <$> getParam "path" - let finalDir = joinPath $ map (dirBase . nameToDirId . T.pack) path - Just name <- getParam "name" - let projectId = nameToProjectId $ T.decodeUtf8 name - let commentFolder = commentRootDir mode (userId user) finalDir projectId - Just (lineNo :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo" - Just (comment :: CommentDesc) <- (decodeStrict =<<) <$> getParam "comment" - liftIO $ deleteCommentFromFile commentFolder lineNo comment - -deleteOwnerReplyHandler :: ClientId -> Snap () -deleteOwnerReplyHandler clientId = do - user <- getUser clientId - mode <- getBuildMode - Just path <- fmap (splitDirectories . BC.unpack) <$> getParam "path" - let finalDir = joinPath $ map (dirBase . nameToDirId . T.pack) path - Just name <- getParam "name" - let projectId = nameToProjectId $ T.decodeUtf8 name - let commentFolder = commentRootDir mode (userId user) finalDir projectId - Just (lineNo :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo" - Just (comment :: CommentDesc) <- (decodeStrict =<<) <$> getParam "comment" - Just (reply :: ReplyDesc) <- (decodeStrict =<<) <$> getParam "reply" - liftIO $ deleteReplyFromComment commentFolder lineNo comment reply - -readCommentHandler :: Snap () -readCommentHandler = do - mode <- getBuildMode - Just commentHash <- fmap (CommentId . T.decodeUtf8) <$> getParam "chash" - commentFolder <- liftIO $ BC.unpack <$> B.readFile (commentHashRootDir mode commentHashLink commentHash) - Just (lineNo :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo" - Just comments <- liftIO $ getLineComment commentFolder lineNo - writeLBS (encode comments) - -readOwnerCommentHandler :: ClientId -> Snap () -readOwnerCommentHandler clientId = do - user <- getUser clientId - mode <- getBuildMode - Just path <- fmap (splitDirectories . BC.unpack) <$> getParam "path" - let finalDir = joinPath $ map (dirBase . nameToDirId . T.pack) path - Just name <- getParam "name" - let projectId = nameToProjectId $ T.decodeUtf8 name - let commentFolder = commentRootDir mode (userId user) finalDir projectId - liftIO $ createDirectoryIfMissing False commentFolder - Just (lineNo :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo" - Just comments <- liftIO $ getLineComment commentFolder lineNo - writeLBS (encode comments) - -viewCommentSourceHandler :: Snap () -viewCommentSourceHandler = do - mode <- getBuildMode - Just commentHash <- fmap (CommentId . T.decodeUtf8) <$> getParam "chash" - commentFolder <- liftIO $ BC.unpack <$> B.readFile (commentHashRootDir mode commentHashLink commentHash) - modifyResponse $ setContentType "text/x-haskell" - Just (project :: Project) <- liftIO $ decode <$> (LB.readFile $ take (length commentFolder - 9) commentFolder) - writeBS (T.encodeUtf8 $ projectSource project) - -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) - Just isFile <- getParam "isFile" - case (moveTo == moveFrom, isFile) of - (False, "true") -> do - Just name <- getParam "name" - let projectId = nameToProjectId $ T.decodeUtf8 name - liftIO $ ensureProjectDir mode (userId user) moveToDir projectId - liftIO $ copyDirIfExists (dropFileName $ moveFromDir projectFile projectId) - (dropFileName $ projectDir moveToDir projectFile projectId) - 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 - (True, _) -> return () + route ([ + ("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) + ] ++ + (commentRoutes clientId) ++ + (folderRoutes clientId)) <|> + serveDirectory "web" saveXMLHashHandler :: Snap () saveXMLHashHandler = do @@ -482,18 +106,10 @@ 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 + unless (mode == BuildMode "blocklyXML") $ modifyResponse $ setResponseCode 500 programId <- getHashParam False mode modifyResponse $ setContentType "text/plain" serveFile (buildRootDir mode sourceXML programId) @@ -522,7 +138,6 @@ runMessageHandler = do indentHandler :: Snap () indentHandler = do - mode <- getBuildMode Just source <- getParam "source" case reformat defaultConfig Nothing source of Left err -> do @@ -536,13 +151,13 @@ compileIfNeeded :: BuildMode -> ProgramId -> IO Bool compileIfNeeded mode programId = do hasResult <- doesFileExist (buildRootDir mode resultFile programId) hasTarget <- doesFileExist (buildRootDir mode targetFile programId) - if hasResult - then return hasTarget - else compileSource + if hasResult + then return hasTarget + else compileSource (buildRootDir mode sourceFile programId) (buildRootDir mode targetFile programId) (buildRootDir mode resultFile programId) - (getMode mode) + (getMode mode) getMode :: BuildMode -> String getMode (BuildMode m) = m diff --git a/codeworld-server/src/Model.hs b/codeworld-server/src/Model.hs index 8284471d4..c8bfaea0b 100644 --- a/codeworld-server/src/Model.hs +++ b/codeworld-server/src/Model.hs @@ -18,12 +18,10 @@ module Model where -import Control.Applicative import Control.Monad import Data.Aeson import Data.Text (Text) import Data.Time.Clock (UTCTime) -import System.FilePath (FilePath) data User = User { userId :: Text, audience :: Text } 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/web/js/codeworld.js b/web/js/codeworld.js index b8d948f94..d4706963d 100644 --- a/web/js/codeworld.js +++ b/web/js/codeworld.js @@ -77,7 +77,7 @@ function init() { registerStandardHints(function(){setMode(true);}); updateUI(); } - + if (hash.length > 0) { if (hash.slice(-2) == '==') { hash = hash.slice(0, -2); diff --git a/web/js/codeworld_shared.js b/web/js/codeworld_shared.js index e18deea7e..8de3b95bc 100644 --- a/web/js/codeworld_shared.js +++ b/web/js/codeworld_shared.js @@ -293,7 +293,7 @@ function handleGAPILoad() { if (auth2.isSignedIn.get() == true) auth2.signIn(); }); }); - + discoverProjects("", 0); updateUI(); } @@ -626,6 +626,7 @@ function newProject_(path) { } sweetAlert.close(); + setCode(''); saveProjectBase(path, fileName, 'create'); } @@ -643,7 +644,7 @@ function newProject_(path) { } function loadProject_(index, name, buildMode, successFunc) { - + warnIfUnsaved(function(){ if (!signedIn()) { sweetAlert('Oops!', 'You must sign in to open projects.', 'error'); @@ -753,7 +754,7 @@ function shareFolder_(mode) { 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'); From 32f1244ea737ae6dbb11e7d441f2daf79658c843 Mon Sep 17 00:00:00 2001 From: parv Date: Sun, 16 Jul 2017 02:47:45 +0530 Subject: [PATCH 07/28] modifies Folder.hs according to requirements of Comment.hs --- codeworld-server/src/Folder.hs | 24 ++++++++++++------------ web/js/codeworld_comments.js | 14 ++++++++++---- 2 files changed, 22 insertions(+), 16 deletions(-) diff --git a/codeworld-server/src/Folder.hs b/codeworld-server/src/Folder.hs index f9b27a2e7..7314caf0f 100644 --- a/codeworld-server/src/Folder.hs +++ b/codeworld-server/src/Folder.hs @@ -75,7 +75,6 @@ createFolderHandler clientId = do deleteFolderHandler :: ClientId -> Snap () deleteFolderHandler clientId = do (user, mode, finalDir, _) <- getFrequentParams False clientId - liftIO $ ensureUserDir mode (userId user) finalDir let dir' = userProjectDir mode (userId user) finalDir empty <- liftIO $ fmap (\ l1 -> @@ -86,20 +85,19 @@ deleteFolderHandler clientId = do deleteProjectHandler :: ClientId -> Snap () deleteProjectHandler clientId = do (user, mode, finalDir, Just projectId) <- getFrequentParams True clientId - liftIO $ ensureProjectDir mode (userId user) finalDir projectId let file = userProjectDir mode (userId user) finalDir projectFile projectId + liftIO $ removeFileIfExists file + liftIO $ removeDirectoryIfExists $ file <.> "comments" empty <- liftIO $ fmap (\ l1 -> - length l1 == 3 && sort l1 == sort [".", "..", takeFileName file]) + length l1 == 2 && sort l1 == sort [".", ".."]) (getDirectoryContents (dropFileName file)) liftIO $ if empty then removeDirectoryIfExists (dropFileName file) - else removeFileIfExists file + else return () listFolderHandler :: ClientId -> Snap () listFolderHandler clientId = do (user, mode, finalDir, _) <- getFrequentParams False clientId - 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 @@ -111,7 +109,6 @@ listFolderHandler clientId = do loadProjectHandler :: ClientId -> Snap () loadProjectHandler clientId = do (user, mode, finalDir, Just projectId) <- getFrequentParams True clientId - liftIO $ ensureProjectDir mode (userId user) finalDir projectId let file = userProjectDir mode (userId user) finalDir projectFile projectId modifyResponse $ setContentType "application/json" serveFile file @@ -133,14 +130,17 @@ moveProjectHandler clientId = do liftIO $ ensureProjectDir mode (userId user) moveToDir projectId liftIO $ copyDirIfExists (dropFileName $ moveFromDir projectFile projectId) (dropFileName $ projectDir moveToDir projectFile projectId) + let file = moveFromDir projectFile projectId + liftIO $ removeFileIfExists file + liftIO $ removeDirectoryIfExists $ file <.> "comments" empty <- liftIO $ fmap (\ l1 -> - length l1 == 3 && - sort l1 == sort [".", "..", takeFileName $ projectFile projectId]) + length l1 == 2 && + sort l1 == sort [".", ".."]) (getDirectoryContents - (dropFileName $ moveFromDir projectFile projectId)) - liftIO $ if empty then removeDirectoryIfExists (dropFileName $ moveFromDir projectFile projectId) - else removeFileIfExists $ moveFromDir projectFile projectId + (dropFileName file)) + liftIO $ if empty then removeDirectoryIfExists (dropFileName file) + else return () (False, "false") -> do let dirName = last $ splitDirectories moveFromDir let dir' = moveToDir take 3 dirName dirName diff --git a/web/js/codeworld_comments.js b/web/js/codeworld_comments.js index 57a94fc7e..d0e19fb7c 100644 --- a/web/js/codeworld_comments.js +++ b/web/js/codeworld_comments.js @@ -113,10 +113,14 @@ function toggleUserComments(cm, line, gutter) { window.openComments = new Object(); } if (window.openCommentLines[line + 1] != undefined) { - window.openCommentLines[line + 1].clear(); - window.openCommentLines[line + 1] = undefined; - window.openComments[line + 1] = undefined; - return; + 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); } @@ -150,6 +154,8 @@ function generateComments(line) { 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(); From a364e4859d73b48fa43a90a8695e317347c5cdac Mon Sep 17 00:00:00 2001 From: Parv Mor Date: Fri, 21 Jul 2017 10:50:07 +0530 Subject: [PATCH 08/28] Changes the comment handlers to support versioning of code. frontend and backend are not compatible.(Comment and Folder modules may not compile. Yet to complete certain handlers) --- codeworld-server/codeworld-server.cabal | 3 +- codeworld-server/src/Comment.hs | 163 +--------- codeworld-server/src/CommentUtil.hs | 345 ++++++++++++++++++--- codeworld-server/src/Comment_.hs | 390 ++++++++++++++++++++++++ codeworld-server/src/DataUtil.hs | 33 +- codeworld-server/src/Folder.hs | 174 +---------- codeworld-server/src/Folder_.hs | 322 +++++++++++++++++++ codeworld-server/src/Model.hs | 79 ++++- web/js/codeworld.js | 30 +- web/js/codeworld_comments.js | 107 +++++++ web/js/codeworld_shared.js | 7 +- 11 files changed, 1258 insertions(+), 395 deletions(-) create mode 100644 codeworld-server/src/Comment_.hs create mode 100644 codeworld-server/src/Folder_.hs diff --git a/codeworld-server/codeworld-server.cabal b/codeworld-server/codeworld-server.cabal index b47fcd4ad..4a2a6cfc0 100644 --- a/codeworld-server/codeworld-server.cabal +++ b/codeworld-server/codeworld-server.cabal @@ -38,7 +38,8 @@ Executable codeworld-server temporary, text, time, - unix + unix, + unordered-containers Ghc-options: -threaded -Wall -funbox-strict-fields -O2 -fno-warn-unused-do-bind diff --git a/codeworld-server/src/Comment.hs b/codeworld-server/src/Comment.hs index ab3bf4a73..b14a68632 100644 --- a/codeworld-server/src/Comment.hs +++ b/codeworld-server/src/Comment.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} - {- Copyright 2017 The CodeWorld Authors. All rights reserved. @@ -17,162 +14,6 @@ limitations under the License. -} -module Comment 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 Snap.Core -import System.Directory -import System.FilePath - -import CommentUtil -import DataUtil -import Model -import SnapUtil - -commentRoutes :: ClientId -> [(B.ByteString, Snap ())] -commentRoutes clientId = - [ ("commentShare", commentShareHandler clientId) - , ("deleteComment", deleteCommentHandler clientId) - , ("deleteOwnerComment", deleteOwnerCommentHandler clientId) - , ("deleteOwnerReply", deleteOwnerReplyHandler clientId) - , ("deleteReply", deleteReplyHandler clientId) - , ("readComment", readCommentHandler) - , ("readOwnerComment", readOwnerCommentHandler clientId) - , ("viewCommentSource", viewCommentSourceHandler) - , ("writeComment", writeCommentHandler clientId) - , ("writeOwnerComment", writeOwnerCommentHandler clientId) - , ("writeOwnerReply", writeOwnerReplyHandler clientId) - , ("writeReply", writeReplyHandler clientId) - ] - -getFrequentParams :: Bool -> ClientId -> Snap (User, BuildMode, FilePath, Maybe ProjectId) -getFrequentParams owner clientId = do - user <- getUser clientId - mode <- getBuildMode - case owner of - True -> do - Just path' <- fmap (splitDirectories . BC.unpack) <$> getParam "path" - let finalDir = joinPath $ map (dirBase . nameToDirId . T.pack) path' - Just name <- getParam "name" - let projectId = nameToProjectId $ T.decodeUtf8 name - return (user, mode, finalDir, Just projectId) - False -> do - Just commentHash <- fmap (CommentId . T.decodeUtf8) <$> getParam "chash" - commentFolder <- liftIO $ - BC.unpack <$> B.readFile (commentHashRootDir mode commentHashLink commentHash) - return (user, mode, commentFolder, Nothing) - -commentShareHandler :: ClientId -> Snap () -commentShareHandler clientId = do - (user, mode, finalDir, Just projectId) <- getFrequentParams True clientId - let commentFolder = commentRootDir mode (userId user) finalDir projectId - liftIO $ createDirectoryIfMissing False commentFolder - let commentHash = nameToCommentHash commentFolder - liftIO $ ensureCommentHashDir mode commentHash - liftIO $ B.writeFile (commentHashRootDir mode commentHashLink commentHash) $ - BC.pack commentFolder - modifyResponse $ setContentType "text/plain" - writeBS $ T.encodeUtf8 $ unCommentId commentHash - -deleteCommentHandler :: ClientId -> Snap () -deleteCommentHandler clientId = do - (_, _, commentFolder, _) <- getFrequentParams False clientId - Just (lineNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo" - Just (comment' :: CommentDesc) <- (decodeStrict =<<) <$> getParam "comment" - liftIO $ deleteCommentFromFile commentFolder lineNo' comment' - -deleteOwnerCommentHandler :: ClientId -> Snap () -deleteOwnerCommentHandler clientId = do - (user, mode, finalDir, Just projectId) <- getFrequentParams True clientId - let commentFolder = commentRootDir mode (userId user) finalDir projectId - Just (lineNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo" - Just (comment' :: CommentDesc) <- (decodeStrict =<<) <$> getParam "comment" - liftIO $ deleteCommentFromFile commentFolder lineNo' comment' - -deleteOwnerReplyHandler :: ClientId -> Snap () -deleteOwnerReplyHandler clientId = do - (user, mode, finalDir, Just projectId) <- getFrequentParams True clientId - let commentFolder = commentRootDir mode (userId user) finalDir projectId - Just (lineNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo" - Just (comment' :: CommentDesc) <- (decodeStrict =<<) <$> getParam "comment" - Just (reply' :: ReplyDesc) <- (decodeStrict =<<) <$> getParam "reply" - liftIO $ deleteReplyFromComment commentFolder lineNo' comment' reply' - -deleteReplyHandler :: ClientId -> Snap () -deleteReplyHandler clientId = do - (_, _, commentFolder, _) <- getFrequentParams False clientId - Just (lineNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo" - Just (comment' :: CommentDesc) <- (decodeStrict =<<) <$> getParam "comment" - Just (reply' :: ReplyDesc) <- (decodeStrict =<<) <$> getParam "reply" - liftIO $ deleteReplyFromComment commentFolder lineNo' comment' reply' - -readCommentHandler :: Snap () -readCommentHandler = do - mode <- getBuildMode - Just commentHash <- fmap (CommentId . T.decodeUtf8) <$> getParam "chash" - commentFolder <- liftIO $ - BC.unpack <$> B.readFile (commentHashRootDir mode commentHashLink commentHash) - Just (lineNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo" - Just comments' <- liftIO $ getLineComment commentFolder lineNo' - modifyResponse $ setContentType "application/json" - writeLBS (encode comments') - -readOwnerCommentHandler :: ClientId -> Snap () -readOwnerCommentHandler clientId = do - (user, mode, finalDir, Just projectId) <- getFrequentParams True clientId - let commentFolder = commentRootDir mode (userId user) finalDir projectId - liftIO $ createDirectoryIfMissing False commentFolder - Just (lineNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo" - Just comments' <- liftIO $ getLineComment commentFolder lineNo' - modifyResponse $ setContentType "application/json" - writeLBS (encode comments') - -viewCommentSourceHandler :: Snap () -viewCommentSourceHandler = do - mode <- getBuildMode - Just commentHash <- fmap (CommentId . T.decodeUtf8) <$> getParam "chash" - commentFolder <- liftIO $ - BC.unpack <$> B.readFile (commentHashRootDir mode commentHashLink commentHash) - Just (project :: Project) <- liftIO $ - decode <$> (LB.readFile $ take (length commentFolder - 9) commentFolder) - modifyResponse $ setContentType "text/x-haskell" - writeBS (T.encodeUtf8 $ projectSource project) - -writeCommentHandler :: ClientId -> Snap () -writeCommentHandler clientId = do - (_, _, commentFolder, _) <- getFrequentParams False clientId - Just (lineNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo" - Just (comment' :: CommentDesc) <- (decodeStrict =<<) <$> getParam "comment" - liftIO $ addCommentToFile commentFolder lineNo' comment' - -writeOwnerCommentHandler :: ClientId -> Snap () -writeOwnerCommentHandler clientId = do - (user, mode, finalDir, Just projectId) <- getFrequentParams True clientId - let commentFolder = commentRootDir mode (userId user) finalDir projectId - liftIO $ createDirectoryIfMissing False commentFolder - Just (lineNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo" - Just (comment' :: CommentDesc) <- (decodeStrict =<<) <$> getParam "comment" - liftIO $ addCommentToFile commentFolder lineNo' comment' - -writeOwnerReplyHandler :: ClientId -> Snap () -writeOwnerReplyHandler clientId = do - (user, mode, finalDir, Just projectId) <- getFrequentParams True clientId - let commentFolder = commentRootDir mode (userId user) finalDir projectId - Just (lineNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo" - Just (comment' :: CommentDesc) <- (decodeStrict =<<) <$> getParam "comment" - Just (reply' :: ReplyDesc) <- (decodeStrict =<<) <$> getParam "reply" - liftIO $ addReplyToComment commentFolder lineNo' comment' reply' +module Comment (module Comment__) where -writeReplyHandler :: ClientId -> Snap () -writeReplyHandler clientId = do - (_, _, commentFolder, _) <- getFrequentParams False clientId - Just (lineNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo" - Just (comment' :: CommentDesc) <- (decodeStrict =<<) <$> getParam "comment" - Just (reply' :: ReplyDesc) <- (decodeStrict =<<) <$> getParam "reply" - liftIO $ addReplyToComment commentFolder lineNo' comment' reply' +import Comment_ as Comment__ hiding (getFrequentParams) diff --git a/codeworld-server/src/CommentUtil.hs b/codeworld-server/src/CommentUtil.hs index 3ae721244..bfac16c48 100644 --- a/codeworld-server/src/CommentUtil.hs +++ b/codeworld-server/src/CommentUtil.hs @@ -18,17 +18,21 @@ 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 (elemIndex, splitAt) +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 Model import DataUtil +import Model newtype CommentId = CommentId { unCommentId :: Text } deriving Eq @@ -39,9 +43,16 @@ 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 @@ -49,52 +60,310 @@ ensureCommentHashDir :: BuildMode -> CommentId -> IO () ensureCommentHashDir mode (CommentId c) = createDirectoryIfMissing True dir where dir = commentHashRootDir mode take 3 (T.unpack c) -getLineComment :: FilePath -> Int -> IO (Maybe LineComment) -getLineComment commentFolder lineNo' = do - fileBool <- doesFileExist (commentFolder show lineNo') - case fileBool of - True -> decode <$> LB.readFile (commentFolder show lineNo') - False -> return (Just $ LineComment lineNo' []) - -addCommentToFile :: FilePath -> Int -> CommentDesc -> IO () -addCommentToFile commentFolder lineNo' comment' = do - fileBool <- doesFileExist (commentFolder show lineNo') - lc <- case fileBool of - True -> do - Just (lc :: LineComment) <- decode <$> LB.readFile (commentFolder show lineNo') - return lc - False -> return (LineComment lineNo' []) +ensureSharedCommentsDir :: BuildMode -> Text -> IO () +ensureSharedCommentsDir mode userId' = createDirectoryIfMissing True dir + where dir = sharedCommentsDir mode userId' + +removeCommentHash :: BuildMode -> FilePath -> IO () +removeCommentHash mode commentFolder = do + let commentHash = nameToCommentHash commentFolder + removeFileIfExists $ commentHashRootDir mode commentHashLink commentHash + +cleanCommentPaths :: BuildMode -> FilePath -> IO () +cleanCommentPaths mode commentFolder = do + dirBool <- doesDirectoryExist commentFolder + case dirBool of + True -> do + removeDirectoryIfExists commentFolder + removeDirectoryIfExists $ commentFolder <.> "users" + removeDirectoryIfExists $ commentFolder <.> "versions" + let commentHash = nameToCommentHash commentFodler + commentHashPath = commentHashRootDir mode commentHashLink commentHash + removeFileIfExists commentHashPath + Just (currentUsers :: [UserDump]) <- decode <$> + LB.readFile (commentHashPath <.> "users") + forM_ currentUsers $ \u -> do + removeFileIfExists $ upath u + removeFileIfExists $ upath u <.> "info" + empty <- fmap + (\ l -> + length l == 2 && + sort l == sort [".", ".."]) + (getDirectoryContents (dropFileName $ upath u)) + if empty then removeDirectroyIfExists (dropFileName $ upath u) + else return () + removeFileIfExists $ commentHashPath <.> "users" + empty <- fmap + (\ l -> + length l == 2 && + sort l == sort [".", ".."]) + (getDirectoryContents (dropFileName commentHashPath)) + if empty then removeDirectoryIfExists (dropFileName commentHashPath) + else return () + False -> return () + +deleteFolderWithComments :: Buildmode -> Text -> FilePath -> IO (Either String ()) +deleteFolderWithComments mode userId' finalDir = do + case finalDir == "commentables" of + True -> return $ Left "`commentables` Directory Cannot Be Deleted" + False -> do + let dir' = userProjectDir mode userId' finalDir + 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 mode userId') allFilePaths + empty <- fmap (\ l -> + length l == 3 && + sort l == sort [".", "..", takeFileName dir']) + (getDirectoryContents (takeDirectory dir')) + removeDirectoryIfExists $ if empty then takeDirectory dir' else dir' + return $ Right () + | otherwise -> do + mapM_ (\x -> cleanCommentPaths mode $ x <.> "comments") allFilePaths + empty <- fmap (\ l -> + length l == 3 && + sort l == sort [".", "..", takeFileName dir']) + (getDirectoryContents (takeDirectory dir')) + removeDirectoryIfExists $ if empty then takeDirectory dir' else dir' + return $ Right () + +removeUserFromComments :: BuildMode -> Text -> FilePath -> IO () +removeUserFromComments mode userId' userPath = do + commentHashFile <- BC.unpack <$> B.readFile userPath + commentFolder <- BC.unpack <$> B.readFile commentHashFile + Just (currentUsers :: [UserDump]) <- decode <$> + LB.readFile (commentHashPath <.> "users") + let currentUserIds = map uuserId currentUsers + currentUser = currentUsers !! (fromJust $ userId' `elemIndex` currentUserIds) + removeFileIfExists commentFolder <.> "users" uuserIdent currentUser + LB.writeFile (commentHashPath <.> "users") $ + encode (delete currentUser currentUsers) + removeFileIfExists userPath + removeFileIfExists userPath <.> "info" + empty <- fmap + (\ l -> + length l ==2 && + sort l == sort [".", ".."]) + (getDirectoryContents (dropFileName userPath)) + if empty then removeDirectoryIfExists (dropFileName userPath) + else return () + +copyDirFromCommentables :: BuildMode -> Text -> FilePath -> FilePath -> Value -> IO () +copyDirFromCommentables mode userId' toDir fromDir emptyPH = do + let projectId = userProjectDir mode userId' + dirList <- listDirectoryWithPrefix fromDir + dirFiles <- dirFilter dirList 'S' + forM_ dirFiles $ \ f -> do + let file = takeFileName f + case isSuffixOf ".info" (drop 23 file) of + True -> return () + False -> do + commentHashLink <- BC.unpack <$> B.readFile f + commentFolder <- BC.unpack <$> B.readFile f + Just (project :: Project) <- decode <$> + (LB.readFile $ take (length commentFolder - 9) commentFolder) + fileName <- T.decodeUtf8 <$> B.readFile (f <.> "info") + createDirectoryIfMissing $ takeDirectory toDir + createDirectory $ toDir + B.writeFile () + LB.writeFile (toDir file) $ encode + (Project fileName (projectSource project) emptyPH) + addSelf mode userId' "Anonynous Owner" (toDir file <.> "comments") + dirDirs <- dirFilter dirList 'D' + + +createNewVersionIfReq :: Text -> FilePath -> IO () +createNewVersionIfReq latestSource commentFolder = do + currentVersions :: [Int] <- reverse . sort . map read <$> + listDirectory (commentFolder <.> "versions") + let currentVersion = currentVersion !! 0 + currentSource <- T.decodeUtf8 <$> + B.readFile (commentFolder <.> "versions" show currentVersion) + case currentSource == latestSource of + True -> return () + False -> do + currentlines :: [Int] <- delete 0 . fmap read <$> listDirectory commentFolder + commentVersionLists :: [[[CommentDesc]]] <- mapM (\x -> versions . fromJust . decode <$> + LB.readFile (commentFolder show x)) currentLines + let hasComments = foldr (\l acc -> + case length l of + x | (x <= currentVersion) && (l !! currentVersion /= []) -> True + | otherwise -> acc + ) False commentVersionLists + case hasComments of + True -> do + B.writeFile (commentFolder <.> "versions" show (currentVersion + 1)) $ + T.encodeUtf8 latestSource + ensureVersionLines (currentVersion + 1) commentFolder + False -> return () + +addUserVersionLS :: Text -> FilePath -> IO () +addUserVersionLS userIdent' commentFolder = do + currentLines :: [Int] <- delete 0 . fmap read <$> listDirectory commentFolder + currentVersions :: [Int] <- fmap read <$> (listDirectory $ commentFolder <.> "versions") + commentVersionLists :: [[[CommentDesc]]] <- mapM (\x -> versions . fromJust . decode <$> + LB.readFile (commentFolder show x)) currentLines + let versionLS = map (\v -> VersionLS v . LineStatuses $ foldr (\l acc -> + case length l of + x | (x <= v) && (l !! v /= []) -> + (LineStatus (currentLines !! (fromJust $ + l `elemIndex` commentVersionLists)) "unread") : acc + | otherwise -> acc + ) [] commentVersionLists + ) currentVersions + LB.writeFile (commentFolder <.> "users" T.unpack userIdent') $ + 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 + let currentCount = + mapM_ (\x -> do + fileBool <- doesFileExist $ commentFolder show x + newLC <- case fileBool of + True -> do + Just (currentLC :: LineComment) <- decode <$> + LB.readFile (commentFolder show x) + return $ LineComment x (versions currentLC ++ [[]]) + False -> return $ LineComment x [[]] + LB.writeFile (commentFolder show x) $ encode newLC) [1..totalLines `max` currentLines] + +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 ['/', '.', '+'] + case identAllowed of + True -> return $ Left "User Identifier Has Unallowed Char(/+.)" + False -> do + fileBool <- doesFileExist commentHashPath + case fileBool of + True -> do + Just (currentUsers :: [UserDump]) <- decode <$> + LB.readFile (commentHashPath <.> "users") + let currentIdents = map uuserIdent currentUsers + case userIdent' `elem` currentIdents of + False -> do + B.writeFile userPath $ BC.pack commentHashPath + B.writeFile (userPath <.> "info") $ BC.pack name + LB.writeFile (commentHashPath <.> "users") $ encode (UserDump + userId' userIdent' (T.pack userPath) : currentUsers) + commentFolder <- BC.unpack <$> B.readFile commentHashPath + addUserVersionLS userIdent' commentFolder + return $ Right () + True -> return $ Left "User Identifier Already Exists" + False -> return $ Left "File Does Not Exists" + +addSelf :: BuildMode -> Text -> Text -> FilePath -> IO () +addSelf mode userId' userIdent' commentFolder = do + let commentHash = nameToCommentHash commentFolder + commentHashPath = commentHashRootDir mode commentHashLink commentHash + createDirectoryIfMissing False commentFolder + ensureCommentHashDir mode commentHash + B.writeFile commentHashPath $ BC.pack commentFolder + LB.writeFile (commentHashPath <.> "users") $ encode . UserDump + userId' userIdent' $ T.pack $ drop (length commentFolder - 9) commentFolder + createDirectoryIfMissing False $ commentFolder <.> "users" + createDirectoryIfMissing False $ commentFolder <.> "versions" + Just (project :: Project) <- decode <$> + (LB.readFile $ take (length commentFolder - 9) commentFolder) + B.writeFile (commentFolder <.> "versions" "0") $ T.encodeUtf8 . projectSource $ project + ensureVersionLines 0 commentFolder + addUserVersionLS userIdent' $ commentFolder + +listUnreadComments :: Text -> FilePath -> Int -> IO [Int] +listUnreadComments userIdent' commentFolder versionNo' = do + Just (versionLS :: VersionLS_) <- decode <$> + LB.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) <- decode <$> LB.readFile (commentFolder show lineNo') + return $ (versions lc) !! versionNo' + +markReadComments :: Text -> FilePath -> Int -> Int -> IO () +markReadComments userIdent' commentFolder lineNo' versionNo' = do + Just (versionLS :: VersionLS_) <- decode <$> + LB.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) + LB.writeFile (commentFolder <.> "users" T.unpack userIdent') $ + encode . VersionLS_ $ fst spnll ++ (newLineList : (tail $ snd spnll)) + +addCommentToFile :: FilePath -> Int -> Int -> CommentDesc -> IO () +addCommentToFile commentFolder lineNo' versionNo' comment' = do + Just (lc :: LineComment) <- decode <$> LB.readFile (commentFolder show lineNo') + let newComments = ((versions lc) !! versionNo') ++ [comment'] + spvn = splitAt versionNo' (versions lc) LB.writeFile (commentFolder show lineNo') $ encode (LineComment lineNo' $ - comments lc ++ [comment']) + 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_) <- decode <$> + LB.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) + LB.writeFile (commentFolder <.> "users" T.unpack userIdent') $ + encode . VersionLS_ $ fst spnll ++ (newLineList : (tail $ snd spnll)) -addReplyToComment :: FilePath -> Int -> CommentDesc -> ReplyDesc -> IO () -addReplyToComment commentFolder lineNo' cd rd = do +addReplyToComment :: FilePath -> Int -> Int -> CommentDesc -> ReplyDesc -> IO () +addReplyToComment commentFolder lineNo' versionNo' cd rd = do Just (lc :: LineComment) <- decode <$> LB.readFile (commentFolder show lineNo') - let Just ind = elemIndex cd (comments lc) - newcd = CommentDesc (userIdent cd) (dateTime cd) (comment cd) (replies cd ++ [rd]) - splc = splitAt ind $ comments lc - newlc = LineComment lineNo' $ (fst splc) ++ (newcd : (tail $ snd splc)) + 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)) LB.writeFile (commentFolder show lineNo') $ encode newlc -deleteCommentFromFile :: FilePath -> Int -> CommentDesc -> IO () -deleteCommentFromFile commentFolder lineNo' cd = do +deleteCommentFromFile :: FilePath -> Int -> Int -> CommentDesc -> IO () +deleteCommentFromFile commentFolder lineNo' versionNo' cd = do Just (lc :: LineComment) <- decode <$> LB.readFile (commentFolder show lineNo') - let Just ind = elemIndex cd (comments lc) - newcd = CommentDesc "none" (dateTime cd) "deleted" (replies cd) - splc = splitAt ind $ comments lc - newlc = LineComment lineNo' $ (fst splc) ++ (if (length $ replies cd) /= 0 - then newcd : (tail $ snd splc) - else tail $ snd splc) + 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)) LB.writeFile (commentFolder show lineNo') $ encode newlc -deleteReplyFromComment :: FilePath -> Int -> CommentDesc -> ReplyDesc -> IO () -deleteReplyFromComment commentFolder lineNo' cd rd = do +deleteReplyFromComment :: FilePath -> Int -> Int -> CommentDesc -> ReplyDesc -> IO () +deleteReplyFromComment commentFolder lineNo' versionNo' cd rd = do Just (lc :: LineComment) <- decode <$> LB.readFile (commentFolder show lineNo') - let Just cdInd = elemIndex cd (comments lc) + let Just cdInd = elemIndex cd ((versions lc) !! versionNo') Just rdInd = elemIndex rd (replies cd) - splc = splitAt cdInd $ comments lc + spvn = splitAt cdInd $ (versions lc) !! versionNo' + splc = splitAt versionNo' $ versions lc spcd = splitAt rdInd $ replies cd - newcd = CommentDesc (userIdent cd) (dateTime cd) (comment cd) $ + newcd = CommentDesc (cuserIdent cd) (cdateTime cd) (cstatus cd) (comment cd) $ (fst spcd) ++ (tail $ snd spcd) - newlc = LineComment lineNo' $ (fst splc) ++ (newcd : (tail $ snd splc)) + 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)) LB.writeFile (commentFolder show lineNo') $ encode newlc diff --git a/codeworld-server/src/Comment_.hs b/codeworld-server/src/Comment_.hs new file mode 100644 index 000000000..97ecf948c --- /dev/null +++ b/codeworld-server/src/Comment_.hs @@ -0,0 +1,390 @@ +{-# 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_ 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 Data.List +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", getUserIdent clientId) + , ("listComments", listCommentsHandler clientId) + , ("listOwnerComments", listOwnerCommentsHandler clientId) + , ("listOwnerVersions", listOwnerVersionsHandler clientId) + , ("listUnreadComments", listUnreadCommentsHandler clientId) + , ("listUnreadOwnerComments", listUnreadOwnerCommentsHandler clientId) + , ("listVersions", listVersionsHandler clientId) + , ("readComment", readCommentHandler clientId) + , ("readOwnerComment", readOwnerCommentHandler clientId) + , ("viewCommentSource", viewCommentSourceHandler clientId) + , ("writeComment", writeCommentHandler clientId) + , ("writeOwnerComment", writeOwnerCommentHandler clientId) + , ("writeOwnerReply", writeOwnerReplyHandler clientId) + , ("writeReply", writeReplyHandler clientId) + ] + +getFrequentParams :: Int -> ClientId -> Snap (User, BuildMode, FilePath) +getFrequentParams getType clientId = do + user <- getUser clientId + mode <- getBuildMode + case getType of + 1 -> 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' + commentFolder = commentRootDir mode (userId user) finalDir projectId + case path' !! 0 of + x | x /= "commentables" -> do + return (user, mode, commentFolder) + 2 -> do + Just commentHash <- fmap (CommentId . T.decodeUtf8) <$> getParam "chash" + commentFolder <- liftIO $ + BC.unpack <$> B.readFile (commentHashRootDir mode commentHashLink commentHash) + return (user, mode, commentFolder) + _ -> 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) + +addSharedCommentHandler :: ClientId -> Snap () +addSharedCommentHandler clientId = do + (user, mode, commentFolder) <- getFrequentParams 2 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' (T.unpack name) + (finalDir commentProjectLink projectId) + (commentHashRootDir mode commentHashLink commentHash) + case res of + Left err -> do + modifyResponse $ setContentType "text/plain" + modifyResponse $ setResponseCode 500 + writeBS . BC.pack $ err + Right _ -> return () + _ -> do + modifyResponse $ setContentType "text/plain" + writeBS . BC.pack $ "Shared Comments Should Be In `commentables` Directory" + +commentShareHandler :: ClientId -> Snap () +commentShareHandler clientId = do + (_, _, commentFolder) <- getFrequentParams 1 clientId + modifyResponse $ setContentType "text/plain" + writeBS . T.encodeUtf8 . unCommentId . nameToCommentHash $ commentFolder + +deleteCommentHandler :: ClientId -> Snap () +deleteCommentHandler clientId = do + (user, mode, commentFolder) <- getFrequentParams 3 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 $ + decode <$> LB.readFile (commentHashPath <.> "users") + let currentUserIds = map uuserId currentUsers + case (userId user) `elemIndex` currentUserIds of + Just ind -> do + let userIdent' = uuserIdent (currentUsers !! ind) + case userIdent' == cuserIdent comment' of + True -> liftIO $ do + deleteCommentFromFile commentFolder lineNo' versionNo' comment' + False -> do + modifyResponse $ setContentType "text/plain" + modifyResponse $ setResponseCode 500 + writeBS . BC.pack $ "User Identifier Not Allowed To Delete This Comment" + Nothing -> do + modifyResponse $ setContentType "text/plain" + modifyResponse $ setResponseCode 500 + writeBS . BC.pack $ "User Identifier Not Found" + +deleteOwnerCommentHandler :: ClientId -> Snap () +deleteOwnerCommentHandler clientId = do + (_, _, commentFolder) <- getFrequentParams 1 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" + case T.pack "Anonymous Owner" == cuserIdent comment' of + True -> liftIO $ do + deleteCommentFromFile commentFolder lineNo' versionNo' comment' + False -> do + modifyResponse $ setContentType "text/plain" + modifyResponse $ setResponseCode 500 + writeBS . BC.pack $ "User Identifier Not Allowed To Delete This Comment" + +deleteOwnerReplyHandler :: ClientId -> Snap () +deleteOwnerReplyHandler clientId = do + (_, _, commentFolder) <- getFrequentParams 1 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" + case T.pack "Anonymous Owner" == ruserIdent reply' of + True -> liftIO $ do + deleteReplyFromComment commentFolder lineNo' versionNo' comment' reply' + False -> do + modifyResponse $ setContentType "text/plain" + modifyResponse $ setResponseCode 500 + writeBS . BC.pack $ "User Identifier Not Allowed To Delete This Reply" + +deleteReplyHandler :: ClientId -> Snap () +deleteReplyHandler clientId = do + (user, mode, commentFolder) <- getFrequentParams 3 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 $ + decode <$> LB.readFile (commentHashPath <.> "users") + let currentUserIds = map uuserId currentUsers + case (userId user) `elemIndex` currentUserIds of + Just ind -> do + let userIdent' = uuserIdent (currentUsers !! ind) + case userIdent' == cuserIdent comment' of + True -> liftIO $ do + deleteReplyFromComment commentFolder lineNo' versionNo' comment' reply' + False -> do + modifyResponse $ setContentType "text/plain" + modifyResponse $ setResponseCode 500 + writeBS . BC.pack $ "User Identifier Not Allowed To Delete This Reply" + Nothing -> do + modifyResponse $ setContentType "text/plain" + modifyResponse $ setResponseCode 500 + writeBS . BC.pack $ "User Identifier Not Found" + +getUserIdent :: ClientId -> Snap () +getUserIdent clientId = do + (user, mode, commentFolder) <- getFrequentParams 3 clientId + let commentHash = nameToCommentHash commentFolder + commentHashPath = commentHashRootDir mode commentHashLink commentHash + Just (currentUsers :: [UserDump]) <- liftIO $ + decode <$> LB.readFile (commentHashPath <.> "users") + let currentUserIds = map uuserId currentUsers + case (userId user) `elemIndex` currentUserIds of + Just ind -> do + modifyResponse $ setContentType "text/plain" + modifyResponse $ setResponseCode 500 + writeBS . T.encodeUtf8 . uuserIdent $ currentUsers !! ind + Nothing -> do + modifyResponse $ setContentType "text/plain" + modifyResponse $ setResponseCode 500 + writeBS . BC.pack $ "User Identifier Not Found" + +listCommentsHandler :: ClientId -> Snap () +listCommentsHandler clientId = do + (_, _, commentFolder) <- getFrequentParams 3 clientId + modifyResponse $ setContentType "application/json" + writeLBS =<< (liftIO $ encode <$> listDirectory commentFolder) + +listOwnerCommentsHandler :: ClientId -> Snap () +listOwnerCommentsHandler clientId = do + (_, _, commentFolder) <- getFrequentParams 1 clientId + modifyResponse $ setContentType "application/json" + writeLBS =<< (liftIO $ encode <$> listDirectory commentFolder) + +listOwnerVersionsHandler :: ClientId -> Snap () +listOwnerVersionsHandler clientId = do + (_, _, commentFolder) <- getFrequentParams 1 clientId + modifyResponse $ setContentType "application/json" + writeLBS =<< (liftIO $ encode <$> listDirectory (commentFolder <.> "versions")) + +listUnreadCommentsHandler :: ClientId -> Snap () +listUnreadCommentsHandler clientId = do + (user, mode, commentFolder) <- getFrequentParams 3 clientId + Just (versionNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "versionNo" + let commentHash = nameToCommentHash commentFolder + commentHashPath = commentHashRootDir mode commentHashLink commentHash + Just (currentUsers :: [UserDump]) <- liftIO $ + decode <$> LB.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 + (_, _, commentFolder) <- getFrequentParams 1 clientId + Just (versionNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "versionNo" + unreadComments <- liftIO $ listUnreadComments "Anonymous Owner" commentFolder versionNo' + modifyResponse $ setContentType "application/json" + writeLBS . encode $ unreadComments + +listVersionsHandler :: ClientId -> Snap () +listVersionsHandler clientId = do + (_, _, commentFolder) <- getFrequentParams 3 clientId + modifyResponse $ setContentType "application/json" + writeLBS =<< (liftIO $ encode <$> listDirectory (commentFolder <.> "versions")) + +readCommentHandler :: ClientId -> Snap () +readCommentHandler clientId = do + (user, mode, commentFolder) <- getFrequentParams 3 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 $ + decode <$> LB.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 500 + writeBS . BC.pack $ "User Identifier Not Found" + +readOwnerCommentHandler :: ClientId -> Snap () +readOwnerCommentHandler clientId = do + (_, _, commentFolder) <- getFrequentParams 1 clientId + Just (lineNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "lineNo" + Just (versionNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "versionNo" + comments' <- liftIO $ getLineComment commentFolder lineNo' versionNo' + liftIO $ markReadComments "Anonymous Owner" commentFolder lineNo' versionNo' + modifyResponse $ setContentType "application/json" + writeLBS (encode comments') + +viewCommentSourceHandler :: ClientId -> Snap () +viewCommentSourceHandler clientId = do + (_, _, commentFolder) <- getFrequentParams 3 clientId + Just (versionNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "versionNo" + currentSource <- B.readFile (commentFolder <.> "versions" show versionNo') + modifyResponse $ setContentType "text/x-haskell" + writeBS currentSource + +writeCommentHandler :: ClientId -> Snap () +writeCommentHandler clientId = do + (user, mode, commentFolder) <- getFrequentParams 3 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 $ + decode <$> LB.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 500 + writeBS . BC.pack $ "User Identifier Not Found" + +writeOwnerCommentHandler :: ClientId -> Snap () +writeOwnerCommentHandler clientId = do + (_, _, commentFolder) <- getFrequentParams 1 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 commentDesc = CommentDesc "Anonymous Owner" dateTime' "present" comment' [] + liftIO $ do + addCommentToFile commentFolder lineNo' versionNo' commentDesc + markUnreadComments "Anonymous Owner" commentFolder lineNo' versionNo' + +writeOwnerReplyHandler :: ClientId -> Snap () +writeOwnerReplyHandler clientId = do + (_, _, commentFolder) <- getFrequentParams 1 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 replyDesc = ReplyDesc "Anonymous Owner" dateTime' "present" reply' + liftIO $ do + addReplyToComment commentFolder lineNo' versionNo' comment' replyDesc + +writeReplyHandler :: ClientId -> Snap () +writeReplyHandler clientId = do + (user, mode, commentFolder) <- getFrequentParams 3 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 $ + decode <$> LB.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 500 + writeBS . BC.pack $ "User Identifier Not Found" diff --git a/codeworld-server/src/DataUtil.hs b/codeworld-server/src/DataUtil.hs index a4b644f6f..35cb395f5 100644 --- a/codeworld-server/src/DataUtil.hs +++ b/codeworld-server/src/DataUtil.hs @@ -28,6 +28,7 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC import qualified Data.ByteString.Base64 as B64 import qualified Data.ByteString.Lazy as LB +import Data.List import Data.Maybe import Data.Monoid import Data.Text (Text) @@ -164,8 +165,14 @@ projectFileNames subHashedDirs = do hashedFiles <- dirFilter subHashedDirs 'S' projects <- fmap catMaybes $ forM hashedFiles $ \f -> do exists <- doesFileExist f - if exists then decode <$> LB.readFile f else return Nothing - return $ map projectName projects + case reverse f of + x | take 3 x == "wc." && length x == 26 -> + if exists then (fmap projectName) <$> (decode <$> LB.readFile f) + else return Nothing + x | take 5 x == "ofni." && length x == 28 -> + if exists then Just . T.decodeUtf8 <$> B.readFile f else return Nothing + _ -> return Nothing + return projects projectDirNames :: [FilePath] -> IO [Text] projectDirNames subHashedDirs = do @@ -190,7 +197,8 @@ isDir path = do migrateUser :: FilePath -> IO () migrateUser userRoot = do - prevContent <- filter (\x -> take 3 (reverse x) == "wc.") <$> listDirectory userRoot + 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 @@ -199,9 +207,17 @@ getFilesRecursive path = do dirBool <- isDir path case dirBool of True -> do - contents <- listDirectory path - concat <$> mapM (getFilesRecursive . (path )) contents - False -> return [path] + case path of + x | isSuffixOf ".comments" (drop 23 x) -> return [] + | isSuffixOf ".comments.users" (drop 23 x) -> return [] + | isSuffixOf ".comments.versions" (drop 23 x) -> return [] + | otherwise -> do + contents <- listDirectory path + concat <$> mapM (getFilesRecursive . (path )) contents + False -> case reverse path of + x | isSuffixOf ".info" (drop 23 x) -> return [] + | x == "dir.info" -> return [] + | otherwise -> return [path] dirToCheckSum :: FilePath -> IO Text dirToCheckSum path = do @@ -233,7 +249,10 @@ hashToId pfx = (pfx <>) toWebSafe c = c copyDirIfExists :: FilePath -> FilePath -> IO () -copyDirIfExists folder1 folder2 = getDirectory folder1 >>= copyTo_ folder2 +copyDirIfExists folder1 folder2 = (getDirectory folder1 >>= copyTo_ folder2) `catch` handleExists + where handleExists e + | isDoesNotExistError e = return () + | otherwise = throwIO e removeFileIfExists :: FilePath -> IO () removeFileIfExists fileName = removeFile fileName `catch` handleExists diff --git a/codeworld-server/src/Folder.hs b/codeworld-server/src/Folder.hs index 7314caf0f..d1f56bb1f 100644 --- a/codeworld-server/src/Folder.hs +++ b/codeworld-server/src/Folder.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE CPP #-} - {- Copyright 2017 The CodeWorld Authors. All rights reserved. @@ -17,173 +14,6 @@ limitations under the License. -} -module Folder 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 (sort) -import Data.Maybe (fromJust) -import Snap.Core -import Snap.Util.FileServe -import System.Directory -import System.FilePath - -import DataUtil -import Model -import SnapUtil - -folderRoutes :: ClientId -> [(B.ByteString, Snap ())] -folderRoutes clientId = - [ ("createFolder", createFolderHandler clientId) - , ("deleteFolder", deleteFolderHandler clientId) - , ("deleteProject", deleteProjectHandler clientId) - , ("listFolder", listFolderHandler clientId) - , ("loadProject", loadProjectHandler clientId) - , ("moveProject", moveProjectHandler clientId) - , ("shareContent", shareContentHandler clientId) - , ("shareFolder", shareFolderHandler clientId) - , ("saveProject", saveProjectHandler clientId) - ] - -getFrequentParams :: Bool -> ClientId -> Snap (User, BuildMode, FilePath, Maybe ProjectId) -getFrequentParams file clientId = do - user <- getUser clientId - mode <- getBuildMode - Just path' <- fmap (splitDirectories . BC.unpack) <$> getParam "path" - let finalDir = joinPath $ map (dirBase . nameToDirId . T.pack) path' - case file of - True -> do - Just name <- getParam "name" - let projectId = nameToProjectId $ T.decodeUtf8 name - return (user, mode, finalDir, Just projectId) - False -> return (user, mode, finalDir, Nothing) - -createFolderHandler :: ClientId -> Snap () -createFolderHandler clientId = do - (user, mode, finalDir, _) <- getFrequentParams False clientId - Just path' <- fmap (splitDirectories . BC.unpack) <$> getParam "path" - liftIO $ ensureUserBaseDir mode (userId user) finalDir - liftIO $ createDirectory $ userProjectDir mode (userId user) finalDir - liftIO $ B.writeFile (userProjectDir mode (userId user) finalDir "dir.info") $ - BC.pack $ last path' - -deleteFolderHandler :: ClientId -> Snap () -deleteFolderHandler clientId = do - (user, mode, finalDir, _) <- getFrequentParams False clientId - 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' - -deleteProjectHandler :: ClientId -> Snap () -deleteProjectHandler clientId = do - (user, mode, finalDir, Just projectId) <- getFrequentParams True clientId - let file = userProjectDir mode (userId user) finalDir projectFile projectId - liftIO $ removeFileIfExists file - liftIO $ removeDirectoryIfExists $ file <.> "comments" - empty <- liftIO $ fmap - (\ l1 -> - length l1 == 2 && sort l1 == sort [".", ".."]) - (getDirectoryContents (dropFileName file)) - liftIO $ if empty then removeDirectoryIfExists (dropFileName file) - else return () - -listFolderHandler :: ClientId -> Snap () -listFolderHandler clientId = do - (user, mode, finalDir, _) <- getFrequentParams False clientId - 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')) - -loadProjectHandler :: ClientId -> Snap () -loadProjectHandler clientId = do - (user, mode, finalDir, Just projectId) <- getFrequentParams True clientId - let file = userProjectDir mode (userId user) finalDir projectFile projectId - modifyResponse $ setContentType "application/json" - serveFile file - -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) - Just isFile <- getParam "isFile" - case (moveTo == moveFrom, isFile) of - (False, "true") -> do - Just name <- getParam "name" - let projectId = nameToProjectId $ T.decodeUtf8 name - liftIO $ ensureProjectDir mode (userId user) moveToDir projectId - liftIO $ copyDirIfExists (dropFileName $ moveFromDir projectFile projectId) - (dropFileName $ projectDir moveToDir projectFile projectId) - let file = moveFromDir projectFile projectId - liftIO $ removeFileIfExists file - liftIO $ removeDirectoryIfExists $ file <.> "comments" - empty <- liftIO $ fmap - (\ l1 -> - length l1 == 2 && - sort l1 == sort [".", ".."]) - (getDirectoryContents - (dropFileName file)) - liftIO $ if empty then removeDirectoryIfExists (dropFileName file) - else return () - (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 () - -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 - -shareFolderHandler :: ClientId -> Snap () -shareFolderHandler clientId = do - (user, mode, finalDir, _) <- getFrequentParams False clientId - 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 +module Folder (module Folder__) where -saveProjectHandler :: ClientId -> Snap () -saveProjectHandler clientId = do - (user, mode, finalDir, _) <- getFrequentParams False clientId - 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 +import Folder_ as Folder__ hiding (getFrequentParams) diff --git a/codeworld-server/src/Folder_.hs b/codeworld-server/src/Folder_.hs new file mode 100644 index 000000000..f8181594a --- /dev/null +++ b/codeworld-server/src/Folder_.hs @@ -0,0 +1,322 @@ +{-# 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 Folder_ 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 (sort) +import Data.Maybe (fromJust) +import Snap.Core +import Snap.Util.FileServe +import System.Directory +import System.FilePath + +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) + ] + +getFrequentParams :: Bool -> ClientId -> Snap (User, BuildMode, FilePath, Maybe ProjectId) +getFrequentParams file clientId = do + user <- getUser clientId + mode <- getBuildMode + Just path' <- fmap (splitDirectories . BC.unpack) <$> getParam "path" + let finalDir = case length path' of + 0 -> "" + _ | path' !! 0 == "commentables" -> "commentables" (joinPath $ + map (dirBase . nameToDirId . T.pack) $ tail path') + | otherwise -> joinPath $ map (dirBase . nameToDirId . T.pack) path' + case file of + True -> do + Just name <- getParam "name" + let projectId = nameToProjectId $ T.decodeUtf8 name + return (user, mode, finalDir, Just projectId) + False -> 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 copyToDir = joinPath $ map (dirBase . nameToDirId . T.pack) copyTo + projectDir = userProjectDir mode (userId user) + copyFromDir = case length copyFrom of + 0 -> "" + _ -> | copyFrom !! 0 == "commentables" -> + "commentables" (joinPath $ + map (dirBase . nameToDirId . T.pack) $ tail copyFrom) + | otherwise -> + joinPath $ map (dirBase . nameToDirId . T.pack) copyFrom + Just isFile <- getParam "isFile" + case length copyTo of + x | (x > 0) && copyTo !! 0 == "commentables" -> do + modifyResponse $ setContentType "text/plain" + modifyResponse $ setResponseCode 500 + writeBS . BC.pack "Cannot Copy Something Into `commentables` Directory" + | otherwise -> do + case (copyTo == copyFrom, isFile) of + (False, "true") -> do + Just name <- getParam "name" + Just (project :: Project) <- decodeStrict . fromJust <$> getParam "project" + let projectId = nameToProjectId $ T.decodeUtf8 name + toFile = projectDir copyToDir projectFile projectId + cleanCommentPaths mode $ toFile <.> "comments" + ensureProjectDir mode (userId user) copyToDir projectId + LB.writeFile toFile $ encode $ + Project (T.decodeUtf8 name) (projectSource project) (projectHistory project) + addSelf mode (userId user) "Anonymous Owner" $ toFile <.> "comments" + (False, "false") -> do + Just name <- fmap (BC.unpack) <$> getParam "name" + Just (emptyPH :: Value) <- decode . LB.fromStrict . fromJust <$> getParam "empty" + let toDir = joinPath $ map (dirBase . nameToDirId . T.pack) (copyTo ++ [name]) + case length copyFrom of + x | (x > 0) && copyFrom !! 0 == "commentables" -> do + let projectDir = userProjectDir mode (userId user) + dirBool <- doesDirectoryExist (projectDir toDir) + case dirBool of + True -> do + res <- liftIO $ deleteFolderWithComments mode (userId user) toDir + case res of + Left err -> do + modifyResponse $ setContentType "text/plain" + modifyResponse $ setResponseCode 500 + writeBS . BC.pack $ err + Right _ -> return () + False -> return () + liftIO $ copyDirFromCommentables mode (userId user) + (projectDir toDir) (projectDir copyFrom) emptyPH + | otherwise -> do + + (_, _) -> return () + +createFolderHandler :: ClientId -> Snap () +createFolderHandler clientId = do + (user, mode, finalDir, _) <- getFrequentParams False clientId + case finalDir == "commentables" of + True -> do + modifyResponse $ setContentType "text/plain" + modifyResponse $ setResponseCode 500 + writeBS . BC.pack $ + "`commentables` Hash Directory Is Forbidden In Root Folder For User Use" + False -> do + Just path' <- fmap (splitDirectories . BC.unpack) <$> getParam "path" + liftIO $ do + 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 500 + writeBS . BC.pack $ err + Right _ -> return () + False -> return () + ensureUserBaseDir mode (userId user) finalDir + createDirectory $ userProjectDir mode (userId user) finalDir + B.writeFile (userProjectDir mode (userId user) finalDir "dir.info") $ + BC.pack $ last path' + +deleteFolderHandler :: ClientId -> Snap () +deleteFolderHandler clientId = do + (user, mode, finalDir, _) <- getFrequentParams False clientId + res <- liftIO $ deleteFolderWithComments mode (userId user) finalDir + case res of + Left err -> do + modifyResponse $ setContentType "text/plain" + modifyResponse $ setResponseCode 500 + writeBS . BC.pack $ err + Right _ -> return () + +deleteProjectHandler :: ClientId -> Snap () +deleteProjectHandler clientId = do + (user, mode, finalDir, Just projectId) <- getFrequentParams True clientId + case length (splitDirectories finalDir) of + x | (x /= 0) && ((splitDirectories finalDir) !! 0 == "commentables") -> do + let file = userProjectDir mode (userId user) + finalDir commentProjectLink projectId + removeUserFromComments mode (userId user) file + | otherwise -> do + let file = userProjectDir mode (userId user) finalDir projectFile projectId + liftIO $ cleanCommentPaths mode (file <.> "comments") + +listFolderHandler :: ClientId -> Snap () +listFolderHandler clientId = do + (user, mode, finalDir, _) <- getFrequentParams False clientId + liftIO $ migrateUser $ userProjectDir mode (userId user) + liftIO $ 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 True clientId + case length (splitDirectories finalDir) of + x | (x /= 0) && ((splitDirectories finalDir) !! 0 == "commentables") -> do + modifyResponse $ setContentType "text/plain" + modifyResponse $ setResponseCode 500 + writeBS . BC.pack $ "Wrong Route To View A Source In `commentables` Directory" + | otherwise -> do + let file = userProjectDir mode (userId user) finalDir projectFile projectId + modifyResponse $ setContentType "application/json" + serveFile file + +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 moveToDir = joinPath $ map (dirBase . nameToDirId . T.pack) moveTo + moveFromDir = projectDir joinPath (map (dirBase . nameToDirId . T.pack) moveFrom) + projectDir = userProjectDir mode (userId user) + Just isFile <- getParam "isFile" + case (moveTo == moveFrom, 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 $ do + removeFileIfExists toFile + removeDirectoryIfExists $ toFile <.> "comments" + ensureProjectDir mode (userId user) moveToDir projectId + copyFile file toFile + copyDirIfExists (file <.> "comments") (toFile <.> "comments") + removeFileIfExists file + removeDirectoryIfExists $ file <.> "comments" + removeCommentHash mode $ file <.> "comments" + empty <- fmap + (\ l1 -> + length l1 == 2 && + sort l1 == sort [".", ".."]) + (getDirectoryContents (dropFileName file)) + if empty then removeDirectoryIfExists (dropFileName file) + else return () + (False, "false") -> do + let dirName = last $ splitDirectories moveFromDir + dir' = moveToDir take 3 dirName dirName + liftIO $ do + ensureUserBaseDir mode (userId user) dir' + copyDirIfExists moveFromDir $ projectDir dir' + empty <- fmap + (\ l1 -> + length l1 == 3 && + sort l1 == sort [".", "..", takeFileName moveFromDir]) + (getDirectoryContents (takeDirectory moveFromDir)) + removeDirectoryIfExists $ + if empty then takeDirectory moveFromDir else moveFromDir + (_, _) -> return () + +newProjectHandler :: ClientId -> Snap () +newProjectHandler clientId = do + (user, mode, finalDir, _) <- getFrequentParams False clientId + case length (splitDirectories finalDir) of + x | (x /= 0) && ((splitDirectories finalDir) !! 0 == "commentables") -> do + modifyResponse $ setContentType "text/plain" + modifyResponse $ setResponseCode 500 + writeBS . BC.pack $ "`commentables` Directory Does Not Allows New Projects" + | otherwise -> do + Just (project :: Project) <- decode . LB.fromStrict . fromJust <$> getParam "project" + let projectId = nameToProjectId (projectName project) + file = userProjectDir mode (userId user) finalDir projectFile projectId + liftIO $ do + ensureProjectDir mode (userId user) finalDir projectId + cleanCommentPaths mode $ file <.> "comments" + LB.writeFile file $ encode project + addSelf mode (userId user) "Anonymous Owner" $ file <.> "comments" + +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 $ do + ensureUserBaseDir mode (userId user) dirPath + copyDirIfExists (BC.unpack sharingFolder) $ + userProjectDir mode (userId user) dirPath + B.writeFile (userProjectDir mode (userId user) dirPath "dir.info") name + +shareFolderHandler :: ClientId -> Snap () +shareFolderHandler clientId = do + (user, mode, finalDir, _) <- getFrequentParams False 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 False clientId + case length (splitDirectories finalDir) of + x | (x /= 0) && ((splitDirectories finalDir) !! 0 == "commentables") -> do + modifyResponse $ setContentType "text/plain" + modifyResponse $ setResponseCode 500 + writeBS . BC.pack $ "`commentables` Directory Does Not Allows Editing Projects" + | otherwise -> do + Just (project :: Project) <- decode . LB.fromStrict . fromJust <$> getParam "project" + let projectId = nameToProjectId (projectName project) + file = userProjectDir mode (userId user) finalDir projectFile projectId + liftIO $ do + ensureProjectDir mode (userId user) finalDir projectId + LB.writeFile file $ encode project + createNewVersionIfReq (projectSource project) $ file <.> "comments" diff --git a/codeworld-server/src/Model.hs b/codeworld-server/src/Model.hs index c8bfaea0b..a964207c2 100644 --- a/codeworld-server/src/Model.hs +++ b/codeworld-server/src/Model.hs @@ -20,7 +20,9 @@ module Model where import Control.Monad import Data.Aeson -import Data.Text (Text) +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 } @@ -50,7 +52,7 @@ instance ToJSON Project where data Directory = Directory { files :: [Text], dirs :: [Text] - } deriving Show + } instance ToJSON Directory where toJSON dir = object [ "files" .= files dir, @@ -68,23 +70,27 @@ instance ToJSON CompileResult where 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 { - userIdent :: Text, - dateTime :: UTCTime, + cuserIdent :: Text, + cdateTime :: UTCTime, + cstatus :: Text, comment :: Text, replies :: [ReplyDesc] } deriving (Eq) @@ -92,26 +98,79 @@ data CommentDesc = CommentDesc { 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" .= userIdent cd, - "dateTime" .= dateTime cd, + 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 - comments :: [CommentDesc] + versions :: [[CommentDesc]] } instance FromJSON LineComment where parseJSON (Object o) = LineComment <$> o .: "lineNo" - <*> o .: "comments" + <*> o .: "versions" parseJSON _ = mzero instance ToJSON LineComment where - toJSON lc = object [ "lineNo" .= lineNo lc, - "comments" .= comments lc ] + 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 + } deriving (Eq) + +instance FromJSON UserDump where + parseJSON (Object o) = UserDump <$> o .: "userId" + <*> o .: "userIdent" + <*> o .: "path" + parseJSON _ = mzero + +instance ToJSON UserDump where + toJSON ud = object [ "userId" .= uuserId ud, + "userIdent" .= uuserIdent ud, + "path" .= upath 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/web/js/codeworld.js b/web/js/codeworld.js index d4706963d..edec56bcd 100644 --- a/web/js/codeworld.js +++ b/web/js/codeworld.js @@ -357,6 +357,20 @@ function updateUI() { document.getElementById('moveButton').style.display = 'none'; } + /* if (window.lineSet != undefined) { + for (i of lineSet) { + document.getElementsByClassName('CodeMirror-gutter-elt')[Number(i) + 1].innerHTML = 'c ' + i; + } + } + //change that from elt to wrapper then find elt + var doc = window.codeworldEditor.getDoc(); + doc.eachLine(function(f) { + let line = f.lineNo() + f.on('delete', function() { + shiftLineByX(line, -1); + }); + });*/ + var title; if (window.openProjectName) { title = window.openProjectName; @@ -498,9 +512,12 @@ function moveProject() { var tempOpen = openProjectName; var tempPath = nestedDirs.slice(1).join('/'); setCode(''); - nestedDirs = [""]; - allProjectNames = [[]]; - allFolderNames = [[]]; + 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'; @@ -657,6 +674,13 @@ function loadProject(name, index) { } function successFunc(project){ setCode(project.source, project.history, name); + addPresentCommentInd(); + /*var doc = window.codeworldEditor.getDoc(); + doc.eachLine(function(f) { + f.on('delete', function() { + shiftLineByX(f.lineNo(), -1); + }); + });*/ } loadProject_(index, name, window.buildMode, successFunc); } diff --git a/web/js/codeworld_comments.js b/web/js/codeworld_comments.js index d0e19fb7c..bd9305669 100644 --- a/web/js/codeworld_comments.js +++ b/web/js/codeworld_comments.js @@ -95,6 +95,44 @@ function shareForFeedback() { }); } +function addPresentCommentInd() { + /* if (!signedIn()) { + sweelAlert('Oops!', 'You must sign in to see and write comments!', 'error'); + return; + } + + function go(request) { + if (request.status != 200) { + sweetAlert('Oops!', 'Sorry! Could not load an indicator of where comments are present.', 'error'); + return; + } + window.lineSet = new Set(JSON.parse(request.responseText)); + for (i of lineSet) { + document.getElementsByClassName('CodeMirror-gutter-elt')[Number(i) + 1].innerHTML = 'c ' + 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'; + } + } + + var data = new FormData(); + data.append('mode', window.buildMode); + data.append('id_token', auth2.currentUser.get().getAuthResponse().id_token); + if (window.chash != undefined){ + data.append('chash', window.chash); + sendHttp('POST', 'listComments', data, function(request) { + go(request); + }); + } else { + data.append('path', nestedDirs.slice(1).join('/')); + data.append('name', openProjectName); + sendHttp('POST', 'listOwnerComments', data, function(request) { + go(request); + }); + }*/ +} + function toggleUserComments(cm, line, gutter) { var hash = window.location.hash.slice(1); if (hash.length > 0) { @@ -483,6 +521,75 @@ function deleteReply(ind, commentIdx, line) { }); } } +/* +function shiftLineByX(lineNo, x) { + if (!signedIn()) { + sweetAlert('Oops!', 'Please sign in to continue, otherwise the comments in the file will be misplaced.', 'error'); + return; + } + if (openProjectName == null || openProjectName == '') { + return; + } + if (window.openCommentLines != undefined) { + return; + } + console.log(lineNo) + if (window.currentShift != undefined) { + if (window.pendingShifts == undefined) { + window.pendingShifts = [[],[]]; + } + if (openProjectName != window.currentShiftFile || nestedDirs.slice(1).join('/') != window.currentShiftDir) { + return; + } + window.pendingShifts[0].push(lineNo); + window.pendingShifts[1].push(x); + } else { + window.currentShift = [[lineNo], [x]]; + window.currentShiftFile = openProjectName; + window.currentShiftDir = nestedDirs.slice(1).join('/'); + var data = new FormData(); + data.append('id_token', auth2.currentUser.get().getAuthResponse().id_token); + data.append('mode', window.buildMode); + data.append('path', window.currentShiftDir); + data.append('name', window.currentShiftFile); + data.append('shifts', JSON.stringify([[lineNo], [x]])); + sendHttp('POST', 'shiftLinesByXs', data, function(request) { + if (request.status != 200) { + sweetAlert('Oops!', 'Could not update comments according to the new line changes! Reverting back to previous version.', 'error'); + revertBack(); + return; + } + if (window.pendingShifts != undefined) { + var data = new FormData(); + data.append('id_token', auth2.currentUser.get().getAuthResponse().id_token); + data.append('mode', window.buildMode); + data.append('path', window.currentShiftDir); + data.append('name', window.currentShiftFile); + data.append('shifts', JSON.stringify(window.pendingShifts)); + window.currentShift = window.pendingShifts; + window.pendingShifts = undefined; + sendHttp('POST', 'shiftLinesByXs', data, function(request) { + if (request.status != 200) { + sweetAlert('Oops!', 'Could not update comments according to the new line changes!', 'error'); + return; + } + window.currentShift = undefined; + window.currentShiftFile = undefined; + window.currentShiftDir = undefined; + }); + + } else { + window.currentShift = undefined; + window.currentShiftFile = undefined; + window.currentShiftDir = undefined; + } + }); + } +} + +function revertBack() { + +}*/ function randomString(length = 32, chars = '0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ') { var result = ''; diff --git a/web/js/codeworld_shared.js b/web/js/codeworld_shared.js index 8de3b95bc..272bf3949 100644 --- a/web/js/codeworld_shared.js +++ b/web/js/codeworld_shared.js @@ -594,6 +594,9 @@ function createFolder(path, buildMode, successFunc) { } allFolderNames[allFolderNames.length - 1].push(folderName); + nestedDirs.push(folderName); + allFolderNames.push([]); + allProjectNames.push([]); successFunc(); updateNavBar(); }); @@ -625,7 +628,6 @@ function newProject_(path) { return; } - sweetAlert.close(); setCode(''); saveProjectBase(path, fileName, 'create'); } @@ -644,7 +646,6 @@ function newProject_(path) { } function loadProject_(index, name, buildMode, successFunc) { - warnIfUnsaved(function(){ if (!signedIn()) { sweetAlert('Oops!', 'You must sign in to open projects.', 'error'); @@ -662,11 +663,11 @@ function loadProject_(index, name, buildMode, successFunc) { if (request.status == 200) { var project = JSON.parse(request.responseText); - successFunc(project); window.nestedDirs = nestedDirs.slice(0, index + 1); window.allProjectNames = allProjectNames.slice(0, index + 1); window.allFolderNames = allFolderNames.slice(0, index + 1); updateUI(); + successFunc(project); } }); }, false); From 220c1822f50e56dfbe7320b5c39fe1e65dbee23a Mon Sep 17 00:00:00 2001 From: Parv Mor Date: Sat, 22 Jul 2017 20:56:45 +0530 Subject: [PATCH 09/28] complete copy dir handler --- codeworld-server/src/CommentUtil.hs | 30 ++++++++++--- codeworld-server/src/DataUtil.hs | 13 ++++-- codeworld-server/src/Folder_.hs | 65 ++++++++++++++--------------- 3 files changed, 67 insertions(+), 41 deletions(-) diff --git a/codeworld-server/src/CommentUtil.hs b/codeworld-server/src/CommentUtil.hs index bfac16c48..0d39228cf 100644 --- a/codeworld-server/src/CommentUtil.hs +++ b/codeworld-server/src/CommentUtil.hs @@ -151,7 +151,6 @@ removeUserFromComments mode userId' userPath = do copyDirFromCommentables :: BuildMode -> Text -> FilePath -> FilePath -> Value -> IO () copyDirFromCommentables mode userId' toDir fromDir emptyPH = do - let projectId = userProjectDir mode userId' dirList <- listDirectoryWithPrefix fromDir dirFiles <- dirFilter dirList 'S' forM_ dirFiles $ \ f -> do @@ -164,14 +163,35 @@ copyDirFromCommentables mode userId' toDir fromDir emptyPH = do Just (project :: Project) <- decode <$> (LB.readFile $ take (length commentFolder - 9) commentFolder) fileName <- T.decodeUtf8 <$> B.readFile (f <.> "info") - createDirectoryIfMissing $ takeDirectory toDir - createDirectory $ toDir - B.writeFile () LB.writeFile (toDir file) $ encode (Project fileName (projectSource project) emptyPH) addSelf mode userId' "Anonynous Owner" (toDir file <.> "comments") dirDirs <- dirFilter dirList 'D' - + forM_ dirDirs $ \ d -> do + dirName <- BC.unpack <$> B.readFile (d "dir.info") + let newToDir = toDir (dirBase $ takeFileName d) + createNewFolder mode userId' newToDir dirName + copyDirFromCommentables mode userId' newToDir d emptyPH + +copyDirFromSelf :: BuildMode -> Text -> FilePath -> FilePath -> IO () +copyDirFromSelf mode userId' toDir fromDir = do + dirList <- listDirectoryWithPrefix fromDir + dirFiles <- dirFilter dirList 'S' + forM_ dirFiles $ \f -> do + let file = takeFileName f + fileBool <- doesFileExist f + case (fileBool, isSuffixOf ".cw" (drop 23 file)) of + (True, True) -> do + Just (project :: Project) <- decode <$> LB.readFile f + LB.writeFile (toDir file) $ encode project + addSelf mode userId' "Anonymous Owner" (toDir file <.> "comments") + (_, _) -> return () + dirDirs <- dirFilter dirList 'D' + forM_ dirDirs $ \ d -> do + dirName <- BC.unpack <$> B.readFile (d "dir.info") + let newToDir = toDir (dirBase $ takeFileName d) + createNewFolder mode userId' newToDir dirName + copyDirFromSelf mode userId' newToDir d createNewVersionIfReq :: Text -> FilePath -> IO () createNewVersionIfReq latestSource commentFolder = do diff --git a/codeworld-server/src/DataUtil.hs b/codeworld-server/src/DataUtil.hs index 35cb395f5..f9dd8546e 100644 --- a/codeworld-server/src/DataUtil.hs +++ b/codeworld-server/src/DataUtil.hs @@ -40,6 +40,7 @@ import System.FilePath import System.File.Tree (getDirectory, copyTo_) import System.Posix.Files +import CommentUtil (addSelf) import Model newtype BuildMode = BuildMode String deriving Eq @@ -153,6 +154,12 @@ ensureProjectDir mode userId' path projectId = do 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 @@ -250,9 +257,9 @@ hashToId pfx = (pfx <>) copyDirIfExists :: FilePath -> FilePath -> IO () copyDirIfExists folder1 folder2 = (getDirectory folder1 >>= copyTo_ folder2) `catch` handleExists - where handleExists e - | isDoesNotExistError e = return () - | otherwise = throwIO e + where handlerExists e + | isDoesNotExistError e = return () + | otherwise = throwIO e removeFileIfExists :: FilePath -> IO () removeFileIfExists fileName = removeFile fileName `catch` handleExists diff --git a/codeworld-server/src/Folder_.hs b/codeworld-server/src/Folder_.hs index f8181594a..7adb7a5e9 100644 --- a/codeworld-server/src/Folder_.hs +++ b/codeworld-server/src/Folder_.hs @@ -40,7 +40,7 @@ import SnapUtil folderRoutes :: ClientId -> [(B.ByteString, Snap ())] folderRoutes clientId = --- [ ("copyProject", copyProjectHandler clientId) + [ ("copyProject", copyProjectHandler clientId) , ("createFolder", createFolderHandler clientId) , ("deleteFolder", deleteFolderHandler clientId) , ("deleteProject", deleteProjectHandler clientId) @@ -107,24 +107,26 @@ copyProjectHandler clientId = do Just name <- fmap (BC.unpack) <$> getParam "name" Just (emptyPH :: Value) <- decode . LB.fromStrict . fromJust <$> getParam "empty" let toDir = joinPath $ map (dirBase . nameToDirId . T.pack) (copyTo ++ [name]) + projectDir = userProjectDir mode (userId user) + dirBool <- liftIO $ doesDirectroyExist (projectDir toDir) + case dirBool of + True -> do + res <- liftIO $ deleteFolderWithComments mode (userId user) toDir + case res of + Left err -> do + modifyResponse $ setContentType "text/plain" + modifyResponse $ setResponseCode 500 + writeBS . BC.pack $ err + Right _ -> return () + False -> return () + liftIO $ createNewFolder mode (userId user) toDir name case length copyFrom of - x | (x > 0) && copyFrom !! 0 == "commentables" -> do - let projectDir = userProjectDir mode (userId user) - dirBool <- doesDirectoryExist (projectDir toDir) - case dirBool of - True -> do - res <- liftIO $ deleteFolderWithComments mode (userId user) toDir - case res of - Left err -> do - modifyResponse $ setContentType "text/plain" - modifyResponse $ setResponseCode 500 - writeBS . BC.pack $ err - Right _ -> return () - False -> return () - liftIO $ copyDirFromCommentables mode (userId user) + x | (x > 0) && copyFrom !! 0 == "commentables" -> liftIO $ do + copyDirFromCommentables mode (userId user) (projectDir toDir) (projectDir copyFrom) emptyPH - | otherwise -> do - + | otherwise -> liftIO $ do + copyDirFromSelf mode (userId user) + (projectDir toDir) (projectDir fromDir) (_, _) -> return () createFolderHandler :: ClientId -> Snap () @@ -138,22 +140,19 @@ createFolderHandler clientId = do "`commentables` Hash Directory Is Forbidden In Root Folder For User Use" False -> do Just path' <- fmap (splitDirectories . BC.unpack) <$> getParam "path" - liftIO $ do - 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 500 - writeBS . BC.pack $ err - Right _ -> return () - False -> return () - ensureUserBaseDir mode (userId user) finalDir - createDirectory $ userProjectDir mode (userId user) finalDir - B.writeFile (userProjectDir mode (userId user) finalDir "dir.info") $ - BC.pack $ last 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 500 + writeBS . BC.pack $ err + Right _ -> do + createNewFolder mode (userId user) finaDir (last path') + False -> do + createNewFolder mode (userId user) finaDir (last path') deleteFolderHandler :: ClientId -> Snap () deleteFolderHandler clientId = do From f6dc72403ccdbe41249607d1bc05a9a020eb33ea Mon Sep 17 00:00:00 2001 From: Parv Mor Date: Mon, 24 Jul 2017 18:11:32 +0530 Subject: [PATCH 10/28] Fixes type mismatches --- codeworld-server/src/CommentUtil.hs | 54 ++++++++++++++--------------- codeworld-server/src/Comment_.hs | 4 +-- codeworld-server/src/DataUtil.hs | 3 +- codeworld-server/src/Folder_.hs | 43 ++++++++++++----------- 4 files changed, 52 insertions(+), 52 deletions(-) diff --git a/codeworld-server/src/CommentUtil.hs b/codeworld-server/src/CommentUtil.hs index 0d39228cf..678eff509 100644 --- a/codeworld-server/src/CommentUtil.hs +++ b/codeworld-server/src/CommentUtil.hs @@ -77,20 +77,20 @@ cleanCommentPaths mode commentFolder = do removeDirectoryIfExists commentFolder removeDirectoryIfExists $ commentFolder <.> "users" removeDirectoryIfExists $ commentFolder <.> "versions" - let commentHash = nameToCommentHash commentFodler + let commentHash = nameToCommentHash commentFolder commentHashPath = commentHashRootDir mode commentHashLink commentHash removeFileIfExists commentHashPath Just (currentUsers :: [UserDump]) <- decode <$> LB.readFile (commentHashPath <.> "users") forM_ currentUsers $ \u -> do - removeFileIfExists $ upath u - removeFileIfExists $ upath u <.> "info" + removeFileIfExists $ T.unpack (upath u) + removeFileIfExists $ T.unpack (upath u) <.> "info" empty <- fmap (\ l -> length l == 2 && sort l == sort [".", ".."]) - (getDirectoryContents (dropFileName $ upath u)) - if empty then removeDirectroyIfExists (dropFileName $ upath u) + (getDirectoryContents (dropFileName $ T.unpack (upath u))) + if empty then removeDirectoryIfExists (dropFileName $ T.unpack (upath u)) else return () removeFileIfExists $ commentHashPath <.> "users" empty <- fmap @@ -102,7 +102,7 @@ cleanCommentPaths mode commentFolder = do else return () False -> return () -deleteFolderWithComments :: Buildmode -> Text -> FilePath -> IO (Either String ()) +deleteFolderWithComments :: BuildMode -> Text -> FilePath -> IO (Either String ()) deleteFolderWithComments mode userId' finalDir = do case finalDir == "commentables" of True -> return $ Left "`commentables` Directory Cannot Be Deleted" @@ -112,7 +112,7 @@ deleteFolderWithComments mode userId' finalDir = do case length (splitDirectories finalDir) of x | x == 0 -> return $ Left "Root Directory Cannot Be Deleted" | (x /= 0) && ((splitDirectories finalDir) !! 0 == "commentables") -> do - mapM_ (removeUserFromComments mode userId') allFilePaths + mapM_ (removeUserFromComments userId') allFilePaths empty <- fmap (\ l -> length l == 3 && sort l == sort [".", "..", takeFileName dir']) @@ -120,7 +120,7 @@ deleteFolderWithComments mode userId' finalDir = do removeDirectoryIfExists $ if empty then takeDirectory dir' else dir' return $ Right () | otherwise -> do - mapM_ (\x -> cleanCommentPaths mode $ x <.> "comments") allFilePaths + mapM_ (\t -> cleanCommentPaths mode $ t <.> "comments") allFilePaths empty <- fmap (\ l -> length l == 3 && sort l == sort [".", "..", takeFileName dir']) @@ -128,19 +128,19 @@ deleteFolderWithComments mode userId' finalDir = do removeDirectoryIfExists $ if empty then takeDirectory dir' else dir' return $ Right () -removeUserFromComments :: BuildMode -> Text -> FilePath -> IO () -removeUserFromComments mode userId' userPath = do +removeUserFromComments :: Text -> FilePath -> IO () +removeUserFromComments userId' userPath = do commentHashFile <- BC.unpack <$> B.readFile userPath commentFolder <- BC.unpack <$> B.readFile commentHashFile Just (currentUsers :: [UserDump]) <- decode <$> - LB.readFile (commentHashPath <.> "users") + LB.readFile (commentHashFile <.> "users") let currentUserIds = map uuserId currentUsers currentUser = currentUsers !! (fromJust $ userId' `elemIndex` currentUserIds) - removeFileIfExists commentFolder <.> "users" uuserIdent currentUser - LB.writeFile (commentHashPath <.> "users") $ + removeFileIfExists $ commentFolder <.> "users" T.unpack (uuserIdent currentUser) + LB.writeFile (commentHashFile <.> "users") $ encode (delete currentUser currentUsers) removeFileIfExists userPath - removeFileIfExists userPath <.> "info" + removeFileIfExists $ userPath <.> "info" empty <- fmap (\ l -> length l ==2 && @@ -158,8 +158,8 @@ copyDirFromCommentables mode userId' toDir fromDir emptyPH = do case isSuffixOf ".info" (drop 23 file) of True -> return () False -> do - commentHashLink <- BC.unpack <$> B.readFile f - commentFolder <- BC.unpack <$> B.readFile f + commentHashFile <- BC.unpack <$> B.readFile f + commentFolder <- BC.unpack <$> B.readFile commentHashFile Just (project :: Project) <- decode <$> (LB.readFile $ take (length commentFolder - 9) commentFolder) fileName <- T.decodeUtf8 <$> B.readFile (f <.> "info") @@ -169,7 +169,7 @@ copyDirFromCommentables mode userId' toDir fromDir emptyPH = do dirDirs <- dirFilter dirList 'D' forM_ dirDirs $ \ d -> do dirName <- BC.unpack <$> B.readFile (d "dir.info") - let newToDir = toDir (dirBase $ takeFileName d) + let newToDir = toDir (dirBase . nameToDirId $ T.pack dirName) createNewFolder mode userId' newToDir dirName copyDirFromCommentables mode userId' newToDir d emptyPH @@ -189,7 +189,7 @@ copyDirFromSelf mode userId' toDir fromDir = do dirDirs <- dirFilter dirList 'D' forM_ dirDirs $ \ d -> do dirName <- BC.unpack <$> B.readFile (d "dir.info") - let newToDir = toDir (dirBase $ takeFileName d) + let newToDir = toDir (dirBase . nameToDirId $ T.pack dirName) createNewFolder mode userId' newToDir dirName copyDirFromSelf mode userId' newToDir d @@ -197,20 +197,20 @@ createNewVersionIfReq :: Text -> FilePath -> IO () createNewVersionIfReq latestSource commentFolder = do currentVersions :: [Int] <- reverse . sort . map read <$> listDirectory (commentFolder <.> "versions") - let currentVersion = currentVersion !! 0 + let currentVersion = currentVersions !! 0 currentSource <- T.decodeUtf8 <$> B.readFile (commentFolder <.> "versions" show currentVersion) case currentSource == latestSource of True -> return () False -> do - currentlines :: [Int] <- delete 0 . fmap read <$> listDirectory commentFolder + currentLines :: [Int] <- delete 0 . fmap read <$> listDirectory commentFolder commentVersionLists :: [[[CommentDesc]]] <- mapM (\x -> versions . fromJust . decode <$> LB.readFile (commentFolder show x)) currentLines let hasComments = foldr (\l acc -> - case length l of - x | (x <= currentVersion) && (l !! currentVersion /= []) -> True - | otherwise -> acc - ) False commentVersionLists + case length l of + x | (x <= currentVersion) && (l !! currentVersion /= []) -> True + | otherwise -> acc + ) False commentVersionLists case hasComments of True -> do B.writeFile (commentFolder <.> "versions" show (currentVersion + 1)) $ @@ -240,7 +240,7 @@ ensureVersionLines versionNo' commentFolder = do totalLines <- (length . lines . BC.unpack) <$> (B.readFile $ commentFolder <.> "versions" show versionNo') currentLines :: [Int] <- delete 0 . fmap read <$> listDirectory commentFolder - let currentCount = + let currentCount = 1 mapM_ (\x -> do fileBool <- doesFileExist $ commentFolder show x newLC <- case fileBool of @@ -249,12 +249,12 @@ ensureVersionLines versionNo' commentFolder = do LB.readFile (commentFolder show x) return $ LineComment x (versions currentLC ++ [[]]) False -> return $ LineComment x [[]] - LB.writeFile (commentFolder show x) $ encode newLC) [1..totalLines `max` currentLines] + LB.writeFile (commentFolder show x) $ encode newLC) [1..totalLines `max` currentCount] 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 + else acc ) True ['/', '.', '+'] case identAllowed of True -> return $ Left "User Identifier Has Unallowed Char(/+.)" diff --git a/codeworld-server/src/Comment_.hs b/codeworld-server/src/Comment_.hs index 97ecf948c..75bb87ab7 100644 --- a/codeworld-server/src/Comment_.hs +++ b/codeworld-server/src/Comment_.hs @@ -108,7 +108,7 @@ addSharedCommentHandler clientId = do finalDir = sharedCommentsDir mode (userId user) pathDir commentHash = nameToCommentHash commentFolder res <- liftIO $ do - addNewUser (userId user) userIdent' (T.unpack name) + addNewUser (userId user) userIdent' (BC.unpack name) (finalDir commentProjectLink projectId) (commentHashRootDir mode commentHashLink commentHash) case res of @@ -315,7 +315,7 @@ viewCommentSourceHandler :: ClientId -> Snap () viewCommentSourceHandler clientId = do (_, _, commentFolder) <- getFrequentParams 3 clientId Just (versionNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "versionNo" - currentSource <- B.readFile (commentFolder <.> "versions" show versionNo') + currentSource <- liftIO $ B.readFile (commentFolder <.> "versions" show versionNo') modifyResponse $ setContentType "text/x-haskell" writeBS currentSource diff --git a/codeworld-server/src/DataUtil.hs b/codeworld-server/src/DataUtil.hs index f9dd8546e..124d0f265 100644 --- a/codeworld-server/src/DataUtil.hs +++ b/codeworld-server/src/DataUtil.hs @@ -40,7 +40,6 @@ import System.FilePath import System.File.Tree (getDirectory, copyTo_) import System.Posix.Files -import CommentUtil (addSelf) import Model newtype BuildMode = BuildMode String deriving Eq @@ -257,7 +256,7 @@ hashToId pfx = (pfx <>) copyDirIfExists :: FilePath -> FilePath -> IO () copyDirIfExists folder1 folder2 = (getDirectory folder1 >>= copyTo_ folder2) `catch` handleExists - where handlerExists e + where handleExists e | isDoesNotExistError e = return () | otherwise = throwIO e diff --git a/codeworld-server/src/Folder_.hs b/codeworld-server/src/Folder_.hs index 7adb7a5e9..b717b209c 100644 --- a/codeworld-server/src/Folder_.hs +++ b/codeworld-server/src/Folder_.hs @@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} +{-# LANGUAGE ScopedTypeVariables #-} {- Copyright 2017 The CodeWorld Authors. All rights reserved. @@ -26,7 +27,7 @@ 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 (sort) +import Data.List import Data.Maybe (fromJust) import Snap.Core import Snap.Util.FileServe @@ -80,17 +81,17 @@ copyProjectHandler clientId = do projectDir = userProjectDir mode (userId user) copyFromDir = case length copyFrom of 0 -> "" - _ -> | copyFrom !! 0 == "commentables" -> + _ | copyFrom !! 0 == "commentables" -> "commentables" (joinPath $ map (dirBase . nameToDirId . T.pack) $ tail copyFrom) - | otherwise -> + | otherwise -> joinPath $ map (dirBase . nameToDirId . T.pack) copyFrom Just isFile <- getParam "isFile" case length copyTo of x | (x > 0) && copyTo !! 0 == "commentables" -> do modifyResponse $ setContentType "text/plain" modifyResponse $ setResponseCode 500 - writeBS . BC.pack "Cannot Copy Something Into `commentables` Directory" + writeBS . BC.pack $ "Cannot Copy Something Into `commentables` Directory" | otherwise -> do case (copyTo == copyFrom, isFile) of (False, "true") -> do @@ -98,17 +99,17 @@ copyProjectHandler clientId = do Just (project :: Project) <- decodeStrict . fromJust <$> getParam "project" let projectId = nameToProjectId $ T.decodeUtf8 name toFile = projectDir copyToDir projectFile projectId - cleanCommentPaths mode $ toFile <.> "comments" - ensureProjectDir mode (userId user) copyToDir projectId - LB.writeFile toFile $ encode $ - Project (T.decodeUtf8 name) (projectSource project) (projectHistory project) - addSelf mode (userId user) "Anonymous Owner" $ toFile <.> "comments" + liftIO $ do + cleanCommentPaths mode $ toFile <.> "comments" + ensureProjectDir mode (userId user) copyToDir projectId + LB.writeFile toFile $ encode $ + Project (T.decodeUtf8 name) (projectSource project) (projectHistory project) + addSelf mode (userId user) "Anonymous Owner" $ toFile <.> "comments" (False, "false") -> do Just name <- fmap (BC.unpack) <$> getParam "name" Just (emptyPH :: Value) <- decode . LB.fromStrict . fromJust <$> getParam "empty" let toDir = joinPath $ map (dirBase . nameToDirId . T.pack) (copyTo ++ [name]) - projectDir = userProjectDir mode (userId user) - dirBool <- liftIO $ doesDirectroyExist (projectDir toDir) + dirBool <- liftIO $ doesDirectoryExist (projectDir toDir) case dirBool of True -> do res <- liftIO $ deleteFolderWithComments mode (userId user) toDir @@ -121,12 +122,12 @@ copyProjectHandler clientId = do False -> return () liftIO $ createNewFolder mode (userId user) toDir name case length copyFrom of - x | (x > 0) && copyFrom !! 0 == "commentables" -> liftIO $ do + y | (y > 0) && copyFrom !! 0 == "commentables" -> liftIO $ do copyDirFromCommentables mode (userId user) - (projectDir toDir) (projectDir copyFrom) emptyPH + (projectDir toDir) (projectDir copyFromDir) emptyPH | otherwise -> liftIO $ do copyDirFromSelf mode (userId user) - (projectDir toDir) (projectDir fromDir) + (projectDir toDir) (projectDir copyFromDir) (_, _) -> return () createFolderHandler :: ClientId -> Snap () @@ -149,10 +150,10 @@ createFolderHandler clientId = do modifyResponse $ setContentType "text/plain" modifyResponse $ setResponseCode 500 writeBS . BC.pack $ err - Right _ -> do - createNewFolder mode (userId user) finaDir (last path') - False -> do - createNewFolder mode (userId user) finaDir (last path') + 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 @@ -171,8 +172,8 @@ deleteProjectHandler clientId = do case length (splitDirectories finalDir) of x | (x /= 0) && ((splitDirectories finalDir) !! 0 == "commentables") -> do let file = userProjectDir mode (userId user) - finalDir commentProjectLink projectId - removeUserFromComments mode (userId user) file + finalDir commentProjectLink projectId + liftIO $ removeUserFromComments (userId user) file | otherwise -> do let file = userProjectDir mode (userId user) finalDir projectFile projectId liftIO $ cleanCommentPaths mode (file <.> "comments") @@ -268,7 +269,7 @@ newProjectHandler clientId = do file = userProjectDir mode (userId user) finalDir projectFile projectId liftIO $ do ensureProjectDir mode (userId user) finalDir projectId - cleanCommentPaths mode $ file <.> "comments" + cleanCommentPaths mode $ file <.> "comments" LB.writeFile file $ encode project addSelf mode (userId user) "Anonymous Owner" $ file <.> "comments" From 3583656587c63c1b832ab621bfcc03f9329bb641 Mon Sep 17 00:00:00 2001 From: Parv Mor Date: Wed, 26 Jul 2017 00:35:05 +0530 Subject: [PATCH 11/28] improves copyHandler and implements moveHandler --- codeworld-server/src/CommentUtil.hs | 256 +++++++++++++++++++--------- codeworld-server/src/Comment_.hs | 1 + codeworld-server/src/DataUtil.hs | 7 + codeworld-server/src/Folder_.hs | 190 +++++++++++---------- 4 files changed, 281 insertions(+), 173 deletions(-) diff --git a/codeworld-server/src/CommentUtil.hs b/codeworld-server/src/CommentUtil.hs index 678eff509..b6872b602 100644 --- a/codeworld-server/src/CommentUtil.hs +++ b/codeworld-server/src/CommentUtil.hs @@ -74,9 +74,9 @@ cleanCommentPaths mode commentFolder = do dirBool <- doesDirectoryExist commentFolder case dirBool of True -> do - removeDirectoryIfExists commentFolder - removeDirectoryIfExists $ commentFolder <.> "users" - removeDirectoryIfExists $ commentFolder <.> "versions" + mapM_ (\x -> removeDirectoryIfExists $ commentFolder <.> x) ["", "users", "versions"] + removeFileIfExists $ take (length commentFolder - 9) commentFolder + cleanBaseDirectory commentFolder let commentHash = nameToCommentHash commentFolder commentHashPath = commentHashRootDir mode commentHashLink commentHash removeFileIfExists commentHashPath @@ -85,72 +85,85 @@ cleanCommentPaths mode commentFolder = do forM_ currentUsers $ \u -> do removeFileIfExists $ T.unpack (upath u) removeFileIfExists $ T.unpack (upath u) <.> "info" - empty <- fmap - (\ l -> - length l == 2 && - sort l == sort [".", ".."]) - (getDirectoryContents (dropFileName $ T.unpack (upath u))) - if empty then removeDirectoryIfExists (dropFileName $ T.unpack (upath u)) - else return () + cleanBaseDirectory $ T.unpack (upath u) removeFileIfExists $ commentHashPath <.> "users" - empty <- fmap - (\ l -> - length l == 2 && - sort l == sort [".", ".."]) - (getDirectoryContents (dropFileName commentHashPath)) - if empty then removeDirectoryIfExists (dropFileName commentHashPath) - else return () + cleanBaseDirectory commentHashPath False -> return () deleteFolderWithComments :: BuildMode -> Text -> FilePath -> IO (Either String ()) deleteFolderWithComments mode userId' finalDir = do - case finalDir == "commentables" of - True -> return $ Left "`commentables` Directory Cannot Be Deleted" - False -> do - let dir' = userProjectDir mode userId' finalDir - 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 - empty <- fmap (\ l -> - length l == 3 && - sort l == sort [".", "..", takeFileName dir']) - (getDirectoryContents (takeDirectory dir')) - removeDirectoryIfExists $ if empty then takeDirectory dir' else dir' - return $ Right () - | otherwise -> do - mapM_ (\t -> cleanCommentPaths mode $ t <.> "comments") allFilePaths - empty <- fmap (\ l -> - length l == 3 && - sort l == sort [".", "..", takeFileName dir']) - (getDirectoryContents (takeDirectory dir')) - removeDirectoryIfExists $ if empty then takeDirectory dir' else dir' - return $ Right () + dirBool <- doesDirectoryExist finalDir + case dirBool of + True -> do + case finalDir == "commentables" of + True -> return $ Left "`commentables` Directory Cannot Be Deleted" + False -> do + let dir' = userProjectDir mode userId' finalDir + 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_ (\t -> cleanCommentPaths mode $ t <.> "comments") allFilePaths + removeDirectoryIfExists dir' + cleanBaseDirectory dir' + return $ Right () + False -> return $ Left "Directory Does Not Exists" + removeUserFromComments :: Text -> FilePath -> IO () removeUserFromComments userId' userPath = do - commentHashFile <- BC.unpack <$> B.readFile userPath + fileBool <- doesFileExist userPath + case fileBool of + True -> do + commentHashFile <- BC.unpack <$> B.readFile userPath + commentFolder <- BC.unpack <$> B.readFile commentHashFile + Just (currentUsers :: [UserDump]) <- decode <$> + LB.readFile (commentHashFile <.> "users") + let currentUserIds = map uuserId currentUsers + currentUser = currentUsers !! (fromJust $ userId' `elemIndex` currentUserIds) + removeFileIfExists $ commentFolder <.> "users" T.unpack (uuserIdent currentUser) + LB.writeFile (commentHashFile <.> "users") $ + encode (delete currentUser currentUsers) + removeFileIfExists userPath + removeFileIfExists $ userPath <.> "info" + cleanBaseDirectory userPath + False -> return () + +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]) <- decode <$> + LB.readFile (commentHashFile <.> "users") + let newUsr usr = UserDump userId' (uuserIdent usr) $ T.pack userPath + newUsers = map (\usr -> if uuserId usr /= userId' then usr + else newUsr usr) currentUsers + LB.writeFile (commentHashFile <.> "users") $ + encode newUsers + False -> return () + +copyFileFromCommentables :: BuildMode -> Text -> FilePath -> FilePath -> Text -> Value -> IO () +copyFileFromCommentables mode userId' fromFile toFile name emptyPH = do + cleanCommentPaths mode $ toFile <.> "comments" + createDirectoryIfMissing False $ takeDirectory toFile + commentHashFile <- BC.unpack <$> B.readFile fromFile commentFolder <- BC.unpack <$> B.readFile commentHashFile - Just (currentUsers :: [UserDump]) <- decode <$> - LB.readFile (commentHashFile <.> "users") - let currentUserIds = map uuserId currentUsers - currentUser = currentUsers !! (fromJust $ userId' `elemIndex` currentUserIds) - removeFileIfExists $ commentFolder <.> "users" T.unpack (uuserIdent currentUser) - LB.writeFile (commentHashFile <.> "users") $ - encode (delete currentUser currentUsers) - removeFileIfExists userPath - removeFileIfExists $ userPath <.> "info" - empty <- fmap - (\ l -> - length l ==2 && - sort l == sort [".", ".."]) - (getDirectoryContents (dropFileName userPath)) - if empty then removeDirectoryIfExists (dropFileName userPath) - else return () - -copyDirFromCommentables :: BuildMode -> Text -> FilePath -> FilePath -> Value -> IO () -copyDirFromCommentables mode userId' toDir fromDir emptyPH = do + Just (project :: Project) <- decode <$> + LB.readFile (take (length commentFolder - 9) commentFolder) + LB.writeFile toFile $ encode + (Project name (projectSource project) emptyPH) + addSelf mode userId' "Anonymous Owner" $ toFile <.> "comments" + +copyFolderFromCommentables :: BuildMode -> Text -> FilePath -> FilePath -> Text -> Value -> IO () +copyFolderFromCommentables mode userId' fromDir toDir name emptyPH = do + createNewFolder mode userId' toDir $ T.unpack name dirList <- listDirectoryWithPrefix fromDir dirFiles <- dirFilter dirList 'S' forM_ dirFiles $ \ f -> do @@ -158,23 +171,27 @@ copyDirFromCommentables mode userId' toDir fromDir emptyPH = do case isSuffixOf ".info" (drop 23 file) of True -> return () False -> do - commentHashFile <- BC.unpack <$> B.readFile f - commentFolder <- BC.unpack <$> B.readFile commentHashFile - Just (project :: Project) <- decode <$> - (LB.readFile $ take (length commentFolder - 9) commentFolder) + let toFile = toDir take 3 file file fileName <- T.decodeUtf8 <$> B.readFile (f <.> "info") - LB.writeFile (toDir file) $ encode - (Project fileName (projectSource project) emptyPH) - addSelf mode userId' "Anonynous Owner" (toDir file <.> "comments") + copyFileFromCommentables mode userId' f toFile fileName emptyPH dirDirs <- dirFilter dirList 'D' forM_ dirDirs $ \ d -> do - dirName <- BC.unpack <$> B.readFile (d "dir.info") - let newToDir = toDir (dirBase . nameToDirId $ T.pack dirName) - createNewFolder mode userId' newToDir dirName - copyDirFromCommentables mode userId' newToDir d emptyPH - -copyDirFromSelf :: BuildMode -> Text -> FilePath -> FilePath -> IO () -copyDirFromSelf mode userId' toDir fromDir = do + dirName <- T.decodeUtf8 <$> B.readFile (d "dir.info") + let newToDir = toDir (dirBase . nameToDirId $ dirName) + copyFolderFromCommentables mode userId' d newToDir dirName emptyPH + +copyFileFromSelf :: BuildMode -> Text -> FilePath -> FilePath -> Text -> IO () +copyFileFromSelf mode userId' fromFile toFile name = do + cleanCommentPaths mode $ toFile <.> "comments" + createDirectoryIfMissing False $ takeDirectory toFile + Just (project :: Project) <- decode <$> LB.readFile fromFile + LB.writeFile toFile $ encode + (Project name (projectSource project) (projectHistory project)) + addSelf mode userId' "Anonymous Owner" $ toFile <.> "comments" + +copyFolderFromSelf :: BuildMode -> Text -> FilePath -> FilePath -> Text -> IO () +copyFolderFromSelf mode userId' fromDir toDir name = do + createNewFolder mode userId' toDir $ T.unpack name dirList <- listDirectoryWithPrefix fromDir dirFiles <- dirFilter dirList 'S' forM_ dirFiles $ \f -> do @@ -182,16 +199,94 @@ copyDirFromSelf mode userId' toDir fromDir = do fileBool <- doesFileExist f case (fileBool, isSuffixOf ".cw" (drop 23 file)) of (True, True) -> do + let toFile = toDir take 3 file file + Just (project :: Project) <- decode <$> LB.readFile f + copyFileFromSelf mode userId' f toFile $ projectName project + (_, _) -> 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' 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" (drop 23 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 $ toFile <.> "comments" + createDirectoryIfMissing False $ takeDirectory toFile + mapM_ (\x -> renameDirectory (fromFile <.> x) (toFile <.> x)) $ + map ("comments" <.>) ["", "users", "versions"] + renameFile fromFile toFile + cleanBaseDirectory fromFile + Just (project :: Project) <- decode <$> LB.readFile toFile + LB.writeFile toFile $ encode + (Project name (projectSource project) (projectHistory project)) + let fromCommentHash = nameToCommentHash $ fromFile <.> "comments" + toCommentHash = nameToCommentHash $ toFile <.> "comments" + fromCommentHashPath = commentHashRootDir mode commentHashLink fromCommentHash + toCommentHashPath = commentHashRootDir mode commentHashLink toCommentHash + ensureCommentHashDir mode toCommentHash + renameFile fromCommentHashPath toCommentHashPath + renameFile (fromCommentHashPath <.> "users") (toCommentHashPath <.> "users") + cleanBaseDirectory fromCommentHashPath + -- change user paths to toCommentHashPath + Just (currentUsers :: [UserDump]) <- decode <$> + LB.readFile (toCommentHashPath <.> "users") + mapM_ (\u -> + if (uuserId u /= userId') then B.writeFile (T.unpack $ upath u) $ BC.pack toCommentHashPath + else return () + ) currentUsers + +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" (drop 23 file)) of + (True, True) -> do + let toFile = toDir take 3 file file Just (project :: Project) <- decode <$> LB.readFile f - LB.writeFile (toDir file) $ encode project - addSelf mode userId' "Anonymous Owner" (toDir file <.> "comments") + moveFileFromSelf mode userId' f toFile $ projectName project (_, _) -> return () dirDirs <- dirFilter dirList 'D' forM_ dirDirs $ \ d -> do - dirName <- BC.unpack <$> B.readFile (d "dir.info") - let newToDir = toDir (dirBase . nameToDirId $ T.pack dirName) - createNewFolder mode userId' newToDir dirName - copyDirFromSelf mode userId' newToDir d + dirName <- T.decodeUtf8 <$> B.readFile (d "dir.info") + let newToDir = toDir (dirBase . nameToDirId $ dirName) + moveFolderFromSelf mode userId' d newToDir dirName + removeDirectoryIfExists fromDir + cleanBaseDirectory fromDir createNewVersionIfReq :: Text -> FilePath -> IO () createNewVersionIfReq latestSource commentFolder = do @@ -267,6 +362,7 @@ addNewUser userId' userIdent' name userPath commentHashPath = do let currentIdents = map uuserIdent currentUsers case userIdent' `elem` currentIdents of False -> do + createDirectoryIfMissing False $ takeDirectory userPath B.writeFile userPath $ BC.pack commentHashPath B.writeFile (userPath <.> "info") $ BC.pack name LB.writeFile (commentHashPath <.> "users") $ encode (UserDump diff --git a/codeworld-server/src/Comment_.hs b/codeworld-server/src/Comment_.hs index 75bb87ab7..f71a05943 100644 --- a/codeworld-server/src/Comment_.hs +++ b/codeworld-server/src/Comment_.hs @@ -119,6 +119,7 @@ addSharedCommentHandler clientId = do Right _ -> return () _ -> do modifyResponse $ setContentType "text/plain" + modifyResponse $ setResponseCode 500 writeBS . BC.pack $ "Shared Comments Should Be In `commentables` Directory" commentShareHandler :: ClientId -> Snap () diff --git a/codeworld-server/src/DataUtil.hs b/codeworld-server/src/DataUtil.hs index 124d0f265..fafb66cb4 100644 --- a/codeworld-server/src/DataUtil.hs +++ b/codeworld-server/src/DataUtil.hs @@ -208,6 +208,13 @@ migrateUser userRoot = do 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 diff --git a/codeworld-server/src/Folder_.hs b/codeworld-server/src/Folder_.hs index b717b209c..5d37c197f 100644 --- a/codeworld-server/src/Folder_.hs +++ b/codeworld-server/src/Folder_.hs @@ -25,6 +25,7 @@ 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.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as T import Data.List @@ -47,7 +48,7 @@ folderRoutes clientId = , ("deleteProject", deleteProjectHandler clientId) , ("listFolder", listFolderHandler clientId) , ("loadProject", loadProjectHandler clientId) --- , ("moveProject", moveProjectHandler clientId) + , ("moveProject", moveProjectHandler clientId) , ("newProject", newProjectHandler clientId) , ("shareContent", shareContentHandler clientId) , ("shareFolder", shareFolderHandler clientId) @@ -77,58 +78,54 @@ copyProjectHandler clientId = do user <- getUser clientId Just copyTo <- fmap (splitDirectories . BC.unpack) <$> getParam "copyTo" Just copyFrom <- fmap (splitDirectories . BC.unpack) <$> getParam "copyFrom" - let copyToDir = joinPath $ map (dirBase . nameToDirId . T.pack) copyTo - projectDir = userProjectDir mode (userId user) - copyFromDir = case length copyFrom of - 0 -> "" - _ | copyFrom !! 0 == "commentables" -> - "commentables" (joinPath $ + 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) - | otherwise -> - joinPath $ map (dirBase . nameToDirId . T.pack) copyFrom - Just isFile <- getParam "isFile" - case length copyTo of - x | (x > 0) && copyTo !! 0 == "commentables" -> do - modifyResponse $ setContentType "text/plain" - modifyResponse $ setResponseCode 500 - writeBS . BC.pack $ "Cannot Copy Something Into `commentables` Directory" - | otherwise -> do - case (copyTo == copyFrom, isFile) of - (False, "true") -> do - Just name <- getParam "name" - Just (project :: Project) <- decodeStrict . fromJust <$> getParam "project" - let projectId = nameToProjectId $ T.decodeUtf8 name - toFile = projectDir copyToDir projectFile projectId - liftIO $ do - cleanCommentPaths mode $ toFile <.> "comments" - ensureProjectDir mode (userId user) copyToDir projectId - LB.writeFile toFile $ encode $ - Project (T.decodeUtf8 name) (projectSource project) (projectHistory project) - addSelf mode (userId user) "Anonymous Owner" $ toFile <.> "comments" - (False, "false") -> do - Just name <- fmap (BC.unpack) <$> getParam "name" - Just (emptyPH :: Value) <- decode . LB.fromStrict . fromJust <$> getParam "empty" - let toDir = joinPath $ map (dirBase . nameToDirId . T.pack) (copyTo ++ [name]) - dirBool <- liftIO $ doesDirectoryExist (projectDir toDir) - case dirBool of - True -> do - res <- liftIO $ deleteFolderWithComments mode (userId user) toDir - case res of - Left err -> do - modifyResponse $ setContentType "text/plain" - modifyResponse $ setResponseCode 500 - writeBS . BC.pack $ err - Right _ -> return () - False -> return () - liftIO $ createNewFolder mode (userId user) toDir name - case length copyFrom of - y | (y > 0) && copyFrom !! 0 == "commentables" -> liftIO $ do - copyDirFromCommentables mode (userId user) - (projectDir toDir) (projectDir copyFromDir) emptyPH - | otherwise -> liftIO $ do - copyDirFromSelf mode (userId user) - (projectDir toDir) (projectDir copyFromDir) - (_, _) -> return () + False -> joinPath $ map (dirBase . nameToDirId . T.pack) copyFrom + case toType of + True -> do + modifyResponse $ setContentType "text/plain" + modifyResponse $ setResponseCode 500 + 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" + 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) + fromFile toFile (T.pack name') emptyPH + False -> liftIO $ do + let fromFile = projectDir copyFromDir projectFile projectId + copyFileFromSelf mode (userId user) fromFile toFile $ T.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) (projectDir fromDir) + (projectDir toDir) (T.pack name') emptyPH + False -> liftIO $ do + copyFolderFromSelf mode (userId user) (projectDir fromDir) + (projectDir toDir) $ T.pack name' + (_, _) -> return () createFolderHandler :: ClientId -> Snap () createFolderHandler clientId = do @@ -214,46 +211,53 @@ moveProjectHandler clientId = do user <- getUser clientId Just moveTo <- fmap (splitDirectories . BC.unpack) <$> getParam "moveTo" Just moveFrom <- fmap (splitDirectories . BC.unpack) <$> getParam "moveFrom" - let moveToDir = joinPath $ map (dirBase . nameToDirId . T.pack) moveTo - moveFromDir = projectDir joinPath (map (dirBase . nameToDirId . T.pack) moveFrom) - projectDir = userProjectDir mode (userId user) - Just isFile <- getParam "isFile" - case (moveTo == moveFrom, 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 $ do - removeFileIfExists toFile - removeDirectoryIfExists $ toFile <.> "comments" - ensureProjectDir mode (userId user) moveToDir projectId - copyFile file toFile - copyDirIfExists (file <.> "comments") (toFile <.> "comments") - removeFileIfExists file - removeDirectoryIfExists $ file <.> "comments" - removeCommentHash mode $ file <.> "comments" - empty <- fmap - (\ l1 -> - length l1 == 2 && - sort l1 == sort [".", ".."]) - (getDirectoryContents (dropFileName file)) - if empty then removeDirectoryIfExists (dropFileName file) - else return () - (False, "false") -> do - let dirName = last $ splitDirectories moveFromDir - dir' = moveToDir take 3 dirName dirName - liftIO $ do - ensureUserBaseDir mode (userId user) dir' - copyDirIfExists moveFromDir $ projectDir dir' - empty <- fmap - (\ l1 -> - length l1 == 3 && - sort l1 == sort [".", "..", takeFileName moveFromDir]) - (getDirectoryContents (takeDirectory moveFromDir)) - removeDirectoryIfExists $ - if empty then takeDirectory moveFromDir else moveFromDir - (_, _) -> return () + 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 500 + writeBS . BC.pack $ "Cannot Move From `commentables` to Normal and vice-versa" newProjectHandler :: ClientId -> Snap () newProjectHandler clientId = do @@ -268,8 +272,8 @@ newProjectHandler clientId = do let projectId = nameToProjectId (projectName project) file = userProjectDir mode (userId user) finalDir projectFile projectId liftIO $ do - ensureProjectDir mode (userId user) finalDir projectId cleanCommentPaths mode $ file <.> "comments" + ensureProjectDir mode (userId user) finalDir projectId LB.writeFile file $ encode project addSelf mode (userId user) "Anonymous Owner" $ file <.> "comments" From ad50f2e96ee9e88d5316188d648848f6f2589551 Mon Sep 17 00:00:00 2001 From: Parv Mor Date: Mon, 14 Aug 2017 23:10:32 +0530 Subject: [PATCH 12/28] completes save handler --- codeworld-server/src/CommentUtil.hs | 33 ++++++++++++++--------------- codeworld-server/src/Folder_.hs | 6 +++--- 2 files changed, 19 insertions(+), 20 deletions(-) diff --git a/codeworld-server/src/CommentUtil.hs b/codeworld-server/src/CommentUtil.hs index b6872b602..3e291c907 100644 --- a/codeworld-server/src/CommentUtil.hs +++ b/codeworld-server/src/CommentUtil.hs @@ -302,9 +302,7 @@ createNewVersionIfReq latestSource commentFolder = do commentVersionLists :: [[[CommentDesc]]] <- mapM (\x -> versions . fromJust . decode <$> LB.readFile (commentFolder show x)) currentLines let hasComments = foldr (\l acc -> - case length l of - x | (x <= currentVersion) && (l !! currentVersion /= []) -> True - | otherwise -> acc + if (l !! currentVersion /= []) then True else acc ) False commentVersionLists case hasComments of True -> do @@ -313,18 +311,16 @@ createNewVersionIfReq latestSource commentFolder = do ensureVersionLines (currentVersion + 1) commentFolder False -> return () -addUserVersionLS :: Text -> FilePath -> IO () -addUserVersionLS userIdent' commentFolder = do +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 . decode <$> LB.readFile (commentFolder show x)) currentLines let versionLS = map (\v -> VersionLS v . LineStatuses $ foldr (\l acc -> - case length l of - x | (x <= v) && (l !! v /= []) -> - (LineStatus (currentLines !! (fromJust $ - l `elemIndex` commentVersionLists)) "unread") : acc - | otherwise -> acc + LineStatus (currentLines !! (fromJust $ + l `elemIndex` commentVersionLists)) + (if (l !! v /= []) then "unread" else "read") : acc ) [] commentVersionLists ) currentVersions LB.writeFile (commentFolder <.> "users" T.unpack userIdent') $ @@ -335,7 +331,6 @@ ensureVersionLines versionNo' commentFolder = do totalLines <- (length . lines . BC.unpack) <$> (B.readFile $ commentFolder <.> "versions" show versionNo') currentLines :: [Int] <- delete 0 . fmap read <$> listDirectory commentFolder - let currentCount = 1 mapM_ (\x -> do fileBool <- doesFileExist $ commentFolder show x newLC <- case fileBool of @@ -344,13 +339,17 @@ ensureVersionLines versionNo' commentFolder = do LB.readFile (commentFolder show x) return $ LineComment x (versions currentLC ++ [[]]) False -> return $ LineComment x [[]] - LB.writeFile (commentFolder show x) $ encode newLC) [1..totalLines `max` currentCount] + LB.writeFile (commentFolder show x) $ encode newLC) + [1..totalLines `max` length currentLines] + currentUsers <- map T.pack <$> listDirectory (commentFolder <.> "users") + forM_ currentUsers (\u -> updateUserVersionLS u commentFolder) + 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 ['/', '.', '+'] + let identAllowed = foldl (\acc l -> + if l `elem` (T.unpack userIdent') then False else acc + ) True ['/', '.', '+'] case identAllowed of True -> return $ Left "User Identifier Has Unallowed Char(/+.)" False -> do @@ -368,7 +367,7 @@ addNewUser userId' userIdent' name userPath commentHashPath = do LB.writeFile (commentHashPath <.> "users") $ encode (UserDump userId' userIdent' (T.pack userPath) : currentUsers) commentFolder <- BC.unpack <$> B.readFile commentHashPath - addUserVersionLS userIdent' commentFolder + updateUserVersionLS userIdent' commentFolder return $ Right () True -> return $ Left "User Identifier Already Exists" False -> return $ Left "File Does Not Exists" @@ -388,7 +387,7 @@ addSelf mode userId' userIdent' commentFolder = do (LB.readFile $ take (length commentFolder - 9) commentFolder) B.writeFile (commentFolder <.> "versions" "0") $ T.encodeUtf8 . projectSource $ project ensureVersionLines 0 commentFolder - addUserVersionLS userIdent' $ commentFolder + updateUserVersionLS userIdent' $ commentFolder listUnreadComments :: Text -> FilePath -> Int -> IO [Int] listUnreadComments userIdent' commentFolder versionNo' = do diff --git a/codeworld-server/src/Folder_.hs b/codeworld-server/src/Folder_.hs index 5d37c197f..488c20c7c 100644 --- a/codeworld-server/src/Folder_.hs +++ b/codeworld-server/src/Folder_.hs @@ -25,7 +25,6 @@ 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.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as T import Data.List @@ -52,7 +51,7 @@ folderRoutes clientId = , ("newProject", newProjectHandler clientId) , ("shareContent", shareContentHandler clientId) , ("shareFolder", shareFolderHandler clientId) --- , ("saveProject", saveProjectHandler clientId) + , ("saveProject", saveProjectHandler clientId) ] getFrequentParams :: Bool -> ClientId -> Snap (User, BuildMode, FilePath, Maybe ProjectId) @@ -321,6 +320,7 @@ saveProjectHandler clientId = do let projectId = nameToProjectId (projectName project) file = userProjectDir mode (userId user) finalDir projectFile projectId liftIO $ do - ensureProjectDir mode (userId user) finalDir projectId + -- no need to ensure a project file as + -- constrained to create a new project before editing. LB.writeFile file $ encode project createNewVersionIfReq (projectSource project) $ file <.> "comments" From 26c608d591abec064de90f011d627a068adb91ae Mon Sep 17 00:00:00 2001 From: Parv Mor Date: Tue, 15 Aug 2017 23:22:07 +0530 Subject: [PATCH 13/28] adds a copy feature to frontend --- codeworld-server/src/CommentUtil.hs | 2 +- codeworld-server/src/DataUtil.hs | 5 +- codeworld-server/src/Folder_.hs | 12 +-- web/env.html | 9 +++ web/js/codeworld.js | 85 ++++++++++++++++---- web/js/codeworld_shared.js | 120 ++++++++++++++++++++++++++-- 6 files changed, 203 insertions(+), 30 deletions(-) diff --git a/codeworld-server/src/CommentUtil.hs b/codeworld-server/src/CommentUtil.hs index 3e291c907..b3e884192 100644 --- a/codeworld-server/src/CommentUtil.hs +++ b/codeworld-server/src/CommentUtil.hs @@ -380,7 +380,7 @@ addSelf mode userId' userIdent' commentFolder = do ensureCommentHashDir mode commentHash B.writeFile commentHashPath $ BC.pack commentFolder LB.writeFile (commentHashPath <.> "users") $ encode . UserDump - userId' userIdent' $ T.pack $ drop (length commentFolder - 9) commentFolder + userId' userIdent' $ T.pack $ take (length commentFolder - 9) commentFolder createDirectoryIfMissing False $ commentFolder <.> "users" createDirectoryIfMissing False $ commentFolder <.> "versions" Just (project :: Project) <- decode <$> diff --git a/codeworld-server/src/DataUtil.hs b/codeworld-server/src/DataUtil.hs index fafb66cb4..de986daf2 100644 --- a/codeworld-server/src/DataUtil.hs +++ b/codeworld-server/src/DataUtil.hs @@ -171,11 +171,12 @@ projectFileNames subHashedDirs = do hashedFiles <- dirFilter subHashedDirs 'S' projects <- fmap catMaybes $ forM hashedFiles $ \f -> do exists <- doesFileExist f + let fileName = takeFileName f case reverse f of - x | take 3 x == "wc." && length x == 26 -> + x | take 3 x == "wc." && length fileName == 26 -> if exists then (fmap projectName) <$> (decode <$> LB.readFile f) else return Nothing - x | take 5 x == "ofni." && length x == 28 -> + x | take 5 x == "ofni." && length fileName == 28 -> if exists then Just . T.decodeUtf8 <$> B.readFile f else return Nothing _ -> return Nothing return projects diff --git a/codeworld-server/src/Folder_.hs b/codeworld-server/src/Folder_.hs index 488c20c7c..644ffe042 100644 --- a/codeworld-server/src/Folder_.hs +++ b/codeworld-server/src/Folder_.hs @@ -91,7 +91,7 @@ copyProjectHandler clientId = do case toType of True -> do modifyResponse $ setContentType "text/plain" - modifyResponse $ setResponseCode 500 + modifyResponse $ setResponseCode 404 writeBS . BC.pack $ "Cannot Copy Something Into `commentables` Directory" False -> do Just isFile <- getParam "isFile" @@ -111,7 +111,7 @@ copyProjectHandler clientId = do copyFileFromCommentables mode (userId user) fromFile toFile (T.pack name') emptyPH False -> liftIO $ do - let fromFile = projectDir copyFromDir projectFile projectId + let fromFile = projectDir copyFromDir projectFile fromProjectId copyFileFromSelf mode (userId user) fromFile toFile $ T.pack name' (False, "false") -> do let toDir = copyToDir (dirBase . nameToDirId . T.pack $ name') @@ -177,8 +177,10 @@ deleteProjectHandler clientId = do listFolderHandler :: ClientId -> Snap () listFolderHandler clientId = do (user, mode, finalDir, _) <- getFrequentParams False clientId - liftIO $ migrateUser $ userProjectDir mode (userId user) - liftIO $ ensureSharedCommentsDir mode (userId user) + liftIO $ do + ensureUserProjectDir mode (userId user) + migrateUser $ userProjectDir mode (userId user) + ensureSharedCommentsDir mode (userId user) let projectDir = userProjectDir mode (userId user) subHashedDirs <- liftIO $ listDirectoryWithPrefix $ projectDir finalDir let subHashedDirs' = case finalDir == "" of @@ -264,7 +266,7 @@ newProjectHandler clientId = do case length (splitDirectories finalDir) of x | (x /= 0) && ((splitDirectories finalDir) !! 0 == "commentables") -> do modifyResponse $ setContentType "text/plain" - modifyResponse $ setResponseCode 500 + modifyResponse $ setResponseCode 404 writeBS . BC.pack $ "`commentables` Directory Does Not Allows New Projects" | otherwise -> do Just (project :: Project) <- decode . LB.fromStrict . fromJust <$> getParam "project" diff --git a/web/env.html b/web/env.html index e55fb6ef6..944a814a9 100644 --- a/web/env.html +++ b/web/env.html @@ -58,6 +58,15 @@   Download + + + diff --git a/web/js/codeworld.js b/web/js/codeworld.js index edec56bcd..f6f1d0de4 100644 --- a/web/js/codeworld.js +++ b/web/js/codeworld.js @@ -277,7 +277,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 { @@ -332,6 +332,7 @@ function updateUI() { } window.move = undefined; + window.copy = undefined; document.getElementById('newButton').style.display = ''; document.getElementById('runButtons').style.display = ''; @@ -350,27 +351,17 @@ function updateUI() { updateNavBar(); document.getElementById('moveHereButton').style.display = 'none'; + document.getElementById('copyHereButton').style.display = 'none'; document.getElementById('cancelMoveButton').style.display = 'none'; + document.getElementById('cancelCopyButton').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'; } - /* if (window.lineSet != undefined) { - for (i of lineSet) { - document.getElementsByClassName('CodeMirror-gutter-elt')[Number(i) + 1].innerHTML = 'c ' + i; - } - } - //change that from elt to wrapper then find elt - var doc = window.codeworldEditor.getDoc(); - doc.eachLine(function(f) { - let line = f.lineNo() - f.on('delete', function() { - shiftLineByX(line, -1); - }); - });*/ - var title; if (window.openProjectName) { title = window.openProjectName; @@ -528,6 +519,9 @@ function moveProject() { document.getElementById('moveButton').style.display = 'none'; document.getElementById('moveHereButton').style.display = ''; document.getElementById('cancelMoveButton').style.display = ''; + document.getElementById('copyButton').style.display = 'none'; + document.getElementById('copyHereButton').style.display = 'none'; + document.getElementById('cancelCopyButton').style.display = 'none'; document.getElementById('runButtons').style.display = 'none'; window.move = Object(); @@ -538,6 +532,52 @@ 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('saveAsButton').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('cancelCopyButton').style.display = ''; + document.getElementById('moveButton').style.display = 'none'; + document.getElementById('moveHereButton').style.display = 'none'; + document.getElementById('cancelMoveButton').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 = [""]; @@ -549,6 +589,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(); @@ -662,14 +713,14 @@ function newProject() { function newFolder() { function successFunc() { - if (window.move == undefined) + if (window.move == undefined && window.copy == undefined) setCode(''); } createFolder(nestedDirs.slice(1).join('/'), window.buildMode, successFunc); } function loadProject(name, index) { - if(window.move != undefined) { + if(window.move != undefined || window.copy != undefined) { return; } function successFunc(project){ diff --git a/web/js/codeworld_shared.js b/web/js/codeworld_shared.js index 272bf3949..cf477f02f 100644 --- a/web/js/codeworld_shared.js +++ b/web/js/codeworld_shared.js @@ -341,6 +341,10 @@ function cancelMove() { updateUI(); } +function cancelCopy() { + updateUI(); +} + function moveHere_(path, buildMode, successFunc) { if (!signedIn()) { sweetAlert('Oops!', 'You must sign in before moving.', 'error'); @@ -360,15 +364,19 @@ function moveHere_(path, buildMode, successFunc) { data.append('moveTo', path); data.append('moveFrom', window.move.path); if (window.move.file != undefined) { - data.append('isFile', "true"); + data.append('isFile', 'true'); data.append('name', window.move.file); } else { - data.append('isFile', "false"); + data.append('isFile', 'false'); } sendHttp('POST', 'moveProject', data, function(request) { if (request.status != 200) { - sweetAlert('Oops', 'Could not move your project! Please try again.', 'error'); + if (request.status == 404) { + sweetAlert('Oops!', request.responseText, 'error'); + } else { + sweetAlert('Oops', 'Could not move your project! Please try again.', 'error'); + } cancelMove(); return; } @@ -376,6 +384,63 @@ function moveHere_(path, buildMode, successFunc) { }); } +function copyHere_(path, buildMode, successFunc) { + if (!signedIn()) { + sweetAlert('Oops!', 'You must sign in before moving.', 'error'); + cancelCopy(); + return; + } + + if (window.copy == undefined) { + sweetAlert('Oops!', 'You must first select something to copy.', 'error'); + cancelCopy(); + 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'); + } + cancelCopy(); + 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('copyFrom', window.copy.path); + if (window.copy.file != undefined) { + data.append('isFile', 'true'); + data.append('empty', JSON.stringify(getCurrentProject()['history'])); + data.append('fromName', window.copy.file); + sweetAlert({ + html: true, + title: '  Copy File', + text: 'Enter a name for your file to be created at /' + path + ':', + type: 'input', + inputValue: '', + confirmButtonText: 'Copy', + showCancelButton: true, + closeOnConfirm: false + }, function (name) { + sweetAlert.close(); + data.append('name', name); + go(); + }); + } else { + data.append('isFile', 'false'); + go(); + } + +} + function warnIfUnsaved(action, showAnother) { if (isEditorClean()) { action(); @@ -627,9 +692,54 @@ function newProject_(path) { if (fileName == null || fileName == '') { return; } - + sweetAlert.close(); setCode(''); - saveProjectBase(path, fileName, 'create'); + + function go_() { + sweetAlert.close(); + var project = getCurrentProject(); + project['name'] = fileName; + + var data = new FormData(); + data.append('id_token', auth2.currentUser.get().getAuthResponse().id_token); + data.append('project', JSON.stringify(project)); + data.append('mode', window.buildMode); + data.append('path', path); + + 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; + var doc = window.codeworldEditor.getDoc(); + window.savedGeneration = doc.changeGeneration(true); + updateUI(); + + if (allProjectNames[allProjectNames.length - 1].indexOf(fileName) == -1) { + discoverProjects(path, allProjectNames.length - 1); + } + }); + } + + 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({ From 01b433cc10c36c5d5b6146c55ce6f9203490077b Mon Sep 17 00:00:00 2001 From: Parv Mor Date: Wed, 16 Aug 2017 22:47:25 +0530 Subject: [PATCH 14/28] updates askForFeedback() according to latest backend --- codeworld-server/src/CommentUtil.hs | 17 ++- codeworld-server/src/Comment_.hs | 11 +- codeworld-server/src/Folder_.hs | 12 +- web/js/codeworld.js | 28 ++-- web/js/codeworld_comments.js | 207 ++++++++++++---------------- web/js/codeworld_shared.js | 85 +++++++++--- 6 files changed, 185 insertions(+), 175 deletions(-) diff --git a/codeworld-server/src/CommentUtil.hs b/codeworld-server/src/CommentUtil.hs index b3e884192..c5137e4e9 100644 --- a/codeworld-server/src/CommentUtil.hs +++ b/codeworld-server/src/CommentUtil.hs @@ -83,22 +83,25 @@ cleanCommentPaths mode commentFolder = do Just (currentUsers :: [UserDump]) <- decode <$> LB.readFile (commentHashPath <.> "users") forM_ currentUsers $ \u -> do - removeFileIfExists $ T.unpack (upath u) - removeFileIfExists $ T.unpack (upath u) <.> "info" - cleanBaseDirectory $ T.unpack (upath u) + case uuserIdent u of + "Anonymous Owner" -> return () + _ -> do + removeFileIfExists $ T.unpack (upath u) + removeFileIfExists $ T.unpack (upath u) <.> "info" + cleanBaseDirectory $ T.unpack (upath u) removeFileIfExists $ commentHashPath <.> "users" cleanBaseDirectory commentHashPath False -> return () deleteFolderWithComments :: BuildMode -> Text -> FilePath -> IO (Either String ()) deleteFolderWithComments mode userId' finalDir = do - dirBool <- doesDirectoryExist finalDir + 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 - let dir' = userProjectDir mode userId' finalDir allFilePaths <- getFilesRecursive dir' case length (splitDirectories finalDir) of x | x == 0 -> return $ Left "Root Directory Cannot Be Deleted" @@ -379,8 +382,8 @@ addSelf mode userId' userIdent' commentFolder = do createDirectoryIfMissing False commentFolder ensureCommentHashDir mode commentHash B.writeFile commentHashPath $ BC.pack commentFolder - LB.writeFile (commentHashPath <.> "users") $ encode . UserDump - userId' userIdent' $ T.pack $ take (length commentFolder - 9) commentFolder + LB.writeFile (commentHashPath <.> "users") $ encode (UserDump + userId' userIdent' (T.pack $ take (length commentFolder - 9) commentFolder) : []) createDirectoryIfMissing False $ commentFolder <.> "users" createDirectoryIfMissing False $ commentFolder <.> "versions" Just (project :: Project) <- decode <$> diff --git a/codeworld-server/src/Comment_.hs b/codeworld-server/src/Comment_.hs index f71a05943..62ef5a424 100644 --- a/codeworld-server/src/Comment_.hs +++ b/codeworld-server/src/Comment_.hs @@ -73,9 +73,10 @@ getFrequentParams getType clientId = do let projectId = nameToProjectId $ T.decodeUtf8 name finalDir = joinPath $ map (dirBase . nameToDirId . T.pack) path' commentFolder = commentRootDir mode (userId user) finalDir projectId - case path' !! 0 of - x | x /= "commentables" -> do - return (user, mode, commentFolder) + case length path' of + 0 -> return (user, mode, commentFolder) + _ -> case path' !! 0 of + x | x /= "commentables" -> return (user, mode, commentFolder) 2 -> do Just commentHash <- fmap (CommentId . T.decodeUtf8) <$> getParam "chash" commentFolder <- liftIO $ @@ -114,12 +115,12 @@ addSharedCommentHandler clientId = do case res of Left err -> do modifyResponse $ setContentType "text/plain" - modifyResponse $ setResponseCode 500 + modifyResponse $ setResponseCode 404 writeBS . BC.pack $ err Right _ -> return () _ -> do modifyResponse $ setContentType "text/plain" - modifyResponse $ setResponseCode 500 + modifyResponse $ setResponseCode 404 writeBS . BC.pack $ "Shared Comments Should Be In `commentables` Directory" commentShareHandler :: ClientId -> Snap () diff --git a/codeworld-server/src/Folder_.hs b/codeworld-server/src/Folder_.hs index 644ffe042..4e41d99ea 100644 --- a/codeworld-server/src/Folder_.hs +++ b/codeworld-server/src/Folder_.hs @@ -132,7 +132,7 @@ createFolderHandler clientId = do case finalDir == "commentables" of True -> do modifyResponse $ setContentType "text/plain" - modifyResponse $ setResponseCode 500 + modifyResponse $ setResponseCode 404 writeBS . BC.pack $ "`commentables` Hash Directory Is Forbidden In Root Folder For User Use" False -> do @@ -144,7 +144,7 @@ createFolderHandler clientId = do case res of Left err -> do modifyResponse $ setContentType "text/plain" - modifyResponse $ setResponseCode 500 + modifyResponse $ setResponseCode 404 writeBS . BC.pack $ err Right _ -> liftIO $ do createNewFolder mode (userId user) finalDir (last path') @@ -158,7 +158,7 @@ deleteFolderHandler clientId = do case res of Left err -> do modifyResponse $ setContentType "text/plain" - modifyResponse $ setResponseCode 500 + modifyResponse $ setResponseCode 404 writeBS . BC.pack $ err Right _ -> return () @@ -199,7 +199,7 @@ loadProjectHandler clientId = do case length (splitDirectories finalDir) of x | (x /= 0) && ((splitDirectories finalDir) !! 0 == "commentables") -> do modifyResponse $ setContentType "text/plain" - modifyResponse $ setResponseCode 500 + 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 @@ -257,7 +257,7 @@ moveProjectHandler clientId = do (_, _) -> return () False -> do modifyResponse $ setContentType "text/plain" - modifyResponse $ setResponseCode 500 + modifyResponse $ setResponseCode 404 writeBS . BC.pack $ "Cannot Move From `commentables` to Normal and vice-versa" newProjectHandler :: ClientId -> Snap () @@ -315,7 +315,7 @@ saveProjectHandler clientId = do case length (splitDirectories finalDir) of x | (x /= 0) && ((splitDirectories finalDir) !! 0 == "commentables") -> do modifyResponse $ setContentType "text/plain" - modifyResponse $ setResponseCode 500 + modifyResponse $ setResponseCode 404 writeBS . BC.pack $ "`commentables` Directory Does Not Allows Editing Projects" | otherwise -> do Just (project :: Project) <- decode . LB.fromStrict . fromJust <$> getParam "project" diff --git a/web/js/codeworld.js b/web/js/codeworld.js index f6f1d0de4..591f65394 100644 --- a/web/js/codeworld.js +++ b/web/js/codeworld.js @@ -89,14 +89,7 @@ function init() { } }); } else if (hash[0] == 'C') { - sendHttp('GET', 'viewCommentSource?chash=' + hash + '&mode=' + window.buildMode, null, function(request) { - if(request.status == 200) { - setCode(request.responseText, null, null, false); - window.location.hash = '#' + hash; - checkForCommentHash(); - window.chash = hash; - } - }); + addSharedComment(); } else if (hash[0] != 'F') { setCode(''); if (!signedIn()) help(); @@ -143,11 +136,19 @@ function initCodeworld() { window.codeworldEditor.refresh(); CodeMirror.commands.save = function(cm) { - saveProject(); + if (window.openProjectName == '' || window.openProjectName == undefined) { + newProject(); + } else { + saveProject(); + } } document.onkeydown = function(e) { if (e.ctrlKey && e.keyCode === 83) { // Ctrl+S - saveProject(); + if (window.openProjectName == '' || window.openProjectName == undefined) { + newProject(); + } else { + saveProject(); + } return false; } if (e.ctrlKey && e.keyCode === 73) { // Ctrl+I @@ -483,7 +484,6 @@ function updateNavBar() { document.getElementById('compileButton').style.display = ''; document.getElementById('stopButton').style.display = ''; } - checkForCommentHash(); } function moveProject() { @@ -726,12 +726,6 @@ function loadProject(name, index) { function successFunc(project){ setCode(project.source, project.history, name); addPresentCommentInd(); - /*var doc = window.codeworldEditor.getDoc(); - doc.eachLine(function(f) { - f.on('delete', function() { - shiftLineByX(f.lineNo(), -1); - }); - });*/ } loadProject_(index, name, window.buildMode, successFunc); } diff --git a/web/js/codeworld_comments.js b/web/js/codeworld_comments.js index bd9305669..8fe6a7411 100644 --- a/web/js/codeworld_comments.js +++ b/web/js/codeworld_comments.js @@ -14,19 +14,90 @@ * limitations under the License. */ -function checkForCommentHash() { - var hash = window.location.hash.slice(1); - if (hash.length > 0) { - if (hash.slice(-2) == '==') { - hash = hash.slice(0, -2); +function addSharedComment() { + if (!signedIn()) { + sweetAlert('Oops!', 'You must sign in to view this!', '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('chash', hash); + + function go() { + sendHttp('POST', 'addSharedComment', data, function(request) { + if(request.status == 200) { + setCode(''); + nestedDirs = [""]; + allProjectNames = [[]]; + allFolderNames = [[]]; + discoverProjects("", 0); + updateUI(); + sweetAlert('Success!', 'The shared 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'); + } + updateUI(); + return; + } + }); + } + + // 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 (hash[0] == 'C') { - document.getElementById('askFeedbackButton').style.display = ''; - document.getElementById('stopButton').style.display = ''; - document.getElementById('compileButton').style.display = ''; + if (!(path.startsWith('/commentables/') || path.startsWith('commentables/') || path == '/commentables' || path == 'commentables')) { + if (path[0] == '/') { + path = 'commentables' + path; + } else { + path = 'commentables/' + path; + } } - } - return; + 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() { @@ -36,31 +107,8 @@ function shareForFeedback() { return; } if (openProjectName == '' || openProjectName == null) { - var hash = window.location.hash.slice(1); - if (hash.length > 0) { - if (hash.slice(-2) == '==') { - hash = hash.slice(0, -2); - } - if (hash[0] == 'C') { - sweetAlert({ - html: true, - title: '  Ask Feedback', - text: msg, - type: 'input', - inputValue: window.location.href, - showConfirmButton: false, - showCancelButton: true, - cancelButtonText: 'Done', - animation: 'slide-from-bottom' - }); - } else { - sweetAlert('Oops!', 'You must select your project for feedback!', 'error'); - updateUI(); - } - } else { - sweetAlert('Oops!', 'You must select a project for feedback!', 'error'); - updateUI(); - } + sweetAlert('Oops!', 'You must select a project for feedback!', 'error'); + updateUI(); return; } var path = nestedDirs.slice(1).join('/'); @@ -134,15 +182,7 @@ function addPresentCommentInd() { } function toggleUserComments(cm, line, gutter) { - var hash = window.location.hash.slice(1); - if (hash.length > 0) { - if (hash.slice(-2) == '==') { - hash = hash.slice(0, -2); - } - if (hash.length > 0 && hash[0] != 'C') { - return; - } - } else if (openProjectName == null || openProjectName == '') { + if (openProjectName == null || openProjectName == '') { return; } doc = codeworldEditor.getDoc(); @@ -521,80 +561,3 @@ function deleteReply(ind, commentIdx, line) { }); } } -/* -function shiftLineByX(lineNo, x) { - if (!signedIn()) { - sweetAlert('Oops!', 'Please sign in to continue, otherwise the comments in the file will be misplaced.', 'error'); - return; - } - if (openProjectName == null || openProjectName == '') { - return; - } - if (window.openCommentLines != undefined) { - return; - } - console.log(lineNo) - if (window.currentShift != undefined) { - if (window.pendingShifts == undefined) { - window.pendingShifts = [[],[]]; - } - if (openProjectName != window.currentShiftFile || nestedDirs.slice(1).join('/') != window.currentShiftDir) { - return; - } - window.pendingShifts[0].push(lineNo); - window.pendingShifts[1].push(x); - } else { - window.currentShift = [[lineNo], [x]]; - window.currentShiftFile = openProjectName; - window.currentShiftDir = nestedDirs.slice(1).join('/'); - var data = new FormData(); - data.append('id_token', auth2.currentUser.get().getAuthResponse().id_token); - data.append('mode', window.buildMode); - data.append('path', window.currentShiftDir); - data.append('name', window.currentShiftFile); - data.append('shifts', JSON.stringify([[lineNo], [x]])); - sendHttp('POST', 'shiftLinesByXs', data, function(request) { - if (request.status != 200) { - sweetAlert('Oops!', 'Could not update comments according to the new line changes! Reverting back to previous version.', 'error'); - revertBack(); - return; - } - if (window.pendingShifts != undefined) { - var data = new FormData(); - data.append('id_token', auth2.currentUser.get().getAuthResponse().id_token); - data.append('mode', window.buildMode); - data.append('path', window.currentShiftDir); - data.append('name', window.currentShiftFile); - data.append('shifts', JSON.stringify(window.pendingShifts)); - window.currentShift = window.pendingShifts; - window.pendingShifts = undefined; - sendHttp('POST', 'shiftLinesByXs', data, function(request) { - if (request.status != 200) { - sweetAlert('Oops!', 'Could not update comments according to the new line changes!', 'error'); - return; - } - window.currentShift = undefined; - window.currentShiftFile = undefined; - window.currentShiftDir = undefined; - }); - - } else { - window.currentShift = undefined; - window.currentShiftFile = undefined; - window.currentShiftDir = undefined; - } - }); - } -} - -function revertBack() { - -}*/ - -function randomString(length = 32, chars = '0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ') { - var result = ''; - for (var i = length; i > 0; i--) { - result += chars[Math.floor(Math.random() * chars.length)]; - } - return result; -} diff --git a/web/js/codeworld_shared.js b/web/js/codeworld_shared.js index cf477f02f..53420c6ed 100644 --- a/web/js/codeworld_shared.js +++ b/web/js/codeworld_shared.js @@ -357,6 +357,20 @@ function moveHere_(path, buildMode, successFunc) { cancelMove(); 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'); + } + cancelMove(); + return; + } + successFunc(); + }); + } var data = new FormData(); data.append('id_token', auth2.currentUser.get().getAuthResponse().id_token); @@ -365,28 +379,30 @@ function moveHere_(path, buildMode, successFunc) { data.append('moveFrom', window.move.path); if (window.move.file != undefined) { data.append('isFile', 'true'); - data.append('name', window.move.file); + data.append('fromName', window.move.file); + sweetAlert({ + html: true, + title: '  Move File', + text: 'Enter a name for your file to be created at /' + path + ':', + type: 'input', + inputValue: '', + confirmButtonText: 'Move', + showCancelButton: true, + closeOnConfirm: false + }, function (name) { + sweetAlert.close(); + data.append('name', name); + go(); + }); } else { data.append('isFile', 'false'); + 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'); - } - cancelMove(); - return; - } - successFunc(); - }); } function copyHere_(path, buildMode, successFunc) { if (!signedIn()) { - sweetAlert('Oops!', 'You must sign in before moving.', 'error'); + sweetAlert('Oops!', 'You must sign in before copying.', 'error'); cancelCopy(); return; } @@ -438,7 +454,6 @@ function copyHere_(path, buildMode, successFunc) { data.append('isFile', 'false'); go(); } - } function warnIfUnsaved(action, showAnother) { @@ -527,7 +542,12 @@ function saveProjectBase_(path, projectName, mode, successFunc, type) { sendHttp('POST', 'saveProject', data, function(request) { if (request.status != 200) { - sweetAlert('Oops!', 'Could not ' + type + ' your project!!! Please try again.', 'error'); + if (request.status == 404) { + sweetAlert('Oops!', request.responseText, 'error'); + } else { + sweetAlert('Oops!', 'Could not ' + type + ' your project!!! Please try again.', 'error'); + } + updateUI(); return; } @@ -577,6 +597,14 @@ function deleteProject_(path, buildMode, successFunc) { 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; } }); } @@ -615,6 +643,14 @@ function deleteFolder_(path, buildMode, successFunc) { 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; } }); } @@ -654,7 +690,12 @@ function createFolder(path, buildMode, successFunc) { sendHttp('POST', 'createFolder', data, function(request) { if (request.status != 200) { - sweetAlert('Oops', 'Could not create your directory! Please try again.', 'error'); + if (request.status == 404) { + sweetAlert('Oops!', request.responseText, 'error'); + } else { + sweetAlert('Oops', 'Could not create your directory! Please try again.', 'error'); + } + updateUI(); return; } @@ -778,6 +819,14 @@ function loadProject_(index, name, buildMode, successFunc) { 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); From c26cd61e4fabc67ab65f10ea2f4e18a9f9eda8e9 Mon Sep 17 00:00:00 2001 From: Parv Mor Date: Mon, 21 Aug 2017 23:13:02 +0530 Subject: [PATCH 15/28] update frontend to accomodate versions --- codeworld-server/src/CommentUtil.hs | 15 +-- codeworld-server/src/Comment_.hs | 9 ++ codeworld-server/src/Folder_.hs | 17 ++- web/env.html | 15 +-- web/js/codeworld.js | 60 +++++++---- web/js/codeworld_comments.js | 157 ++++++++++++++++++++++++++++ web/js/codeworld_shared.js | 98 +++++++++-------- web/js/funblocks.js | 4 +- 8 files changed, 289 insertions(+), 86 deletions(-) diff --git a/codeworld-server/src/CommentUtil.hs b/codeworld-server/src/CommentUtil.hs index c5137e4e9..8d02ce395 100644 --- a/codeworld-server/src/CommentUtil.hs +++ b/codeworld-server/src/CommentUtil.hs @@ -291,16 +291,17 @@ moveFolderFromSelf mode userId' fromDir toDir name = do removeDirectoryIfExists fromDir cleanBaseDirectory fromDir -createNewVersionIfReq :: Text -> FilePath -> IO () -createNewVersionIfReq latestSource commentFolder = do +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 of - True -> return () - False -> do + case (currentSource == latestSource, currentVersion == versionNo') of + (_, False) -> 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 . decode <$> LB.readFile (commentFolder show x)) currentLines @@ -312,7 +313,8 @@ createNewVersionIfReq latestSource commentFolder = do B.writeFile (commentFolder <.> "versions" show (currentVersion + 1)) $ T.encodeUtf8 latestSource ensureVersionLines (currentVersion + 1) commentFolder - False -> return () + return $ Right () + False -> return $ Right () updateUserVersionLS :: Text -> FilePath -> IO () updateUserVersionLS userIdent' commentFolder = do @@ -347,7 +349,6 @@ ensureVersionLines versionNo' commentFolder = do currentUsers <- map T.pack <$> listDirectory (commentFolder <.> "users") forM_ currentUsers (\u -> updateUserVersionLS u commentFolder) - addNewUser :: Text -> Text -> FilePath -> FilePath -> FilePath -> IO (Either String ()) addNewUser userId' userIdent' name userPath commentHashPath = do let identAllowed = foldl (\acc l -> diff --git a/codeworld-server/src/Comment_.hs b/codeworld-server/src/Comment_.hs index 62ef5a424..731a141a4 100644 --- a/codeworld-server/src/Comment_.hs +++ b/codeworld-server/src/Comment_.hs @@ -56,6 +56,7 @@ commentRoutes clientId = , ("readComment", readCommentHandler clientId) , ("readOwnerComment", readOwnerCommentHandler clientId) , ("viewCommentSource", viewCommentSourceHandler clientId) + , ("viewOwnerCommentSource", viewOwnerCommentSourceHandler clientId) , ("writeComment", writeCommentHandler clientId) , ("writeOwnerComment", writeOwnerCommentHandler clientId) , ("writeOwnerReply", writeOwnerReplyHandler clientId) @@ -321,6 +322,14 @@ viewCommentSourceHandler clientId = do modifyResponse $ setContentType "text/x-haskell" writeBS currentSource +viewOwnerCommentSourceHandler :: ClientId -> Snap() +viewOwnerCommentSourceHandler clientId = do + (_, _, commentFolder) <- getFrequentParams 1 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 3 clientId diff --git a/codeworld-server/src/Folder_.hs b/codeworld-server/src/Folder_.hs index 4e41d99ea..74ade3af7 100644 --- a/codeworld-server/src/Folder_.hs +++ b/codeworld-server/src/Folder_.hs @@ -319,10 +319,17 @@ saveProjectHandler clientId = do writeBS . BC.pack $ "`commentables` Directory Does Not Allows Editing Projects" | otherwise -> do Just (project :: Project) <- decode . LB.fromStrict . fromJust <$> getParam "project" + Just (versionNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "versionNo" let projectId = nameToProjectId (projectName project) file = userProjectDir mode (userId user) finalDir projectFile projectId - liftIO $ do - -- no need to ensure a project file as - -- constrained to create a new project before editing. - LB.writeFile file $ encode project - createNewVersionIfReq (projectSource project) $ file <.> "comments" + -- no need to ensure a project file as + -- constrained to create a new project before editing. + liftIO $ LB.writeFile file $ encode project + res <- liftIO $ createNewVersionIfReq (projectSource project) versionNo' $ + file <.> "comments" + case res of + Left err -> do + modifyResponse $ setContentType "text/plain" + modifyResponse $ setResponseCode 404 + writeBS . BC.pack $ err + Right _ -> return () diff --git a/web/env.html b/web/env.html index 944a814a9..0db186133 100644 --- a/web/env.html +++ b/web/env.html @@ -28,13 +28,13 @@ @@ -52,6 +52,9 @@   Save As + @@ -64,18 +67,18 @@ - - +
diff --git a/web/js/codeworld.js b/web/js/codeworld.js index 591f65394..8d0190bc9 100644 --- a/web/js/codeworld.js +++ b/web/js/codeworld.js @@ -293,7 +293,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'; @@ -304,7 +310,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'; @@ -334,7 +344,13 @@ function updateUI() { window.move = undefined; window.copy = undefined; - document.getElementById('newButton').style.display = ''; + + 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 = ''; var NDlength = nestedDirs.length; @@ -345,16 +361,20 @@ function updateUI() { document.getElementById('shareFolderButton').style.display = 'none'; } if (openProjectName == null || openProjectName == '') { + document.getElementById('viewCommentVersions').style.display = 'none'; + window.currentVersion = undefined; + window.maxVersion = undefined; + window.project = undefined; document.getElementById('askFeedbackButton').style.display = 'none'; } else { + document.getElementById('viewCommentVersions').style.display = ''; document.getElementById('askFeedbackButton').style.display = ''; } updateNavBar(); document.getElementById('moveHereButton').style.display = 'none'; document.getElementById('copyHereButton').style.display = 'none'; - document.getElementById('cancelMoveButton').style.display = 'none'; - document.getElementById('cancelCopyButton').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 = ''; @@ -378,24 +398,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; @@ -478,8 +497,13 @@ function updateNavBar() { document.getElementById('compileButton').style.display = 'none'; document.getElementById('stopButton').style.display = 'none'; } else { - window.codeworldEditor.setOption('readOnly', false); - document.getElementById('saveAsButton').style.display = ''; + if (window.isCommentables == true) { + window.codeWorldEditor.setOption('readOnly', true); + document.getElementById('saveAsButton').style.display = 'none'; + } else { + window.codeworldEditor.setOption('readOnly', false); + document.getElementById('saveAsButton').style.display = ''; + } document.getElementById('downloadButton').style.display = ''; document.getElementById('compileButton').style.display = ''; document.getElementById('stopButton').style.display = ''; @@ -518,10 +542,9 @@ function moveProject() { 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('cancelCopyButton').style.display = 'none'; document.getElementById('runButtons').style.display = 'none'; window.move = Object(); @@ -564,10 +587,9 @@ function copyProject() { document.getElementById('downloadButton').style.display = 'none'; document.getElementById('copyButton').style.display = 'none'; document.getElementById('copyHereButton').style.display = ''; - document.getElementById('cancelCopyButton').style.display = ''; + document.getElementById('cancelButton').style.display = ''; document.getElementById('moveButton').style.display = 'none'; document.getElementById('moveHereButton').style.display = 'none'; - document.getElementById('cancelMoveButton').style.display = 'none'; document.getElementById('runButtons').style.display = 'none'; window.copy = Object(); @@ -712,19 +734,17 @@ function newProject() { } function newFolder() { - function successFunc() { - if (window.move == undefined && window.copy == 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 || window.copy != undefined) { return; } - function successFunc(project){ + function successFunc(project) { + window.project = project setCode(project.source, project.history, name); + getCommentVersions(); addPresentCommentInd(); } loadProject_(index, name, window.buildMode, successFunc); diff --git a/web/js/codeworld_comments.js b/web/js/codeworld_comments.js index 8fe6a7411..a30b660fb 100644 --- a/web/js/codeworld_comments.js +++ b/web/js/codeworld_comments.js @@ -14,6 +14,114 @@ * 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)); + }); +} + +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('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 = '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('viewCommentVersions').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; + } + 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(); + doc.setValue(code); + // if () + + window.version + updateUI(); + }); + return; + }, false); +} + function addSharedComment() { if (!signedIn()) { sweetAlert('Oops!', 'You must sign in to view this!', 'error'); @@ -561,3 +669,52 @@ function deleteReply(ind, commentIdx, line) { }); } } + +function generateTestEnv() { + warnIfUnsaved(function() { + if (!signedIn()) { + sweetAlert('Oops!', 'You need to login to test the code.', 'error'); + updateUI(); + return; + } + if (!(window.nestedDirs.length > 1 && window.nestedDir[1] == 'commentables')) { + updateUI(); + return; + } + if (openProjectName == '' || openProjectName == null) { + updateUI(); + return; + } + window.testEnv = new Object(); + window.testEnv.project = window.project.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('saveAsButton').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 (project.lastChild) { + projects.removeChild(projects.lastChild); + } + document.getElementById('viewCommentVersions').onclick = function() { + window.openProjectName = window.testEnv.prevName; + var doc = window.codeworldEditor.getDoc(); + doc.setValue(window.testEnv.project); + window.testEnv = undefined; + updateUI(); + }; + var doc = window.codeworldEditor.getDoc(); + doc.setValue(window.testEnv.project); + doc.clearHistory(); + }, false); +} diff --git a/web/js/codeworld_shared.js b/web/js/codeworld_shared.js index 53420c6ed..51828d2a7 100644 --- a/web/js/codeworld_shared.js +++ b/web/js/codeworld_shared.js @@ -337,24 +337,20 @@ function discoverProjects_(path, buildMode, index) { }); } -function cancelMove() { - updateUI(); -} - -function cancelCopy() { +function cancel() { updateUI(); } function moveHere_(path, buildMode, successFunc) { if (!signedIn()) { sweetAlert('Oops!', 'You must sign in before moving.', 'error'); - cancelMove(); + cancel(); return; } if (window.move == undefined) { sweetAlert('Oops!', 'You must first select something to move.', 'error'); - cancelMove(); + cancel(); return; } function go() { @@ -365,7 +361,7 @@ function moveHere_(path, buildMode, successFunc) { } else { sweetAlert('Oops!', 'Could not move your project! Please try again.', 'error'); } - cancelMove(); + cancel(); return; } successFunc(); @@ -403,13 +399,13 @@ function moveHere_(path, buildMode, successFunc) { function copyHere_(path, buildMode, successFunc) { if (!signedIn()) { sweetAlert('Oops!', 'You must sign in before copying.', 'error'); - cancelCopy(); + cancel(); return; } if (window.copy == undefined) { sweetAlert('Oops!', 'You must first select something to copy.', 'error'); - cancelCopy(); + cancel(); return; } function go() { @@ -420,7 +416,7 @@ function copyHere_(path, buildMode, successFunc) { } else { sweetAlert('Oops!', 'Could not copy your project! Please try again.', 'error'); } - cancelCopy(); + cancel(); return; } successFunc(); @@ -666,7 +662,7 @@ function deleteFolder_(path, buildMode, successFunc) { }, go); } -function createFolder(path, buildMode, successFunc) { +function createFolder(path, buildMode) { warnIfUnsaved(function() { if(!signedIn()) { sweetAlert('Oops!', 'You must sign in to create a folder.', 'error'); @@ -678,7 +674,6 @@ function createFolder(path, buildMode, successFunc) { if(folderName == null || folderName == '') { return; } - sweetAlert.close(); var data = new FormData(); data.append('id_token', auth2.currentUser.get().getAuthResponse().id_token); @@ -687,7 +682,6 @@ function createFolder(path, buildMode, successFunc) { data.append('path', folderName); else data.append('path', path + '/' + folderName); - sendHttp('POST', 'createFolder', data, function(request) { if (request.status != 200) { if (request.status == 404) { @@ -698,12 +692,13 @@ function createFolder(path, buildMode, successFunc) { updateUI(); return; } - allFolderNames[allFolderNames.length - 1].push(folderName); nestedDirs.push(folderName); allFolderNames.push([]); allProjectNames.push([]); - successFunc(); + if (window.move == undefined && window.copy == undefined) { + setCode(''); + } updateNavBar(); }); } @@ -728,6 +723,11 @@ function newProject_(path) { updateUI(); return; } + if (path.length > 1 && path[1] == 'commentables') { + sweetAlert('error', 'Cannot create a project in commentables directory!', 'error'); + updateUI(); + return; + } function go(fileName) { if (fileName == null || fileName == '') { @@ -740,7 +740,6 @@ function newProject_(path) { sweetAlert.close(); var project = getCurrentProject(); project['name'] = fileName; - var data = new FormData(); data.append('id_token', auth2.currentUser.get().getAuthResponse().id_token); data.append('project', JSON.stringify(project)); @@ -797,39 +796,46 @@ function newProject_(path) { } function loadProject_(index, name, buildMode, successFunc) { - warnIfUnsaved(function(){ - if (!signedIn()) { - sweetAlert('Oops!', 'You must sign in to open projects.', 'error'); - updateUI(); - 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); + warnIfUnsaved(function(){ + if (!signedIn()) { + sweetAlert('Oops!', 'You must sign in to open or close projects.', 'error'); 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'); - } + return; + } + if (window.openProjectName != '' && window.openProjectName != null) { + setCode(''); updateUI(); return; } - }); - }, false); + if (window.nestedDirs.length > 1 && window.nestedDirs[0] == '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() { diff --git a/web/js/funblocks.js b/web/js/funblocks.js index fc6ef36fd..db456a26c 100644 --- a/web/js/funblocks.js +++ b/web/js/funblocks.js @@ -346,7 +346,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 +491,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(); From 0a075203703f6e6d21aebb56007529f7b5cc82f2 Mon Sep 17 00:00:00 2001 From: Parv Mor Date: Fri, 25 Aug 2017 23:08:28 +0530 Subject: [PATCH 16/28] remove save as functionality --- web/env.html | 5 +-- web/js/codeworld.js | 17 ++++++---- web/js/codeworld_comments.js | 25 ++++++++++----- web/js/codeworld_shared.js | 62 +++++++++++------------------------- 4 files changed, 48 insertions(+), 61 deletions(-) diff --git a/web/env.html b/web/env.html index 0db186133..da9c32872 100644 --- a/web/env.html +++ b/web/env.html @@ -49,11 +49,8 @@ - -   Save As - + @@ -101,6 +104,7 @@
+ @@ -137,12 +141,15 @@ }); + + + diff --git a/web/js/codeworld.js b/web/js/codeworld.js index 4c4e37a5f..dfddae36a 100644 --- a/web/js/codeworld.js +++ b/web/js/codeworld.js @@ -88,6 +88,8 @@ function init() { }); } else if (hash[0] == 'C') { addSharedComment(hash); + } else if (hash[0] == 'H') { + addToCollaborate(hash); } else { initCodeworld(); registerStandardHints(function(){setMode(true);}); @@ -109,7 +111,7 @@ function init() { setCode(request.responseText, null, null, true); } }); - } else if (hash[0] != 'F' && hash[0] !='C') { + } else if (hash[0] != 'F' && hash[0] !='C' && hash[0] != 'H') { setCode(''); if (!signedIn()) help(); } @@ -373,19 +375,39 @@ function updateUI() { } 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 { @@ -523,7 +545,11 @@ function updateNavBar() { window.codeworldEditor.setOption('readOnly', true); } else { if (window.currentVersion == window.maxVersion) { - window.codeworldEditor.setOption('readOnly', false); + if (window.socket != undefined) { + window.codeworldEditor.setOption('readOnly', false); + } else { + window.codeworldEditor.setOption('readOnly', true); + } } else { window.codeworldEditor.setOption('readOnly', true); } @@ -768,7 +794,7 @@ function loadProject(name, index) { setCode(project.source, project.history, name); getCommentVersions(); getUserIdent(); - addPresentCommentInd(); + initializeCollaboration(); } loadProject_(index, name, window.buildMode, successFunc); } diff --git a/web/js/codeworld_collaborate.js b/web/js/codeworld_collaborate.js index 36a9762a0..be062f5ab 100644 --- a/web/js/codeworld_collaborate.js +++ b/web/js/codeworld_collaborate.js @@ -13,3 +13,292 @@ * 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: '  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('listCurrentOwners').style.display = 'none'; + + 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 == '') ? '' : (':' + window.location.port)) + + 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 index 5de4d6ef5..fafba2c8d 100644 --- a/web/js/codeworld_comments.js +++ b/web/js/codeworld_comments.js @@ -39,6 +39,7 @@ function getCommentVersions() { } addCommentVersions(versions.sort(sortNumber)); updateUI(); + addPresentCommentInd(); }); } @@ -98,6 +99,7 @@ function viewCommentVersions() { 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) { @@ -189,6 +191,7 @@ function loadProjectForComments(index, name, buildMode, successFunc) { updateUI(); addCommentVersions(versions); getUserIdent(); + addPresentCommentInd(); }); }); } @@ -211,7 +214,7 @@ function addSharedComment(hash) { allFolderNames = [[]]; discoverProjects("", 0); updateUI(); - sweetAlert('Success!', 'The shared folder is moved into the specifed directory.', 'success'); + sweetAlert('Success!', 'The commentable folder is moved into the specifed directory.', 'success'); return; } else { if (request.status == 404) { @@ -312,7 +315,7 @@ function shareForFeedback() { a.hash = '#' + request.responseText; sweetAlert({ html: true, - title: '  Ask Feedback', + title: '  Ask Feedback', text: msg, type: 'input', inputValue: a.href, @@ -325,41 +328,47 @@ function shareForFeedback() { } function addPresentCommentInd() { - /* if (!signedIn()) { + 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; + } - function go(request) { + 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) { - sweetAlert('Oops!', 'Sorry! Could not load an indicator of where comments are present.', 'error'); + 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) + 1].innerHTML = 'c ' + i; + document.getElementsByClassName('CodeMirror-gutter-elt')[Number(i)].innerHTML = '! ' + 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'; } - } - - var data = new FormData(); - data.append('mode', window.buildMode); - data.append('id_token', auth2.currentUser.get().getAuthResponse().id_token); - if (window.chash != undefined){ - data.append('chash', window.chash); - sendHttp('POST', 'listComments', data, function(request) { - go(request); - }); - } else { - data.append('path', nestedDirs.slice(1).join('/')); - data.append('name', openProjectName); - sendHttp('POST', 'listOwnerComments', data, function(request) { - go(request); - }); - }*/ + }); } function toggleUserComments(cm, line, gutter) { diff --git a/web/js/codeworld_shared.js b/web/js/codeworld_shared.js index 247ce44db..3cf0e27ca 100644 --- a/web/js/codeworld_shared.js +++ b/web/js/codeworld_shared.js @@ -794,6 +794,7 @@ function newProject_(path) { }; window.currentVersion = 0; window.maxVersion = 0; + initializeCollaboration(); }); } diff --git a/web/js/ot-min.js b/web/js/ot-min.js new file mode 120000 index 000000000..1ed049ed9 --- /dev/null +++ b/web/js/ot-min.js @@ -0,0 +1 @@ +../../third_party/ot.js/ot-min.js \ No newline at end of file From fd7206e38517c04b85a8db30fe22c685bb27f65f Mon Sep 17 00:00:00 2001 From: parv Date: Fri, 8 Sep 2017 04:50:36 +0530 Subject: [PATCH 23/28] make a seperate library for funblocks-server due to conflicting handlers with codeworld-server --- build.sh | 3 +- codeworld-server/codeworld-server.cabal | 1 + codeworld-server/src/Main.hs | 38 +- funblocks-server/.ghci | 2 + funblocks-server/.gitignore | 1 + funblocks-server/LICENSE | 202 +++++ funblocks-server/Setup.hs | 15 + funblocks-server/funblocks-server.cabal | 45 ++ funblocks-server/src/Funblocks.hs | 261 ++++++ funblocks-server/src/Model.hs | 62 ++ funblocks-server/src/Util.hs | 245 ++++++ web/blocks.html | 8 +- web/doc.html | 2 +- web/env.html | 2 +- web/js/codeworld.js | 2 +- web/js/codeworld_collaborate.js | 1 - ...eworld_shared.js => codeworld_requests.js} | 2 - web/js/funblocks.js | 9 +- web/js/funblocks_requests.js | 762 ++++++++++++++++++ 19 files changed, 1620 insertions(+), 43 deletions(-) create mode 100644 funblocks-server/.ghci create mode 100644 funblocks-server/.gitignore create mode 100644 funblocks-server/LICENSE create mode 100644 funblocks-server/Setup.hs create mode 100644 funblocks-server/funblocks-server.cabal create mode 100644 funblocks-server/src/Funblocks.hs create mode 100644 funblocks-server/src/Model.hs create mode 100644 funblocks-server/src/Util.hs rename web/js/{codeworld_shared.js => codeworld_requests.js} (99%) create mode 100644 web/js/funblocks_requests.js diff --git a/build.sh b/build.sh index f5a425b03..e9fa25693 100755 --- a/build.sh +++ b/build.sh @@ -44,9 +44,10 @@ run codeworld-api cabal haddock --hoogle # Build codeworld-server from this project. run . cabal_install ./third_party/ot.hs \ - ./codeworld-server \ + ./funblocks-server \ ./codeworld-error-sanitizer \ ./codeworld-compiler \ + ./codeworld-server \ ./codeworld-game-api \ ./codeworld-prediction \ ./codeworld-api \ diff --git a/codeworld-server/codeworld-server.cabal b/codeworld-server/codeworld-server.cabal index f5f37fecd..46d654695 100644 --- a/codeworld-server/codeworld-server.cabal +++ b/codeworld-server/codeworld-server.cabal @@ -28,6 +28,7 @@ Executable codeworld-server engine-io-snap, filepath, filesystem-trees, + funblocks-server, hashable, hindent >= 5 && < 5.2.3, http-conduit, diff --git a/codeworld-server/src/Main.hs b/codeworld-server/src/Main.hs index b6fe8192d..20355158b 100644 --- a/codeworld-server/src/Main.hs +++ b/codeworld-server/src/Main.hs @@ -43,10 +43,11 @@ import System.FilePath import Collaboration import Comment -import DataUtil -import Folder -import Model -import SnapUtil +import DataUtil +import Folder +import qualified Funblocks as FB +import Model +import SnapUtil main :: IO () main = do @@ -73,32 +74,21 @@ site :: Snap () -> ClientId -> Snap () site socketIOHandler clientId = route ([ ("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) ] ++ (collabRoutes socketIOHandler clientId) ++ (commentRoutes clientId) ++ - (folderRoutes clientId)) <|> + (folderRoutes clientId) ++ + (FB.funblockRoutes $ currToFB clientId)) <|> serveDirectory "web" - -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)) + where + currToFB clientId = case clientId of + ClientId a -> FB.ClientId a compileHandler :: Snap () compileHandler = do @@ -116,14 +106,6 @@ compileHandler = do let result = CompileResult (unProgramId programId) (unDeployId deployId) writeLBS (encode result) -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 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/funblocks-server/Setup.hs b/funblocks-server/Setup.hs new file mode 100644 index 000000000..51c7b3500 --- /dev/null +++ b/funblocks-server/Setup.hs @@ -0,0 +1,15 @@ +{- + 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 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 +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/funblocks-server/src/Util.hs b/funblocks-server/src/Util.hs new file mode 100644 index 000000000..5fa505f52 --- /dev/null +++ b/funblocks-server/src/Util.hs @@ -0,0 +1,245 @@ +{-# 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 Util where + +import Control.Exception +import Control.Monad +import qualified Crypto.Hash as Crypto +import Data.Aeson +import Data.ByteArray (convert) +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as BC +import qualified Data.ByteString.Base64 as B64 +import qualified Data.ByteString.Lazy as LB +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 + +import Model + +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 + +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 + if exists then decode <$> LB.readFile f else return Nothing + return $ map projectName 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.") <$> listDirectory userRoot + mapM_ (\x -> createDirectoryIfMissing False $ userRoot take 3 x) prevContent + mapM_ (\x -> renameFile (userRoot x) $ userRoot take 3 x x) prevContent + +getFilesRecursive :: FilePath -> IO [FilePath] +getFilesRecursive path = do + dirBool <- isDir path + case dirBool of + True -> do + contents <- listDirectory path + concat <$> mapM (getFilesRecursive . (path )) contents + False -> return [path] + +dirToCheckSum :: FilePath -> IO Text +dirToCheckSum path = do + files <- getFilesRecursive path + fileContents <- mapM B.readFile files + let cryptoContext = Crypto.hashInitWith Crypto.MD5 + return $ (T.pack "F" <>) + . T.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 + +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/web/blocks.html b/web/blocks.html index 6ce1cb813..410a406a2 100644 --- a/web/blocks.html +++ b/web/blocks.html @@ -61,10 +61,10 @@ - + - - + + @@ -110,7 +110,7 @@ Edit code - + 
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 @@
     
     
     
-    
+    
     
   
   
diff --git a/web/env.html b/web/env.html
index 4a715e75f..d23bf28c3 100644
--- a/web/env.html
+++ b/web/env.html
@@ -147,7 +147,7 @@
     
     
     
-    
+    
     
     
     
diff --git a/web/js/codeworld.js b/web/js/codeworld.js
index cb1bebe8f..8f29b0603 100644
--- a/web/js/codeworld.js
+++ b/web/js/codeworld.js
@@ -603,7 +603,7 @@ function moveProject() {
         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;
diff --git a/web/js/codeworld_collaborate.js b/web/js/codeworld_collaborate.js
index be062f5ab..f709f7175 100644
--- a/web/js/codeworld_collaborate.js
+++ b/web/js/codeworld_collaborate.js
@@ -169,7 +169,6 @@ function listCurrentOwners() {
             return;
         }
         window.owners = JSON.parse(request.responseText);
-        document.getElementById('listCurrentOwners').style.display = 'none';
 
         document.getElementById('newFolderButton').style.display = 'none';
         document.getElementById('newButton').style.display = 'none';
diff --git a/web/js/codeworld_shared.js b/web/js/codeworld_requests.js
similarity index 99%
rename from web/js/codeworld_shared.js
rename to web/js/codeworld_requests.js
index 97f1510aa..27517dd6d 100644
--- a/web/js/codeworld_shared.js
+++ b/web/js/codeworld_requests.js
@@ -789,8 +789,6 @@ function newProject_(path) {
                     }
 
                     window.openProjectName = fileName;
-                    var doc = window.codeworldEditor.getDoc();
-                    window.savedGeneration = doc.changeGeneration(true);
                     updateUI();
 
                     if (allProjectNames[allProjectNames.length - 1].indexOf(fileName) == -1) {
diff --git a/web/js/funblocks.js b/web/js/funblocks.js
index db456a26c..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;
 
diff --git a/web/js/funblocks_requests.js b/web/js/funblocks_requests.js
new file mode 100644
index 000000000..2104f49af
--- /dev/null
+++ b/web/js/funblocks_requests.js
@@ -0,0 +1,762 @@
+/*
+ * 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(/program\.hs:(\d+):((\d+)(-\d+)?)/g,
+            'Line $1, Column $2')
+        .replace(/program\.hs:\((\d+),(\d+)\)-\((\d+),(\d+)\)/g,
+            'Line $1-$3, Column $2-$4');
+
+    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', 'flistFolder', data, function(request) {
+        if (request.status != 200) {
+            return;
+        }
+        var allContents = JSON.parse(request.responseText);
+        allProjectNames[index] = allContents['files'];
+        allFolderNames[index] = allContents['dirs'];
+        updateNavBar();
+    });
+}
+
+function cancelMove() {
+    updateUI();
+}
+
+function moveHere_(path, buildMode, successFunc) {
+    if (!signedIn()) {
+        sweetAlert('Oops!', 'You must sign in before moving.', 'error');
+        cancelMove();
+        return;
+    }
+
+    if (window.move == undefined) {
+        sweetAlert('Oops!', 'You must first select something to move.', 'error');
+        cancelMove();
+        return;
+    }
+
+    var data = new FormData();
+    data.append('id_token', auth2.currentUser.get().getAuthResponse().id_token);
+    data.append('mode', buildMode);
+    data.append('moveTo', path);
+    data.append('moveFrom', window.move.path);
+    if (window.move.file != undefined) {
+        data.append('isFile', "true");
+        data.append('name', window.move.file);
+    } else {
+        data.append('isFile', "false");
+    }
+
+    sendHttp('POST', 'fmoveProject', data, function(request) {
+        if (request.status != 200) {
+            sweetAlert('Oops', 'Could not move your project! Please try again.', 'error');
+            cancelMove();
+            return;
+        }
+        successFunc();
+    });
+}
+
+function warnIfUnsaved(action, showAnother) {
+    if (isEditorClean()) {
+        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 saveProjectAs() {
+    if (!signedIn()) {
+        sweetAlert('Oops!', 'You must sign in to save files.', 'error');
+        updateUI();
+        return;
+    }
+
+    // window.codeworldEditor.focus();
+    var text = 'Save Project As: ';
+
+    var defaultName;
+    if (window.openProjectName) {
+        defaultName = window.openProjectName;
+    } else {
+        defaultName = '';
+    }
+
+    function go(projectName) {
+        saveProjectBase(nestedDirs.slice(1).join('/'), projectName);
+    }
+
+    sweetAlert({
+        html: true,
+        title: '  Save As',
+        text: 'Enter a name for your project:',
+        type: 'input',
+        inputValue: defaultName,
+        confirmButtonText: 'Save',
+        showCancelButton: true,
+        closeOnConfirm: false
+    }, go);
+}
+
+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 {
+        saveProjectAs();
+    }
+}
+
+function saveProjectBase_(path, projectName, mode, successFunc) {
+    if (projectName == null || projectName == '') return;
+
+    if (!signedIn()) {
+        sweetAlert('Oops!', 'You must sign in to save files.', 'error');
+        updateUI();
+        return;
+    }
+
+    function go() {
+        sweetAlert.close();
+        var project = getCurrentProject();
+        project['name'] = projectName;
+
+        var data = new FormData();
+        data.append('id_token', auth2.currentUser.get().getAuthResponse().id_token);
+        data.append('project', JSON.stringify(project));
+        data.append('mode', mode);
+        data.append('path', path);
+
+        sendHttp('POST', 'fsaveProject', data, function(request) {
+            if (request.status != 200) {
+                sweetAlert('Oops!', 'Could not save your project!!!  Please try again.', 'error');
+                return;
+            }
+
+            successFunc();
+
+            updateUI();
+
+            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 save 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', 'fdeleteProject', data, function(request) {
+            if (request.status == 200) {
+                successFunc();
+                discoverProjects(path, allProjectNames.length - 1);
+            }
+        });
+    }
+
+    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', 'fdeleteFolder', data, function(request) {
+            if (request.status == 200) {
+                successFunc();
+                nestedDirs.pop();
+                allProjectNames.pop();
+                allFolderNames.pop();
+                discoverProjects(nestedDirs.slice(1).join('/'), allProjectNames.length - 1);
+            }
+        });
+    }
+
+    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, successFunc) {
+    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', 'fcreateFolder', data, function(request) {
+                if (request.status != 200) {
+                    sweetAlert('Oops', 'Could not create your directory! Please try again.', 'error');
+                    return;
+                }
+
+                allFolderNames[allFolderNames.length - 1].push(folderName);
+                nestedDirs.push(folderName);
+                allFolderNames.push([]);
+                allProjectNames.push([]);
+                successFunc();
+                updateNavBar();
+            });
+        }
+
+        sweetAlert({
+            html: true,
+            title: '  Create Folder',
+            text: 'Enter a name for your folder:',
+            type: 'input',
+            inputValue: '',
+            confirmButtonText: 'Create',
+            showCancelButton: true,
+            closeOnConfirm: false
+        }, go);
+    }, true);
+}
+
+function loadProject_(index, name, buildMode, successFunc) {
+
+  warnIfUnsaved(function(){
+    if (!signedIn()) {
+        sweetAlert('Oops!', 'You must sign in to open projects.', 'error');
+        updateUI();
+        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', 'floadProject', data, function(request) {
+        if (request.status == 200) {
+            var project = JSON.parse(request.responseText);
+
+            successFunc(project);
+            window.nestedDirs = nestedDirs.slice(0, index + 1);
+            window.allProjectNames = allProjectNames.slice(0, index + 1);
+            window.allFolderNames = allFolderNames.slice(0, index + 1);
+            updateUI();
+        }
+    });
+  }, 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: '  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', 'fshareFolder', 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: '  Share Folder',
+                text: msg,
+                type: 'input',
+                inputValue: url,
+                showConfirmButton: false,
+                showCancelButton: true,
+                cancelButtonText: 'Done',
+                animation: 'slide-from-bottom'
+            });
+        });
+    }
+
+    go();
+}

From b7220627c7979ca1d192cb5417f2ed0808b91997 Mon Sep 17 00:00:00 2001
From: Parv Mor 
Date: Tue, 12 Sep 2017 01:52:49 +0530
Subject: [PATCH 24/28] clean the hiding functions hack, improve pattern
 matching

---
 codeworld-server/src/Collaboration.hs  | 239 +++++++++++-
 codeworld-server/src/Collaboration_.hs | 246 ------------
 codeworld-server/src/Comment.hs        | 480 +++++++++++++++++++++++-
 codeworld-server/src/CommentFolder.hs  |   1 +
 codeworld-server/src/Comment_.hs       | 494 -------------------------
 codeworld-server/src/Folder.hs         | 346 ++++++++++++++++-
 codeworld-server/src/Folder_.hs        | 357 ------------------
 codeworld-server/src/Main.hs           |   3 +-
 8 files changed, 1061 insertions(+), 1105 deletions(-)
 delete mode 100644 codeworld-server/src/Collaboration_.hs
 delete mode 100644 codeworld-server/src/Comment_.hs
 delete mode 100644 codeworld-server/src/Folder_.hs

diff --git a/codeworld-server/src/Collaboration.hs b/codeworld-server/src/Collaboration.hs
index 81cfc28c5..14aa66438 100644
--- a/codeworld-server/src/Collaboration.hs
+++ b/codeworld-server/src/Collaboration.hs
@@ -1,3 +1,11 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
 {-
   Copyright 2017 The CodeWorld Authors. All rights reserved.
 
@@ -14,6 +22,233 @@
   limitations under the License.
 -}
 
-module Collaboration (module Collaboration__) where
+module Collaboration (
+    -- routes for simultaneous editing and adding user for collaboration into the project
+    collabRoutes,
+
+    -- initial collaborative server
+    initCollabServer,
+
+    -- handler to handle socket connections and requests over sockets
+    collabServer
+    ) where
+
+import qualified Control.Concurrent.STM as STM
+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 qualified Network.SocketIO as SIO
+import           Snap.Core
+import           System.FilePath
+
+import CollaborationUtil
+import DataUtil
+import Model
+import SnapUtil
+
+collabRoutes :: Snap () -> ClientId -> [(B.ByteString, Snap ())]
+collabRoutes socketIOHandler clientId =
+    [ ("addToCollaborate",  addToCollaborateHandler clientId)
+    , ("collabShare",       collabShareHandler clientId)
+    , ("listCurrentOwners", listCurrentOwnersHandler clientId)
+    , ("socket.io", socketIOHandler)
+    ]
+
+getFrequentParams :: Int -> ClientId -> Snap (User, BuildMode, FilePath)
+getFrequentParams getType clientId = do
+    user <- getUser clientId
+    mode <- getBuildMode
+    case getType of
+        1 -> 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)
+        _ -> 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 2 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 1 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 1 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
+
+-- Simultaneous Coding Handlers
+
+initCollabServer :: IO CollabServerState
+initCollabServer = do
+    started <- getCurrentTime
+    collabProjects <- STM.newTVarIO HM.empty
+    return CollabServerState{..}
+
+initCollaborationHandler :: CollabServerState -> ClientId -> Snap (Text, Text, CollabId)
+initCollaborationHandler state clientId = do
+    (user, _, filePath) <- getFrequentParams 1 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' project $ CollabId . T.pack $ collabHash
+    return ((userId user), userIdent', CollabId . T.pack $ collabHash)
+
+addNewCollaborator :: CollabServerState -> Text -> Text -> Project -> CollabId -> IO ()
+addNewCollaborator state userId' userIdent' project 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 project)
+                                , 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'
+                                                        })
+
+getCollabProject :: CollabServerState -> CollabId -> STM.STM (STM.TVar CollabProject)
+getCollabProject state collabHash = do
+    hm <- STM.readTVar $ collabProjects state
+    return $ fromJust . HM.lookup collabHash $ hm
+
+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]
 
-import Collaboration_ as Collaboration__ hiding (getFrequentParams)
+    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-server/src/Collaboration_.hs b/codeworld-server/src/Collaboration_.hs
deleted file mode 100644
index 314802e83..000000000
--- a/codeworld-server/src/Collaboration_.hs
+++ /dev/null
@@ -1,246 +0,0 @@
-{-# 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 Collaboration_ where
-
-import qualified Control.Concurrent.STM as STM
-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 qualified Network.SocketIO as SIO
-import           Snap.Core
-import           System.FilePath
-
-import CollaborationUtil
-import DataUtil
-import Model
-import SnapUtil
-
-collabRoutes :: Snap () -> ClientId -> [(B.ByteString, Snap ())]
-collabRoutes socketIOHandler clientId =
-    [ ("addToCollaborate",  addToCollaborateHandler clientId)
-    , ("collabShare",       collabShareHandler clientId)
-    , ("listCurrentOwners", listCurrentOwnersHandler clientId)
-    , ("socket.io", socketIOHandler)
-    ]
-
-getFrequentParams :: Int -> ClientId -> Snap (User, BuildMode, FilePath)
-getFrequentParams getType clientId = do
-    user <- getUser clientId
-    mode <- getBuildMode
-    case getType of
-        1 -> 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' of
-                0 -> return (user, mode, file)
-                _ -> case path' !! 0 of
-                         x | x /= "commentables" -> return (user, mode, file)
-        _ -> 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 2 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 1 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 1 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
-
--- Simultaneous Coding Handlers
-
-initCollabServer :: IO CollabServerState
-initCollabServer = do
-    started <- getCurrentTime
-    collabProjects <- STM.newTVarIO HM.empty
-    return CollabServerState{..}
-
-initCollaborationHandler :: CollabServerState -> ClientId -> Snap (Text, Text, CollabId)
-initCollaborationHandler state clientId = do
-    (user, _, filePath) <- getFrequentParams 1 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' project $ CollabId . T.pack $ collabHash
-    return ((userId user), userIdent', CollabId . T.pack $ collabHash)
-
-addNewCollaborator :: CollabServerState -> Text -> Text -> Project -> CollabId -> IO ()
-addNewCollaborator state userId' userIdent' project 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 project)
-                                , 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'
-                                                        })
-
-getCollabProject :: CollabServerState -> CollabId -> STM.STM (STM.TVar CollabProject)
-getCollabProject state collabHash = do
-    hm <- STM.readTVar $ collabProjects state
-    return $ fromJust . HM.lookup collabHash $ hm
-
-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-server/src/Comment.hs b/codeworld-server/src/Comment.hs
index b14a68632..2548db038 100644
--- a/codeworld-server/src/Comment.hs
+++ b/codeworld-server/src/Comment.hs
@@ -1,3 +1,6 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
 {-
   Copyright 2017 The CodeWorld Authors. All rights reserved.
 
@@ -14,6 +17,479 @@
   limitations under the License.
 -}
 
-module Comment (module Comment__) where
+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)
+    ]
+
+getFrequentParams :: Int -> ClientId -> Snap (User, BuildMode, FilePath)
+getFrequentParams getType clientId = do
+    user <- getUser clientId
+    mode <- getBuildMode
+    case getType of
+        1 -> 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
+            commentFolder <- liftIO $ (<.> "comments") . BC.unpack <$> B.readFile file
+            case (length path', path' !! 0) of
+                (0, _) -> return (user, mode, commentFolder)
+                (_, x) | x /= "commentables" -> return (user, mode, commentFolder)
+        2 -> do
+            Just commentHash <- fmap (CommentId . T.decodeUtf8) <$> getParam "chash"
+            commentFolder <- liftIO $
+              BC.unpack <$> B.readFile (commentHashRootDir mode  commentHashLink commentHash)
+            return (user, mode, commentFolder)
+        3 -> 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)
+        _ -> 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)
+
+addSharedCommentHandler :: ClientId -> Snap ()
+addSharedCommentHandler clientId = do
+    (user, mode, commentFolder) <- getFrequentParams 2 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 1 clientId
+    modifyResponse $ setContentType "text/plain"
+    writeBS . T.encodeUtf8 . unCommentId . nameToCommentHash $ commentFolder
+
+deleteCommentHandler :: ClientId -> Snap ()
+deleteCommentHandler clientId = do
+    (user, mode, commentFolder) <- getFrequentParams 3 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 1 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 1 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 3 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 3 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 1 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 3 clientId
+    modifyResponse $ setContentType "application/json"
+    writeLBS =<< (liftIO $ encode <$> listDirectory commentFolder)
+
+listOwnerCommentsHandler :: ClientId -> Snap ()
+listOwnerCommentsHandler clientId = do
+    (_, _, commentFolder) <- getFrequentParams 1 clientId
+    modifyResponse $ setContentType "application/json"
+    writeLBS =<< (liftIO $ encode <$> listDirectory commentFolder)
+
+listOwnerVersionsHandler :: ClientId -> Snap ()
+listOwnerVersionsHandler clientId = do
+    (_, _, commentFolder) <- getFrequentParams 1 clientId
+    modifyResponse $ setContentType "application/json"
+    writeLBS =<< (liftIO $ encode <$> listDirectory (commentFolder <.> "versions"))
+
+listUnreadCommentsHandler :: ClientId -> Snap ()
+listUnreadCommentsHandler clientId = do
+    (user, mode, commentFolder) <- getFrequentParams 3 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 1 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 3 clientId
+    modifyResponse $ setContentType "application/json"
+    writeLBS =<< (liftIO $ encode <$> listDirectory (commentFolder <.> "versions"))
+
+readCommentHandler :: ClientId -> Snap ()
+readCommentHandler clientId = do
+    (user, mode, commentFolder) <- getFrequentParams 3  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 1 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 3 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 1 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 3 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 1 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 1 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"
 
-import Comment_ as Comment__ hiding (getFrequentParams)
+writeReplyHandler :: ClientId -> Snap ()
+writeReplyHandler clientId = do
+    (user, mode, commentFolder) <- getFrequentParams 3 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
index 7d816a2af..d88cdce09 100644
--- a/codeworld-server/src/CommentFolder.hs
+++ b/codeworld-server/src/CommentFolder.hs
@@ -15,6 +15,7 @@
   limitations under the License.
 -}
 
+-- this separate module was required because of cyclic dependency between CommentUtil and CollaborationUtil
 module CommentFolder where
 
 import           Control.Monad
diff --git a/codeworld-server/src/Comment_.hs b/codeworld-server/src/Comment_.hs
deleted file mode 100644
index 26c879d55..000000000
--- a/codeworld-server/src/Comment_.hs
+++ /dev/null
@@ -1,494 +0,0 @@
-{-# 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_ 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)
-    ]
-
-getFrequentParams :: Int -> ClientId -> Snap (User, BuildMode, FilePath)
-getFrequentParams getType clientId = do
-    user <- getUser clientId
-    mode <- getBuildMode
-    case getType of
-        1 -> 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
-            commentFolder <- liftIO $ (<.> "comments") . BC.unpack <$> B.readFile file
-            case length path' of
-                0 -> return (user, mode, commentFolder)
-                _ -> case path' !! 0 of
-                         x | x /= "commentables" -> return (user, mode, commentFolder)
-        2 -> do
-            Just commentHash <- fmap (CommentId . T.decodeUtf8) <$> getParam "chash"
-            commentFolder <- liftIO $
-              BC.unpack <$> B.readFile (commentHashRootDir mode  commentHashLink commentHash)
-            return (user, mode, commentFolder)
-        3 -> 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)
-        _ -> 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' of
-                0 -> return (user, mode, file)
-                _ -> case path' !! 0 of
-                         x | x /= "commentables" -> return (user, mode, file)
-
-addSharedCommentHandler :: ClientId -> Snap ()
-addSharedCommentHandler clientId = do
-    (user, mode, commentFolder) <- getFrequentParams 2 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 1 clientId
-    modifyResponse $ setContentType "text/plain"
-    writeBS . T.encodeUtf8 . unCommentId . nameToCommentHash $ commentFolder
-
-deleteCommentHandler :: ClientId -> Snap ()
-deleteCommentHandler clientId = do
-    (user, mode, commentFolder) <- getFrequentParams 3 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 1 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 1 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 3 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 3 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 1 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 3 clientId
-    modifyResponse $ setContentType "application/json"
-    writeLBS =<< (liftIO $ encode <$> listDirectory commentFolder)
-
-listOwnerCommentsHandler :: ClientId -> Snap ()
-listOwnerCommentsHandler clientId = do
-    (_, _, commentFolder) <- getFrequentParams 1 clientId
-    modifyResponse $ setContentType "application/json"
-    writeLBS =<< (liftIO $ encode <$> listDirectory commentFolder)
-
-listOwnerVersionsHandler :: ClientId -> Snap ()
-listOwnerVersionsHandler clientId = do
-    (_, _, commentFolder) <- getFrequentParams 1 clientId
-    modifyResponse $ setContentType "application/json"
-    writeLBS =<< (liftIO $ encode <$> listDirectory (commentFolder <.> "versions"))
-
-listUnreadCommentsHandler :: ClientId -> Snap ()
-listUnreadCommentsHandler clientId = do
-    (user, mode, commentFolder) <- getFrequentParams 3 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 1 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 3 clientId
-    modifyResponse $ setContentType "application/json"
-    writeLBS =<< (liftIO $ encode <$> listDirectory (commentFolder <.> "versions"))
-
-readCommentHandler :: ClientId -> Snap ()
-readCommentHandler clientId = do
-    (user, mode, commentFolder) <- getFrequentParams 3  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 1 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 3 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 1 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 3 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 1 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 1 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 3 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/Folder.hs b/codeworld-server/src/Folder.hs
index d1f56bb1f..c6f8c0099 100644
--- a/codeworld-server/src/Folder.hs
+++ b/codeworld-server/src/Folder.hs
@@ -1,3 +1,7 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
 {-
   Copyright 2017 The CodeWorld Authors. All rights reserved.
 
@@ -14,6 +18,344 @@
   limitations under the License.
 -}
 
-module Folder (module Folder__) where
+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)
+    ]
+
+getFrequentParams :: Bool -> ClientId -> Snap (User, BuildMode, FilePath, Maybe ProjectId)
+getFrequentParams file 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 file of
+        True -> do
+            Just name <- getParam "name"
+            let projectId = nameToProjectId $ T.decodeUtf8 name
+            return (user, mode, finalDir, Just projectId)
+        False -> 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 False 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 False 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 True 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 False 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 True 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 False 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 False 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 False 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
 
-import Folder_ as Folder__ hiding (getFrequentParams)
+saveProjectHandler :: ClientId -> Snap ()
+saveProjectHandler clientId = do
+    (user, mode, finalDir, _) <- getFrequentParams False 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/Folder_.hs b/codeworld-server/src/Folder_.hs
deleted file mode 100644
index aebbc2b80..000000000
--- a/codeworld-server/src/Folder_.hs
+++ /dev/null
@@ -1,357 +0,0 @@
-{-# 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_ 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)
-    ]
-
-getFrequentParams :: Bool -> ClientId -> Snap (User, BuildMode, FilePath, Maybe ProjectId)
-getFrequentParams file clientId = do
-    user <- getUser clientId
-    mode <- getBuildMode
-    Just path' <- fmap (splitDirectories . BC.unpack) <$> getParam "path"
-    let finalDir = case length path' of
-                       0 -> ""
-                       _ | path' !! 0 == "commentables" -> "commentables"  (joinPath $
-                             map (dirBase . nameToDirId . T.pack) $ tail path')
-                         | otherwise -> joinPath $ map (dirBase . nameToDirId . T.pack) path'
-    case file of
-        True -> do
-            Just name <- getParam "name"
-            let projectId = nameToProjectId $ T.decodeUtf8 name
-            return (user, mode, finalDir, Just projectId)
-        False -> 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 False 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 False 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 True 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 False clientId
-    liftIO $ do
-        ensureUserProjectDir mode (userId user)
---       migrateUser $ userProjectDir mode (userId user)
-        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 True 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 False 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 False 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 False 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 False 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 20355158b..1ab4a7a99 100644
--- a/codeworld-server/src/Main.hs
+++ b/codeworld-server/src/Main.hs
@@ -30,7 +30,6 @@ import qualified Data.ByteString.Char8 as BC
 import qualified Data.ByteString.Lazy as LB
 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 qualified Network.SocketIO as SIO
@@ -87,7 +86,7 @@ site socketIOHandler clientId =
         (FB.funblockRoutes $ currToFB clientId)) <|>
         serveDirectory "web"
   where
-    currToFB clientId = case clientId of
+    currToFB clientId' = case clientId' of
         ClientId a -> FB.ClientId a
 
 compileHandler :: Snap ()

From 139d75a2440d115d6415873d306da05326aa800f Mon Sep 17 00:00:00 2001
From: Parv Mor 
Date: Tue, 12 Sep 2017 03:14:59 +0530
Subject: [PATCH 25/28] replace frequent param extraction type with a data type
 instead of int

---
 codeworld-server/src/Collaboration.hs | 16 +++---
 codeworld-server/src/Comment.hs       | 76 +++++++++++++--------------
 codeworld-server/src/Folder.hs        | 30 ++++++-----
 3 files changed, 62 insertions(+), 60 deletions(-)

diff --git a/codeworld-server/src/Collaboration.hs b/codeworld-server/src/Collaboration.hs
index 14aa66438..5c18e6b66 100644
--- a/codeworld-server/src/Collaboration.hs
+++ b/codeworld-server/src/Collaboration.hs
@@ -65,12 +65,14 @@ collabRoutes socketIOHandler clientId =
     , ("socket.io", socketIOHandler)
     ]
 
-getFrequentParams :: Int -> ClientId -> Snap (User, BuildMode, FilePath)
+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
-        1 -> do
+        NotInCommentables -> do
             Just path' <- fmap (splitDirectories . BC.unpack) <$> getParam "path"
             Just name <- getParam "name"
             let projectId = nameToProjectId $ T.decodeUtf8 name
@@ -79,14 +81,14 @@ getFrequentParams getType clientId = do
             case (length path', path' !! 0) of
                 (0, _) -> return (user, mode, file)
                 (_, x) | x /= "commentables" -> return (user, mode, file)
-        _ -> do
+        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 2 clientId
+    (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
@@ -109,14 +111,14 @@ addToCollaborateHandler clientId = do
 
 collabShareHandler :: ClientId -> Snap ()
 collabShareHandler clientId = do
-    (_, _, filePath) <- getFrequentParams 1 clientId
+    (_, _, 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 1 clientId
+    (_, _, filePath) <- getFrequentParams NotInCommentables clientId
     collabHashPath <- liftIO $ BC.unpack <$> B.readFile filePath
     Just (currentUsers :: [UserDump]) <- liftIO $ decodeStrict <$>
       B.readFile (collabHashPath <.> "users")
@@ -134,7 +136,7 @@ initCollabServer = do
 
 initCollaborationHandler :: CollabServerState -> ClientId -> Snap (Text, Text, CollabId)
 initCollaborationHandler state clientId = do
-    (user, _, filePath) <- getFrequentParams 1 clientId
+    (user, _, filePath) <- getFrequentParams NotInCommentables clientId
     collabHashPath <- liftIO $ BC.unpack <$> B.readFile filePath
     let collabHash = take (length collabHashPath - 3) . takeFileName $ collabHashPath
     Just (currentUsers :: [UserDump]) <- liftIO $ decodeStrict <$>
diff --git a/codeworld-server/src/Comment.hs b/codeworld-server/src/Comment.hs
index 2548db038..10f871f19 100644
--- a/codeworld-server/src/Comment.hs
+++ b/codeworld-server/src/Comment.hs
@@ -67,27 +67,19 @@ commentRoutes clientId =
     , ("writeReply",              writeReplyHandler clientId)
     ]
 
-getFrequentParams :: Int -> ClientId -> Snap (User, BuildMode, FilePath)
+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
-        1 -> 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
-            commentFolder <- liftIO $ (<.> "comments") . BC.unpack <$> B.readFile file
-            case (length path', path' !! 0) of
-                (0, _) -> return (user, mode, commentFolder)
-                (_, x) | x /= "commentables" -> return (user, mode, commentFolder)
-        2 -> do
+        GetFromHash -> do
             Just commentHash <- fmap (CommentId . T.decodeUtf8) <$> getParam "chash"
             commentFolder <- liftIO $
               BC.unpack <$> B.readFile (commentHashRootDir mode  commentHashLink commentHash)
             return (user, mode, commentFolder)
-        3 -> do
+        InCommentables -> do
             Just path' <- fmap (splitDirectories . BC.unpack) <$> getParam "path"
             Just name <- getParam "name"
             let projectId = nameToProjectId $ T.decodeUtf8 name
@@ -98,19 +90,25 @@ getFrequentParams getType clientId = do
                       (sharedCommentsDir mode (userId user)  cDir  commentProjectLink projectId)
                     commentFolder <- BC.unpack <$> B.readFile commentHashFile
                     return (user, mode, commentFolder)
-        _ -> do
+        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) of
-                (0, _) -> return (user, mode, file)
-                (_, x) | x /= "commentables" -> return (user, mode, file)
+            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 2 clientId
+    (user, mode, commentFolder) <- getFrequentParams GetFromHash clientId
     Just path' <- fmap (splitDirectories . BC.unpack) <$> getParam "path"
     case path' !! 0 of
         "commentables" -> do
@@ -139,13 +137,13 @@ addSharedCommentHandler clientId = do
 
 commentShareHandler :: ClientId -> Snap ()
 commentShareHandler clientId = do
-    (_, _, commentFolder) <- getFrequentParams 1 clientId
+    (_, _, 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 3 clientId
+    (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"
@@ -171,7 +169,7 @@ deleteCommentHandler clientId = do
 
 deleteOwnerCommentHandler :: ClientId -> Snap ()
 deleteOwnerCommentHandler clientId = do
-    (user, mode, commentFolder) <- getFrequentParams 1 clientId
+    (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"
@@ -196,7 +194,7 @@ deleteOwnerCommentHandler clientId = do
 
 deleteOwnerReplyHandler :: ClientId -> Snap ()
 deleteOwnerReplyHandler clientId = do
-    (user, mode, commentFolder) <- getFrequentParams 1 clientId
+    (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"
@@ -222,7 +220,7 @@ deleteOwnerReplyHandler clientId = do
 
 deleteReplyHandler :: ClientId -> Snap ()
 deleteReplyHandler clientId = do
-    (user, mode, commentFolder) <- getFrequentParams 3 clientId
+    (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"
@@ -249,7 +247,7 @@ deleteReplyHandler clientId = do
 
 getUserIdentHandler :: ClientId -> Snap ()
 getUserIdentHandler clientId = do
-    (user, mode, commentFolder) <- getFrequentParams 3 clientId
+    (user, mode, commentFolder) <- getFrequentParams InCommentables clientId
     let commentHash = nameToCommentHash commentFolder
         commentHashPath = commentHashRootDir mode  commentHashLink commentHash
     Just (currentUsers :: [UserDump]) <- liftIO $
@@ -266,7 +264,7 @@ getUserIdentHandler clientId = do
 
 getOwnerUserIdentHandler :: ClientId -> Snap ()
 getOwnerUserIdentHandler clientId = do
-    (user, _, commentFolder) <- getFrequentParams 1 clientId
+    (user, _, commentFolder) <- getFrequentParams (NotInCommentables True) clientId
     let projectPath = take (length commentFolder - 9) commentFolder
     Just (currentUsers :: [UserDump]) <- liftIO $
       decodeStrict <$> B.readFile (projectPath <.> "users")
@@ -282,25 +280,25 @@ getOwnerUserIdentHandler clientId = do
 
 listCommentsHandler :: ClientId -> Snap ()
 listCommentsHandler clientId = do
-    (_, _, commentFolder) <- getFrequentParams 3 clientId
+    (_, _, commentFolder) <- getFrequentParams InCommentables clientId
     modifyResponse $ setContentType "application/json"
     writeLBS =<< (liftIO $ encode <$> listDirectory commentFolder)
 
 listOwnerCommentsHandler :: ClientId -> Snap ()
 listOwnerCommentsHandler clientId = do
-    (_, _, commentFolder) <- getFrequentParams 1 clientId
+    (_, _, commentFolder) <- getFrequentParams (NotInCommentables True) clientId
     modifyResponse $ setContentType "application/json"
     writeLBS =<< (liftIO $ encode <$> listDirectory commentFolder)
 
 listOwnerVersionsHandler :: ClientId -> Snap ()
 listOwnerVersionsHandler clientId = do
-    (_, _, commentFolder) <- getFrequentParams 1 clientId
+    (_, _, 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 3 clientId
+    (user, mode, commentFolder) <- getFrequentParams InCommentables clientId
     Just (versionNo' :: Int) <- fmap (read . BC.unpack) <$> getParam "versionNo"
     let commentHash = nameToCommentHash commentFolder
         commentHashPath = commentHashRootDir mode  commentHashLink commentHash
@@ -320,7 +318,7 @@ listUnreadCommentsHandler clientId = do
 
 listUnreadOwnerCommentsHandler :: ClientId -> Snap ()
 listUnreadOwnerCommentsHandler clientId = do
-    (user, _, commentFolder) <- getFrequentParams 1 clientId
+    (user, _, commentFolder) <- getFrequentParams (NotInCommentables True) clientId
     let projectPath = take (length commentFolder - 9) commentFolder
     Just (currentUsers :: [UserDump]) <- liftIO $
       decodeStrict <$> B.readFile (projectPath <.> "users")
@@ -339,13 +337,13 @@ listUnreadOwnerCommentsHandler clientId = do
 
 listVersionsHandler :: ClientId -> Snap ()
 listVersionsHandler clientId = do
-    (_, _, commentFolder) <- getFrequentParams 3 clientId
+    (_, _, commentFolder) <- getFrequentParams InCommentables clientId
     modifyResponse $ setContentType "application/json"
     writeLBS =<< (liftIO $ encode <$> listDirectory (commentFolder <.> "versions"))
 
 readCommentHandler :: ClientId -> Snap ()
 readCommentHandler clientId = do
-    (user, mode, commentFolder) <- getFrequentParams 3  clientId
+    (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
@@ -367,7 +365,7 @@ readCommentHandler clientId = do
 
 readOwnerCommentHandler :: ClientId -> Snap ()
 readOwnerCommentHandler clientId = do
-    (user, _, commentFolder) <- getFrequentParams 1 clientId
+    (user, _, commentFolder) <- getFrequentParams (NotInCommentables True) clientId
     let projectPath = take (length commentFolder - 9) commentFolder
     Just (currentUsers :: [UserDump]) <- liftIO $
       decodeStrict <$> B.readFile (projectPath <.> "users")
@@ -388,7 +386,7 @@ readOwnerCommentHandler clientId = do
 
 viewCommentSourceHandler :: ClientId -> Snap ()
 viewCommentSourceHandler clientId = do
-    (_, _, commentFolder) <- getFrequentParams 3 clientId
+    (_, _, 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"
@@ -396,7 +394,7 @@ viewCommentSourceHandler clientId = do
 
 viewOwnerCommentSourceHandler :: ClientId -> Snap()
 viewOwnerCommentSourceHandler clientId = do
-    (_, _, commentFolder) <- getFrequentParams 1 clientId
+    (_, _, 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"
@@ -404,7 +402,7 @@ viewOwnerCommentSourceHandler clientId = do
 
 writeCommentHandler :: ClientId -> Snap ()
 writeCommentHandler clientId = do
-    (user, mode, commentFolder) <- getFrequentParams 3 clientId
+    (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"
@@ -427,7 +425,7 @@ writeCommentHandler clientId = do
 
 writeOwnerCommentHandler :: ClientId -> Snap ()
 writeOwnerCommentHandler clientId = do
-    (user, _, commentFolder) <- getFrequentParams 1 clientId
+    (user, _, commentFolder) <- getFrequentParams (NotInCommentables True) clientId
     let projectPath = take (length commentFolder - 9) commentFolder
     Just (currentUsers :: [UserDump]) <- liftIO $
       decodeStrict <$> B.readFile (projectPath <.> "users")
@@ -450,7 +448,7 @@ writeOwnerCommentHandler clientId = do
 
 writeOwnerReplyHandler :: ClientId -> Snap ()
 writeOwnerReplyHandler clientId = do
-    (user, _, commentFolder) <- getFrequentParams 1 clientId
+    (user, _, commentFolder) <- getFrequentParams (NotInCommentables True) clientId
     let projectPath = take (length commentFolder - 9) commentFolder
     Just (currentUsers :: [UserDump]) <- liftIO $
       decodeStrict <$> B.readFile (projectPath <.> "users")
@@ -473,7 +471,7 @@ writeOwnerReplyHandler clientId = do
 
 writeReplyHandler :: ClientId -> Snap ()
 writeReplyHandler clientId = do
-    (user, mode, commentFolder) <- getFrequentParams 3 clientId
+    (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"
diff --git a/codeworld-server/src/Folder.hs b/codeworld-server/src/Folder.hs
index c6f8c0099..765cfb391 100644
--- a/codeworld-server/src/Folder.hs
+++ b/codeworld-server/src/Folder.hs
@@ -59,8 +59,10 @@ folderRoutes clientId =
     , ("saveProject",   saveProjectHandler clientId)
     ]
 
-getFrequentParams :: Bool -> ClientId -> Snap (User, BuildMode, FilePath, Maybe ProjectId)
-getFrequentParams file clientId = do
+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"
@@ -69,12 +71,12 @@ getFrequentParams file clientId = do
                        (_, "commentables") -> "commentables"  (joinPath $
                            map (dirBase . nameToDirId . T.pack) $ tail path')
                        (_, _) -> joinPath $ map (dirBase . nameToDirId . T.pack) path'
-    case file of
-        True -> do
+    case getType of
+        IsFile -> do
             Just name <- getParam "name"
             let projectId = nameToProjectId $ T.decodeUtf8 name
             return (user, mode, finalDir, Just projectId)
-        False -> return (user, mode, finalDir, Nothing)
+        IsDirectory -> return (user, mode, finalDir, Nothing)
 
 copyProjectHandler :: ClientId -> Snap ()
 copyProjectHandler clientId = do
@@ -134,7 +136,7 @@ copyProjectHandler clientId = do
 
 createFolderHandler :: ClientId -> Snap ()
 createFolderHandler clientId = do
-    (user, mode, finalDir, _) <- getFrequentParams False clientId
+    (user, mode, finalDir, _) <- getFrequentParams IsDirectory clientId
     case finalDir == "commentables" of
         True -> do
             modifyResponse $ setContentType "text/plain"
@@ -159,7 +161,7 @@ createFolderHandler clientId = do
 
 deleteFolderHandler :: ClientId -> Snap ()
 deleteFolderHandler clientId = do
-    (user, mode, finalDir, _) <- getFrequentParams False clientId
+    (user, mode, finalDir, _) <- getFrequentParams IsDirectory clientId
     res <- liftIO $ deleteFolderWithComments mode (userId user) finalDir
     case res of
         Left err -> do
@@ -170,7 +172,7 @@ deleteFolderHandler clientId = do
 
 deleteProjectHandler :: ClientId -> Snap ()
 deleteProjectHandler clientId = do
-    (user, mode, finalDir, Just projectId) <- getFrequentParams True clientId
+    (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) 
@@ -182,7 +184,7 @@ deleteProjectHandler clientId = do
 
 listFolderHandler :: ClientId -> Snap ()
 listFolderHandler clientId = do
-    (user, mode, finalDir, _) <- getFrequentParams False clientId
+    (user, mode, finalDir, _) <- getFrequentParams IsDirectory clientId
     liftIO $ do
         ensureUserProjectDir mode (userId user)
 --       migrateUser $ userProjectDir mode (userId user)
@@ -202,7 +204,7 @@ listFolderHandler clientId = do
 
 loadProjectHandler :: ClientId -> Snap ()
 loadProjectHandler clientId = do
-    (user, mode, finalDir, Just projectId) <- getFrequentParams True clientId
+    (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"
@@ -270,7 +272,7 @@ moveProjectHandler clientId = do
 
 newProjectHandler :: ClientId -> Snap ()
 newProjectHandler clientId = do
-    (user, mode, finalDir, _) <- getFrequentParams False clientId
+    (user, mode, finalDir, _) <- getFrequentParams IsDirectory clientId
     case length (splitDirectories finalDir) of
         x | (x /= 0) && ((splitDirectories finalDir) !! 0 == "commentables") -> do
             modifyResponse $ setContentType "text/plain"
@@ -291,7 +293,7 @@ newProjectHandler clientId = do
 
 shareContentHandler :: ClientId -> Snap ()
 shareContentHandler clientId = do
-    (user, mode, finalDir, _) <- getFrequentParams False clientId
+    (user, mode, finalDir, _) <- getFrequentParams IsDirectory clientId
     case length (splitDirectories finalDir) of
         x | (x /= 0) && ((splitDirectories finalDir) !! 0 == "commentables") -> do
             modifyResponse $ setContentType "text/plain"
@@ -312,7 +314,7 @@ shareContentHandler clientId = do
 
 shareFolderHandler :: ClientId -> Snap ()
 shareFolderHandler clientId = do
-    (user, mode, finalDir, _) <- getFrequentParams False clientId
+    (user, mode, finalDir, _) <- getFrequentParams IsDirectory clientId
     case length (splitDirectories finalDir) of
         x | (x /= 0) && ((splitDirectories finalDir) !! 0 == "commentables") -> do
             modifyResponse $ setContentType "text/plain"
@@ -328,7 +330,7 @@ shareFolderHandler clientId = do
 
 saveProjectHandler :: ClientId -> Snap ()
 saveProjectHandler clientId = do
-    (user, mode, finalDir, _) <- getFrequentParams False clientId
+    (user, mode, finalDir, _) <- getFrequentParams IsDirectory clientId
     case length (splitDirectories finalDir) of
         x | (x /= 0) && ((splitDirectories finalDir) !! 0 == "commentables") -> do
             modifyResponse $ setContentType "text/plain"

From bf121267fbeba2543ec040254ee2255c5cde686c Mon Sep 17 00:00:00 2001
From: Parv Mor 
Date: Tue, 12 Sep 2017 04:15:15 +0530
Subject: [PATCH 26/28] update operational-transformation install to be dynamic

---
 build.sh                                      |    3 +-
 install.sh                                    |   10 +
 third_party/ot.hs/.ghci                       |    4 -
 third_party/ot.hs/.gitignore                  |    7 -
 third_party/ot.hs/.travis.yml                 |   39 -
 third_party/ot.hs/Changelog.md                |    5 -
 third_party/ot.hs/LICENSE                     |   20 -
 third_party/ot.hs/README.md                   |   10 -
 third_party/ot.hs/Setup.hs                    |    2 -
 third_party/ot.hs/TODO.md                     |    7 -
 third_party/ot.hs/ot.cabal                    |   52 -
 .../src/Control/OperationalTransformation.hs  |  164 --
 .../OperationalTransformation/Client.hs       |   66 -
 .../Control/OperationalTransformation/List.hs |   57 -
 .../OperationalTransformation/Properties.hs   |  209 --
 .../OperationalTransformation/Selection.hs    |   93 -
 .../OperationalTransformation/Server.hs       |   49 -
 .../Control/OperationalTransformation/Text.hs |  191 --
 third_party/ot.hs/stack.yaml                  |    5 -
 .../ClientServerTests.hs                      |  142 --
 .../Selection/Tests.hs                        |   65 -
 .../OperationalTransformation/Text/Gen.hs     |   55 -
 .../OperationalTransformation/Text/Tests.hs   |  100 -
 third_party/ot.hs/test/Main.hs                |   14 -
 third_party/ot.js/LICENSE                     |   19 -
 third_party/ot.js/ot-min.js                   |   10 -
 third_party/ot.js/ot.js                       | 1887 -----------------
 web/js/ot-min.js                              |    2 +-
 28 files changed, 12 insertions(+), 3275 deletions(-)
 delete mode 100644 third_party/ot.hs/.ghci
 delete mode 100644 third_party/ot.hs/.gitignore
 delete mode 100644 third_party/ot.hs/.travis.yml
 delete mode 100644 third_party/ot.hs/Changelog.md
 delete mode 100644 third_party/ot.hs/LICENSE
 delete mode 100644 third_party/ot.hs/README.md
 delete mode 100644 third_party/ot.hs/Setup.hs
 delete mode 100644 third_party/ot.hs/TODO.md
 delete mode 100644 third_party/ot.hs/ot.cabal
 delete mode 100644 third_party/ot.hs/src/Control/OperationalTransformation.hs
 delete mode 100644 third_party/ot.hs/src/Control/OperationalTransformation/Client.hs
 delete mode 100644 third_party/ot.hs/src/Control/OperationalTransformation/List.hs
 delete mode 100644 third_party/ot.hs/src/Control/OperationalTransformation/Properties.hs
 delete mode 100644 third_party/ot.hs/src/Control/OperationalTransformation/Selection.hs
 delete mode 100644 third_party/ot.hs/src/Control/OperationalTransformation/Server.hs
 delete mode 100644 third_party/ot.hs/src/Control/OperationalTransformation/Text.hs
 delete mode 100644 third_party/ot.hs/stack.yaml
 delete mode 100644 third_party/ot.hs/test/Control/OperationalTransformation/ClientServerTests.hs
 delete mode 100644 third_party/ot.hs/test/Control/OperationalTransformation/Selection/Tests.hs
 delete mode 100644 third_party/ot.hs/test/Control/OperationalTransformation/Text/Gen.hs
 delete mode 100644 third_party/ot.hs/test/Control/OperationalTransformation/Text/Tests.hs
 delete mode 100644 third_party/ot.hs/test/Main.hs
 delete mode 100644 third_party/ot.js/LICENSE
 delete mode 100644 third_party/ot.js/ot-min.js
 delete mode 100644 third_party/ot.js/ot.js

diff --git a/build.sh b/build.sh
index e9fa25693..b7887056a 100755
--- a/build.sh
+++ b/build.sh
@@ -43,8 +43,7 @@ run codeworld-api   cabal haddock --hoogle
 
 # Build codeworld-server from this project.
 
-run .  cabal_install ./third_party/ot.hs \
-                     ./funblocks-server \
+run .  cabal_install ./funblocks-server \
                      ./codeworld-error-sanitizer \
                      ./codeworld-compiler \
                      ./codeworld-server \
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/third_party/ot.hs/.ghci b/third_party/ot.hs/.ghci
deleted file mode 100644
index 4564b0fbe..000000000
--- a/third_party/ot.hs/.ghci
+++ /dev/null
@@ -1,4 +0,0 @@
-:set -fwarn-unused-binds -fwarn-unused-imports
-:set -XOverloadedStrings
-:set -isrc
-:set -itest
diff --git a/third_party/ot.hs/.gitignore b/third_party/ot.hs/.gitignore
deleted file mode 100644
index a6762c612..000000000
--- a/third_party/ot.hs/.gitignore
+++ /dev/null
@@ -1,7 +0,0 @@
-dist
-.DS_Store
-
-.cabal-sandbox
-cabal.sandbox.config
-
-.stack-work
\ No newline at end of file
diff --git a/third_party/ot.hs/.travis.yml b/third_party/ot.hs/.travis.yml
deleted file mode 100644
index 57ad9a78b..000000000
--- a/third_party/ot.hs/.travis.yml
+++ /dev/null
@@ -1,39 +0,0 @@
-sudo: required
-
-env:
-  - CABALVER=1.18 GHCVER=7.6.3
-  - CABALVER=1.18 GHCVER=7.8.4
-  - CABALVER=1.22 GHCVER=7.10.2
-  - CABALVER=head GHCVER=head
-
-matrix:
-  allow_failures:
-   - env: CABALVER=head GHCVER=head
-
-# Note: the distinction between `before_install` and `install` is not important.
-before_install:
-  - travis_retry sudo add-apt-repository -y ppa:hvr/ghc
-  - travis_retry sudo apt-get update
-  - travis_retry sudo apt-get install cabal-install-$CABALVER ghc-$GHCVER # see note about happy/alex
-  - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH
-
-install:
-  - cabal --version
-  - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"
-  - travis_retry cabal update
-  - cabal install --only-dependencies --enable-tests --enable-benchmarks
-
-# Here starts the actual work to be performed for the package under test; any command which exits with a non-zero exit code causes the build to fail.
-script:
-  - if [ -f configure.ac ]; then autoreconf -i; fi
-  - cabal configure --enable-tests --enable-benchmarks -v2  # -v2 provides useful information for debugging
-  - cabal build   # this builds all libraries and executables (including tests/benchmarks)
-  - cabal test
-  - cabal check
-  - cabal sdist   # tests that a source-distribution can be generated
-
-# Check that the resulting source distribution can be built & installed.
-# If there are no other `.tar.gz` files in `dist`, this can be even simpler:
-# `cabal install --force-reinstalls dist/*-*.tar.gz`
-  - SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz &&
-    (cd dist && cabal install --force-reinstalls "$SRC_TGZ")
diff --git a/third_party/ot.hs/Changelog.md b/third_party/ot.hs/Changelog.md
deleted file mode 100644
index e1dd21779..000000000
--- a/third_party/ot.hs/Changelog.md
+++ /dev/null
@@ -1,5 +0,0 @@
-# Change Log
-
-## 0.2.1.0 - 2015-10-13
-
-- Added new QuickCheck properties
diff --git a/third_party/ot.hs/LICENSE b/third_party/ot.hs/LICENSE
deleted file mode 100644
index e9ec7d334..000000000
--- a/third_party/ot.hs/LICENSE
+++ /dev/null
@@ -1,20 +0,0 @@
-The MIT License (MIT)
-Copyright © 2011-2012 Tim Baumann, http://timbaumann.info
-
-Permission is hereby granted, free of charge, to any person obtaining a copy
-of this software and associated documentation files (the “Software”), to deal
-in the Software without restriction, including without limitation the rights
-to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
-copies of the Software, and to permit persons to whom the Software is
-furnished to do so, subject to the following conditions:
-
-The above copyright notice and this permission notice shall be included in
-all copies or substantial portions of the Software.
-
-THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
-THE SOFTWARE.
\ No newline at end of file
diff --git a/third_party/ot.hs/README.md b/third_party/ot.hs/README.md
deleted file mode 100644
index 465a0e309..000000000
--- a/third_party/ot.hs/README.md
+++ /dev/null
@@ -1,10 +0,0 @@
-[![Build Status][travis-image]][travis-url]
-[![Hackage][hackage-image]][hackage-url]
-[![Hackage Dependencies][hackage-deps-image]][hackage-deps-url]
-
-[travis-image]: https://img.shields.io/travis/Operational-Transformation/ot.hs.svg
-[travis-url]: http://travis-ci.org/Operational-Transformation/ot.hs
-[hackage-image]: https://img.shields.io/hackage/v/ot.svg
-[hackage-url]: http://hackage.haskell.org/package/ot
-[hackage-deps-image]: https://img.shields.io/hackage-deps/v/ot.svg
-[hackage-deps-url]: http://packdeps.haskellers.com/reverse/ot
diff --git a/third_party/ot.hs/Setup.hs b/third_party/ot.hs/Setup.hs
deleted file mode 100644
index 9a994af67..000000000
--- a/third_party/ot.hs/Setup.hs
+++ /dev/null
@@ -1,2 +0,0 @@
-import Distribution.Simple
-main = defaultMain
diff --git a/third_party/ot.hs/TODO.md b/third_party/ot.hs/TODO.md
deleted file mode 100644
index 20028e062..000000000
--- a/third_party/ot.hs/TODO.md
+++ /dev/null
@@ -1,7 +0,0 @@
-* Write README
-* Write documentation
-* Optimize performance
-  * Benchmarks
-* Add example and demo
-* Release on Hackage
-* Use ropes instead of Data.Text for performance and memory reasons
\ No newline at end of file
diff --git a/third_party/ot.hs/ot.cabal b/third_party/ot.hs/ot.cabal
deleted file mode 100644
index 09e642602..000000000
--- a/third_party/ot.hs/ot.cabal
+++ /dev/null
@@ -1,52 +0,0 @@
-Name:                ot
-Version:             0.2.1.0
-Synopsis:            Real-time collaborative editing with Operational Transformation
-Description:         OT is a technique to handle changes to a document in a setting where users are editing concurrently. This package implements operational transformation for simple plain text documents as well as server and client modules.
-Homepage:            https://github.com/operational-transformation/ot.hs
-License:             MIT
-License-file:        LICENSE
-Author:              Tim Baumann
-Maintainer:          tim@timbaumann.info
-
-Category:            Text
-Build-type:          Simple
-
--- Constraint on the version of Cabal needed to build this package.
-Cabal-version:         >= 1.8
-
-source-repository head
-  type:     git
-  location: https://github.com/Operational-Transformation/ot.hs.git
-
-Library
-  Ghc-options:         -Wall
-  Hs-source-dirs:      src
-  Exposed-modules:     Control.OperationalTransformation, Control.OperationalTransformation.List, Control.OperationalTransformation.Text, Control.OperationalTransformation.Selection, Control.OperationalTransformation.Properties, Control.OperationalTransformation.Client, Control.OperationalTransformation.Server
-  Build-depends:       base,
-                       text,
-                       aeson,
-                       attoparsec,
-                       QuickCheck,
-                       binary,
-                       either,
-                       mtl,
-                       ghc
-
-  -- Modules not exported by this package.
-  -- Other-modules:       
-
-Test-suite tests
-  Ghc-options:         -Wall -rtsopts
-  Hs-source-dirs:      test
-  type:                exitcode-stdio-1.0
-  main-is:             Main.hs
-  Build-depends:       ot,
-                       QuickCheck,
-                       HUnit,
-                       base,
-                       text,
-                       aeson,
-                       test-framework >= 0.6 && < 0.9,
-                       test-framework-quickcheck2 >= 0.3.0 && < 0.4,
-                       test-framework-hunit >= 0.3.0 && < 0.4,
-                       binary >= 0.5.1.0
diff --git a/third_party/ot.hs/src/Control/OperationalTransformation.hs b/third_party/ot.hs/src/Control/OperationalTransformation.hs
deleted file mode 100644
index c2c8719ff..000000000
--- a/third_party/ot.hs/src/Control/OperationalTransformation.hs
+++ /dev/null
@@ -1,164 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FunctionalDependencies #-}
-
-module Control.OperationalTransformation
-  ( OTOperation (..)
-  , OTComposableOperation (..)
-  , OTCursor (..)
-  , OTSystem (..)
-  ) where
-
-import Control.Monad (foldM)
-
-class OTOperation op where
-  -- | Transforms two concurrent operations /a/ and /b/, producing /a'/ and /b'/ 
-  -- such that @b' ∘ a == a' ∘ b@.
-  transform :: op -> op -> Either String (op, op)
-
-class (OTOperation op) => OTComposableOperation op where
-  -- | Composes two operations /a/ and /b/, producing /c/, such that /c/ has the
-  -- same effect when applied to a document as applying /a/ and /b/ one after
-  -- another.
-  compose :: op -> op -> Either String op
-
-class (OTOperation op) => OTSystem doc op where
-  -- | Apply an operation to a document, producing a new document.
-  apply :: op -> doc -> Either String doc
-
-instance (OTOperation op) => OTOperation [op] where
-  transform = transformList2
-    where
-      transformList1 o [] = return (o, [])
-      transformList1 o (p:ps) = do
-        (o', p') <- transform o p
-        (o'', ps') <- transformList1 o' ps
-        return (o'', p':ps')
-
-      transformList2 [] ps = return ([], ps)
-      transformList2 (o:os) ps = do
-        (o', ps') <- transformList1 o ps
-        (os', ps'') <- transformList2 os ps'
-        return (o':os', ps'')
-
--- | Cursor position
-class OTCursor cursor op where
-  updateCursor :: op -> cursor -> cursor
-
-
-instance (OTOperation op) => OTComposableOperation [op] where
-  compose a b = return $ a ++ b
-
-instance (OTSystem doc op) => OTSystem doc [op] where
-  apply = flip $ foldM $ flip apply
-
-
-instance OTCursor () op where
-  updateCursor _ _ = ()
-
-instance OTCursor cursor op => OTCursor [cursor] op where
-  updateCursor op = map (updateCursor op)
-
-instance (OTCursor a op, OTCursor b op) => OTCursor (a, b) op where
-  updateCursor op (a, b) = (updateCursor op a, updateCursor op b)
-
-instance (OTCursor a op, OTCursor b op, OTCursor c op) => OTCursor (a, b, c) op where
-  updateCursor op (a, b, c) = (updateCursor op a, updateCursor op b, updateCursor op c)
-
-instance (OTCursor a op, OTCursor b op, OTCursor c op, OTCursor d op) => OTCursor (a, b, c, d) op where
-  updateCursor op (a, b, c, d) = (updateCursor op a, updateCursor op b, updateCursor op c, updateCursor op d)
-
-instance (OTCursor a op, OTCursor b op, OTCursor c op, OTCursor d op, OTCursor e op) => OTCursor (a, b, c, d, e) op where
-  updateCursor op (a, b, c, d, e) = (updateCursor op a, updateCursor op b, updateCursor op c, updateCursor op d, updateCursor op e)
-
-
-instance (OTOperation a, OTOperation b) => OTOperation (a, b) where
-  transform (a1, a2) (b1, b2) = do
-    (a1', b1') <- transform a1 b1
-    (a2', b2') <- transform a2 b2
-    return ((a1', a2'), (b1', b2'))
-
-instance (OTComposableOperation a, OTComposableOperation b) => OTComposableOperation (a, b) where
-  compose (a1, a2) (b1, b2) = do
-    c1 <- compose a1 b1
-    c2 <- compose a2 b2
-    return (c1, c2)
-
-instance (OTSystem doca a, OTSystem docb b) => OTSystem (doca, docb) (a, b) where
-  apply (a, b) (doca, docb) = do
-    doca' <- apply a doca
-    docb' <- apply b docb
-    return (doca', docb')
-
-
-instance (OTOperation a, OTOperation b, OTOperation c) => OTOperation (a, b, c) where
-  transform (a1, a2, a3) (b1, b2, b3) = do
-    (a1', b1') <- transform a1 b1
-    (a2', b2') <- transform a2 b2
-    (a3', b3') <- transform a3 b3
-    return ((a1', a2', a3'), (b1', b2', b3'))
-
-instance (OTComposableOperation a, OTComposableOperation b, OTComposableOperation c) => OTComposableOperation (a, b, c) where
-  compose (a1, a2, a3) (b1, b2, b3) = do
-    c1 <- compose a1 b1
-    c2 <- compose a2 b2
-    c3 <- compose a3 b3
-    return (c1, c2, c3)
-
-instance (OTSystem doca a, OTSystem docb b, OTSystem docc c) => OTSystem (doca, docb, docc) (a, b, c) where
-  apply (a, b, c) (doca, docb, docc) = do
-    doca' <- apply a doca
-    docb' <- apply b docb
-    docc' <- apply c docc
-    return (doca', docb', docc')
-
-
-instance (OTOperation a, OTOperation b, OTOperation c, OTOperation d) => OTOperation (a, b, c, d) where
-  transform (a1, a2, a3, a4) (b1, b2, b3, b4) = do
-    (a1', b1') <- transform a1 b1
-    (a2', b2') <- transform a2 b2
-    (a3', b3') <- transform a3 b3
-    (a4', b4') <- transform a4 b4
-    return ((a1', a2', a3', a4'), (b1', b2', b3', b4'))
-
-instance (OTComposableOperation a, OTComposableOperation b, OTComposableOperation c, OTComposableOperation d) => OTComposableOperation (a, b, c, d) where
-  compose (a1, a2, a3, a4) (b1, b2, b3, b4) = do
-    c1 <- compose a1 b1
-    c2 <- compose a2 b2
-    c3 <- compose a3 b3
-    c4 <- compose a4 b4
-    return (c1, c2, c3, c4)
-
-instance (OTSystem doca a, OTSystem docb b, OTSystem docc c, OTSystem docd d) => OTSystem (doca, docb, docc, docd) (a, b, c, d) where
-  apply (a, b, c, d) (doca, docb, docc, docd) = do
-    doca' <- apply a doca
-    docb' <- apply b docb
-    docc' <- apply c docc
-    docd' <- apply d docd
-    return (doca', docb', docc', docd')
-
-
-instance (OTOperation a, OTOperation b, OTOperation c, OTOperation d, OTOperation e) => OTOperation (a, b, c, d, e) where
-  transform (a1, a2, a3, a4, a5) (b1, b2, b3, b4, b5) = do
-    (a1', b1') <- transform a1 b1
-    (a2', b2') <- transform a2 b2
-    (a3', b3') <- transform a3 b3
-    (a4', b4') <- transform a4 b4
-    (a5', b5') <- transform a5 b5
-    return ((a1', a2', a3', a4', a5'), (b1', b2', b3', b4', b5'))
-
-instance (OTComposableOperation a, OTComposableOperation b, OTComposableOperation c, OTComposableOperation d, OTComposableOperation e) => OTComposableOperation (a, b, c, d, e) where
-  compose (a1, a2, a3, a4, a5) (b1, b2, b3, b4, b5) = do
-    c1 <- compose a1 b1
-    c2 <- compose a2 b2
-    c3 <- compose a3 b3
-    c4 <- compose a4 b4
-    c5 <- compose a5 b5
-    return (c1, c2, c3, c4, c5)
-
-instance (OTSystem doca a, OTSystem docb b, OTSystem docc c, OTSystem docd d, OTSystem doce e) => OTSystem (doca, docb, docc, docd, doce) (a, b, c, d, e) where
-  apply (a, b, c, d, e) (doca, docb, docc, docd, doce) = do
-    doca' <- apply a doca
-    docb' <- apply b docb
-    docc' <- apply c docc
-    docd' <- apply d docd
-    doce' <- apply e doce
-    return (doca', docb', docc', docd', doce')
\ No newline at end of file
diff --git a/third_party/ot.hs/src/Control/OperationalTransformation/Client.hs b/third_party/ot.hs/src/Control/OperationalTransformation/Client.hs
deleted file mode 100644
index dc8008173..000000000
--- a/third_party/ot.hs/src/Control/OperationalTransformation/Client.hs
+++ /dev/null
@@ -1,66 +0,0 @@
-module Control.OperationalTransformation.Client
-  ( ClientState (..)
-  , initialClientState
-  , applyClient
-  , applyServer
-  , serverAck
-  ) where
-
-import Control.OperationalTransformation
-
--- | At every moment, the client is in one of three states.
-data ClientState op
-  -- | All of the client's operations have been acknowledged by the server.
-  = ClientSynchronized
-  -- | The client has sent an operation to the server and it is still waiting
-  -- for an acknowledgement.
-  | ClientWaiting op
-  -- | The client is waiting for an acknowledgement for a pending operation and
-  -- the client is buffering local changes.
-  | ClientWaitingWithBuffer op op
-  deriving (Eq, Show, Read)
-
--- | The state a newly connected client starts in (synonym for
--- 'ClientSynchronized').
-initialClientState :: ClientState op
-initialClientState = ClientSynchronized
-
--- | Handle user-generated operations.
-applyClient :: (OTComposableOperation op)
-            => ClientState op
-            -> op
-            -- ^ The operation the user has performed on the local document.
-            -> Either String (Bool, ClientState op)
-            -- ^ Whether to send the operation to the server and the new client
-            -- state (or an error).
-applyClient ClientSynchronized op = Right (True, ClientWaiting op)
-applyClient (ClientWaiting w) op = Right (False, ClientWaitingWithBuffer w op)
-applyClient (ClientWaitingWithBuffer w b) op = case compose b op of
-  Left err -> Left $ "operations couldn't be composed: " ++ err
-  Right b' -> Right (False, ClientWaitingWithBuffer w b')
-
--- | Handle incoming operations from the server.
-applyServer :: (OTComposableOperation op)
-            => ClientState op
-            -> op
-            -> Either String (op, ClientState op)
-            -- ^ The transformed operation that must be applied to local
-            -- document and the new state (or an error).
-applyServer ClientSynchronized op = Right (op, ClientSynchronized)
-applyServer (ClientWaiting w) op = case transform w op of
-  Left err -> Left $ "transform failed: " ++ err
-  Right (w', op') -> Right (op', ClientWaiting w')
-applyServer (ClientWaitingWithBuffer w b) op = case transform w op of
-  Left err -> Left $ "transform failed: " ++ err
-  Right (w', op') -> case transform b op' of
-    Left err -> Left $ "transform failed: " ++ err
-    Right (b', op'') -> Right (op'', ClientWaitingWithBuffer w' b')
-
--- | Handle acknowledgements.
-serverAck :: ClientState op
-          -> Maybe (Maybe op, ClientState op)
-          -- ^ An optional operation that must be sent to the server if present
-          -- and the new state.
-serverAck ClientSynchronized            = Nothing
-serverAck (ClientWaiting _)             = Just (Nothing, ClientSynchronized)
-serverAck (ClientWaitingWithBuffer _ b) = Just (Just b, ClientWaiting b)
\ No newline at end of file
diff --git a/third_party/ot.hs/src/Control/OperationalTransformation/List.hs b/third_party/ot.hs/src/Control/OperationalTransformation/List.hs
deleted file mode 100644
index 0c8a173d8..000000000
--- a/third_party/ot.hs/src/Control/OperationalTransformation/List.hs
+++ /dev/null
@@ -1,57 +0,0 @@
-{-# LANGUAGE GADTs, DataKinds, TypeFamilies #-}
-
-module Control.OperationalTransformation.List
-  ( N (..)
-  , Vector (..)
-  , Operation (..)
-  , apply
-  , compose
-  , TransformedPair (..)
-  , transform
-  ) where
-
-data N = Z | S N deriving (Eq, Show)
-
-data Vector :: * -> N -> * where
-  EmptyV :: Vector a Z
-  ConsV  :: a -> Vector a n -> Vector a (S n)
-
-data Operation :: * -> N -> N -> * where
-  EmptyOp  :: Operation a Z Z
-  RetainOp :: Operation a n m -> Operation a (S n) (S m)
-  InsertOp :: a -> Operation a n m -> Operation a n (S m)
-  DeleteOp :: Operation a n m -> Operation a (S n) m
-
-apply :: Operation a n m -> Vector a n -> Vector a m
-apply EmptyOp         EmptyV       = EmptyV
-apply (RetainOp o')   (ConsV x xs) = ConsV x (apply o' xs)
-apply (InsertOp x o') xs           = ConsV x (apply o' xs)
-apply (DeleteOp o')   (ConsV _ xs) = apply o' xs
-apply _               _            = error "not possible!"
-
-addDeleteOp :: Operation a n m -> Operation a (S n) m
-addDeleteOp (InsertOp x o') = InsertOp x (addDeleteOp o')
-addDeleteOp o               = DeleteOp o
-
-compose :: Operation a n m -> Operation a m k -> Operation a n k
-compose EmptyOp         EmptyOp         = EmptyOp
-compose (DeleteOp a')   b               = addDeleteOp (compose a' b)
-compose a               (InsertOp x b') = InsertOp x (compose a b')
-compose (RetainOp a')   (RetainOp b')   = RetainOp (compose a' b')
-compose (RetainOp a')   (DeleteOp b')   = addDeleteOp (compose a' b')
-compose (InsertOp x a') (RetainOp b')   = InsertOp x (compose a' b')
-compose (InsertOp _ a') (DeleteOp b')   = compose a' b'
-compose _               _               = error "not possible!"
-
-data TransformedPair :: * -> N -> N -> * where
-  TP :: Operation a n k -> Operation a m k -> TransformedPair a n m
-
-transform :: Operation a n m -> Operation a n k -> TransformedPair a k m
-transform EmptyOp         EmptyOp         = TP EmptyOp EmptyOp
-transform (InsertOp x a') b               = case transform a' b  of TP at bt -> TP (InsertOp x at)  (RetainOp bt)
-transform a               (InsertOp x b') = case transform a  b' of TP at bt -> TP (RetainOp at)    (InsertOp x bt)
-transform (RetainOp a')   (RetainOp b')   = case transform a' b' of TP at bt -> TP (RetainOp at)    (RetainOp bt)
-transform (DeleteOp a')   (DeleteOp b')   = transform a' b'
-transform (RetainOp a')   (DeleteOp b')   = case transform a' b' of TP at bt -> TP at               (addDeleteOp bt)
-transform (DeleteOp a')   (RetainOp b')   = case transform a' b' of TP at bt -> TP (addDeleteOp at) bt
-transform _               _               = error "not possible!"
\ No newline at end of file
diff --git a/third_party/ot.hs/src/Control/OperationalTransformation/Properties.hs b/third_party/ot.hs/src/Control/OperationalTransformation/Properties.hs
deleted file mode 100644
index 9a9d209ba..000000000
--- a/third_party/ot.hs/src/Control/OperationalTransformation/Properties.hs
+++ /dev/null
@@ -1,209 +0,0 @@
-{-# LANGUAGE DataKinds, ConstraintKinds, KindSignatures, GADTs #-}
-{-# LANGUAGE FlexibleInstances, FlexibleContexts, MultiParamTypeClasses #-}
-{-# LANGUAGE UndecidableInstances, ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneDeriving #-}
-
-module Control.OperationalTransformation.Properties
-  ( ArbitraryFor (..)
-  -- , TestableOTSystem
-  -- , ArbitraryOTSystem
-  , Nat (..), One, Two, Three
-  , DocHistory (..)
-  , ConcurrentDocHistories (..)
-  , prop_compose_assoc
-  , prop_apply_functorial
-  , prop_transform_apply_comm
-  , prop_transform_comm
-  , prop_transform_compose_compat_l
-  , prop_transform_compose_compat_r
-  , prop_transform_functorial
-  ) where
-
-import Control.OperationalTransformation
-import Test.QuickCheck hiding (Result, reason)
-import Test.QuickCheck.Property
-import Control.Applicative ((<$>), (<*>))
-
-{-
-type ArbitraryOTSystem doc op =
-  ( OTSystem doc op, OTComposableOperation op
-  , Arbitrary doc, ArbitraryFor doc op --Arbitrary (GenOp doc op)
-  , Show doc, Eq doc, Show op, Eq op
-  )
--}
-
-type TestableOTSystem doc op =
-  ( OTSystem doc op, OTComposableOperation op
-  --, Arbitrary doc, ArbitraryFor doc op --Arbitrary (GenOp doc op)
-  , Show doc, Eq doc, Show op, Eq op
-  )
-
-class ArbitraryFor a b where
-  arbitraryFor :: a -> Gen b
-
-genOp :: (OTSystem doc op, ArbitraryFor doc op) => doc -> Gen (op, doc)
-genOp doc = do
-  op <- arbitraryFor doc
-  case apply op doc of
-    Left err -> fail err
-    Right doc' -> return (op, doc')
-
-
-data Nat = Z | S !Nat deriving (Eq, Show)
-
-type One = S Z
-type Two = S One
-type Three = S Two
-
-data DocHistory doc op :: Nat -> * where
-  -- | Last state
-  LS :: doc -> DocHistory doc op Z
-  -- | Snapshot
-  SS :: doc -> op -> DocHistory doc op n -> DocHistory doc op (S n)
-
-deriving instance (Show doc, Show op) => Show (DocHistory doc op n)
-deriving instance (Eq doc, Eq op) => Eq (DocHistory doc op n)
-
-data ConcurrentDocHistories doc op n k =
-  CDH (DocHistory doc op n) (DocHistory doc op k)
-
-deriving instance (Show doc, Show op) => Show (ConcurrentDocHistories doc op n k)
-deriving instance (Eq doc, Eq op) => Eq (ConcurrentDocHistories doc op n k)
-
-{-
-getCurrentState :: DocHistory doc op n -> doc
-getCurrentState (LS doc) = doc
-getCurrentState (SS _ _ dh) = getCurrentState dh
-
-snocDocHistory :: DocHistory doc op n -> op -> doc -> DocHistory doc op (S n)
-snocDocHistory (LS doc) op doc' = SS doc op (LS doc')
-snocDocHistory (SS doc op dh) op' doc' = SS doc op (snocDocHistory dh op' doc')
--}
-
-instance ArbitraryFor doc (DocHistory doc op Z) where
-  arbitraryFor = return . LS
-
-instance (OTSystem doc op, ArbitraryFor doc op, ArbitraryFor doc (DocHistory doc op n)) => ArbitraryFor doc (DocHistory doc op (S n)) where
-  arbitraryFor doc = do
-    (op, doc') <- genOp doc
-    SS doc op <$> arbitraryFor doc'
-
-instance (Arbitrary doc, ArbitraryFor doc (DocHistory doc op n)) => Arbitrary (DocHistory doc op n) where
-  arbitrary = (arbitrary :: Gen doc) >>= arbitraryFor
-
-instance (ArbitraryFor doc (DocHistory doc op n), ArbitraryFor doc (DocHistory doc op k)) => ArbitraryFor doc (ConcurrentDocHistories doc op n k) where
-  arbitraryFor doc = CDH <$> arbitraryFor doc <*> arbitraryFor doc
-
-instance (Arbitrary doc, ArbitraryFor doc (ConcurrentDocHistories doc op n k)) => Arbitrary (ConcurrentDocHistories doc op n k) where
-  arbitrary = (arbitrary :: Gen doc) >>= arbitraryFor
-
-(==?) :: (Eq a, Show a) => a -> a -> Result
-a ==? b | a == b    = succeeded
-        | otherwise = failed { reason = "expected " ++ show a ++ " to be " ++ show b }
-
-eitherResult :: Either String a -> (a -> Result) -> Result
-eitherResult (Left err) _ = failed { reason = err }
-eitherResult (Right a) f  = f a
-
-eitherProperty :: Either String a -> (a -> Property) -> Property
-eitherProperty (Left err) _ = property $ failed { reason = err }
-eitherProperty (Right res) prop = prop res
-
-prop_compose_assoc
-  :: TestableOTSystem doc op
-  => DocHistory doc op Three
-  -> Result
-prop_compose_assoc (SS _doc a (SS _ b (SS _ c _))) =
-  eitherResult (compose a b) $ \ab ->
-  eitherResult (compose ab c) $ \abc1 ->
-  eitherResult (compose b c) $ \bc ->
-  eitherResult (compose a bc) $ \abc2 ->
-  abc1 ==? abc2
-
--- | @(b ∘ a)(d) = a(b(d))@ where /a/ and /b/ are two consecutive operations
--- and /d/ is the initial document.
-prop_apply_functorial
-  :: TestableOTSystem doc op
-  => DocHistory doc op Two
-  -> Result
-prop_apply_functorial (SS doc a (SS _ b (LS _))) =
-  eitherResult (apply a doc) $ \doc' ->
-  eitherResult (apply b doc') $ \doc''1 ->
-  eitherResult (compose a b) $ \ab ->
-  eitherResult (apply ab doc) $ \doc''2 ->
-  doc''1 ==? doc''2
-
--- | @b'(a(d)) = a'(b(d))@ where /a/ and /b/ are random operations, /d/ is the
--- initial document and @(a', b') = transform(a, b)@.
-prop_transform_apply_comm
-  :: TestableOTSystem doc op
-  => ConcurrentDocHistories doc op One One
-  -> Result
-prop_transform_apply_comm (CDH (SS _ a (LS docA)) (SS _ b (LS docB))) =
-  eitherResult (transform a b) $ \(a', b') ->
-  eitherResult (apply a' docB) $ \doc''1 ->
-  eitherResult (apply b' docA) $ \doc''2 ->
-  doc''1 ==? doc''2
-
--- | @b' ∘ a = a' ∘ b@ where /a/ and /b/ are random operations and
--- @(a', b') = transform(a, b)@. Note that this is a stronger property than
--- 'prop_transform_apply_comm', because 'prop_transform_comm' and
--- 'prop_apply_functorial' imply 'prop_transform_apply_comm'.
-prop_transform_comm
-  :: TestableOTSystem doc op
-  => ConcurrentDocHistories doc op One One
-  -> Result
-prop_transform_comm (CDH (SS _ a _) (SS _ b _)) =
-  eitherResult (transform a b) $ \(a', b') ->
-  eitherResult (compose a b') $ \ab' ->
-  eitherResult (compose b a') $ \ba' ->
-  ab' ==? ba'
-
--- | Transformation is compatible with composition on the left. That is, if we
--- have two consecutive operations /a/ and /b/ and a concurrent operation /c/,
--- then it doesn't make a difference whether we transform /c/ against /a/ and
--- then against /b/ or transform /c/ against the composition of /a/ and /b/.
--- In other terms, @c'_1 = c'_2@ where @(_, c'_1) = transform(b ∘ a, c)@,
--- @(_, c') = transform(a, c)@ and @(_, c'_2) = transform(b, c')@.
-prop_transform_compose_compat_l
-  :: (OTSystem doc op, OTComposableOperation op, Arbitrary doc, Show op, Eq op)
-  => (doc -> Gen op)
-  -> Property
-prop_transform_compose_compat_l genOperation = property $ do
-  doc <- arbitrary
-  a <- genOperation doc
-  c <- genOperation doc
-  return $ eitherProperty (apply a doc) $ \doc' -> property $ do
-    b <- genOperation doc'
-    let res = (,) <$> (snd <$> (compose a b >>= flip transform c))
-                  <*> (snd <$> (transform a c >>= transform b . snd))
-    return $ eitherProperty res $ \(c'_1, c'_2) ->
-      property $ c'_1 ==? c'_2
-
--- | Transformation is compatible with composition on the /right/.
-prop_transform_compose_compat_r
-  :: (OTSystem doc op, OTComposableOperation op, Arbitrary doc, Show op, Eq op)
-  => (doc -> Gen op)
-  -> Property
-prop_transform_compose_compat_r genOperation = property $ do
-  doc <- arbitrary
-  a <- genOperation doc
-  c <- genOperation doc
-  return $ eitherProperty (apply a doc) $ \doc' -> property $ do
-    b <- genOperation doc'
-    let res = (,) <$> (fst <$> (compose a b >>= transform c))
-                  <*> (fst <$> (transform c a >>= flip transform b . fst))
-    return $ eitherProperty res $ \(c'_1, c'_2) -> property $ c'_1 ==? c'_2
-
--- second functor axiom (F(f . g) = Ff . Fg) for F = transform c
-prop_transform_functorial
-  :: TestableOTSystem doc op
-  => ConcurrentDocHistories doc op One Two
-  -> Result
-prop_transform_functorial (CDH (SS _ c _) (SS _ a (SS _ b _))) =
-  eitherResult (compose a b) $ \ab ->
-  eitherResult (transform c ab) $ \(_c''1, abPrimed1) ->
-  eitherResult (transform c a) $ \(c', a') ->
-  eitherResult (transform c' b) $ \(_c''2, b') ->
-  eitherResult (compose a' b') $ \abPrimed2 ->
-  abPrimed1 ==? abPrimed2
diff --git a/third_party/ot.hs/src/Control/OperationalTransformation/Selection.hs b/third_party/ot.hs/src/Control/OperationalTransformation/Selection.hs
deleted file mode 100644
index 879037c70..000000000
--- a/third_party/ot.hs/src/Control/OperationalTransformation/Selection.hs
+++ /dev/null
@@ -1,93 +0,0 @@
-{-# LANGUAGE CPP, TypeFamilies, OverloadedStrings #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses #-}
-
-module Control.OperationalTransformation.Selection
-  ( Range (..)
-  , Selection (..)
-  , createCursor
-  , size
-  , somethingSelected
-  ) where
-
-import Control.OperationalTransformation
-import Control.OperationalTransformation.Text
-import Data.Aeson
-import Control.Applicative
-import Data.Monoid
-import Data.List (sort)
-import qualified Data.Text as T
-#if MIN_VERSION_ghc(7,8,0)
-import GHC.Exts (IsList (..))
-#endif
-
--- | Range has `anchor` and `head` properties, which are zero-based indices into
--- the document. The `anchor` is the side of the selection that stays fixed,
--- `head` is the side of the selection where the cursor is. When both are
--- equal, the range represents a cursor.
-data Range = Range { rangeAnchor :: !Int, rangeHead :: !Int }
-  deriving (Show, Read, Eq, Ord)
-
-instance ToJSON Range where
-  toJSON (Range a h) = object [ "anchor" .= a, "head" .= h ]
-
-instance FromJSON Range where
-  parseJSON (Object o) = Range <$> o .: "anchor" <*> o .: "head"
-  parseJSON _ = fail "expected an object"
-
-instance OTCursor Range TextOperation where
-  updateCursor (TextOperation actions) (Range a h) = Range a' h'
-    where
-      a' = updateComponent a
-      h' = if a == h then a' else updateComponent h
-      updateComponent c = loop c c actions
-      loop :: Int -> Int -> [Action] -> Int
-      loop oldIndex newIndex as
-        | oldIndex < 0 = newIndex
-        | otherwise =
-          case as of
-            (op:ops) -> case op of
-              Retain r -> loop (oldIndex-r) newIndex ops
-              Insert i -> loop oldIndex (newIndex + T.length i) ops
-              Delete d -> loop (oldIndex-d) (newIndex - min oldIndex d) ops
-            _ -> newIndex -- matching on `[]` gives a non-exhaustive pattern
-                          -- match warning for some reason
-
--- | A selection consists of a list of ranges. Each range may represent a
--- selected part of the document or a cursor in the document.
-newtype Selection = Selection { ranges :: [Range] }
-  deriving (Monoid, Show, Read)
-
-instance OTCursor Selection TextOperation where
-  updateCursor op = Selection . updateCursor op . ranges
-
-instance Eq Selection where
-  Selection rs1 == Selection rs2 = sort rs1 == sort rs2
-
-instance Ord Selection where
-  Selection rs1 `compare` Selection rs2 = sort rs1 `compare` sort rs2
-
-instance ToJSON Selection where
-  toJSON (Selection rs) = object [ "ranges" .= rs ]
-
-instance FromJSON Selection where
-  parseJSON (Object o) = Selection <$> o .: "ranges"
-  parseJSON _ = fail "expected an object"
-
-#if MIN_VERSION_ghc(7,8,0)
-instance IsList Selection where
-  type Item Selection = Range
-  fromList = Selection
-  toList = ranges
-#endif
-
--- | Create a selection that represents a cursor.
-createCursor :: Int -> Selection
-createCursor i = Selection [Range i i]
-
--- | Does the selection contain any characters?
-somethingSelected :: Selection -> Bool
-somethingSelected = any (\r -> rangeAnchor r /= rangeHead r) . ranges
-
--- | Number of selected characters
-size :: Selection -> Int
-size = sum . map (\r -> abs (rangeAnchor r - rangeHead r)) . ranges
diff --git a/third_party/ot.hs/src/Control/OperationalTransformation/Server.hs b/third_party/ot.hs/src/Control/OperationalTransformation/Server.hs
deleted file mode 100644
index 5147e50f6..000000000
--- a/third_party/ot.hs/src/Control/OperationalTransformation/Server.hs
+++ /dev/null
@@ -1,49 +0,0 @@
-module Control.OperationalTransformation.Server
-  ( Revision
-  , ServerState (..)
-  , initialServerState
-  , applyOperation
-  ) where
-
-import Control.OperationalTransformation
-import Control.Monad.Trans.Either
-import Control.Monad.Identity
-
-type Revision = Integer
-
--- | The server keeps the current revision number and a list of previous
--- operations to transform incoming operations against.
-data ServerState doc op = ServerState Revision doc [op]
-
-initialServerState :: doc -> ServerState doc op
-initialServerState doc = ServerState 0 doc []
-
--- | Handles incoming operations.
-applyOperation :: (OTSystem doc op, OTCursor cursor op)
-               => ServerState doc op
-               -> Revision
-               -- ^ The latest operation that the client has received from the server when it sent the operation.
-               -> op
-               -- ^ The operation received from the client.
-               -> cursor
-               -- ^ The clients cursor position after the operation. (Use @()@
-               -- if not needed.)
-               -> Either String (op, cursor, ServerState doc op)
-               -- ^ The operation and the cursor to broadcast to all
-               -- connected clients  (except the client which has created the
-               -- operation; that client must be sent an acknowledgement) and
-               -- the new state (or an error).
-applyOperation (ServerState rev doc ops) oprev op cursor =
-  runIdentity $ runEitherT $ do
-    concurrentOps <- if oprev > rev || rev - oprev > fromIntegral (length ops)
-      then fail "unknown revision number"
-      else return $ take (fromInteger $ rev - oprev) ops
-    (op', cursor') <- foldM transformFst (op, cursor) (reverse concurrentOps)
-    doc' <- case apply op' doc of
-      Left err -> fail $ "apply failed: " ++ err
-      Right d -> return d
-    return $ (op', cursor', ServerState (rev+1) doc' (op':ops))
-    where
-      transformFst (a, curs) b = case transform a b of
-        Left err -> fail $ "transform failed: " ++ err
-        Right (a', _) -> return (a', updateCursor op curs)
diff --git a/third_party/ot.hs/src/Control/OperationalTransformation/Text.hs b/third_party/ot.hs/src/Control/OperationalTransformation/Text.hs
deleted file mode 100644
index 7dbd85dd5..000000000
--- a/third_party/ot.hs/src/Control/OperationalTransformation/Text.hs
+++ /dev/null
@@ -1,191 +0,0 @@
-{-# LANGUAGE CPP, OverloadedStrings, MultiParamTypeClasses #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable, FlexibleInstances #-}
-{-# LANGUAGE FlexibleContexts, UndecidableInstances, TypeFamilies #-}
-
-module Control.OperationalTransformation.Text
-  (
-    -- * Simple text operations
-    Action (..)
-  , TextOperation (..)
-  , invertOperation
-  ) where
-
-import Control.OperationalTransformation
-import qualified Data.Text as T
-import Data.Monoid (mappend)
-import Data.Aeson (Value (..), FromJSON (..), ToJSON (..))
-import Data.Binary (Binary (..), putWord8, getWord8)
-import Data.Typeable (Typeable)
-import Data.Text (pack, unpack)
-import Control.Applicative ((<$>))
-#if MIN_VERSION_ghc(7,8,0)
-import GHC.Exts (IsList (..))
-#endif
-
--- | An action changes the text at the current position or advances the cursor.
-data Action = Retain !Int    -- ^ Skip the next n characters.
-            | Insert !T.Text -- ^ Insert the given text at the current position.
-            | Delete !Int    -- ^ Delete the next n characters.
-            deriving (Eq, Read, Show, Typeable)
-
-instance Binary Action where
-  put (Retain n) = putWord8 0 >> put n
-  put (Insert i) = putWord8 1 >> put (unpack i)
-  put (Delete n) = putWord8 2 >> put n
-  get = do
-    t <- getWord8
-    case t of
-      0 -> Retain <$> get
-      1 -> Insert . pack <$> get
-      _ -> Delete <$> get
-
-instance ToJSON Action where
-  toJSON (Retain n) = Number $ fromIntegral n
-  toJSON (Insert t) = String t
-  toJSON (Delete n) = Number $ fromIntegral (-n)
-
-instance FromJSON Action where
-  parseJSON (Number x) = do
-    n <- parseJSON (Number x)
-    case compare n 0 of
-      GT -> return $ Retain (fromInteger n)
-      LT -> return $ Delete (fromInteger (-n))
-      EQ -> fail "integer must not be zero"
-  parseJSON (String i) = return $ Insert i
-  parseJSON _ = fail "expected a non-zero integer or a string"
-
--- | An edit on plain text documents. An operation consists of multiple actions
--- that change the document at the current cursor position or advance the
--- cursor. After applying all actions, the cursor must be at the end of the
--- document.
-newtype TextOperation = TextOperation [Action] deriving (Read, Show, Binary, Typeable, FromJSON, ToJSON)
-
-#if MIN_VERSION_ghc(7,8,0)
-instance IsList TextOperation where
-  type Item TextOperation = Action
-  fromList = TextOperation
-  toList (TextOperation as) = as
-#endif
-
-addRetain :: Int -> [Action] -> [Action]
-addRetain n (Retain m : xs) = Retain (n+m) : xs
-addRetain n xs = Retain n : xs
-
-addInsert :: T.Text -> [Action] -> [Action]
-addInsert s (Delete d : xs) = Delete d : addInsert s xs
-addInsert s (Insert t : xs) = Insert (t `mappend` s) : xs
-addInsert s xs = Insert s : xs
-
-addDelete :: Int -> [Action] -> [Action]
-addDelete n (Delete m : xs) = Delete (n+m) : xs
-addDelete n xs = Delete n : xs
-
--- | Merges actions, removes empty ops and makes insert ops come before delete
--- ops. Properties:
---
---     * Idempotence: @canonicalize op = canonicalize (canonicalize op)@
---
---     * Preserves the effect under apply: @apply op doc = apply (canonicalize op) doc@
-canonicalize :: TextOperation -> TextOperation
-canonicalize (TextOperation ops) = TextOperation $ reverse $ loop [] $ reverse ops
-  where
-    loop as [] = as
-    loop as (Retain n : bs) | n <= 0  = loop as bs
-                            | True    = loop (addRetain n as) bs
-    loop as (Insert i : bs) | i == "" = loop as bs
-                            | True    = loop (addInsert i as) bs
-    loop as (Delete d : bs) | d <= 0  = loop as bs
-                            | True    = loop (addDelete d as) bs
-
-instance Eq TextOperation where
-  a == b = opsa == opsb
-    where TextOperation opsa = canonicalize a
-          TextOperation opsb = canonicalize b
-
-instance OTOperation TextOperation where
-  transform (TextOperation o1) (TextOperation o2) = both (TextOperation . reverse) `fmap` loop o1 o2 [] []
-    where
-      both :: (a -> b) -> (a, a) -> (b, b)
-      both f (a, b) = (f a, f b)
-
-      loop [] [] xs ys = Right (xs, ys)
-      loop aa@(a:as) bb@(b:bs) xs ys = case (a, b) of
-        (Insert i, _) -> loop as bb (addInsert i xs) (addRetain (T.length i) ys)
-        (_, Insert i) -> loop aa bs (addRetain (T.length i) xs) (addInsert i ys)
-        (Retain n, Retain m) -> case compare n m of
-          LT -> loop as (Retain (m-n) : bs) (addRetain n xs) (addRetain n ys)
-          EQ -> loop as bs (addRetain n xs) (addRetain n ys)
-          GT -> loop (Retain (n-m) : as) bs (addRetain m xs) (addRetain m ys)
-        (Delete n, Delete m) -> case compare n m of
-          LT -> loop as (Delete (m-n) : bs) xs ys
-          EQ -> loop as bs xs ys
-          GT -> loop (Delete (n-m) : as) bs xs ys
-        (Retain r, Delete d) -> case compare r d of
-          LT -> loop as (Delete (d-r) : bs) xs (addDelete r ys)
-          EQ -> loop as bs xs (addDelete d ys)
-          GT -> loop (Retain (r-d) : as) bs xs (addDelete d ys)
-        (Delete d, Retain r) -> case compare d r of
-          LT -> loop as (Retain (r-d) : bs) (addDelete d xs) ys
-          EQ -> loop as bs (addDelete d xs) ys
-          GT -> loop (Delete (d-r) : as) bs (addDelete r xs) ys
-      loop [] (Insert i : bs) xs ys = loop [] bs (addRetain (T.length i) xs) (addInsert i ys)
-      loop (Insert i : as) [] xs ys = loop as [] (addInsert i xs) (addRetain (T.length i) ys)
-      loop _ _ _ _ = Left "the operations couldn't be transformed because they haven't been applied to the same document"
-
-instance OTComposableOperation TextOperation where
-  compose (TextOperation o1) (TextOperation o2) = (TextOperation . reverse) `fmap` loop o1 o2 []
-    where
-      loop [] [] xs = Right xs
-      loop aa@(a:as) bb@(b:bs) xs = case (a, b) of
-        (Delete d, _) -> loop as bb (addDelete d xs)
-        (_, Insert i) -> loop aa bs (addInsert i xs)
-        (Retain n, Retain m) -> case compare n m of
-          LT -> loop as (Retain (m-n) : bs) (addRetain n xs)
-          EQ -> loop as bs (addRetain n xs)
-          GT -> loop (Retain (n-m) : as) bs (addRetain m xs)
-        (Retain r, Delete d) -> case compare r d of
-          LT -> loop as (Delete (d-r) : bs) (addDelete r xs)
-          EQ -> loop as bs (addDelete d xs)
-          GT -> loop (Retain (r-d) : as) bs (addDelete d xs)
-        (Insert i, Retain m) -> case compare (T.length i) m of
-          LT -> loop as (Retain (m - T.length i) : bs) (addInsert i xs)
-          EQ -> loop as bs (addInsert i xs)
-          GT -> let (before, after) = T.splitAt m i
-                in loop (Insert after : as) bs (addInsert before xs)
-        (Insert i, Delete d) -> case compare (T.length i) d of
-          LT -> loop as (Delete (d - T.length i) : bs) xs
-          EQ -> loop as bs xs
-          GT -> loop (Insert (T.drop d i) : as) bs xs
-      loop (Delete d : as) [] xs = loop as [] (addDelete d xs)
-      loop [] (Insert i : bs) xs = loop [] bs (addInsert i xs)
-      loop _ _ _ = Left "the operations couldn't be composed since their lengths don't match"
-
-instance OTSystem T.Text TextOperation where
-  apply (TextOperation actions) input = loop actions input ""
-    where
-      loop [] "" ot = Right ot
-      loop (op:ops) it ot = case op of
-        Retain r -> if T.length it < r
-          then Left "operation can't be applied to the document: operation is longer than the text"
-          else let (before, after) = T.splitAt r it
-               in loop ops after (ot `mappend` before)
-        Insert i -> loop ops it (ot `mappend` i)
-        Delete d -> if d > T.length it
-          then Left "operation can't be applied to the document: operation is longer than the text"
-          else loop ops (T.drop d it) ot
-      loop _ _ _ = Left "operation can't be applied to the document: text is longer than the operation"
-
--- | Computes the inverse of an operation. Useful for implementing undo.
-invertOperation
-  :: TextOperation               -- ^ An operation
-  -> T.Text                      -- ^ Document to apply the operation to
-  -> Either String TextOperation
-invertOperation (TextOperation actions) doc = loop actions doc []
-  where
-    loop (op:ops) text inv = case op of
-      (Retain n) -> loop ops (T.drop n text) (Retain n : inv)
-      (Insert i) -> loop ops text (Delete (T.length i) : inv)
-      (Delete d) -> let (before, after) = T.splitAt d text
-                    in loop ops after (Insert before : inv)
-    loop [] "" inv = Right . TextOperation . reverse $ inv
-    loop [] _ _ = Left "invert failed: text is longer than the operation"
diff --git a/third_party/ot.hs/stack.yaml b/third_party/ot.hs/stack.yaml
deleted file mode 100644
index 52f0d6f89..000000000
--- a/third_party/ot.hs/stack.yaml
+++ /dev/null
@@ -1,5 +0,0 @@
-flags: {}
-packages:
-- '.'
-extra-deps: []
-resolver: lts-3.9
diff --git a/third_party/ot.hs/test/Control/OperationalTransformation/ClientServerTests.hs b/third_party/ot.hs/test/Control/OperationalTransformation/ClientServerTests.hs
deleted file mode 100644
index a0c16073d..000000000
--- a/third_party/ot.hs/test/Control/OperationalTransformation/ClientServerTests.hs
+++ /dev/null
@@ -1,142 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, BangPatterns #-}
-
-module Control.OperationalTransformation.ClientServerTests
-  ( tests
-  ) where
-
-import Control.OperationalTransformation
-import Control.OperationalTransformation.Client
-import Control.OperationalTransformation.Server
-import Data.Maybe (fromJust)
-
-import Control.OperationalTransformation.Text.Gen (genOperation)
-
-import Test.Framework
-import Test.Framework.Providers.QuickCheck2
-import Test.QuickCheck hiding (reason)
-import Test.QuickCheck.Property
-
-type Queue a = [a]
-
-emptyQueue :: Queue a
-emptyQueue = []
-
-appendQueue :: a -> Queue a -> Queue a
-appendQueue a q = q ++ [a]
-
-type ClientId = Int
-
-data ExtendedClient doc op = ExtendedClient { clientId :: !ClientId
-                                            , clientRevision :: !Revision
-                                            , clientSendQueue :: Queue (Revision, op)
-                                            , clientReceiveQueue :: Queue (Maybe op)
-                                            , clientDoc :: !doc
-                                            , clientState :: !(ClientState op)
-                                            } deriving (Show)
-
-prop_client_server :: (Eq doc, Arbitrary doc, OTSystem doc op, OTComposableOperation op)
-                   => (doc -> Gen op) -> Property
-prop_client_server genOp = property $ do
-  doc <- arbitrary
-  let server = initialServerState doc
-      clients = createClients doc $ take numClients [1..]
-  (server', clients') <- simulate numActions server clients
-  return $ if not (all isSynchronized clients')
-    then property $ failed { reason = "some clients are not synchronized" }
-    else let ServerState _ doc' _ = server'
-         in if all ((== doc') . clientDoc) clients'
-              then property True
-              else property $ failed { reason = "client documents did not converge" }
-
-  where
-    numClients, numActions :: Int
-    numClients = 2
-    numActions = 100
-
-    firstRevision = 0
-    createClients doc = map $ \n ->
-      ExtendedClient { clientId = n
-                     , clientRevision = firstRevision
-                     , clientSendQueue = emptyQueue
-                     , clientReceiveQueue = emptyQueue
-                     , clientDoc = doc
-                     , clientState = initialClientState
-                     }
-
-    simulate !n !server !clients = do
-      clientN <- choose (0, length clients - 1)
-      actionN <- choose (0, 2) :: Gen Int
-      let client = clients !! clientN
-      (server', clients') <- case actionN of
-        0 | canReceive client -> do
-          let client' = receiveClient client
-          return (server, replace clientN client' clients)
-        1 | canSend client -> do
-          let ((rev, op), client') = sendClient client
-              Right (op', (), server') = applyOperation server rev op ()
-              clients' = replace clientN client' clients
-              clients'' = broadcast (clientId client) op' clients'
-          return (server', clients'')
-        _ | n < 0 -> return (server, clients)
-          | otherwise -> do
-          client' <- editClient client
-          return (server, replace clientN  client' clients)
-      if n > 0 || any (\c -> canReceive c || canSend c) clients'
-        then simulate (n-1) server' clients'
-        else return (server', clients')
-
-    replace 0 e (_:xs) = e:xs
-    replace n e (x:xs) = x:(replace (n-1) e xs)
-    replace _ _ [] = error "replacing empty list"
-
-    canReceive = not . null . clientReceiveQueue
-    canSend = not . null . clientSendQueue
-
-    receiveClient client = case clientReceiveQueue client of
-      [] -> error "empty receive queue"
-      msg:ops ->
-        let
-          client' = client { clientReceiveQueue = ops
-                           , clientRevision = clientRevision client + 1
-                           }
-        in case msg of
-          Nothing -> case fromJust $ serverAck (clientState client') of
-            (Just op, clientState') -> client'
-              { clientState = clientState'
-              , clientSendQueue = appendQueue (clientRevision client', op) (clientSendQueue client')
-              }
-            (Nothing, clientState') -> client' { clientState = clientState' }
-          Just op -> case applyServer (clientState client) op of
-            Left err -> error $ "should not happen: " ++ err
-            Right (op', clientState') -> case apply op' (clientDoc client') of
-              Left err ->  error $ "apply failed: " ++ err
-              Right doc' -> client' { clientState = clientState', clientDoc = doc' }
-
-    sendClient client = case clientSendQueue client of
-      [] -> error "empty send queue"
-      op:ops -> (op, client { clientSendQueue = ops })
-
-    editClient client = do
-      op <- genOp $ clientDoc client
-      let doc' = fromRight $ apply op $ clientDoc client
-          (shouldSend, state') = fromRight $ applyClient (clientState client) op
-          client' = client { clientState = state', clientDoc = doc' }
-      return $ if shouldSend
-        then client' { clientSendQueue = appendQueue (clientRevision client', op) (clientSendQueue client) }
-        else client'
-
-    fromRight (Right a) = a
-    fromRight (Left err) = error err
-
-    broadcast creator op = map $ \client ->
-      let msg = if creator == clientId client then Nothing else Just op
-      in client { clientReceiveQueue = appendQueue msg (clientReceiveQueue client) }
-
-    isSynchronized client = case clientState client of
-      ClientSynchronized -> True
-      _ -> False
-
-tests :: Test
-tests = testGroup "Control.OperationalTransformation.ClientServerTests"
-  [ testProperty "prop_client_server" $ prop_client_server genOperation
-  ]
\ No newline at end of file
diff --git a/third_party/ot.hs/test/Control/OperationalTransformation/Selection/Tests.hs b/third_party/ot.hs/test/Control/OperationalTransformation/Selection/Tests.hs
deleted file mode 100644
index 40ee4e95d..000000000
--- a/third_party/ot.hs/test/Control/OperationalTransformation/Selection/Tests.hs
+++ /dev/null
@@ -1,65 +0,0 @@
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# LANGUAGE StandaloneDeriving, GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE OverloadedStrings #-}
-
-module Control.OperationalTransformation.Selection.Tests (tests) where
-
-import Control.OperationalTransformation
-import Control.OperationalTransformation.Text
-import Control.OperationalTransformation.Selection
-import Test.Framework
-import Test.QuickCheck
-import Test.Framework.Providers.QuickCheck2 (testProperty)
-import Test.HUnit hiding (Test)
-import Test.Framework.Providers.HUnit (testCase)
-import Control.Applicative
---import Data.Aeson
-import Data.Aeson.Types hiding (Result)
-import Data.Monoid
-
-instance Arbitrary Range where
-  arbitrary = Range <$> (abs <$> arbitrary) <*> (abs <$> arbitrary)
-
-deriving instance Arbitrary Selection
-
-prop_json_id :: Selection -> Bool
-prop_json_id o = parseMaybe parseJSON (toJSON o) == Just o
-
-testUpdateRange :: Assertion
-testUpdateRange = do
-  let range = Range 3 7
-  Range 8 10 @=? updateCursor (TextOperation [Retain 3, Insert "lorem", Delete 2, Retain 42]) range
-  Range 0 0  @=? updateCursor (TextOperation [Delete 45]) range
-
-testUpdateSelection :: Assertion
-testUpdateSelection =
-  let sel = Selection [Range 2 4, Range 6 8]
-  in Selection [Range 2 6, Range 8 8] @=?
-     updateCursor (TextOperation [Retain 3, Insert "hi", Retain 3, Delete 2]) sel
-
-testSize :: Assertion
-testSize = do
-  size (createCursor 5) @=? 0
-  size (Selection [Range 5 8, Range 10 20]) @=? 13
-
-prop_sizeNotNegative :: Selection -> Bool
-prop_sizeNotNegative sel = size sel >= 0
-
-prop_sizeAdditive :: Selection -> Selection -> Bool
-prop_sizeAdditive sel1 sel2 =
-  size sel1 + size sel2 == size (sel1 <> sel2)
-
-prop_sizeZero_notSomethingSelected :: Selection -> Bool
-prop_sizeZero_notSomethingSelected sel =
-  (size sel /= 0) == (somethingSelected sel)
-
-tests :: Test
-tests = testGroup "Control.OperationalTransformation.Selection"
-  [ testProperty "prop_json_id" prop_json_id
-  , testCase "testUpdateRange" testUpdateRange
-  , testCase "testUpdateSelection" testUpdateSelection
-  , testCase "testSize" testSize
-  , testProperty "prop_sizeNotNegative" prop_sizeNotNegative
-  , testProperty "prop_sizeAdditive" prop_sizeAdditive
-  , testProperty "prop_sizeZero_notSomethingSelected" prop_sizeZero_notSomethingSelected
-  ]
\ No newline at end of file
diff --git a/third_party/ot.hs/test/Control/OperationalTransformation/Text/Gen.hs b/third_party/ot.hs/test/Control/OperationalTransformation/Text/Gen.hs
deleted file mode 100644
index 91d4ba140..000000000
--- a/third_party/ot.hs/test/Control/OperationalTransformation/Text/Gen.hs
+++ /dev/null
@@ -1,55 +0,0 @@
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-
-module Control.OperationalTransformation.Text.Gen
-  ( genOperation'
-  , genOperation
-  ) where
-
-import Control.OperationalTransformation.Text
-import Control.OperationalTransformation.Properties (ArbitraryFor (..))
-import Test.QuickCheck hiding (Result)
-import qualified Data.Text as T
-import Control.Applicative ((<$>))
-import Data.Monoid ((<>))
-
-genOperation' :: Int -> Gen TextOperation
-genOperation' = fmap TextOperation . gen
-  where
-    maxLength = 32
-    arbitraryText n = fmap (T.pack . take n) $ listOf1 (choose ('!', '~'))
-    insert text [] = [Insert text]
-    insert text (Insert text' : ops) = Insert (text <> text') : ops
-    insert text ops@(Retain _ : _) = Insert text : ops
-    insert text ops@(Delete _ : _) = Insert text : ops
-    delete d [] = [Delete d]
-    delete d (Insert text : ops) = Insert text : delete d ops
-    delete d ops@(Retain _ : _) = Delete d : ops
-    delete d (Delete d' : ops) = Delete (d+d') : ops
-    retain r [] = [Retain r]
-    retain r ops@(Insert _ : _) = Retain r : ops
-    retain r (Retain r' : ops) = Retain (r+r') : ops
-    retain r ops@(Delete _ : _) = Retain r : ops
-    gen l =
-      if l <= 0
-      then oneof [return [], fmap ((:[]) . Insert) (arbitraryText maxLength)]
-      else do
-        len <- choose (1, min maxLength l)
-        oneof [ retain len <$> gen (l - len)
-              , do s2 <- arbitraryText len
-                   insert s2 <$> gen l
-              , delete len <$> gen (l - len)
-              ]
-
-
-genOperation :: T.Text -> Gen TextOperation
-genOperation = genOperation' . T.length
-
-instance ArbitraryFor T.Text TextOperation where
-  arbitraryFor = genOperation
-
-instance Arbitrary T.Text where
-  arbitrary = T.pack <$> listOf (choose ('!', '~'))
-
-instance Arbitrary TextOperation where
-  arbitrary = arbitrary >>= genOperation
diff --git a/third_party/ot.hs/test/Control/OperationalTransformation/Text/Tests.hs b/third_party/ot.hs/test/Control/OperationalTransformation/Text/Tests.hs
deleted file mode 100644
index 37a19eeb6..000000000
--- a/third_party/ot.hs/test/Control/OperationalTransformation/Text/Tests.hs
+++ /dev/null
@@ -1,100 +0,0 @@
-{-# LANGUAGE OverloadedStrings, DataKinds #-}
-
-module Control.OperationalTransformation.Text.Tests
-  ( tests
-  ) where
-
-import Control.OperationalTransformation
-import Control.OperationalTransformation.Text
-import Control.OperationalTransformation.Properties
-
-import Control.OperationalTransformation.Text.Gen
-
-import Test.QuickCheck hiding (Result)
-import Test.QuickCheck.Property
-import Test.Framework
-import Test.Framework.Providers.QuickCheck2 (testProperty)
-
-import qualified Data.Text as T
-import Data.Binary (encode, decode)
-import Control.Applicative ((<$>), (<*>))
-import Data.Aeson.Types hiding (Result)
-
-deltaLength :: TextOperation -> Int
-deltaLength (TextOperation ops) = sum (map len ops)
-  where len (Retain _) = 0
-        len (Insert i) = T.length i
-        len (Delete d) = -d
-
-prop_json_id :: TextOperation -> Bool
-prop_json_id o = parseMaybe parseJSON (toJSON o) == Just o
-
-prop_binary_id :: TextOperation -> Bool
-prop_binary_id o = decode (encode o) == o
-
-prop_apply_length :: T.Text -> Property
-prop_apply_length doc = property $ do
-  op <- genOperation doc
-  return $ case apply op doc of
-    Left _ -> False
-    Right str' -> T.length str' == T.length doc + deltaLength op
-
-prop_compose_length :: T.Text -> Property
-prop_compose_length doc = property $ do
-  a <- genOperation doc
-  return $ case apply a doc of
-    Left _ -> property rejected
-    Right doc' -> property $ do
-      b <- genOperation doc'
-      return $ case compose a b of
-        Left _ -> False
-        Right ab -> deltaLength a + deltaLength b == deltaLength ab
-
-prop_compose_well_formed :: T.Text -> Property
-prop_compose_well_formed doc = property $ do
-  a <- genOperation doc
-  let Right doc' = apply a doc
-  b <- genOperation doc'
-  return $ case compose a b of
-    Left _ -> False
-    Right ab -> wellFormed ab
-
-prop_transform_well_formed :: T.Text -> Property
-prop_transform_well_formed doc = property $ do
-  a <- genOperation doc
-  b <- genOperation doc
-  return $ case transform a b of
-    Left _ -> False
-    Right (a', b') -> wellFormed a' && wellFormed b'
-
-wellFormed :: TextOperation -> Bool
-wellFormed (TextOperation ops) = all (not . nullLength) ops
-  where nullLength (Retain n) = n == 0
-        nullLength (Insert i) = i == ""
-        nullLength (Delete d) = d == 0
-
-prop_invert :: T.Text -> Gen Bool
-prop_invert doc = do
-  op <- genOperation doc
-  return $ case (,) <$> invertOperation op doc <*> apply op doc of
-    Left _ -> False
-    Right (invOp, doc') -> case apply invOp doc' of
-      Left _ -> False
-      Right doc2 -> doc2 == doc
-
-tests :: Test
-tests = testGroup "Control.OperationalTransformation.Text.Tests"
-  [ testProperty "prop_json_id" prop_json_id
-  , testProperty "prop_binary_id" prop_binary_id
-  , testProperty "prop_compose_assoc" (prop_compose_assoc :: DocHistory T.Text TextOperation Three -> Result)
-  , testProperty "prop_compose_apply" (prop_apply_functorial :: DocHistory T.Text TextOperation Two -> Result)
-  , testProperty "prop_transform_apply_comm" (prop_transform_apply_comm :: ConcurrentDocHistories T.Text TextOperation One One -> Result)
-  , testProperty "prop_transform_comm" (prop_transform_comm :: ConcurrentDocHistories T.Text TextOperation One One -> Result)
-  -- prop_transform_compose_compat_l, prop_transform_compose_compat_r and prop_transform_functorial
-  -- are /not/ supported.
-  , testProperty "prop_apply_length" prop_apply_length
-  , testProperty "prop_compose_length" prop_compose_length
-  , testProperty "prop_compose_well_formed" prop_compose_well_formed
-  , testProperty "prop_transform_well_formed" prop_transform_well_formed
-  , testProperty "prop_invert" prop_invert
-  ]
diff --git a/third_party/ot.hs/test/Main.hs b/third_party/ot.hs/test/Main.hs
deleted file mode 100644
index 3dbad5c8e..000000000
--- a/third_party/ot.hs/test/Main.hs
+++ /dev/null
@@ -1,14 +0,0 @@
-module Main (main) where
-
-import Test.Framework
-
-import qualified Control.OperationalTransformation.Text.Tests
-import qualified Control.OperationalTransformation.Selection.Tests
-import qualified Control.OperationalTransformation.ClientServerTests
-
-main :: IO ()
-main = defaultMain
-  [ Control.OperationalTransformation.Text.Tests.tests
-  , Control.OperationalTransformation.Selection.Tests.tests
-  , Control.OperationalTransformation.ClientServerTests.tests
-  ]
\ No newline at end of file
diff --git a/third_party/ot.js/LICENSE b/third_party/ot.js/LICENSE
deleted file mode 100644
index 5caf485b9..000000000
--- a/third_party/ot.js/LICENSE
+++ /dev/null
@@ -1,19 +0,0 @@
-Copyright © 2012-2014 Tim Baumann, http://timbaumann.info
-
-Permission is hereby granted, free of charge, to any person obtaining a copy
-of this software and associated documentation files (the “Software”), to deal
-in the Software without restriction, including without limitation the rights
-to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
-copies of the Software, and to permit persons to whom the Software is
-furnished to do so, subject to the following conditions:
-
-The above copyright notice and this permission notice shall be included in
-all copies or substantial portions of the Software.
-
-THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
-THE SOFTWARE.
diff --git a/third_party/ot.js/ot-min.js b/third_party/ot.js/ot-min.js
deleted file mode 100644
index 13c81de0e..000000000
--- a/third_party/ot.js/ot-min.js
+++ /dev/null
@@ -1,10 +0,0 @@
-/*
- *    /\
- *   /  \ ot 0.0.14
- *  /    \ http://operational-transformation.github.com
- *  \    /
- *   \  / (c) 2012-2014 Tim Baumann  (http://timbaumann.info)
- *    \/ ot may be freely distributed under the MIT license.
- */
-
-if("undefined"==typeof ot)var ot={};if(ot.TextOperation=function(){"use strict";function a(){return this&&this.constructor===a?(this.ops=[],this.baseLength=0,void(this.targetLength=0)):new a}function b(b){var c=b.ops,d=a.isRetain;switch(c.length){case 1:return c[0];case 2:return d(c[0])?c[1]:d(c[1])?c[0]:null;case 3:if(d(c[0])&&d(c[2]))return c[1]}return null}function c(a){return d(a.ops[0])?a.ops[0]:0}a.prototype.equals=function(a){if(this.baseLength!==a.baseLength)return!1;if(this.targetLength!==a.targetLength)return!1;if(this.ops.length!==a.ops.length)return!1;for(var b=0;b0},e=a.isInsert=function(a){return"string"==typeof a},f=a.isDelete=function(a){return"number"==typeof a&&0>a};return a.prototype.retain=function(a){if("number"!=typeof a)throw new Error("retain expects an integer");return 0===a?this:(this.baseLength+=a,this.targetLength+=a,d(this.ops[this.ops.length-1])?this.ops[this.ops.length-1]+=a:this.ops.push(a),this)},a.prototype.insert=function(a){if("string"!=typeof a)throw new Error("insert expects a string");if(""===a)return this;this.targetLength+=a.length;var b=this.ops;return e(b[b.length-1])?b[b.length-1]+=a:f(b[b.length-1])?e(b[b.length-2])?b[b.length-2]+=a:(b[b.length]=b[b.length-1],b[b.length-2]=a):b.push(a),this},a.prototype["delete"]=function(a){if("string"==typeof a&&(a=a.length),"number"!=typeof a)throw new Error("delete expects an integer or a string");return 0===a?this:(a>0&&(a=-a),this.baseLength-=a,f(this.ops[this.ops.length-1])?this.ops[this.ops.length-1]+=a:this.ops.push(a),this)},a.prototype.isNoop=function(){return 0===this.ops.length||1===this.ops.length&&d(this.ops[0])},a.prototype.toString=function(){var a=Array.prototype.map||function(a){for(var b=this,c=[],d=0,e=b.length;e>d;d++)c[d]=a(b[d]);return c};return a.call(this.ops,function(a){return d(a)?"retain "+a:e(a)?"insert '"+a+"'":"delete "+-a}).join(", ")},a.prototype.toJSON=function(){return this.ops},a.fromJSON=function(b){for(var c=new a,g=0,h=b.length;h>g;g++){var i=b[g];if(d(i))c.retain(i);else if(e(i))c.insert(i);else{if(!f(i))throw new Error("unknown operation: "+JSON.stringify(i));c["delete"](i)}}return c},a.prototype.apply=function(a){var b=this;if(a.length!==b.baseLength)throw new Error("The operation's base length must be equal to the string's length.");for(var c=[],f=0,g=0,h=this.ops,i=0,j=h.length;j>i;i++){var k=h[i];if(d(k)){if(g+k>a.length)throw new Error("Operation can't retain more characters than are left in the string.");c[f++]=a.slice(g,g+k),g+=k}else e(k)?c[f++]=k:g-=k}if(g!==a.length)throw new Error("The operation didn't operate on the whole string.");return c.join("")},a.prototype.invert=function(b){for(var c=0,f=new a,g=this.ops,h=0,i=g.length;i>h;h++){var j=g[h];d(j)?(f.retain(j),c+=j):e(j)?f["delete"](j.length):(f.insert(b.slice(c,c-j)),c-=j)}return f},a.prototype.compose=function(b){var c=this;if(c.targetLength!==b.baseLength)throw new Error("The base length of the second operation has to be the target length of the first operation");for(var g=new a,h=c.ops,i=b.ops,j=0,k=0,l=h[j++],m=i[k++];;){if("undefined"==typeof l&&"undefined"==typeof m)break;if(f(l))g["delete"](l),l=h[j++];else if(e(m))g.insert(m),m=i[k++];else{if("undefined"==typeof l)throw new Error("Cannot compose operations: first operation is too short.");if("undefined"==typeof m)throw new Error("Cannot compose operations: first operation is too long.");if(d(l)&&d(m))l>m?(g.retain(m),l-=m,m=i[k++]):l===m?(g.retain(l),l=h[j++],m=i[k++]):(g.retain(l),m-=l,l=h[j++]);else if(e(l)&&f(m))l.length>-m?(l=l.slice(-m),m=i[k++]):l.length===-m?(l=h[j++],m=i[k++]):(m+=l.length,l=h[j++]);else if(e(l)&&d(m))l.length>m?(g.insert(l.slice(0,m)),l=l.slice(m),m=i[k++]):l.length===m?(g.insert(l),l=h[j++],m=i[k++]):(g.insert(l),m-=l.length,l=h[j++]);else{if(!d(l)||!f(m))throw new Error("This shouldn't happen: op1: "+JSON.stringify(l)+", op2: "+JSON.stringify(m));l>-m?(g["delete"](m),l+=m,m=i[k++]):l===-m?(g["delete"](m),l=h[j++],m=i[k++]):(g["delete"](l),m+=l,l=h[j++])}}}return g},a.prototype.shouldBeComposedWith=function(a){if(this.isNoop()||a.isNoop())return!0;var d=c(this),g=c(a),h=b(this),i=b(a);return h&&i?e(h)&&e(i)?d+h.length===g:f(h)&&f(i)?g-i===d||d===g:!1:!1},a.prototype.shouldBeComposedWithInverted=function(a){if(this.isNoop()||a.isNoop())return!0;var d=c(this),g=c(a),h=b(this),i=b(a);return h&&i?e(h)&&e(i)?d+h.length===g||d===g:f(h)&&f(i)?g-i===d:!1:!1},a.transform=function(b,c){if(b.baseLength!==c.baseLength)throw new Error("Both operations have to have the same base length");for(var g=new a,h=new a,i=b.ops,j=c.ops,k=0,l=0,m=i[k++],n=j[l++];;){if("undefined"==typeof m&&"undefined"==typeof n)break;if(e(m))g.insert(m),h.retain(m.length),m=i[k++];else if(e(n))g.retain(n.length),h.insert(n),n=j[l++];else{if("undefined"==typeof m)throw new Error("Cannot compose operations: first operation is too short.");if("undefined"==typeof n)throw new Error("Cannot compose operations: first operation is too long.");var o;if(d(m)&&d(n))m>n?(o=n,m-=n,n=j[l++]):m===n?(o=n,m=i[k++],n=j[l++]):(o=m,n-=m,m=i[k++]),g.retain(o),h.retain(o);else if(f(m)&&f(n))-m>-n?(m-=n,n=j[l++]):m===n?(m=i[k++],n=j[l++]):(n-=m,m=i[k++]);else if(f(m)&&d(n))-m>n?(o=n,m+=n,n=j[l++]):-m===n?(o=n,m=i[k++],n=j[l++]):(o=-m,n+=m,m=i[k++]),g["delete"](o);else{if(!d(m)||!f(n))throw new Error("The two operations aren't compatible");m>-n?(o=-n,m+=n,n=j[l++]):m===-n?(o=m,m=i[k++],n=j[l++]):(o=m,n+=m,m=i[k++]),h["delete"](o)}}}return[g,h]},a}(),"object"==typeof module&&(module.exports=ot.TextOperation),"undefined"==typeof ot)var ot={};if(ot.Selection=function(a){"use strict";function b(a,b){this.anchor=a,this.head=b}function c(a){this.ranges=a||[]}var d=a.ot?a.ot.TextOperation:require("./text-operation");return b.fromJSON=function(a){return new b(a.anchor,a.head)},b.prototype.equals=function(a){return this.anchor===a.anchor&&this.head===a.head},b.prototype.isEmpty=function(){return this.anchor===this.head},b.prototype.transform=function(a){function c(b){for(var c=b,e=a.ops,f=0,g=a.ops.length;g>f&&(d.isRetain(e[f])?b-=e[f]:d.isInsert(e[f])?c+=e[f].length:(c-=Math.min(b,-e[f]),b+=e[f]),!(0>b));f++);return c}var e=c(this.anchor);return this.anchor===this.head?new b(e,e):new b(e,c(this.head))},c.Range=b,c.createCursor=function(a){return new c([new b(a,a)])},c.fromJSON=function(a){for(var d=a.ranges||a,e=0,f=[];e=0;e--){var f=d.transform(a[e],b);"function"==typeof f[0].isNoop&&f[0].isNoop()||c.push(f[0]),b=f[1]}return c.reverse()}var c="normal",d="undoing",e="redoing";return a.prototype.add=function(a,b){if(this.state===d)this.redoStack.push(a),this.dontCompose=!0;else if(this.state===e)this.undoStack.push(a),this.dontCompose=!0;else{var c=this.undoStack;!this.dontCompose&&b&&c.length>0?c.push(a.compose(c.pop())):(c.push(a),c.length>this.maxItems&&c.shift()),this.dontCompose=!1,this.redoStack=[]}},a.prototype.transform=function(a){this.undoStack=b(this.undoStack,a),this.redoStack=b(this.redoStack,a)},a.prototype.performUndo=function(a){if(this.state=d,0===this.undoStack.length)throw new Error("undo not possible");a(this.undoStack.pop()),this.state=c},a.prototype.performRedo=function(a){if(this.state=e,0===this.redoStack.length)throw new Error("redo not possible");a(this.redoStack.pop()),this.state=c},a.prototype.canUndo=function(){return 0!==this.undoStack.length},a.prototype.canRedo=function(){return 0!==this.redoStack.length},a.prototype.isUndoing=function(){return this.state===d},a.prototype.isRedoing=function(){return this.state===e},a}(),"object"==typeof module&&(module.exports=ot.UndoManager),"undefined"==typeof ot)var ot={};ot.Client=function(){"use strict";function a(a){this.revision=a,this.state=e}function b(){}function c(a){this.outstanding=a}function d(a,b){this.outstanding=a,this.buffer=b}a.prototype.setState=function(a){this.state=a},a.prototype.applyClient=function(a){this.setState(this.state.applyClient(this,a))},a.prototype.applyServer=function(a){this.revision++,this.setState(this.state.applyServer(this,a))},a.prototype.serverAck=function(){this.revision++,this.setState(this.state.serverAck(this))},a.prototype.serverReconnect=function(){"function"==typeof this.state.resend&&this.state.resend(this)},a.prototype.transformSelection=function(a){return this.state.transformSelection(a)},a.prototype.sendOperation=function(){throw new Error("sendOperation must be defined in child class")},a.prototype.applyOperation=function(){throw new Error("applyOperation must be defined in child class")},a.Synchronized=b,b.prototype.applyClient=function(a,b){return a.sendOperation(a.revision,b),new c(b)},b.prototype.applyServer=function(a,b){return a.applyOperation(b),this},b.prototype.serverAck=function(){throw new Error("There is no pending operation.")},b.prototype.transformSelection=function(a){return a};var e=new b;return a.AwaitingConfirm=c,c.prototype.applyClient=function(a,b){return new d(this.outstanding,b)},c.prototype.applyServer=function(a,b){var d=b.constructor.transform(this.outstanding,b);return a.applyOperation(d[1]),new c(d[0])},c.prototype.serverAck=function(){return e},c.prototype.transformSelection=function(a){return a.transform(this.outstanding)},c.prototype.resend=function(a){a.sendOperation(a.revision,this.outstanding)},a.AwaitingWithBuffer=d,d.prototype.applyClient=function(a,b){var c=this.buffer.compose(b);return new d(this.outstanding,c)},d.prototype.applyServer=function(a,b){var c=b.constructor.transform,e=c(this.outstanding,b),f=c(this.buffer,e[1]);return a.applyOperation(f[1]),new d(e[0],f[0])},d.prototype.serverAck=function(a){return a.sendOperation(a.revision,this.buffer),new c(this.buffer)},d.prototype.transformSelection=function(a){return a.transform(this.outstanding).transform(this.buffer)},d.prototype.resend=function(a){a.sendOperation(a.revision,this.outstanding)},a}(this),"object"==typeof module&&(module.exports=ot.Client),ot.CodeMirrorAdapter=function(){"use strict";function a(a){this.cm=a,this.ignoreNextChange=!1,this.changeInProgress=!1,this.selectionChanged=!1,g(this,"onChanges"),g(this,"onChange"),g(this,"onCursorActivity"),g(this,"onFocus"),g(this,"onBlur"),a.on("changes",this.onChanges),a.on("change",this.onChange),a.on("cursorActivity",this.onCursorActivity),a.on("focus",this.onFocus),a.on("blur",this.onBlur)}function b(a,b){return a.lineb.line?1:a.chb.ch?1:0}function c(a,c){return b(a,c)<=0}function d(a,b){return c(a,b)?a:b}function e(a,b){return c(a,b)?b:a}function f(a){return a.indexFromPos({line:a.lastLine(),ch:0})+a.getLine(a.lastLine()).length}function g(a,b){var c=a[b];a[b]=function(){c.apply(a,arguments)}}var h=ot.TextOperation,i=ot.Selection;a.prototype.detach=function(){this.cm.off("changes",this.onChanges),this.cm.off("change",this.onChange),this.cm.off("cursorActivity",this.onCursorActivity),this.cm.off("focus",this.onFocus),this.cm.off("blur",this.onBlur)},a.operationFromCodeMirrorChanges=function(a,b){function d(a){return a[a.length-1]}function e(a){if(0===a.length)return 0;for(var b=0,c=0;c=0;m--){var n=a[m];l=g(l,n);var o=l(n.from),p=i-o-e(n.text);j=(new h).retain(o)["delete"](e(n.removed)).insert(n.text.join("\n")).retain(p).compose(j),k=k.compose((new h).retain(o)["delete"](e(n.text)).insert(n.removed.join("\n")).retain(p)),i+=e(n.removed)-e(n.text)}return[j,k]},a.operationFromCodeMirrorChange=a.operationFromCodeMirrorChanges,a.applyOperationToCodeMirror=function(a,b){b.operation(function(){for(var c=a.ops,d=0,e=0,f=c.length;f>e;e++){var g=c[e];if(h.isRetain(g))d+=g;else if(h.isInsert(g))b.replaceRange(g,b.posFromIndex(d)),d+=g.length;else if(h.isDelete(g)){var i=b.posFromIndex(d),j=b.posFromIndex(d-g);b.replaceRange("",i,j)}}})},a.prototype.registerCallbacks=function(a){this.callbacks=a},a.prototype.onChange=function(){this.changeInProgress=!0},a.prototype.onChanges=function(b,c){if(!this.ignoreNextChange){var d=a.operationFromCodeMirrorChanges(c,this.cm);this.trigger("change",d[0],d[1])}this.selectionChanged&&this.trigger("selectionChange"),this.changeInProgress=!1,this.ignoreNextChange=!1},a.prototype.onCursorActivity=a.prototype.onFocus=function(){this.changeInProgress?this.selectionChanged=!0:this.trigger("selectionChange")},a.prototype.onBlur=function(){this.cm.somethingSelected()||this.trigger("blur")},a.prototype.getValue=function(){return this.cm.getValue()},a.prototype.getSelection=function(){for(var a=this.cm,b=a.listSelections(),c=[],d=0;d0&&(this.majorRevision+=c.length,this.minorRevision=0);var d=a.events;if(d){for(b=0;bc?c*(1+b):c+b-b*c,f=2*c-d,g=function(a){return 0>a&&(a+=1),a>1&&(a-=1),1>6*a?f+6*(d-f)*a:1>2*a?d:2>3*a?f+6*(d-f)*(2/3-a):f};return e(g(a+1/3),g(a),g(a-1/3))}function g(a){for(var b=1,c=0;c0&&c.shouldBeComposedWithInverted(i(this.undoManager.undoStack).wrapped)),g=new a(this.selection,d);this.undoManager.add(new o(c,g),f),this.applyClient(b)},d.prototype.updateSelection=function(){this.selection=this.editorAdapter.getSelection()},d.prototype.onSelectionChange=function(){var a=this.selection;this.updateSelection(),a&&this.selection.equals(a)||this.sendSelection(this.selection)},d.prototype.onBlur=function(){this.selection=null,this.sendSelection(null)},d.prototype.sendSelection=function(a){this.state instanceof k.AwaitingWithBuffer||this.serverAdapter.sendSelection(a)},d.prototype.sendOperation=function(a,b){this.serverAdapter.sendOperation(a,b.toJSON(),this.selection)},d.prototype.applyOperation=function(a){this.editorAdapter.applyOperation(a),this.updateSelection(),this.undoManager.transform(new o(a,null))},d}();
\ No newline at end of file
diff --git a/third_party/ot.js/ot.js b/third_party/ot.js/ot.js
deleted file mode 100644
index 247787577..000000000
--- a/third_party/ot.js/ot.js
+++ /dev/null
@@ -1,1887 +0,0 @@
-/*
- *    /\
- *   /  \ ot 0.0.14
- *  /    \ http://operational-transformation.github.com
- *  \    /
- *   \  / (c) 2012-2014 Tim Baumann  (http://timbaumann.info)
- *    \/ ot may be freely distributed under the MIT license.
- */
-
-if (typeof ot === 'undefined') {
-  // Export for browsers
-  var ot = {};
-}
-
-ot.TextOperation = (function () {
-  'use strict';
-
-  // Constructor for new operations.
-  function TextOperation () {
-    if (!this || this.constructor !== TextOperation) {
-      // => function was called without 'new'
-      return new TextOperation();
-    }
-
-    // When an operation is applied to an input string, you can think of this as
-    // if an imaginary cursor runs over the entire string and skips over some
-    // parts, deletes some parts and inserts characters at some positions. These
-    // actions (skip/delete/insert) are stored as an array in the "ops" property.
-    this.ops = [];
-    // An operation's baseLength is the length of every string the operation
-    // can be applied to.
-    this.baseLength = 0;
-    // The targetLength is the length of every string that results from applying
-    // the operation on a valid input string.
-    this.targetLength = 0;
-  }
-
-  TextOperation.prototype.equals = function (other) {
-    if (this.baseLength !== other.baseLength) { return false; }
-    if (this.targetLength !== other.targetLength) { return false; }
-    if (this.ops.length !== other.ops.length) { return false; }
-    for (var i = 0; i < this.ops.length; i++) {
-      if (this.ops[i] !== other.ops[i]) { return false; }
-    }
-    return true;
-  };
-
-  // Operation are essentially lists of ops. There are three types of ops:
-  //
-  // * Retain ops: Advance the cursor position by a given number of characters.
-  //   Represented by positive ints.
-  // * Insert ops: Insert a given string at the current cursor position.
-  //   Represented by strings.
-  // * Delete ops: Delete the next n characters. Represented by negative ints.
-
-  var isRetain = TextOperation.isRetain = function (op) {
-    return typeof op === 'number' && op > 0;
-  };
-
-  var isInsert = TextOperation.isInsert = function (op) {
-    return typeof op === 'string';
-  };
-
-  var isDelete = TextOperation.isDelete = function (op) {
-    return typeof op === 'number' && op < 0;
-  };
-
-
-  // After an operation is constructed, the user of the library can specify the
-  // actions of an operation (skip/insert/delete) with these three builder
-  // methods. They all return the operation for convenient chaining.
-
-  // Skip over a given number of characters.
-  TextOperation.prototype.retain = function (n) {
-    if (typeof n !== 'number') {
-      throw new Error("retain expects an integer");
-    }
-    if (n === 0) { return this; }
-    this.baseLength += n;
-    this.targetLength += n;
-    if (isRetain(this.ops[this.ops.length-1])) {
-      // The last op is a retain op => we can merge them into one op.
-      this.ops[this.ops.length-1] += n;
-    } else {
-      // Create a new op.
-      this.ops.push(n);
-    }
-    return this;
-  };
-
-  // Insert a string at the current position.
-  TextOperation.prototype.insert = function (str) {
-    if (typeof str !== 'string') {
-      throw new Error("insert expects a string");
-    }
-    if (str === '') { return this; }
-    this.targetLength += str.length;
-    var ops = this.ops;
-    if (isInsert(ops[ops.length-1])) {
-      // Merge insert op.
-      ops[ops.length-1] += str;
-    } else if (isDelete(ops[ops.length-1])) {
-      // It doesn't matter when an operation is applied whether the operation
-      // is delete(3), insert("something") or insert("something"), delete(3).
-      // Here we enforce that in this case, the insert op always comes first.
-      // This makes all operations that have the same effect when applied to
-      // a document of the right length equal in respect to the `equals` method.
-      if (isInsert(ops[ops.length-2])) {
-        ops[ops.length-2] += str;
-      } else {
-        ops[ops.length] = ops[ops.length-1];
-        ops[ops.length-2] = str;
-      }
-    } else {
-      ops.push(str);
-    }
-    return this;
-  };
-
-  // Delete a string at the current position.
-  TextOperation.prototype['delete'] = function (n) {
-    if (typeof n === 'string') { n = n.length; }
-    if (typeof n !== 'number') {
-      throw new Error("delete expects an integer or a string");
-    }
-    if (n === 0) { return this; }
-    if (n > 0) { n = -n; }
-    this.baseLength -= n;
-    if (isDelete(this.ops[this.ops.length-1])) {
-      this.ops[this.ops.length-1] += n;
-    } else {
-      this.ops.push(n);
-    }
-    return this;
-  };
-
-  // Tests whether this operation has no effect.
-  TextOperation.prototype.isNoop = function () {
-    return this.ops.length === 0 || (this.ops.length === 1 && isRetain(this.ops[0]));
-  };
-
-  // Pretty printing.
-  TextOperation.prototype.toString = function () {
-    // map: build a new array by applying a function to every element in an old
-    // array.
-    var map = Array.prototype.map || function (fn) {
-      var arr = this;
-      var newArr = [];
-      for (var i = 0, l = arr.length; i < l; i++) {
-        newArr[i] = fn(arr[i]);
-      }
-      return newArr;
-    };
-    return map.call(this.ops, function (op) {
-      if (isRetain(op)) {
-        return "retain " + op;
-      } else if (isInsert(op)) {
-        return "insert '" + op + "'";
-      } else {
-        return "delete " + (-op);
-      }
-    }).join(', ');
-  };
-
-  // Converts operation into a JSON value.
-  TextOperation.prototype.toJSON = function () {
-    return this.ops;
-  };
-
-  // Converts a plain JS object into an operation and validates it.
-  TextOperation.fromJSON = function (ops) {
-    var o = new TextOperation();
-    for (var i = 0, l = ops.length; i < l; i++) {
-      var op = ops[i];
-      if (isRetain(op)) {
-        o.retain(op);
-      } else if (isInsert(op)) {
-        o.insert(op);
-      } else if (isDelete(op)) {
-        o['delete'](op);
-      } else {
-        throw new Error("unknown operation: " + JSON.stringify(op));
-      }
-    }
-    return o;
-  };
-
-  // Apply an operation to a string, returning a new string. Throws an error if
-  // there's a mismatch between the input string and the operation.
-  TextOperation.prototype.apply = function (str) {
-    var operation = this;
-    if (str.length !== operation.baseLength) {
-      throw new Error("The operation's base length must be equal to the string's length.");
-    }
-    var newStr = [], j = 0;
-    var strIndex = 0;
-    var ops = this.ops;
-    for (var i = 0, l = ops.length; i < l; i++) {
-      var op = ops[i];
-      if (isRetain(op)) {
-        if (strIndex + op > str.length) {
-          throw new Error("Operation can't retain more characters than are left in the string.");
-        }
-        // Copy skipped part of the old string.
-        newStr[j++] = str.slice(strIndex, strIndex + op);
-        strIndex += op;
-      } else if (isInsert(op)) {
-        // Insert string.
-        newStr[j++] = op;
-      } else { // delete op
-        strIndex -= op;
-      }
-    }
-    if (strIndex !== str.length) {
-      throw new Error("The operation didn't operate on the whole string.");
-    }
-    return newStr.join('');
-  };
-
-  // Computes the inverse of an operation. The inverse of an operation is the
-  // operation that reverts the effects of the operation, e.g. when you have an
-  // operation 'insert("hello "); skip(6);' then the inverse is 'delete("hello ");
-  // skip(6);'. The inverse should be used for implementing undo.
-  TextOperation.prototype.invert = function (str) {
-    var strIndex = 0;
-    var inverse = new TextOperation();
-    var ops = this.ops;
-    for (var i = 0, l = ops.length; i < l; i++) {
-      var op = ops[i];
-      if (isRetain(op)) {
-        inverse.retain(op);
-        strIndex += op;
-      } else if (isInsert(op)) {
-        inverse['delete'](op.length);
-      } else { // delete op
-        inverse.insert(str.slice(strIndex, strIndex - op));
-        strIndex -= op;
-      }
-    }
-    return inverse;
-  };
-
-  // Compose merges two consecutive operations into one operation, that
-  // preserves the changes of both. Or, in other words, for each input string S
-  // and a pair of consecutive operations A and B,
-  // apply(apply(S, A), B) = apply(S, compose(A, B)) must hold.
-  TextOperation.prototype.compose = function (operation2) {
-    var operation1 = this;
-    if (operation1.targetLength !== operation2.baseLength) {
-      throw new Error("The base length of the second operation has to be the target length of the first operation");
-    }
-
-    var operation = new TextOperation(); // the combined operation
-    var ops1 = operation1.ops, ops2 = operation2.ops; // for fast access
-    var i1 = 0, i2 = 0; // current index into ops1 respectively ops2
-    var op1 = ops1[i1++], op2 = ops2[i2++]; // current ops
-    while (true) {
-      // Dispatch on the type of op1 and op2
-      if (typeof op1 === 'undefined' && typeof op2 === 'undefined') {
-        // end condition: both ops1 and ops2 have been processed
-        break;
-      }
-
-      if (isDelete(op1)) {
-        operation['delete'](op1);
-        op1 = ops1[i1++];
-        continue;
-      }
-      if (isInsert(op2)) {
-        operation.insert(op2);
-        op2 = ops2[i2++];
-        continue;
-      }
-
-      if (typeof op1 === 'undefined') {
-        throw new Error("Cannot compose operations: first operation is too short.");
-      }
-      if (typeof op2 === 'undefined') {
-        throw new Error("Cannot compose operations: first operation is too long.");
-      }
-
-      if (isRetain(op1) && isRetain(op2)) {
-        if (op1 > op2) {
-          operation.retain(op2);
-          op1 = op1 - op2;
-          op2 = ops2[i2++];
-        } else if (op1 === op2) {
-          operation.retain(op1);
-          op1 = ops1[i1++];
-          op2 = ops2[i2++];
-        } else {
-          operation.retain(op1);
-          op2 = op2 - op1;
-          op1 = ops1[i1++];
-        }
-      } else if (isInsert(op1) && isDelete(op2)) {
-        if (op1.length > -op2) {
-          op1 = op1.slice(-op2);
-          op2 = ops2[i2++];
-        } else if (op1.length === -op2) {
-          op1 = ops1[i1++];
-          op2 = ops2[i2++];
-        } else {
-          op2 = op2 + op1.length;
-          op1 = ops1[i1++];
-        }
-      } else if (isInsert(op1) && isRetain(op2)) {
-        if (op1.length > op2) {
-          operation.insert(op1.slice(0, op2));
-          op1 = op1.slice(op2);
-          op2 = ops2[i2++];
-        } else if (op1.length === op2) {
-          operation.insert(op1);
-          op1 = ops1[i1++];
-          op2 = ops2[i2++];
-        } else {
-          operation.insert(op1);
-          op2 = op2 - op1.length;
-          op1 = ops1[i1++];
-        }
-      } else if (isRetain(op1) && isDelete(op2)) {
-        if (op1 > -op2) {
-          operation['delete'](op2);
-          op1 = op1 + op2;
-          op2 = ops2[i2++];
-        } else if (op1 === -op2) {
-          operation['delete'](op2);
-          op1 = ops1[i1++];
-          op2 = ops2[i2++];
-        } else {
-          operation['delete'](op1);
-          op2 = op2 + op1;
-          op1 = ops1[i1++];
-        }
-      } else {
-        throw new Error(
-          "This shouldn't happen: op1: " +
-          JSON.stringify(op1) + ", op2: " +
-          JSON.stringify(op2)
-        );
-      }
-    }
-    return operation;
-  };
-
-  function getSimpleOp (operation, fn) {
-    var ops = operation.ops;
-    var isRetain = TextOperation.isRetain;
-    switch (ops.length) {
-    case 1:
-      return ops[0];
-    case 2:
-      return isRetain(ops[0]) ? ops[1] : (isRetain(ops[1]) ? ops[0] : null);
-    case 3:
-      if (isRetain(ops[0]) && isRetain(ops[2])) { return ops[1]; }
-    }
-    return null;
-  }
-
-  function getStartIndex (operation) {
-    if (isRetain(operation.ops[0])) { return operation.ops[0]; }
-    return 0;
-  }
-
-  // When you use ctrl-z to undo your latest changes, you expect the program not
-  // to undo every single keystroke but to undo your last sentence you wrote at
-  // a stretch or the deletion you did by holding the backspace key down. This
-  // This can be implemented by composing operations on the undo stack. This
-  // method can help decide whether two operations should be composed. It
-  // returns true if the operations are consecutive insert operations or both
-  // operations delete text at the same position. You may want to include other
-  // factors like the time since the last change in your decision.
-  TextOperation.prototype.shouldBeComposedWith = function (other) {
-    if (this.isNoop() || other.isNoop()) { return true; }
-
-    var startA = getStartIndex(this), startB = getStartIndex(other);
-    var simpleA = getSimpleOp(this), simpleB = getSimpleOp(other);
-    if (!simpleA || !simpleB) { return false; }
-
-    if (isInsert(simpleA) && isInsert(simpleB)) {
-      return startA + simpleA.length === startB;
-    }
-
-    if (isDelete(simpleA) && isDelete(simpleB)) {
-      // there are two possibilities to delete: with backspace and with the
-      // delete key.
-      return (startB - simpleB === startA) || startA === startB;
-    }
-
-    return false;
-  };
-
-  // Decides whether two operations should be composed with each other
-  // if they were inverted, that is
-  // `shouldBeComposedWith(a, b) = shouldBeComposedWithInverted(b^{-1}, a^{-1})`.
-  TextOperation.prototype.shouldBeComposedWithInverted = function (other) {
-    if (this.isNoop() || other.isNoop()) { return true; }
-
-    var startA = getStartIndex(this), startB = getStartIndex(other);
-    var simpleA = getSimpleOp(this), simpleB = getSimpleOp(other);
-    if (!simpleA || !simpleB) { return false; }
-
-    if (isInsert(simpleA) && isInsert(simpleB)) {
-      return startA + simpleA.length === startB || startA === startB;
-    }
-
-    if (isDelete(simpleA) && isDelete(simpleB)) {
-      return startB - simpleB === startA;
-    }
-
-    return false;
-  };
-
-  // Transform takes two operations A and B that happened concurrently and
-  // produces two operations A' and B' (in an array) such that
-  // `apply(apply(S, A), B') = apply(apply(S, B), A')`. This function is the
-  // heart of OT.
-  TextOperation.transform = function (operation1, operation2) {
-    if (operation1.baseLength !== operation2.baseLength) {
-      throw new Error("Both operations have to have the same base length");
-    }
-
-    var operation1prime = new TextOperation();
-    var operation2prime = new TextOperation();
-    var ops1 = operation1.ops, ops2 = operation2.ops;
-    var i1 = 0, i2 = 0;
-    var op1 = ops1[i1++], op2 = ops2[i2++];
-    while (true) {
-      // At every iteration of the loop, the imaginary cursor that both
-      // operation1 and operation2 have that operates on the input string must
-      // have the same position in the input string.
-
-      if (typeof op1 === 'undefined' && typeof op2 === 'undefined') {
-        // end condition: both ops1 and ops2 have been processed
-        break;
-      }
-
-      // next two cases: one or both ops are insert ops
-      // => insert the string in the corresponding prime operation, skip it in
-      // the other one. If both op1 and op2 are insert ops, prefer op1.
-      if (isInsert(op1)) {
-        operation1prime.insert(op1);
-        operation2prime.retain(op1.length);
-        op1 = ops1[i1++];
-        continue;
-      }
-      if (isInsert(op2)) {
-        operation1prime.retain(op2.length);
-        operation2prime.insert(op2);
-        op2 = ops2[i2++];
-        continue;
-      }
-
-      if (typeof op1 === 'undefined') {
-        throw new Error("Cannot compose operations: first operation is too short.");
-      }
-      if (typeof op2 === 'undefined') {
-        throw new Error("Cannot compose operations: first operation is too long.");
-      }
-
-      var minl;
-      if (isRetain(op1) && isRetain(op2)) {
-        // Simple case: retain/retain
-        if (op1 > op2) {
-          minl = op2;
-          op1 = op1 - op2;
-          op2 = ops2[i2++];
-        } else if (op1 === op2) {
-          minl = op2;
-          op1 = ops1[i1++];
-          op2 = ops2[i2++];
-        } else {
-          minl = op1;
-          op2 = op2 - op1;
-          op1 = ops1[i1++];
-        }
-        operation1prime.retain(minl);
-        operation2prime.retain(minl);
-      } else if (isDelete(op1) && isDelete(op2)) {
-        // Both operations delete the same string at the same position. We don't
-        // need to produce any operations, we just skip over the delete ops and
-        // handle the case that one operation deletes more than the other.
-        if (-op1 > -op2) {
-          op1 = op1 - op2;
-          op2 = ops2[i2++];
-        } else if (op1 === op2) {
-          op1 = ops1[i1++];
-          op2 = ops2[i2++];
-        } else {
-          op2 = op2 - op1;
-          op1 = ops1[i1++];
-        }
-      // next two cases: delete/retain and retain/delete
-      } else if (isDelete(op1) && isRetain(op2)) {
-        if (-op1 > op2) {
-          minl = op2;
-          op1 = op1 + op2;
-          op2 = ops2[i2++];
-        } else if (-op1 === op2) {
-          minl = op2;
-          op1 = ops1[i1++];
-          op2 = ops2[i2++];
-        } else {
-          minl = -op1;
-          op2 = op2 + op1;
-          op1 = ops1[i1++];
-        }
-        operation1prime['delete'](minl);
-      } else if (isRetain(op1) && isDelete(op2)) {
-        if (op1 > -op2) {
-          minl = -op2;
-          op1 = op1 + op2;
-          op2 = ops2[i2++];
-        } else if (op1 === -op2) {
-          minl = op1;
-          op1 = ops1[i1++];
-          op2 = ops2[i2++];
-        } else {
-          minl = op1;
-          op2 = op2 + op1;
-          op1 = ops1[i1++];
-        }
-        operation2prime['delete'](minl);
-      } else {
-        throw new Error("The two operations aren't compatible");
-      }
-    }
-
-    return [operation1prime, operation2prime];
-  };
-
-  return TextOperation;
-
-}());
-
-// Export for CommonJS
-if (typeof module === 'object') {
-  module.exports = ot.TextOperation;
-}
-if (typeof ot === 'undefined') {
-  // Export for browsers
-  var ot = {};
-}
-
-ot.Selection = (function (global) {
-  'use strict';
-
-  var TextOperation = global.ot ? global.ot.TextOperation : require('./text-operation');
-
-  // Range has `anchor` and `head` properties, which are zero-based indices into
-  // the document. The `anchor` is the side of the selection that stays fixed,
-  // `head` is the side of the selection where the cursor is. When both are
-  // equal, the range represents a cursor.
-  function Range (anchor, head) {
-    this.anchor = anchor;
-    this.head = head;
-  }
-
-  Range.fromJSON = function (obj) {
-    return new Range(obj.anchor, obj.head);
-  };
-
-  Range.prototype.equals = function (other) {
-    return this.anchor === other.anchor && this.head === other.head;
-  };
-
-  Range.prototype.isEmpty = function () {
-    return this.anchor === this.head;
-  };
-
-  Range.prototype.transform = function (other) {
-    function transformIndex (index) {
-      var newIndex = index;
-      var ops = other.ops;
-      for (var i = 0, l = other.ops.length; i < l; i++) {
-        if (TextOperation.isRetain(ops[i])) {
-          index -= ops[i];
-        } else if (TextOperation.isInsert(ops[i])) {
-          newIndex += ops[i].length;
-        } else {
-          newIndex -= Math.min(index, -ops[i]);
-          index += ops[i];
-        }
-        if (index < 0) { break; }
-      }
-      return newIndex;
-    }
-
-    var newAnchor = transformIndex(this.anchor);
-    if (this.anchor === this.head) {
-      return new Range(newAnchor, newAnchor);
-    }
-    return new Range(newAnchor, transformIndex(this.head));
-  };
-
-  // A selection is basically an array of ranges. Every range represents a real
-  // selection or a cursor in the document (when the start position equals the
-  // end position of the range). The array must not be empty.
-  function Selection (ranges) {
-    this.ranges = ranges || [];
-  }
-
-  Selection.Range = Range;
-
-  // Convenience method for creating selections only containing a single cursor
-  // and no real selection range.
-  Selection.createCursor = function (position) {
-    return new Selection([new Range(position, position)]);
-  };
-
-  Selection.fromJSON = function (obj) {
-    var objRanges = obj.ranges || obj;
-    for (var i = 0, ranges = []; i < objRanges.length; i++) {
-      ranges[i] = Range.fromJSON(objRanges[i]);
-    }
-    return new Selection(ranges);
-  };
-
-  Selection.prototype.equals = function (other) {
-    if (this.position !== other.position) { return false; }
-    if (this.ranges.length !== other.ranges.length) { return false; }
-    // FIXME: Sort ranges before comparing them?
-    for (var i = 0; i < this.ranges.length; i++) {
-      if (!this.ranges[i].equals(other.ranges[i])) { return false; }
-    }
-    return true;
-  };
-
-  Selection.prototype.somethingSelected = function () {
-    for (var i = 0; i < this.ranges.length; i++) {
-      if (!this.ranges[i].isEmpty()) { return true; }
-    }
-    return false;
-  };
-
-  // Return the more current selection information.
-  Selection.prototype.compose = function (other) {
-    return other;
-  };
-
-  // Update the selection with respect to an operation.
-  Selection.prototype.transform = function (other) {
-    for (var i = 0, newRanges = []; i < this.ranges.length; i++) {
-      newRanges[i] = this.ranges[i].transform(other);
-    }
-    return new Selection(newRanges);
-  };
-
-  return Selection;
-
-}(this));
-
-// Export for CommonJS
-if (typeof module === 'object') {
-  module.exports = ot.Selection;
-}
-
-if (typeof ot === 'undefined') {
-  // Export for browsers
-  var ot = {};
-}
-
-ot.WrappedOperation = (function (global) {
-  'use strict';
-
-  // A WrappedOperation contains an operation and corresponing metadata.
-  function WrappedOperation (operation, meta) {
-    this.wrapped = operation;
-    this.meta    = meta;
-  }
-
-  WrappedOperation.prototype.apply = function () {
-    return this.wrapped.apply.apply(this.wrapped, arguments);
-  };
-
-  WrappedOperation.prototype.invert = function () {
-    var meta = this.meta;
-    return new WrappedOperation(
-      this.wrapped.invert.apply(this.wrapped, arguments),
-      meta && typeof meta === 'object' && typeof meta.invert === 'function' ?
-        meta.invert.apply(meta, arguments) : meta
-    );
-  };
-
-  // Copy all properties from source to target.
-  function copy (source, target) {
-    for (var key in source) {
-      if (source.hasOwnProperty(key)) {
-        target[key] = source[key];
-      }
-    }
-  }
-
-  function composeMeta (a, b) {
-    if (a && typeof a === 'object') {
-      if (typeof a.compose === 'function') { return a.compose(b); }
-      var meta = {};
-      copy(a, meta);
-      copy(b, meta);
-      return meta;
-    }
-    return b;
-  }
-
-  WrappedOperation.prototype.compose = function (other) {
-    return new WrappedOperation(
-      this.wrapped.compose(other.wrapped),
-      composeMeta(this.meta, other.meta)
-    );
-  };
-
-  function transformMeta (meta, operation) {
-    if (meta && typeof meta === 'object') {
-      if (typeof meta.transform === 'function') {
-        return meta.transform(operation);
-      }
-    }
-    return meta;
-  }
-
-  WrappedOperation.transform = function (a, b) {
-    var transform = a.wrapped.constructor.transform;
-    var pair = transform(a.wrapped, b.wrapped);
-    return [
-      new WrappedOperation(pair[0], transformMeta(a.meta, b.wrapped)),
-      new WrappedOperation(pair[1], transformMeta(b.meta, a.wrapped))
-    ];
-  };
-
-  return WrappedOperation;
-
-}(this));
-
-// Export for CommonJS
-if (typeof module === 'object') {
-  module.exports = ot.WrappedOperation;
-}
-if (typeof ot === 'undefined') {
-  // Export for browsers
-  var ot = {};
-}
-
-ot.UndoManager = (function () {
-  'use strict';
-
-  var NORMAL_STATE = 'normal';
-  var UNDOING_STATE = 'undoing';
-  var REDOING_STATE = 'redoing';
-
-  // Create a new UndoManager with an optional maximum history size.
-  function UndoManager (maxItems) {
-    this.maxItems  = maxItems || 50;
-    this.state = NORMAL_STATE;
-    this.dontCompose = false;
-    this.undoStack = [];
-    this.redoStack = [];
-  }
-
-  // Add an operation to the undo or redo stack, depending on the current state
-  // of the UndoManager. The operation added must be the inverse of the last
-  // edit. When `compose` is true, compose the operation with the last operation
-  // unless the last operation was alread pushed on the redo stack or was hidden
-  // by a newer operation on the undo stack.
-  UndoManager.prototype.add = function (operation, compose) {
-    if (this.state === UNDOING_STATE) {
-      this.redoStack.push(operation);
-      this.dontCompose = true;
-    } else if (this.state === REDOING_STATE) {
-      this.undoStack.push(operation);
-      this.dontCompose = true;
-    } else {
-      var undoStack = this.undoStack;
-      if (!this.dontCompose && compose && undoStack.length > 0) {
-        undoStack.push(operation.compose(undoStack.pop()));
-      } else {
-        undoStack.push(operation);
-        if (undoStack.length > this.maxItems) { undoStack.shift(); }
-      }
-      this.dontCompose = false;
-      this.redoStack = [];
-    }
-  };
-
-  function transformStack (stack, operation) {
-    var newStack = [];
-    var Operation = operation.constructor;
-    for (var i = stack.length - 1; i >= 0; i--) {
-      var pair = Operation.transform(stack[i], operation);
-      if (typeof pair[0].isNoop !== 'function' || !pair[0].isNoop()) {
-        newStack.push(pair[0]);
-      }
-      operation = pair[1];
-    }
-    return newStack.reverse();
-  }
-
-  // Transform the undo and redo stacks against a operation by another client.
-  UndoManager.prototype.transform = function (operation) {
-    this.undoStack = transformStack(this.undoStack, operation);
-    this.redoStack = transformStack(this.redoStack, operation);
-  };
-
-  // Perform an undo by calling a function with the latest operation on the undo
-  // stack. The function is expected to call the `add` method with the inverse
-  // of the operation, which pushes the inverse on the redo stack.
-  UndoManager.prototype.performUndo = function (fn) {
-    this.state = UNDOING_STATE;
-    if (this.undoStack.length === 0) { throw new Error("undo not possible"); }
-    fn(this.undoStack.pop());
-    this.state = NORMAL_STATE;
-  };
-
-  // The inverse of `performUndo`.
-  UndoManager.prototype.performRedo = function (fn) {
-    this.state = REDOING_STATE;
-    if (this.redoStack.length === 0) { throw new Error("redo not possible"); }
-    fn(this.redoStack.pop());
-    this.state = NORMAL_STATE;
-  };
-
-  // Is the undo stack not empty?
-  UndoManager.prototype.canUndo = function () {
-    return this.undoStack.length !== 0;
-  };
-
-  // Is the redo stack not empty?
-  UndoManager.prototype.canRedo = function () {
-    return this.redoStack.length !== 0;
-  };
-
-  // Whether the UndoManager is currently performing an undo.
-  UndoManager.prototype.isUndoing = function () {
-    return this.state === UNDOING_STATE;
-  };
-
-  // Whether the UndoManager is currently performing a redo.
-  UndoManager.prototype.isRedoing = function () {
-    return this.state === REDOING_STATE;
-  };
-
-  return UndoManager;
-
-}());
-
-// Export for CommonJS
-if (typeof module === 'object') {
-  module.exports = ot.UndoManager;
-}
-
-// translation of https://github.com/djspiewak/cccp/blob/master/agent/src/main/scala/com/codecommit/cccp/agent/state.scala
-
-if (typeof ot === 'undefined') {
-  var ot = {};
-}
-
-ot.Client = (function (global) {
-  'use strict';
-
-  // Client constructor
-  function Client (revision) {
-    this.revision = revision; // the next expected revision number
-    this.state = synchronized_; // start state
-  }
-
-  Client.prototype.setState = function (state) {
-    this.state = state;
-  };
-
-  // Call this method when the user changes the document.
-  Client.prototype.applyClient = function (operation) {
-    this.setState(this.state.applyClient(this, operation));
-  };
-
-  // Call this method with a new operation from the server
-  Client.prototype.applyServer = function (operation) {
-    this.revision++;
-    this.setState(this.state.applyServer(this, operation));
-  };
-
-  Client.prototype.serverAck = function () {
-    this.revision++;
-    this.setState(this.state.serverAck(this));
-  };
-  
-  Client.prototype.serverReconnect = function () {
-    if (typeof this.state.resend === 'function') { this.state.resend(this); }
-  };
-
-  // Transforms a selection from the latest known server state to the current
-  // client state. For example, if we get from the server the information that
-  // another user's cursor is at position 3, but the server hasn't yet received
-  // our newest operation, an insertion of 5 characters at the beginning of the
-  // document, the correct position of the other user's cursor in our current
-  // document is 8.
-  Client.prototype.transformSelection = function (selection) {
-    return this.state.transformSelection(selection);
-  };
-
-  // Override this method.
-  Client.prototype.sendOperation = function (revision, operation) {
-    throw new Error("sendOperation must be defined in child class");
-  };
-
-  // Override this method.
-  Client.prototype.applyOperation = function (operation) {
-    throw new Error("applyOperation must be defined in child class");
-  };
-
-
-  // In the 'Synchronized' state, there is no pending operation that the client
-  // has sent to the server.
-  function Synchronized () {}
-  Client.Synchronized = Synchronized;
-
-  Synchronized.prototype.applyClient = function (client, operation) {
-    // When the user makes an edit, send the operation to the server and
-    // switch to the 'AwaitingConfirm' state
-    client.sendOperation(client.revision, operation);
-    return new AwaitingConfirm(operation);
-  };
-
-  Synchronized.prototype.applyServer = function (client, operation) {
-    // When we receive a new operation from the server, the operation can be
-    // simply applied to the current document
-    client.applyOperation(operation);
-    return this;
-  };
-
-  Synchronized.prototype.serverAck = function (client) {
-    throw new Error("There is no pending operation.");
-  };
-
-  // Nothing to do because the latest server state and client state are the same.
-  Synchronized.prototype.transformSelection = function (x) { return x; };
-
-  // Singleton
-  var synchronized_ = new Synchronized();
-
-
-  // In the 'AwaitingConfirm' state, there's one operation the client has sent
-  // to the server and is still waiting for an acknowledgement.
-  function AwaitingConfirm (outstanding) {
-    // Save the pending operation
-    this.outstanding = outstanding;
-  }
-  Client.AwaitingConfirm = AwaitingConfirm;
-
-  AwaitingConfirm.prototype.applyClient = function (client, operation) {
-    // When the user makes an edit, don't send the operation immediately,
-    // instead switch to 'AwaitingWithBuffer' state
-    return new AwaitingWithBuffer(this.outstanding, operation);
-  };
-
-  AwaitingConfirm.prototype.applyServer = function (client, operation) {
-    // This is another client's operation. Visualization:
-    //
-    //                   /\
-    // this.outstanding /  \ operation
-    //                 /    \
-    //                 \    /
-    //  pair[1]         \  / pair[0] (new outstanding)
-    //  (can be applied  \/
-    //  to the client's
-    //  current document)
-    var pair = operation.constructor.transform(this.outstanding, operation);
-    client.applyOperation(pair[1]);
-    return new AwaitingConfirm(pair[0]);
-  };
-
-  AwaitingConfirm.prototype.serverAck = function (client) {
-    // The client's operation has been acknowledged
-    // => switch to synchronized state
-    return synchronized_;
-  };
-
-  AwaitingConfirm.prototype.transformSelection = function (selection) {
-    return selection.transform(this.outstanding);
-  };
-
-  AwaitingConfirm.prototype.resend = function (client) {
-    // The confirm didn't come because the client was disconnected.
-    // Now that it has reconnected, we resend the outstanding operation.
-    client.sendOperation(client.revision, this.outstanding);
-  };
-
-
-  // In the 'AwaitingWithBuffer' state, the client is waiting for an operation
-  // to be acknowledged by the server while buffering the edits the user makes
-  function AwaitingWithBuffer (outstanding, buffer) {
-    // Save the pending operation and the user's edits since then
-    this.outstanding = outstanding;
-    this.buffer = buffer;
-  }
-  Client.AwaitingWithBuffer = AwaitingWithBuffer;
-
-  AwaitingWithBuffer.prototype.applyClient = function (client, operation) {
-    // Compose the user's changes onto the buffer
-    var newBuffer = this.buffer.compose(operation);
-    return new AwaitingWithBuffer(this.outstanding, newBuffer);
-  };
-
-  AwaitingWithBuffer.prototype.applyServer = function (client, operation) {
-    // Operation comes from another client
-    //
-    //                       /\
-    //     this.outstanding /  \ operation
-    //                     /    \
-    //                    /\    /
-    //       this.buffer /  \* / pair1[0] (new outstanding)
-    //                  /    \/
-    //                  \    /
-    //          pair2[1] \  / pair2[0] (new buffer)
-    // the transformed    \/
-    // operation -- can
-    // be applied to the
-    // client's current
-    // document
-    //
-    // * pair1[1]
-    var transform = operation.constructor.transform;
-    var pair1 = transform(this.outstanding, operation);
-    var pair2 = transform(this.buffer, pair1[1]);
-    client.applyOperation(pair2[1]);
-    return new AwaitingWithBuffer(pair1[0], pair2[0]);
-  };
-
-  AwaitingWithBuffer.prototype.serverAck = function (client) {
-    // The pending operation has been acknowledged
-    // => send buffer
-    client.sendOperation(client.revision, this.buffer);
-    return new AwaitingConfirm(this.buffer);
-  };
-
-  AwaitingWithBuffer.prototype.transformSelection = function (selection) {
-    return selection.transform(this.outstanding).transform(this.buffer);
-  };
-
-  AwaitingWithBuffer.prototype.resend = function (client) {
-    // The confirm didn't come because the client was disconnected.
-    // Now that it has reconnected, we resend the outstanding operation.
-    client.sendOperation(client.revision, this.outstanding);
-  };
-
-
-  return Client;
-
-}(this));
-
-if (typeof module === 'object') {
-  module.exports = ot.Client;
-}
-
-/*global ot */
-
-ot.CodeMirrorAdapter = (function (global) {
-  'use strict';
-
-  var TextOperation = ot.TextOperation;
-  var Selection = ot.Selection;
-
-  function CodeMirrorAdapter (cm) {
-    this.cm = cm;
-    this.ignoreNextChange = false;
-    this.changeInProgress = false;
-    this.selectionChanged = false;
-
-    bind(this, 'onChanges');
-    bind(this, 'onChange');
-    bind(this, 'onCursorActivity');
-    bind(this, 'onFocus');
-    bind(this, 'onBlur');
-
-    cm.on('changes', this.onChanges);
-    cm.on('change', this.onChange);
-    cm.on('cursorActivity', this.onCursorActivity);
-    cm.on('focus', this.onFocus);
-    cm.on('blur', this.onBlur);
-  }
-
-  // Removes all event listeners from the CodeMirror instance.
-  CodeMirrorAdapter.prototype.detach = function () {
-    this.cm.off('changes', this.onChanges);
-    this.cm.off('change', this.onChange);
-    this.cm.off('cursorActivity', this.onCursorActivity);
-    this.cm.off('focus', this.onFocus);
-    this.cm.off('blur', this.onBlur);
-  };
-
-  function cmpPos (a, b) {
-    if (a.line < b.line) { return -1; }
-    if (a.line > b.line) { return 1; }
-    if (a.ch < b.ch)     { return -1; }
-    if (a.ch > b.ch)     { return 1; }
-    return 0;
-  }
-  function posEq (a, b) { return cmpPos(a, b) === 0; }
-  function posLe (a, b) { return cmpPos(a, b) <= 0; }
-
-  function minPos (a, b) { return posLe(a, b) ? a : b; }
-  function maxPos (a, b) { return posLe(a, b) ? b : a; }
-
-  function codemirrorDocLength (doc) {
-    return doc.indexFromPos({ line: doc.lastLine(), ch: 0 }) +
-      doc.getLine(doc.lastLine()).length;
-  }
-
-  // Converts a CodeMirror change array (as obtained from the 'changes' event
-  // in CodeMirror v4) or single change or linked list of changes (as returned
-  // by the 'change' event in CodeMirror prior to version 4) into a
-  // TextOperation and its inverse and returns them as a two-element array.
-  CodeMirrorAdapter.operationFromCodeMirrorChanges = function (changes, doc) {
-    // Approach: Replay the changes, beginning with the most recent one, and
-    // construct the operation and its inverse. We have to convert the position
-    // in the pre-change coordinate system to an index. We have a method to
-    // convert a position in the coordinate system after all changes to an index,
-    // namely CodeMirror's `indexFromPos` method. We can use the information of
-    // a single change object to convert a post-change coordinate system to a
-    // pre-change coordinate system. We can now proceed inductively to get a
-    // pre-change coordinate system for all changes in the linked list.
-    // A disadvantage of this approach is its complexity `O(n^2)` in the length
-    // of the linked list of changes.
-
-    var docEndLength = codemirrorDocLength(doc);
-    var operation    = new TextOperation().retain(docEndLength);
-    var inverse      = new TextOperation().retain(docEndLength);
-
-    var indexFromPos = function (pos) {
-      return doc.indexFromPos(pos);
-    };
-
-    function last (arr) { return arr[arr.length - 1]; }
-
-    function sumLengths (strArr) {
-      if (strArr.length === 0) { return 0; }
-      var sum = 0;
-      for (var i = 0; i < strArr.length; i++) { sum += strArr[i].length; }
-      return sum + strArr.length - 1;
-    }
-
-    function updateIndexFromPos (indexFromPos, change) {
-      return function (pos) {
-        if (posLe(pos, change.from)) { return indexFromPos(pos); }
-        if (posLe(change.to, pos)) {
-          return indexFromPos({
-            line: pos.line + change.text.length - 1 - (change.to.line - change.from.line),
-            ch: (change.to.line < pos.line) ?
-              pos.ch :
-              (change.text.length <= 1) ?
-                pos.ch - (change.to.ch - change.from.ch) + sumLengths(change.text) :
-                pos.ch - change.to.ch + last(change.text).length
-          }) + sumLengths(change.removed) - sumLengths(change.text);
-        }
-        if (change.from.line === pos.line) {
-          return indexFromPos(change.from) + pos.ch - change.from.ch;
-        }
-        return indexFromPos(change.from) +
-          sumLengths(change.removed.slice(0, pos.line - change.from.line)) +
-          1 + pos.ch;
-      };
-    }
-
-    for (var i = changes.length - 1; i >= 0; i--) {
-      var change = changes[i];
-      indexFromPos = updateIndexFromPos(indexFromPos, change);
-
-      var fromIndex = indexFromPos(change.from);
-      var restLength = docEndLength - fromIndex - sumLengths(change.text);
-
-      operation = new TextOperation()
-        .retain(fromIndex)
-        ['delete'](sumLengths(change.removed))
-        .insert(change.text.join('\n'))
-        .retain(restLength)
-        .compose(operation);
-
-      inverse = inverse.compose(new TextOperation()
-        .retain(fromIndex)
-        ['delete'](sumLengths(change.text))
-        .insert(change.removed.join('\n'))
-        .retain(restLength)
-      );
-
-      docEndLength += sumLengths(change.removed) - sumLengths(change.text);
-    }
-
-    return [operation, inverse];
-  };
-
-  // Singular form for backwards compatibility.
-  CodeMirrorAdapter.operationFromCodeMirrorChange =
-    CodeMirrorAdapter.operationFromCodeMirrorChanges;
-
-  // Apply an operation to a CodeMirror instance.
-  CodeMirrorAdapter.applyOperationToCodeMirror = function (operation, cm) {
-    cm.operation(function () {
-      var ops = operation.ops;
-      var index = 0; // holds the current index into CodeMirror's content
-      for (var i = 0, l = ops.length; i < l; i++) {
-        var op = ops[i];
-        if (TextOperation.isRetain(op)) {
-          index += op;
-        } else if (TextOperation.isInsert(op)) {
-          cm.replaceRange(op, cm.posFromIndex(index));
-          index += op.length;
-        } else if (TextOperation.isDelete(op)) {
-          var from = cm.posFromIndex(index);
-          var to   = cm.posFromIndex(index - op);
-          cm.replaceRange('', from, to);
-        }
-      }
-    });
-  };
-
-  CodeMirrorAdapter.prototype.registerCallbacks = function (cb) {
-    this.callbacks = cb;
-  };
-
-  CodeMirrorAdapter.prototype.onChange = function () {
-    // By default, CodeMirror's event order is the following:
-    // 1. 'change', 2. 'cursorActivity', 3. 'changes'.
-    // We want to fire the 'selectionChange' event after the 'change' event,
-    // but need the information from the 'changes' event. Therefore, we detect
-    // when a change is in progress by listening to the change event, setting
-    // a flag that makes this adapter defer all 'cursorActivity' events.
-    this.changeInProgress = true;
-  };
-
-  CodeMirrorAdapter.prototype.onChanges = function (_, changes) {
-    if (!this.ignoreNextChange) {
-      var pair = CodeMirrorAdapter.operationFromCodeMirrorChanges(changes, this.cm);
-      this.trigger('change', pair[0], pair[1]);
-    }
-    if (this.selectionChanged) { this.trigger('selectionChange'); }
-    this.changeInProgress = false;
-    this.ignoreNextChange = false;
-  };
-
-  CodeMirrorAdapter.prototype.onCursorActivity =
-  CodeMirrorAdapter.prototype.onFocus = function () {
-    if (this.changeInProgress) {
-      this.selectionChanged = true;
-    } else {
-      this.trigger('selectionChange');
-    }
-  };
-
-  CodeMirrorAdapter.prototype.onBlur = function () {
-    if (!this.cm.somethingSelected()) { this.trigger('blur'); }
-  };
-
-  CodeMirrorAdapter.prototype.getValue = function () {
-    return this.cm.getValue();
-  };
-
-  CodeMirrorAdapter.prototype.getSelection = function () {
-    var cm = this.cm;
-
-    var selectionList = cm.listSelections();
-    var ranges = [];
-    for (var i = 0; i < selectionList.length; i++) {
-      ranges[i] = new Selection.Range(
-        cm.indexFromPos(selectionList[i].anchor),
-        cm.indexFromPos(selectionList[i].head)
-      );
-    }
-
-    return new Selection(ranges);
-  };
-
-  CodeMirrorAdapter.prototype.setSelection = function (selection) {
-    var ranges = [];
-    for (var i = 0; i < selection.ranges.length; i++) {
-      var range = selection.ranges[i];
-      ranges[i] = {
-        anchor: this.cm.posFromIndex(range.anchor),
-        head:   this.cm.posFromIndex(range.head)
-      };
-    }
-    this.cm.setSelections(ranges);
-  };
-
-  var addStyleRule = (function () {
-    var added = {};
-    var styleElement = document.createElement('style');
-    document.documentElement.getElementsByTagName('head')[0].appendChild(styleElement);
-    var styleSheet = styleElement.sheet;
-
-    return function (css) {
-      if (added[css]) { return; }
-      added[css] = true;
-      styleSheet.insertRule(css, (styleSheet.cssRules || styleSheet.rules).length);
-    };
-  }());
-
-  CodeMirrorAdapter.prototype.setOtherCursor = function (position, color, clientId) {
-    var cursorPos = this.cm.posFromIndex(position);
-    var cursorCoords = this.cm.cursorCoords(cursorPos);
-    var cursorEl = document.createElement('span');
-    cursorEl.className = 'other-client';
-    cursorEl.style.display = 'inline-block';
-    cursorEl.style.padding = '0';
-    cursorEl.style.marginLeft = cursorEl.style.marginRight = '-1px';
-    cursorEl.style.borderLeftWidth = '2px';
-    cursorEl.style.borderLeftStyle = 'solid';
-    cursorEl.style.borderLeftColor = color;
-    cursorEl.style.height = (cursorCoords.bottom - cursorCoords.top) * 0.9 + 'px';
-    cursorEl.style.zIndex = 0;
-    cursorEl.setAttribute('data-clientid', clientId);
-    return this.cm.setBookmark(cursorPos, { widget: cursorEl, insertLeft: true });
-  };
-
-  CodeMirrorAdapter.prototype.setOtherSelectionRange = function (range, color, clientId) {
-    var match = /^#([0-9a-fA-F]{6})$/.exec(color);
-    if (!match) { throw new Error("only six-digit hex colors are allowed."); }
-    var selectionClassName = 'selection-' + match[1];
-    var rule = '.' + selectionClassName + ' { background: ' + color + '; }';
-    addStyleRule(rule);
-
-    var anchorPos = this.cm.posFromIndex(range.anchor);
-    var headPos   = this.cm.posFromIndex(range.head);
-
-    return this.cm.markText(
-      minPos(anchorPos, headPos),
-      maxPos(anchorPos, headPos),
-      { className: selectionClassName }
-    );
-  };
-
-  CodeMirrorAdapter.prototype.setOtherSelection = function (selection, color, clientId) {
-    var selectionObjects = [];
-    for (var i = 0; i < selection.ranges.length; i++) {
-      var range = selection.ranges[i];
-      if (range.isEmpty()) {
-        selectionObjects[i] = this.setOtherCursor(range.head, color, clientId);
-      } else {
-        selectionObjects[i] = this.setOtherSelectionRange(range, color, clientId);
-      }
-    }
-    return {
-      clear: function () {
-        for (var i = 0; i < selectionObjects.length; i++) {
-          selectionObjects[i].clear();
-        }
-      }
-    };
-  };
-
-  CodeMirrorAdapter.prototype.trigger = function (event) {
-    var args = Array.prototype.slice.call(arguments, 1);
-    var action = this.callbacks && this.callbacks[event];
-    if (action) { action.apply(this, args); }
-  };
-
-  CodeMirrorAdapter.prototype.applyOperation = function (operation) {
-    this.ignoreNextChange = true;
-    CodeMirrorAdapter.applyOperationToCodeMirror(operation, this.cm);
-  };
-
-  CodeMirrorAdapter.prototype.registerUndo = function (undoFn) {
-    this.cm.undo = undoFn;
-  };
-
-  CodeMirrorAdapter.prototype.registerRedo = function (redoFn) {
-    this.cm.redo = redoFn;
-  };
-
-  // Throws an error if the first argument is falsy. Useful for debugging.
-  function assert (b, msg) {
-    if (!b) {
-      throw new Error(msg || "assertion error");
-    }
-  }
-
-  // Bind a method to an object, so it doesn't matter whether you call
-  // object.method() directly or pass object.method as a reference to another
-  // function.
-  function bind (obj, method) {
-    var fn = obj[method];
-    obj[method] = function () {
-      fn.apply(obj, arguments);
-    };
-  }
-
-  return CodeMirrorAdapter;
-
-}(this));
-
-/*global ot */
-
-ot.SocketIOAdapter = (function () {
-  'use strict';
-
-  function SocketIOAdapter (socket) {
-    this.socket = socket;
-
-    var self = this;
-    socket
-      .on('client_left', function (clientId) {
-        self.trigger('client_left', clientId);
-      })
-      .on('set_name', function (clientId, name) {
-        self.trigger('set_name', clientId, name);
-      })
-      .on('ack', function () { self.trigger('ack'); })
-      .on('operation', function (clientId, operation, selection) {
-        self.trigger('operation', operation);
-        self.trigger('selection', clientId, selection);
-      })
-      .on('selection', function (clientId, selection) {
-        self.trigger('selection', clientId, selection);
-      })
-      .on('reconnect', function () {
-        self.trigger('reconnect');
-      });
-  }
-
-  SocketIOAdapter.prototype.sendOperation = function (revision, operation, selection) {
-    this.socket.emit('operation', revision, operation, selection);
-  };
-
-  SocketIOAdapter.prototype.sendSelection = function (selection) {
-    this.socket.emit('selection', selection);
-  };
-
-  SocketIOAdapter.prototype.registerCallbacks = function (cb) {
-    this.callbacks = cb;
-  };
-
-  SocketIOAdapter.prototype.trigger = function (event) {
-    var args = Array.prototype.slice.call(arguments, 1);
-    var action = this.callbacks && this.callbacks[event];
-    if (action) { action.apply(this, args); }
-  };
-
-  return SocketIOAdapter;
-
-}());
-/*global ot, $ */
-
-ot.AjaxAdapter = (function () {
-  'use strict';
-
-  function AjaxAdapter (path, ownUserName, revision) {
-    if (path[path.length - 1] !== '/') { path += '/'; }
-    this.path = path;
-    this.ownUserName = ownUserName;
-    this.majorRevision = revision.major || 0;
-    this.minorRevision = revision.minor || 0;
-    this.poll();
-  }
-
-  AjaxAdapter.prototype.renderRevisionPath = function () {
-    return 'revision/' + this.majorRevision + '-' + this.minorRevision;
-  };
-
-  AjaxAdapter.prototype.handleResponse = function (data) {
-    var i;
-    var operations = data.operations;
-    for (i = 0; i < operations.length; i++) {
-      if (operations[i].user === this.ownUserName) {
-        this.trigger('ack');
-      } else {
-        this.trigger('operation', operations[i].operation);
-      }
-    }
-    if (operations.length > 0) {
-      this.majorRevision += operations.length;
-      this.minorRevision = 0;
-    }
-
-    var events = data.events;
-    if (events) {
-      for (i = 0; i < events.length; i++) {
-        var user = events[i].user;
-        if (user === this.ownUserName) { continue; }
-        switch (events[i].event) {
-          case 'joined':    this.trigger('set_name', user, user); break;
-          case 'left':      this.trigger('client_left', user); break;
-          case 'selection': this.trigger('selection', user, events[i].selection); break;
-        }
-      }
-      this.minorRevision += events.length;
-    }
-
-    var users = data.users;
-    if (users) {
-      delete users[this.ownUserName];
-      this.trigger('clients', users);
-    }
-
-    if (data.revision) {
-      this.majorRevision = data.revision.major;
-      this.minorRevision = data.revision.minor;
-    }
-  };
-
-  AjaxAdapter.prototype.poll = function () {
-    var self = this;
-    $.ajax({
-      url: this.path + this.renderRevisionPath(),
-      type: 'GET',
-      dataType: 'json',
-      timeout: 5000,
-      success: function (data) {
-        self.handleResponse(data);
-        self.poll();
-      },
-      error: function () {
-        setTimeout(function () { self.poll(); }, 500);
-      }
-    });
-  };
-
-  AjaxAdapter.prototype.sendOperation = function (revision, operation, selection) {
-    if (revision !== this.majorRevision) { throw new Error("Revision numbers out of sync"); }
-    var self = this;
-    $.ajax({
-      url: this.path + this.renderRevisionPath(),
-      type: 'POST',
-      data: JSON.stringify({ operation: operation, selection: selection }),
-      contentType: 'application/json',
-      processData: false,
-      success: function (data) {},
-      error: function () {
-        setTimeout(function () { self.sendOperation(revision, operation, selection); }, 500);
-      }
-    });
-  };
-
-  AjaxAdapter.prototype.sendSelection = function (obj) {
-    $.ajax({
-      url: this.path + this.renderRevisionPath() + '/selection',
-      type: 'POST',
-      data: JSON.stringify(obj),
-      contentType: 'application/json',
-      processData: false,
-      timeout: 1000
-    });
-  };
-
-  AjaxAdapter.prototype.registerCallbacks = function (cb) {
-    this.callbacks = cb;
-  };
-
-  AjaxAdapter.prototype.trigger = function (event) {
-    var args = Array.prototype.slice.call(arguments, 1);
-    var action = this.callbacks && this.callbacks[event];
-    if (action) { action.apply(this, args); }
-  };
-
-  return AjaxAdapter;
-
-})();
-/*global ot */
-
-ot.EditorClient = (function () {
-  'use strict';
-
-  var Client = ot.Client;
-  var Selection = ot.Selection;
-  var UndoManager = ot.UndoManager;
-  var TextOperation = ot.TextOperation;
-  var WrappedOperation = ot.WrappedOperation;
-
-
-  function SelfMeta (selectionBefore, selectionAfter) {
-    this.selectionBefore = selectionBefore;
-    this.selectionAfter  = selectionAfter;
-  }
-
-  SelfMeta.prototype.invert = function () {
-    return new SelfMeta(this.selectionAfter, this.selectionBefore);
-  };
-
-  SelfMeta.prototype.compose = function (other) {
-    return new SelfMeta(this.selectionBefore, other.selectionAfter);
-  };
-
-  SelfMeta.prototype.transform = function (operation) {
-    return new SelfMeta(
-      this.selectionBefore.transform(operation),
-      this.selectionAfter.transform(operation)
-    );
-  };
-
-
-  function OtherMeta (clientId, selection) {
-    this.clientId  = clientId;
-    this.selection = selection;
-  }
-
-  OtherMeta.fromJSON = function (obj) {
-    return new OtherMeta(
-      obj.clientId,
-      obj.selection && Selection.fromJSON(obj.selection)
-    );
-  };
-
-  OtherMeta.prototype.transform = function (operation) {
-    return new OtherMeta(
-      this.clientId,
-      this.selection && this.selection.transform(operation)
-    );
-  };
-
-
-  function OtherClient (id, listEl, editorAdapter, name, selection) {
-    this.id = id;
-    this.listEl = listEl;
-    this.editorAdapter = editorAdapter;
-    this.name = name;
-
-    this.li = document.createElement('li');
-    if (name) {
-      this.li.textContent = name;
-      this.listEl.appendChild(this.li);
-    }
-
-    this.setColor(name ? hueFromName(name) : Math.random());
-    if (selection) { this.updateSelection(selection); }
-  }
-
-  OtherClient.prototype.setColor = function (hue) {
-    this.hue = hue;
-    this.color = hsl2hex(hue, 0.75, 0.5);
-    this.lightColor = hsl2hex(hue, 0.5, 0.9);
-    if (this.li) { this.li.style.color = this.color; }
-  };
-
-  OtherClient.prototype.setName = function (name) {
-    if (this.name === name) { return; }
-    this.name = name;
-
-    this.li.textContent = name;
-    if (!this.li.parentNode) {
-      this.listEl.appendChild(this.li);
-    }
-
-    this.setColor(hueFromName(name));
-  };
-
-  OtherClient.prototype.updateSelection = function (selection) {
-    this.removeSelection();
-    this.selection = selection;
-    this.mark = this.editorAdapter.setOtherSelection(
-      selection,
-      selection.position === selection.selectionEnd ? this.color : this.lightColor,
-      this.id
-    );
-  };
-
-  OtherClient.prototype.remove = function () {
-    if (this.li) { removeElement(this.li); }
-    this.removeSelection();
-  };
-
-  OtherClient.prototype.removeSelection = function () {
-    if (this.mark) {
-      this.mark.clear();
-      this.mark = null;
-    }
-  };
-
-
-  function EditorClient (revision, clients, serverAdapter, editorAdapter) {
-    Client.call(this, revision);
-    this.serverAdapter = serverAdapter;
-    this.editorAdapter = editorAdapter;
-    this.undoManager = new UndoManager();
-
-    this.initializeClientList();
-    this.initializeClients(clients);
-
-    var self = this;
-
-    this.editorAdapter.registerCallbacks({
-      change: function (operation, inverse) { self.onChange(operation, inverse); },
-      selectionChange: function () { self.onSelectionChange(); },
-      blur: function () { self.onBlur(); }
-    });
-    this.editorAdapter.registerUndo(function () { self.undo(); });
-    this.editorAdapter.registerRedo(function () { self.redo(); });
-
-    this.serverAdapter.registerCallbacks({
-      client_left: function (clientId) { self.onClientLeft(clientId); },
-      set_name: function (clientId, name) { self.getClientObject(clientId).setName(name); },
-      ack: function () { self.serverAck(); },
-      operation: function (operation) {
-        self.applyServer(TextOperation.fromJSON(operation));
-      },
-      selection: function (clientId, selection) {
-        if (selection) {
-          self.getClientObject(clientId).updateSelection(
-            self.transformSelection(Selection.fromJSON(selection))
-          );
-        } else {
-          self.getClientObject(clientId).removeSelection();
-        }
-      },
-      clients: function (clients) {
-        var clientId;
-        for (clientId in self.clients) {
-          if (self.clients.hasOwnProperty(clientId) && !clients.hasOwnProperty(clientId)) {
-            self.onClientLeft(clientId);
-          }
-        }
-
-        for (clientId in clients) {
-          if (clients.hasOwnProperty(clientId)) {
-            var clientObject = self.getClientObject(clientId);
-
-            if (clients[clientId].name) {
-              clientObject.setName(clients[clientId].name);
-            }
-
-            var selection = clients[clientId].selection;
-            if (selection) {
-              self.clients[clientId].updateSelection(
-                self.transformSelection(Selection.fromJSON(selection))
-              );
-            } else {
-              self.clients[clientId].removeSelection();
-            }
-          }
-        }
-      },
-      reconnect: function () { self.serverReconnect(); }
-    });
-  }
-
-  inherit(EditorClient, Client);
-
-  EditorClient.prototype.addClient = function (clientId, clientObj) {
-    this.clients[clientId] = new OtherClient(
-      clientId,
-      this.clientListEl,
-      this.editorAdapter,
-      clientObj.name || clientId,
-      clientObj.selection ? Selection.fromJSON(clientObj.selection) : null
-    );
-  };
-
-  EditorClient.prototype.initializeClients = function (clients) {
-    this.clients = {};
-    for (var clientId in clients) {
-      if (clients.hasOwnProperty(clientId)) {
-        this.addClient(clientId, clients[clientId]);
-      }
-    }
-  };
-
-  EditorClient.prototype.getClientObject = function (clientId) {
-    var client = this.clients[clientId];
-    if (client) { return client; }
-    return this.clients[clientId] = new OtherClient(
-      clientId,
-      this.clientListEl,
-      this.editorAdapter
-    );
-  };
-
-  EditorClient.prototype.onClientLeft = function (clientId) {
-    console.log("User disconnected: " + clientId);
-    var client = this.clients[clientId];
-    if (!client) { return; }
-    client.remove();
-    delete this.clients[clientId];
-  };
-
-  EditorClient.prototype.initializeClientList = function () {
-    this.clientListEl = document.createElement('ul');
-  };
-
-  EditorClient.prototype.applyUnredo = function (operation) {
-    this.undoManager.add(operation.invert(this.editorAdapter.getValue()));
-    this.editorAdapter.applyOperation(operation.wrapped);
-    this.selection = operation.meta.selectionAfter;
-    this.editorAdapter.setSelection(this.selection);
-    this.applyClient(operation.wrapped);
-  };
-
-  EditorClient.prototype.undo = function () {
-    var self = this;
-    if (!this.undoManager.canUndo()) { return; }
-    this.undoManager.performUndo(function (o) { self.applyUnredo(o); });
-  };
-
-  EditorClient.prototype.redo = function () {
-    var self = this;
-    if (!this.undoManager.canRedo()) { return; }
-    this.undoManager.performRedo(function (o) { self.applyUnredo(o); });
-  };
-
-  EditorClient.prototype.onChange = function (textOperation, inverse) {
-    var selectionBefore = this.selection;
-    this.updateSelection();
-    var meta = new SelfMeta(selectionBefore, this.selection);
-    var operation = new WrappedOperation(textOperation, meta);
-
-    var compose = this.undoManager.undoStack.length > 0 &&
-      inverse.shouldBeComposedWithInverted(last(this.undoManager.undoStack).wrapped);
-    var inverseMeta = new SelfMeta(this.selection, selectionBefore);
-    this.undoManager.add(new WrappedOperation(inverse, inverseMeta), compose);
-    this.applyClient(textOperation);
-  };
-
-  EditorClient.prototype.updateSelection = function () {
-    this.selection = this.editorAdapter.getSelection();
-  };
-
-  EditorClient.prototype.onSelectionChange = function () {
-    var oldSelection = this.selection;
-    this.updateSelection();
-    if (oldSelection && this.selection.equals(oldSelection)) { return; }
-    this.sendSelection(this.selection);
-  };
-
-  EditorClient.prototype.onBlur = function () {
-    this.selection = null;
-    this.sendSelection(null);
-  };
-
-  EditorClient.prototype.sendSelection = function (selection) {
-    if (this.state instanceof Client.AwaitingWithBuffer) { return; }
-    this.serverAdapter.sendSelection(selection);
-  };
-
-  EditorClient.prototype.sendOperation = function (revision, operation) {
-    this.serverAdapter.sendOperation(revision, operation.toJSON(), this.selection);
-  };
-
-  EditorClient.prototype.applyOperation = function (operation) {
-    this.editorAdapter.applyOperation(operation);
-    this.updateSelection();
-    this.undoManager.transform(new WrappedOperation(operation, null));
-  };
-
-  function rgb2hex (r, g, b) {
-    function digits (n) {
-      var m = Math.round(255*n).toString(16);
-      return m.length === 1 ? '0'+m : m;
-    }
-    return '#' + digits(r) + digits(g) + digits(b);
-  }
-
-  function hsl2hex (h, s, l) {
-    if (s === 0) { return rgb2hex(l, l, l); }
-    var var2 = l < 0.5 ? l * (1+s) : (l+s) - (s*l);
-    var var1 = 2 * l - var2;
-    var hue2rgb = function (hue) {
-      if (hue < 0) { hue += 1; }
-      if (hue > 1) { hue -= 1; }
-      if (6*hue < 1) { return var1 + (var2-var1)*6*hue; }
-      if (2*hue < 1) { return var2; }
-      if (3*hue < 2) { return var1 + (var2-var1)*6*(2/3 - hue); }
-      return var1;
-    };
-    return rgb2hex(hue2rgb(h+1/3), hue2rgb(h), hue2rgb(h-1/3));
-  }
-
-  function hueFromName (name) {
-    var a = 1;
-    for (var i = 0; i < name.length; i++) {
-      a = 17 * (a+name.charCodeAt(i)) % 360;
-    }
-    return a/360;
-  }
-
-  // Set Const.prototype.__proto__ to Super.prototype
-  function inherit (Const, Super) {
-    function F () {}
-    F.prototype = Super.prototype;
-    Const.prototype = new F();
-    Const.prototype.constructor = Const;
-  }
-
-  function last (arr) { return arr[arr.length - 1]; }
-
-  // Remove an element from the DOM.
-  function removeElement (el) {
-    if (el.parentNode) {
-      el.parentNode.removeChild(el);
-    }
-  }
-
-  return EditorClient;
-}());
diff --git a/web/js/ot-min.js b/web/js/ot-min.js
index 1ed049ed9..8f24449f1 120000
--- a/web/js/ot-min.js
+++ b/web/js/ot-min.js
@@ -1 +1 @@
-../../third_party/ot.js/ot-min.js
\ No newline at end of file
+../../build/ot.js/dist/ot-min.js
\ No newline at end of file

From 03fd99f3fe193cf4f7dafda08116da014ed8fe36 Mon Sep 17 00:00:00 2001
From: parv 
Date: Tue, 12 Sep 2017 23:06:00 +0530
Subject: [PATCH 27/28] add a separate server for operational transformation

---
 build.sh                                      |   2 +-
 .../LICENSE                                   |   0
 .../Setup.hs                                  |   0
 .../codeworld-collab-server.cabal             |  15 +-
 .../src/Bot.hs                                |   0
 .../src/CodeWorld/CollabModel.hs              |  59 +++++
 .../src/CodeWorld/CollabServer.hs             | 209 ++++++++++++++++++
 .../src/CodeWorld/GameServer.hs               |   0
 codeworld-collab-server/src/Main.hs           |  59 +++++
 .../src/Stresstest.hs                         |   0
 codeworld-game-server/src/Main.hs             |  37 ----
 codeworld-server/codeworld-server.cabal       |  29 ++-
 codeworld-server/src/Collaboration.hs         | 155 +------------
 codeworld-server/src/CollaborationUtil.hs     |  38 +---
 codeworld-server/src/Main.hs                  |  22 +-
 run.sh                                        |   2 +-
 web/js/codeworld_collaborate.js               |   2 +-
 17 files changed, 376 insertions(+), 253 deletions(-)
 rename {codeworld-game-server => codeworld-collab-server}/LICENSE (100%)
 rename {codeworld-game-server => codeworld-collab-server}/Setup.hs (100%)
 rename codeworld-game-server/codeworld-game-server.cabal => codeworld-collab-server/codeworld-collab-server.cabal (82%)
 rename {codeworld-game-server => codeworld-collab-server}/src/Bot.hs (100%)
 create mode 100644 codeworld-collab-server/src/CodeWorld/CollabModel.hs
 create mode 100644 codeworld-collab-server/src/CodeWorld/CollabServer.hs
 rename {codeworld-game-server => codeworld-collab-server}/src/CodeWorld/GameServer.hs (100%)
 create mode 100644 codeworld-collab-server/src/Main.hs
 rename {codeworld-game-server => codeworld-collab-server}/src/Stresstest.hs (100%)
 delete mode 100644 codeworld-game-server/src/Main.hs

diff --git a/build.sh b/build.sh
index b7887056a..d4289f068 100755
--- a/build.sh
+++ b/build.sh
@@ -50,7 +50,7 @@ run .  cabal_install ./funblocks-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 82%
rename from codeworld-game-server/codeworld-game-server.cabal
rename to codeworld-collab-server/codeworld-collab-server.cabal
index 6f2d29d6f..d1afe09a6 100644
--- a/codeworld-game-server/codeworld-game-server.cabal
+++ b/codeworld-collab-server/codeworld-collab-server.cabal
@@ -10,22 +10,33 @@ 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-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..c44074ce2
--- /dev/null
+++ b/codeworld-collab-server/src/Main.hs
@@ -0,0 +1,59 @@
+{-# 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           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 $
+        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-game-server/src/Main.hs b/codeworld-game-server/src/Main.hs
deleted file mode 100644
index 64bef0bea..000000000
--- a/codeworld-game-server/src/Main.hs
+++ /dev/null
@@ -1,37 +0,0 @@
-{-# 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 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) ]
-
-
diff --git a/codeworld-server/codeworld-server.cabal b/codeworld-server/codeworld-server.cabal
index 46d654695..08bbf1668 100644
--- a/codeworld-server/codeworld-server.cabal
+++ b/codeworld-server/codeworld-server.cabal
@@ -24,24 +24,18 @@ Executable codeworld-server
     cryptonite,
     data-default,
     directory,
-    engine-io,
-    engine-io-snap,
     filepath,
     filesystem-trees,
     funblocks-server,
-    hashable,
     hindent >= 5 && < 5.2.3,
     http-conduit,
     memory,
     mtl,
-    ot,
     process,
     regex-compat,
     regex-tdfa,
     snap-core,
     snap-server,
-    socket-io,
-    stm,
     temporary,
     text,
     time,
@@ -51,3 +45,26 @@ Executable codeworld-server
 
   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
index 5c18e6b66..04933acbe 100644
--- a/codeworld-server/src/Collaboration.hs
+++ b/codeworld-server/src/Collaboration.hs
@@ -1,9 +1,4 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 {-
@@ -25,30 +20,14 @@
 module Collaboration (
     -- routes for simultaneous editing and adding user for collaboration into the project
     collabRoutes,
-
-    -- initial collaborative server
-    initCollabServer,
-
-    -- handler to handle socket connections and requests over sockets
-    collabServer
     ) where
 
-import qualified Control.Concurrent.STM as STM
-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 qualified Network.SocketIO as SIO
 import           Snap.Core
 import           System.FilePath
 
@@ -57,12 +36,11 @@ import DataUtil
 import Model
 import SnapUtil
 
-collabRoutes :: Snap () -> ClientId -> [(B.ByteString, Snap ())]
-collabRoutes socketIOHandler clientId =
+collabRoutes :: ClientId -> [(B.ByteString, Snap ())]
+collabRoutes clientId =
     [ ("addToCollaborate",  addToCollaborateHandler clientId)
     , ("collabShare",       collabShareHandler clientId)
     , ("listCurrentOwners", listCurrentOwnersHandler clientId)
-    , ("socket.io", socketIOHandler)
     ]
 
 data ParamsGetType = GetFromHash | NotInCommentables deriving (Eq)
@@ -125,132 +103,3 @@ listCurrentOwnersHandler clientId = do
     let currentOwners = map (T.unpack . uuserIdent) $ filter (\u -> utype u == "owner") currentUsers
     modifyResponse $ setContentType "application/json"
     writeLBS . encode $ currentOwners
-
--- Simultaneous Coding Handlers
-
-initCollabServer :: IO CollabServerState
-initCollabServer = do
-    started <- getCurrentTime
-    collabProjects <- STM.newTVarIO HM.empty
-    return CollabServerState{..}
-
-initCollaborationHandler :: CollabServerState -> ClientId -> Snap (Text, Text, CollabId)
-initCollaborationHandler state clientId = do
-    (user, _, filePath) <- getFrequentParams NotInCommentables 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' project $ CollabId . T.pack $ collabHash
-    return ((userId user), userIdent', CollabId . T.pack $ collabHash)
-
-addNewCollaborator :: CollabServerState -> Text -> Text -> Project -> CollabId -> IO ()
-addNewCollaborator state userId' userIdent' project 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 project)
-                                , 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'
-                                                        })
-
-getCollabProject :: CollabServerState -> CollabId -> STM.STM (STM.TVar CollabProject)
-getCollabProject state collabHash = do
-    hm <- STM.readTVar $ collabProjects state
-    return $ fromJust . HM.lookup collabHash $ hm
-
-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-server/src/CollaborationUtil.hs b/codeworld-server/src/CollaborationUtil.hs
index 0e99188b6..e49d6df4d 100644
--- a/codeworld-server/src/CollaborationUtil.hs
+++ b/codeworld-server/src/CollaborationUtil.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-
@@ -20,22 +18,14 @@
 
 module CollaborationUtil where
 
-import qualified Control.Concurrent.STM as STM
 import           Control.Monad
-import           Control.OperationalTransformation.Selection (Selection)
-import           Control.OperationalTransformation.Server (ServerState)
-import           Control.OperationalTransformation.Text (TextOperation)
 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.Hashable (Hashable)
-import qualified Data.HashMap.Strict as HM
 import           Data.Text (Text)
 import qualified Data.Text as T
-import           Data.Time.Clock
-import           GHC.Generics (Generic)
 import           System.Directory
 import           System.FilePath
 
@@ -43,33 +33,7 @@ import CommentUtil
 import DataUtil
 import Model
 
-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
+newtype CollabId = CollabId { unCollabId :: Text } deriving (Eq)
 
 collabHashRootDir :: BuildMode -> FilePath
 collabHashRootDir (BuildMode m) = "data"  m  "projectContents"
diff --git a/codeworld-server/src/Main.hs b/codeworld-server/src/Main.hs
index 1ab4a7a99..61f64fb1d 100644
--- a/codeworld-server/src/Main.hs
+++ b/codeworld-server/src/Main.hs
@@ -32,16 +32,14 @@ import qualified Data.Text as T
 import qualified Data.Text.IO as T
 import           HIndent (reformat)
 import           HIndent.Types (defaultConfig)
-import qualified Network.SocketIO as SIO
-import           Network.EngineIO.Snap (snapAPI)
 import           Snap.Core
-import qualified Snap.Http.Server as Snap
+import           Snap.Http.Server (quickHttpServe)
 import           Snap.Util.FileServe
 import           System.Directory
 import           System.FilePath
 
-import Collaboration
-import Comment
+import           Collaboration
+import           Comment
 import           DataUtil
 import           Folder
 import qualified Funblocks as FB
@@ -61,16 +59,10 @@ main = do
             return (ClientId (Just (T.strip txt)))
         False -> return (ClientId Nothing)
 
-    state <- initCollabServer
-    socketIOHandler <- SIO.initialize snapAPI (collabServer state clientId)
-    config <- Snap.commandLineConfig $
-        Snap.setErrorLog  (Snap.ConfigFileLog "log/collab-error.log") $
-        Snap.setAccessLog (Snap.ConfigFileLog "log/collab-access.log") $
-        mempty
-    Snap.httpServe config $ (processBody >> site socketIOHandler clientId) <|> site socketIOHandler clientId
+    quickHttpServe $ (processBody >> site clientId) <|> site clientId
 
-site :: Snap () -> ClientId -> Snap ()
-site socketIOHandler clientId =
+site :: ClientId -> Snap ()
+site clientId =
     route ([
         ("compile",     compileHandler),
         ("loadSource",  loadSourceHandler),
@@ -80,7 +72,7 @@ site socketIOHandler clientId =
         ("haskell",     serveFile "web/env.html"),
         ("indent",      indentHandler)
       ] ++
-        (collabRoutes socketIOHandler clientId) ++
+        (collabRoutes clientId) ++
         (commentRoutes clientId) ++
         (folderRoutes clientId) ++
         (FB.funblockRoutes $ currToFB clientId)) <|>
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/js/codeworld_collaborate.js b/web/js/codeworld_collaborate.js
index f709f7175..9d188cea6 100644
--- a/web/js/codeworld_collaborate.js
+++ b/web/js/codeworld_collaborate.js
@@ -229,7 +229,7 @@ function initializeCollaboration() {
     }
     var id_token = auth2.currentUser.get().getAuthResponse().id_token;
     var url = window.location.hostname +
-              ((window.location.port == '') ? '' : (':' + window.location.port)) +
+              ((window.location.port == '') ? '' : (':' + 9160)) +
               window.location.pathname +
               '?id_token=' + id_token +
               '&mode=' + window.buildMode +

From c504e044f9091bdf7a88fe170bdf62e34d97b421 Mon Sep 17 00:00:00 2001
From: Parv Mor 
Date: Wed, 13 Sep 2017 01:38:24 +0530
Subject: [PATCH 28/28] add cross-origin-resource-sharing in collabServer

---
 codeworld-collab-server/codeworld-collab-server.cabal | 1 +
 codeworld-collab-server/src/Main.hs                   | 3 ++-
 web/js/codeworld_collaborate.js                       | 2 +-
 3 files changed, 4 insertions(+), 2 deletions(-)

diff --git a/codeworld-collab-server/codeworld-collab-server.cabal b/codeworld-collab-server/codeworld-collab-server.cabal
index d1afe09a6..f2edea1d6 100644
--- a/codeworld-collab-server/codeworld-collab-server.cabal
+++ b/codeworld-collab-server/codeworld-collab-server.cabal
@@ -27,6 +27,7 @@ Executable codeworld-collab-server
                        websockets == 0.9.*,
                        websockets-snap == 0.10.*,
                        snap-core == 1.0.*,
+                       snap-cors,
                        snap-server == 1.0.*,
                        socket-io,
                        stm,
diff --git a/codeworld-collab-server/src/Main.hs b/codeworld-collab-server/src/Main.hs
index c44074ce2..d5b9a5499 100644
--- a/codeworld-collab-server/src/Main.hs
+++ b/codeworld-collab-server/src/Main.hs
@@ -23,6 +23,7 @@ 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
 
@@ -52,7 +53,7 @@ main = do
         setErrorLog  (ConfigFileLog "log/collab-error.log") $
         setAccessLog (ConfigFileLog "log/collab-access.log") $
         mempty
-    httpServe config $
+    httpServe config $ CORS.applyCORS CORS.defaultOptions $
         ifTop (gameStats gameServerState) <|>
         route [ ("gameserver", gameServer gameServerState)
               , ("socket.io" , socketIOHandler)
diff --git a/web/js/codeworld_collaborate.js b/web/js/codeworld_collaborate.js
index 9d188cea6..53ce6ec7d 100644
--- a/web/js/codeworld_collaborate.js
+++ b/web/js/codeworld_collaborate.js
@@ -229,7 +229,7 @@ function initializeCollaboration() {
     }
     var id_token = auth2.currentUser.get().getAuthResponse().id_token;
     var url = window.location.hostname +
-              ((window.location.port == '') ? '' : (':' + 9160)) +
+              ((window.location.port == '') ? ':9160' : (':9160')) +
               window.location.pathname +
               '?id_token=' + id_token +
               '&mode=' + window.buildMode +