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           OpenSSL
 import           Rakka.Environment
 import           Rakka.Resource.CheckAuth
 import           Rakka.Resource.Index
@@ -104,7 +105,8 @@ printUsage = do putStrLn "Usage:"
 
 
 main :: IO ()
-main = withSubversion $
+main = withOpenSSL $
+       withSubversion $
        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:
-    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
-Homepage:      http://ccm.sherry.jp/Rakka/
+Homepage:      http://rakka.cielonegro.org/
 Category:      Web
 Tested-With:   GHC == 6.6.1
 Cabal-Version: >= 1.2
@@ -57,10 +58,10 @@ Flag hardest-optimization
 
 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:

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
 
-import qualified Codec.Binary.Base64 as B64
 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.Word
+import           OpenSSL.EVP.Base64
+import           OpenSSL.EVP.Digest
 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
@@ -45,10 +45,10 @@ mkAuthDB lsdir
 
 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
@@ -60,16 +60,17 @@ loadUserMap path
                       return . M.fromList . map decodePair . fromJust . deserializeStringPairs
                   else
                       return M.empty
-         return (initMap m)
+         sha1  <- return . fromJust =<< getDigestByName "SHA1"
+         return (initMap sha1 m)
     where
-      decodePair :: (String, String) -> (String, [Word8])
+      decodePair :: (String, String) -> (String, String)
       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"
-                            hash = toOctets $ sha256 ([] :: [Word8])
+                            hash = digest sha1 ""
                         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
 
-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
@@ -43,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
@@ -293,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"
@@ -353,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

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
 
-import qualified Codec.Binary.Base64 as B64
 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           OpenSSL.EVP.Base64
 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 b = Lazy.pack $ fromJust $ B64.decode $ L8.unpack entity
+                                  -> let b = decodeBase64LBS entity
                                      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
 
-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)
             }