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
 
     )
     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 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           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
 import           Rakka.Page
 import           Rakka.Storage
 import           Rakka.SystemConfig


@@ -117,7 +118,7 @@ wikifyBin interpTable
       binToURI m b
           = nullURI {
               uriScheme = "data:"
       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
           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)
 
 
           formatWikiBlocks -< (baseURI, interpreted)
 
 


@@ -145,7 +146,7 @@ makeSubXHTML :: (ArrowXml a, ArrowChoice a, ArrowIO a) =>
                 Storage
              -> SystemConfig
              -> InterpTable
                 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 -< ()
 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
     -> 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)
 
 
           formatWikiBlocks -< (baseURI, interpreted)
 
 


@@ -179,7 +180,7 @@ interpretCommands :: (ArrowXml a, ArrowChoice a, ArrowIO a) =>
                      Storage
                   -> SystemConfig
                   -> InterpTable
                      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 {
 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
                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
                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 "@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)
                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
     -> 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]
           returnA -< concatMap extractFromBlock interpreted
     where
       extractFromElem :: Element -> [PageName]