Bugfix

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

diff --git a/Rakka/Storage/Repos.hs b/Rakka/Storage/Repos.hs
index 76889d7e0ad5fac702041a17b4bb787fe8a491a5..1c5ef08abca28079845c0802dd34170d1551e624 100644 (file)
--- a/Rakka/Storage/Repos.hs
+++ b/Rakka/Storage/Repos.hs
@@ -136,23 +136,24 @@ loadPageInRepository repos name rev
          withRevision fs rev'
              $ do exists <- isFile path
                   if exists then
-                      return . Just =<< loadPage'
+                      return . Just =<< loadPage' fs
                     else
                       return Nothing
     where
       path :: FilePath
       path = mkPagePath name
 
-      loadPage' :: Rev Page
-      loadPage' = do mType <- liftM (fmap (read . chomp)) (getNodeProp path "svn:mime-type")
-                     case mType of
-                       Just (MIMEType "application" "x-rakka-redirection" _)
-                           -> loadPageRedirect
-                       _
-                           -> loadPageEntity
-
-      loadPageEntity :: Rev Page
-      loadPageEntity
+      loadPage' :: FileSystem -> Rev Page
+      loadPage' fs
+          = do mType <- liftM (fmap (read . chomp)) (getNodeProp path "svn:mime-type")
+               case mType of
+                 Just (MIMEType "application" "x-rakka-redirection" _)
+                     -> loadPageRedirect fs
+                 _
+                     -> loadPageEntity fs
+
+      loadPageEntity :: FileSystem -> Rev Page
+      loadPageEntity fs
           = do props   <- getNodePropList path
                hist    <- getNodeHistory True path
                content <- getFileContentsLBS path
@@ -162,7 +163,8 @@ loadPageInRepository repos name rev
                               $ fromMaybe "text/x-rakka"
                               $ fmap chomp (lookup "svn:mime-type" props)
 
-               lastMod <- getRevisionProp "svn:date"
+               lastMod <- unsafeIOToFS $
+                          getRevisionProp' fs pageRev "svn:date"
                           >>= return . fromJust . parseW3CDateTime . chomp . fromJust
 
                return Entity {
@@ -179,27 +181,28 @@ loadPageInRepository repos name rev
                                                      -> True
                           , entityRevision   = pageRev
                           , entityLastMod    = zonedTimeToUTC lastMod
-                          , entitySummary    = lookup "rakka:summary" props
+                          , entitySummary    = fmap decodeString (lookup "rakka:summary" props)
                           , entityOtherLang  = fromMaybe M.empty
                                              $ fmap
-                                                   (M.fromList . fromJust . deserializeStringPairs)
+                                                   (M.fromList . fromJust . deserializeStringPairs . decodeString)
                                                    (lookup "rakka:otherLang" props)
                           , entityContent    = content                                             
                           , entityUpdateInfo = undefined
                           }
       
-      loadPageRedirect :: Rev Page
-      loadPageRedirect
+      loadPageRedirect :: FileSystem -> Rev Page
+      loadPageRedirect fs
           = do hist    <- getNodeHistory True path
                content <- getFileContents path
 
                let pageRev = fst $ head hist
                    dest    = chomp $ decodeString content
 
-               lastMod <- getRevisionProp "svn:date"
+               lastMod <- unsafeIOToFS $
+                          getRevisionProp' fs pageRev "svn:date"
                           >>= return . fromJust . parseW3CDateTime . chomp . fromJust
 
-               isLocked <- getRevisionProp "rakka:isLocked"
+               isLocked <- getNodeProp path "rakka:isLocked"
                            >>= return . isJust
 
                return Redirection {
@@ -226,16 +229,25 @@ putPageIntoRepository repos userID page
                      if denied then
                          return Forbidden
                        else
-                         do ret <- doReposTxn
+                         do rev <- if oldRev == 0 then
+                                       getRepositoryFS repos >>= getYoungestRev
+                                   else
+                                       return oldRev
+                            ret <- doReposTxn
                                    repos
-                                   (uiOldRevision ui)
+                                   rev
                                    author
                                    (Just "Automatic commit by Rakka for page update")
-                                   $ do case uiOldName ui of
+                                   $ do 
+                                        case uiOldName ui of
                                           Nothing      -> return ()
-                                          Just oldName -> movePage (uiOldRevision ui) oldName name
-                                                          >>
-                                                          moveAttachments (uiOldRevision ui) oldName name
+                                          Just oldName -> do exists <- isFile (mkPagePath oldName)
+                                                             when (exists)
+                                                                  $ do movePage (uiOldRevision ui) oldName name
+                                                                       moveAttachments (uiOldRevision ui) oldName name
+                                        exists <- isFile (mkPagePath name)
+                                        unless (exists)
+                                               $ createPage name
                                         updatePage name
                             case ret of
                               Left  _ -> return Conflict
@@ -258,10 +270,14 @@ putPageIntoRepository repos userID page
       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
+                   $ do exists <- isFile (mkPagePath name)
+                        if exists then
+                            do prop <- getNodeProp (mkPagePath name) "rakka:isLocked"
+                               case prop of
+                                 Just _  -> return (isNothing userID) -- 施錠されてゐるので匿名では駄目
+                                 Nothing -> return False
+                          else
+                            return False -- FIXME: 本當は defaultPage の locked 屬性をどうのこうの…
 
       movePage :: RevNum -> PageName -> PageName -> Txn ()
       movePage oldRev oldName newName
@@ -315,13 +331,13 @@ putPageIntoRepository repos userID page
                setNodeProp path "rakka:isFeed"    (encodeFlag $ entityIsFeed page)
                setNodeProp path "rakka:isLocked"  (encodeFlag $ entityIsLocked page)
                setNodeProp path "rakka:isBinary"  (encodeFlag $ entityIsBinary page)
-               setNodeProp path "rakka:summary"   (entitySummary page)
+               setNodeProp path "rakka:summary"   (fmap encodeString $ entitySummary page)
                setNodeProp path "rakka:otherLang" (let otherLang = entityOtherLang page
                                                    in
                                                      if M.null otherLang then
                                                          Nothing
                                                      else
-                                                         Just (serializeStringPairs $ M.toList otherLang))
+                                                         Just (encodeString $ serializeStringPairs $ M.toList otherLang))
                applyTextLBS path Nothing (entityContent page)
 
       encodeFlag :: Bool -> Maybe String
@@ -409,7 +425,7 @@ loadAttachmentInRepository repos pName aName rev
       path = mkAttachmentPath pName aName
 
       loadAttachment' :: Rev a
-      loadAttachment' = getFileContents path >>= return . deserializeFromString
+      loadAttachment' = getFileContents path >>= return . deserializeFromString . decodeString
 
 
 putAttachmentIntoRepository :: Attachment a =>