X-Git-Url: https://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FPage.hs;h=a9dbe4ff2967c9b83909b8d831fbfcfeba57fd50;hb=5b25efa958eac431edbcd97194ac51bb05a7c69b;hp=62606b35af111daa344d37d738dfabd4aa273172;hpb=23977989ef4be7316b1c2c3f709ca1e8e6bb7f84;p=Rakka.git diff --git a/Rakka/Page.hs b/Rakka/Page.hs index 62606b3..a9dbe4f 100644 --- a/Rakka/Page.hs +++ b/Rakka/Page.hs @@ -12,6 +12,7 @@ module Rakka.Page , pageUpdateInfo , pageRevision + , isSafeChar , encodePageName , decodePageName @@ -20,6 +21,7 @@ module Rakka.Page , mkObjectURI , mkFragmentURI , mkAuxiliaryURI + , mkFeedURI , mkRakkaURI , xmlizePage @@ -27,13 +29,13 @@ module Rakka.Page ) 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 @@ -41,6 +43,7 @@ import Data.Maybe import Data.Time import Network.HTTP.Lucu hiding (redirect) import Network.URI hiding (fragment) +import OpenSSL.EVP.Base64 import Rakka.Utils import Rakka.W3CDateTime import Subversion.Types @@ -150,14 +153,14 @@ encodeFragment = escapeURIString isSafeChar . UTF8.encodeString mkPageURI :: URI -> PageName -> URI mkPageURI baseURI name = baseURI { - uriPath = foldl () "/" [uriPath baseURI, encodePageName name ++ ".html"] + uriPath = uriPath baseURI encodePageName name <.> "html" } mkPageFragmentURI :: URI -> PageName -> String -> URI mkPageFragmentURI baseURI name fragment = baseURI { - uriPath = foldl () "/" [uriPath baseURI, encodePageName name ++ ".html"] + uriPath = uriPath baseURI encodePageName name <.> "html" , uriFragment = ('#' : encodeFragment fragment) } @@ -181,6 +184,13 @@ mkAuxiliaryURI baseURI basePath name } +mkFeedURI :: URI -> PageName -> URI +mkFeedURI baseURI name + = baseURI { + uriPath = uriPath baseURI encodePageName name <.> "rdf" + } + + mkRakkaURI :: PageName -> URI mkRakkaURI name = URI { uriScheme = "rakka:" @@ -284,7 +294,7 @@ xmlizePage ) += ( if entityIsBinary page then ( eelem "binaryData" - += txt (B64.encode $ L.unpack $ entityContent page) + += txt (L8.unpack $ encodeBase64LBS $ entityContent page) ) else ( eelem "textData" @@ -344,8 +354,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