basic authorization support

[Rakka.git] / Rakka / Storage / Repos.hs

diff --git a/Rakka/Storage/Repos.hs b/Rakka/Storage/Repos.hs
index 0c4e2531eb17e572dbcdd3a50984f97b09e742d3..8430068922a7e1b8e98676e539dc28d8f1f45296 100644 (file)
--- a/Rakka/Storage/Repos.hs
+++ b/Rakka/Storage/Repos.hs
@@ -167,34 +167,55 @@ loadPageInRepository repos name rev
                           }
 
 
-putPageIntoRepository :: Repository -> Page -> IO StatusCode
-putPageIntoRepository repos page
+putPageIntoRepository :: Repository -> Maybe String -> Page -> IO StatusCode
+putPageIntoRepository repos userID page
     = filterSvnError $
-      do let name = pageName page
-         ret <- case pageUpdateInfo page of
-                  Just ui
-                      -> doReposTxn
-                         repos
-                         (uiOldRevision ui)
-                         "[Rakka]"
-                         (Just "Automatic commit by Rakka for page update")
-                         $ do case uiOldName ui of
-                                Nothing      -> return ()
-                                Just oldName -> renamePage (uiOldRevision ui) oldName name
-                              updatePage name
-                  Nothing
-                      -> do fs  <- getRepositoryFS repos
-                            rev <- getYoungestRev fs
-                            doReposTxn repos
-                                       rev
-                                       "[Rakka]"
-                                       (Just "Automatic commit by Rakka for page creation")
-                                       $ do createPage name
-                                            updatePage name
-         case ret of
-           Left  _ -> return Conflict
-           Right _ -> return Created
+      do let name   = pageName page
+             author = fromMaybe "[Rakka]" userID
+         case pageUpdateInfo page of
+           Just ui
+               -> do let oldRev = uiOldRevision ui
+                     denied <- case uiOldName ui of
+                                 Nothing      -> checkDenial oldRev name
+                                 Just oldName -> checkDenial oldRev oldName
+                     if denied then
+                         return Forbidden
+                       else
+                         do ret <- doReposTxn
+                                   repos
+                                   (uiOldRevision ui)
+                                   author
+                                   (Just "Automatic commit by Rakka for page update")
+                                   $ do case uiOldName ui of
+                                          Nothing      -> return ()
+                                          Just oldName -> renamePage (uiOldRevision ui) oldName name
+                                        updatePage name
+                            case ret of
+                              Left  _ -> return Conflict
+                              Right _ -> return Created
+           Nothing
+               -> do fs  <- getRepositoryFS repos
+                     rev <- getYoungestRev fs
+                     ret <- doReposTxn
+                            repos
+                            rev
+                            author
+                            (Just "Automatic commit by Rakka for page creation")
+                            $ do createPage name
+                                 updatePage name
+                     case ret of
+                       Left  _ -> return Conflict
+                       Right _ -> return Created
     where
+      checkDenial :: RevNum -> PageName -> IO Bool
+      checkDenial rev name
+          = do fs <- getRepositoryFS repos
+               withRevision fs rev
+                   $ do prop <- getNodeProp (mkPagePath name) "rakka:isLocked"
+                        case prop of
+                          Just _  -> return (isNothing userID) -- 施錠されてゐるので匿名では駄目
+                          Nothing -> return False
+
       renamePage :: RevNum -> PageName -> PageName -> Txn ()
       renamePage oldRev oldName newName
           = do let oldPath = mkPagePath oldName
@@ -263,23 +284,36 @@ createParentDirectories path
            DirNode  -> return ()
 
 
-deletePageFromRepository :: Repository -> PageName -> IO StatusCode
-deletePageFromRepository repos name
+deletePageFromRepository :: Repository -> Maybe String -> PageName -> IO StatusCode
+deletePageFromRepository repos userID name
     = filterSvnError $
       do let path = mkPagePath name
          fs     <- getRepositoryFS repos
          rev    <- getYoungestRev fs
-         exists <- withRevision fs rev $ isFile path
-         if exists then
-             do doReposTxn repos
-                           rev
-                           "[Rakka]"
-                           (Just "Automatic commit by Rakka for page deleting")
-                           $ do deleteEntry path
-                                deleteEmptyParentDirectories path
-                return NoContent
-           else
-             return NotFound
+         status <- withRevision fs rev
+                   $ do exists <- isFile path
+                        if exists then
+                            do prop <- getNodeProp path "rakka:isLocked"
+                               return $ case prop of
+                                          Just _
+                                              -> if isNothing userID then
+                                                     -- 施錠されてゐるので匿名では駄目
+                                                     Forbidden
+                                                 else
+                                                     NoContent
+                                          Nothing
+                                              -> NoContent
+                          else
+                            return NotFound
+         when (status == NoContent)
+             $ do doReposTxn repos
+                             rev
+                             "[Rakka]"
+                             (Just "Automatic commit by Rakka for page deleting")
+                             $ do deleteEntry path
+                                  deleteEmptyParentDirectories path
+                  return ()
+         return status
 
 
 deleteEmptyParentDirectories :: FilePath -> Txn ()