Use HsOpenSSL instead of Crypto

darcs-hash:20080217042020-62b54-184042afd0575c185359ca62b0d1c19d58a8d2e8.gz

diff --git a/Main.hs b/Main.hs
index 81f41a5f345cc1443224ff05ea0f8968f37f1556..fc3a1b07d8777ffd43a9f5e8cdb7ebdda44ee82e 100644 (file)
--- a/Main.hs
+++ b/Main.hs
@@ -4,6 +4,7 @@ import           Data.List
 import           Data.Maybe
 import           Network
 import           Network.HTTP.Lucu
 import           Data.Maybe
 import           Network
 import           Network.HTTP.Lucu

+import           OpenSSL

 import           Rakka.Environment
 import           Rakka.Resource.CheckAuth
 import           Rakka.Resource.Index
 import           Rakka.Environment
 import           Rakka.Resource.CheckAuth
 import           Rakka.Resource.Index


@@ -104,7 +105,8 @@ printUsage = do putStrLn "Usage:"
 
 
 main :: IO ()
 
 
 main :: IO ()

-main = withSubversion $
+main = withOpenSSL $
+       withSubversion $

        do (opts, nonOpts, errors) <- return . getOpt Permute options =<< getArgs
 
           when (not $ null errors)
        do (opts, nonOpts, errors) <- return . getOpt Permute options =<< getArgs
 
           when (not $ null errors)

diff --git a/Rakka.cabal b/Rakka.cabal
index b19ab476f09e9d0a7a1de3f68492124bd6c623c9..1f8cea38851f201b29c6bcdce9b1dd10fba9e08d 100644 (file)
--- a/Rakka.cabal
+++ b/Rakka.cabal
@@ -1,13 +1,14 @@
 Name:          Rakka
 Synopsis:      Wiki engine with Subversion backend
 Description:
 Name:          Rakka
 Synopsis:      Wiki engine with Subversion backend
 Description:

-    FIXME: write this
+    Rakka is a wiki engine with Subversion backend. Its syntax is
+    similar to MediaWiki.

 Version:       0.1
 License:       PublicDomain
 Author:        PHO <phonohawk at ps dot sakura dot ne dot jp>
 Maintainer:    PHO <phonohawk at ps dot sakura dot ne dot jp>
 Stability:     experimental
 Version:       0.1
 License:       PublicDomain
 Author:        PHO <phonohawk at ps dot sakura dot ne dot jp>
 Maintainer:    PHO <phonohawk at ps dot sakura dot ne dot jp>
 Stability:     experimental

-Homepage:      http://ccm.sherry.jp/Rakka/
+Homepage:      http://rakka.cielonegro.org/

 Category:      Web
 Tested-With:   GHC == 6.6.1
 Cabal-Version: >= 1.2
 Category:      Web
 Tested-With:   GHC == 6.6.1
 Cabal-Version: >= 1.2


@@ -57,10 +58,10 @@ Flag hardest-optimization
 
 Executable rakka
     Build-Depends:
 
 Executable rakka
     Build-Depends:

-        Crypto, FileManip, HTTP, HUnit, HsHyperEstraier, HsSVN, Lucu,
-        base, bytestring, containers, dataenc, directory, utf8-string,
-        filepath, hslogger, hxt, magic, mtl, network, parsec, stm,
-        time, unix, zlib
+        FileManip, HTTP, HUnit, HsHyperEstraier, HsOpenSSL, HsSVN,
+        Lucu, base, bytestring, containers, dataenc, directory,
+        utf8-string, filepath, hslogger, hxt, magic, mtl, network,
+        parsec, stm, time, unix, zlib

     Main-Is:
         Main.hs
     Other-Modules:
     Main-Is:
         Main.hs
     Other-Modules:

diff --git a/Rakka/Authorization.hs b/Rakka/Authorization.hs
index 04beabae3cb676cd138d1a0b447c818ba1ee5d0c..0f865c3dee08b7be0baf710c5a6216d23d41a879 100644 (file)
--- a/Rakka/Authorization.hs
+++ b/Rakka/Authorization.hs
@@ -5,15 +5,15 @@ module Rakka.Authorization
     )
     where
 
     )
     where
 

-import qualified Codec.Binary.Base64 as B64

 import qualified Codec.Binary.UTF8.String as UTF8
 import           Control.Concurrent.STM
 import           Control.Monad.Trans
 import qualified Codec.Binary.UTF8.String as UTF8
 import           Control.Concurrent.STM
 import           Control.Monad.Trans

-import           Data.Digest.SHA2
+import qualified Data.ByteString as B

 import           Data.Map (Map)
 import qualified Data.Map as M hiding (Map)
 import           Data.Maybe
 import           Data.Map (Map)
 import qualified Data.Map as M hiding (Map)
 import           Data.Maybe

-import           Data.Word
+import           OpenSSL.EVP.Base64
+import           OpenSSL.EVP.Digest

 import           Rakka.SystemConfig
 import           System.Directory
 import           System.FilePath
 import           Rakka.SystemConfig
 import           System.Directory
 import           System.FilePath


@@ -28,7 +28,7 @@ data AuthDB
       }
 
 
       }
 
 

-type UserMap = Map String [Word8]
+type UserMap = Map String String

 
 
 mkAuthDB :: FilePath -> IO AuthDB
 
 
 mkAuthDB :: FilePath -> IO AuthDB


@@ -45,10 +45,10 @@ mkAuthDB lsdir
 
 isValidPair :: MonadIO m => AuthDB -> String -> String -> m Bool
 isValidPair adb name pass
 
 isValidPair :: MonadIO m => AuthDB -> String -> String -> m Bool
 isValidPair adb name pass

