Use HsOpenSSL instead of Crypto

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

diff --git a/Rakka/Wiki/Engine.hs b/Rakka/Wiki/Engine.hs
index 27386961fe4e7416623e6d752679c0579adf56f6..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 {
@@ -399,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]