X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FPage.hs;h=e396c1b32915fa29568e84c2b26a1ae0c2c18a35;hb=88747f2;hp=5d7ef68c455795a36912676ea202643f50f91d0e;hpb=8d621fced0d1b3f66d38b16cd732fd2342622c5d;p=Rakka.git diff --git a/Rakka/Page.hs b/Rakka/Page.hs index 5d7ef68..e396c1b 100644 --- a/Rakka/Page.hs +++ b/Rakka/Page.hs @@ -12,7 +12,6 @@ module Rakka.Page , pageUpdateInfo , pageRevision - , isSafeChar , encodePageName , decodePageName @@ -28,28 +27,21 @@ module Rakka.Page , parseXmlizedPage ) where - -import qualified Codec.Binary.Base64 as B64 -import qualified Codec.Binary.UTF8.String as UTF8 -import Control.Arrow -import Control.Arrow.ArrowIO -import Control.Arrow.ArrowList import qualified Data.ByteString.Lazy as Lazy (ByteString) import qualified Data.ByteString.Lazy as L hiding (ByteString) +import qualified Data.ByteString.Lazy.Char8 as L8 hiding (ByteString) import Data.Char import Data.Map (Map) import qualified Data.Map as M -import Data.Maybe import Data.Time +import qualified Data.Time.W3C as W3C import Network.HTTP.Lucu hiding (redirect) import Network.URI hiding (fragment) +import OpenSSL.EVP.Base64 import Rakka.Utils -import Rakka.W3CDateTime import Subversion.Types import System.FilePath.Posix -import Text.XML.HXT.Arrow.XmlArrow -import Text.XML.HXT.Arrow.XmlNodeSet -import Text.XML.HXT.DOM.TypeDefs +import Text.XML.HXT.XPath type PageName = String @@ -132,15 +124,6 @@ encodePageName = escapeURIString isSafeChar . UTF8.encodeString . fixPageName fixPageName = (\ (x:xs) -> toUpper x : xs) . map (\ c -> if c == ' ' then '_' else c) -isSafeChar :: Char -> Bool -isSafeChar c - | c == '/' = True - | isReserved c = False - | c > ' ' && c <= '~' = True - | otherwise = False - - --- URI unescape して UTF-8 から decode する。 decodePageName :: FilePath -> PageName decodePageName = UTF8.decodeString . unEscapeString @@ -251,7 +234,7 @@ xmlizePage += sattr "redirect" (redirDest page) += sattr "isLocked" (yesOrNo $ redirIsLocked page) += sattr "revision" (show $ redirRevision page) - += sattr "lastModified" (formatW3CDateTime lastMod) + += sattr "lastModified" (W3C.format lastMod) )) -<< () xmlizeEntity :: (ArrowXml a, ArrowChoice a, ArrowIO a) => a Page XmlTree @@ -277,7 +260,7 @@ xmlizePage += sattr "isLocked" (yesOrNo $ entityIsLocked page) += sattr "isBinary" (yesOrNo $ entityIsBinary page) += sattr "revision" (show $ entityRevision page) - += sattr "lastModified" (formatW3CDateTime lastMod) + += sattr "lastModified" (W3C.format lastMod) += ( case entitySummary page of Just s -> eelem "summary" += txt s Nothing -> none @@ -293,7 +276,7 @@ xmlizePage ) += ( if entityIsBinary page then ( eelem "binaryData" - += txt (B64.encode $ L.unpack $ entityContent page) + += txt (L8.unpack $ encodeBase64LBS $ entityContent page) ) else ( eelem "textData" @@ -353,8 +336,8 @@ parseEntity let (isBinary, content) = case (textData, binaryData) of - (Just text, Nothing ) -> (False, L.pack $ UTF8.encode text ) - (Nothing , Just binary) -> (True , L.pack $ fromJust $ B64.decode $ dropWhitespace binary) + (Just text, Nothing ) -> (False, L.pack $ UTF8.encode text) + (Nothing , Just binary) -> (True , L8.pack $ decodeBase64 $ dropWhitespace binary) _ -> error "one of textData or binaryData is required" mimeType = if isBinary then @@ -401,4 +384,4 @@ parseUpdateInfo , uiOldName = oldName } - \ No newline at end of file +