-    = let hash = toOctets $ sha256 $ UTF8.encode pass
-      in
-        liftIO $ atomically $ do m <- readTVar (adbUserMap adb)
-                                 return (M.lookup name m == Just hash)
+    = liftIO $ do sha1 <- return . fromJust =<< getDigestByName "SHA1"
+                  let hash = digestBS sha1 $ B.pack $ UTF8.encode pass
+                  atomically $ do m <- readTVar (adbUserMap adb)
+                                  return (M.lookup name m == Just hash)

 
 
 loadUserMap :: FilePath -> IO UserMap
 
 
 loadUserMap :: FilePath -> IO UserMap


@@ -60,16 +60,17 @@ loadUserMap path
                       return . M.fromList . map decodePair . fromJust . deserializeStringPairs
                   else
                       return M.empty
                       return . M.fromList . map decodePair . fromJust . deserializeStringPairs
                   else
                       return M.empty

-         return (initMap m)
+         sha1  <- return . fromJust =<< getDigestByName "SHA1"
+         return (initMap sha1 m)

     where
     where

-      decodePair :: (String, String) -> (String, [Word8])
+      decodePair :: (String, String) -> (String, String)

       decodePair (name, b64Hash)
       decodePair (name, b64Hash)

-          = (UTF8.decodeString name, fromJust $ B64.decode b64Hash)
+          = (UTF8.decodeString name, decodeBase64 b64Hash)

 
 

-      initMap :: UserMap -> UserMap
-      initMap m
+      initMap :: Digest -> UserMap -> UserMap
+      initMap sha1 m

           | M.null m  = let name = "root"
           | M.null m  = let name = "root"

-                            hash = toOctets $ sha256 ([] :: [Word8])
+                            hash = digest sha1 ""

                         in
                           M.singleton name hash
           | otherwise = m
                         in
                           M.singleton name hash
           | otherwise = m

diff --git a/Rakka/Page.hs b/Rakka/Page.hs
index 5d7ef68c455795a36912676ea202643f50f91d0e..a9dbe4ff2967c9b83909b8d831fbfcfeba57fd50 100644 (file)
--- a/Rakka/Page.hs
+++ b/Rakka/Page.hs
@@ -29,13 +29,13 @@ module Rakka.Page
     )
     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 (ByteString)
 import qualified Data.ByteString.Lazy as L hiding (ByteString)
 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.Char
 import           Data.Map (Map)
 import qualified Data.Map as M


@@ -43,6 +43,7 @@ import           Data.Maybe
 import           Data.Time
 import           Network.HTTP.Lucu hiding (redirect)
 import           Network.URI hiding (fragment)
 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
 import           Rakka.Utils
 import           Rakka.W3CDateTime
 import           Subversion.Types


@@ -293,7 +294,7 @@ xmlizePage
                           )
                        += ( if entityIsBinary page then
                                 ( eelem "binaryData"
                           )
                        += ( if entityIsBinary page then
                                 ( eelem "binaryData"

-                                  += txt (B64.encode $ L.unpack $ entityContent page)
+                                  += txt (L8.unpack $ encodeBase64LBS $ entityContent page)

                                 )
                             else
                                 ( eelem "textData"
                                 )
                             else
                                 ( eelem "textData"


@@ -353,8 +354,8 @@ parseEntity
 
           let (isBinary, content)
                   = case (textData, binaryData) of
 
           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
                       _                        -> error "one of textData or binaryData is required"
               mimeType
                   =  if isBinary then

diff --git a/Rakka/Resource/Render.hs b/Rakka/Resource/Render.hs
index c25ca586fc628cdafcd19dd176f19eec73342d3a..3823cb4fa915f80be5b9c9c98e41a73f817fcadc 100644 (file)
--- a/Rakka/Resource/Render.hs
+++ b/Rakka/Resource/Render.hs
@@ -3,16 +3,15 @@ module Rakka.Resource.Render
     )
     where
 
     )
     where
 

-import qualified Codec.Binary.Base64 as B64

 import           Control.Arrow
 import           Control.Arrow.ArrowIO
 import           Control.Arrow.ArrowList
 import           Control.Monad.Trans
 import           Control.Arrow
 import           Control.Arrow.ArrowIO
 import           Control.Arrow.ArrowList
 import           Control.Monad.Trans

-import qualified Data.ByteString.Lazy as Lazy (ByteString, pack)
-import qualified Data.ByteString.Lazy.Char8 as L8 hiding (ByteString)
+import qualified Data.ByteString.Lazy as Lazy

 import           Data.Maybe
 import           Network.HTTP.Lucu
 import           Network.HTTP.Lucu.Utils
 import           Data.Maybe
 import           Network.HTTP.Lucu
 import           Network.HTTP.Lucu.Utils

+import           OpenSSL.EVP.Base64

 import           Rakka.Environment
 import           Rakka.Page
 import           Rakka.Utils
 import           Rakka.Environment
 import           Rakka.Page
 import           Rakka.Utils


@@ -68,7 +67,7 @@ handleRender env name
 
          let (bin, cType) = case cTypeM of
                               Just (MIMEType "application" "x-rakka-base64-stream" _)
 
          let (bin, cType) = case cTypeM of
                               Just (MIMEType "application" "x-rakka-base64-stream" _)

-                                  -> let b = Lazy.pack $ fromJust $ B64.decode $ L8.unpack entity
+                                  -> let b = decodeBase64LBS entity

                                      in
                                        (b, guessMIMEType b)
                               Just t
                                      in
                                        (b, guessMIMEType b)
                               Just t

diff --git a/Rakka/Wiki/Engine.hs b/Rakka/Wiki/Engine.hs
index e3e49ee176c89676cfa12734c7bde40b7fded674..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)

             }
 
 
             }