Use HsOpenSSL instead of Crypto

[Rakka.git] / Rakka / Wiki / Engine.hs

diff --git a/Rakka/Wiki/Engine.hs b/Rakka/Wiki/Engine.hs
index 90ed666a25db4da0ca9134a4e73b64b154fcc2ef..dc3d4f14149f0b3e70f91f7e8a5f0b19dceb4d61 100644 (file)
--- a/Rakka/Wiki/Engine.hs
+++ b/Rakka/Wiki/Engine.hs
@@ -8,17 +8,18 @@ module Rakka.Wiki.Engine
     )
     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
+import qualified Data.ByteString.Lazy.Char8 as L8 hiding (ByteString)
 import           Data.Map (Map)
 import qualified Data.Map as M
 import           Data.Maybe
 import           Network.HTTP.Lucu
 import           Network.URI
+import           OpenSSL.EVP.Base64
 import           Rakka.Page
 import           Rakka.Storage
 import           Rakka.SystemConfig
@@ -117,7 +118,7 @@ wikifyBin interpTable
       binToURI m b
           = nullURI {
               uriScheme = "data:"
-            , uriPath   = show m ++ ";base64," ++ B64.encode (Lazy.unpack b)
+            , uriPath   = show m ++ ";base64," ++ (L8.unpack $ encodeBase64LBS b)
             }
 
 
@@ -137,7 +138,7 @@ makeMainXHTML sto sysConf interpTable
           wiki            <- wikifyPage interpTable -< tree
           pName           <- getXPathTreesInDoc "/page/@name/text()" >>> getText -< tree
           interpreted     <- interpretCommands sto sysConf interpTable
-                             -< (pName, Just tree, Just wiki, wiki)
+                             -< (Just pName, Just tree, Just wiki, wiki)
           formatWikiBlocks -< (baseURI, interpreted)
 
 
@@ -145,7 +146,7 @@ makeSubXHTML :: (ArrowXml a, ArrowChoice a, ArrowIO a) =>
                 Storage
              -> SystemConfig
              -> InterpTable
-             -> a (PageName, Maybe XmlTree, XmlTree) XmlTree
+             -> a (Maybe PageName, Maybe XmlTree, XmlTree) XmlTree
 makeSubXHTML sto sysConf interpTable
     = proc (mainPageName, mainPage, subPage)
     -> do BaseURI baseURI <- getSysConfA sysConf -< ()
@@ -171,7 +172,7 @@ makePreviewXHTML sto sysConf interpTable
     -> do BaseURI baseURI <- getSysConfA sysConf -< ()
           wiki            <- wikifyBin interpTable -< (pageType, pageBin)
           interpreted     <- interpretCommands sto sysConf interpTable
-                             -< (name, Nothing, Just wiki, wiki)
+                             -< (Just name, Nothing, Just wiki, wiki)
           formatWikiBlocks -< (baseURI, interpreted)
 
 
@@ -179,7 +180,7 @@ interpretCommands :: (ArrowXml a, ArrowChoice a, ArrowIO a) =>
                      Storage
                   -> SystemConfig
                   -> InterpTable
-                  -> a (PageName, Maybe XmlTree, Maybe WikiPage, WikiPage) WikiPage
+                  -> a (Maybe PageName, Maybe XmlTree, Maybe WikiPage, WikiPage) WikiPage
 interpretCommands sto sysConf interpTable
     = proc (name, mainPage, mainWiki, targetWiki)
     -> let ctx = InterpreterContext {
@@ -266,7 +267,6 @@ makeDraft interpTable
                pIsBinary <- getXPathTreesInDoc "/page/@isBinary/text()"     >>> getText -< tree
                pRevision <- getXPathTreesInDoc "/page/@revision/text()"     >>> getText -< tree
                pLang     <- maybeA (getXPathTreesInDoc "/page/@lang/text()"     >>> getText) -< tree
-               pFileName <- maybeA (getXPathTreesInDoc "/page/@fileName/text()" >>> getText) -< tree
                pIsTheme  <- maybeA (getXPathTreesInDoc "/page/@isTheme/text()"  >>> getText) -< tree
                pIsFeed   <- maybeA (getXPathTreesInDoc "/page/@isFeed/text()"   >>> getText) -< tree
                pSummary  <- maybeA (getXPathTreesInDoc "/page/summary/text()"   >>> getText) -< tree
@@ -276,7 +276,6 @@ makeDraft interpTable
                arrIO2 (flip setAttribute "@type"         ) -< (doc, Just pType)
                arrIO2 (flip setAttribute "@mdate"        ) -< (doc, Just pLastMod)
                arrIO2 (flip setAttribute "@lang"         ) -< (doc, pLang)
-               arrIO2 (flip setAttribute "rakka:fileName") -< (doc, pFileName)
                arrIO2 (flip setAttribute "rakka:isLocked") -< (doc, Just pIsLocked)
                arrIO2 (flip setAttribute "rakka:isBinary") -< (doc, Just pIsBinary)
                arrIO2 (flip setAttribute "rakka:revision") -< (doc, Just pRevision)
@@ -401,7 +400,7 @@ makePageLinkList sto sysConf interpTable
     -> do wiki            <- wikifyPage interpTable -< tree
           pName           <- getXPathTreesInDoc "/page/@name/text()" >>> getText -< tree
           interpreted     <- interpretCommands sto sysConf interpTable
-                             -< (pName, Just tree, Just wiki, wiki)
+                             -< (Just pName, Just tree, Just wiki, wiki)
           returnA -< concatMap extractFromBlock interpreted
     where
       extractFromElem :: Element -> [PageName]