fix for interface change of Crypto

darcs-hash:20080123031912-62b54-953c5e5e2443fa4386d047a4de1a609395cc7020.gz

diff --git a/Rakka.cabal b/Rakka.cabal
index 228f1a0a6c8dedf99a11c2d315a36a7433c8a86b..41ea3678a31750bbf4bfdd7febc7463213836bb2 100644 (file)
--- a/Rakka.cabal
+++ b/Rakka.cabal
@@ -44,9 +44,9 @@ Flag build-test-suite
 Executable rakka
     Build-Depends:
         Crypto, FileManip, HUnit, HsHyperEstraier, HsSVN, Lucu, base,
 Executable rakka
     Build-Depends:
         Crypto, FileManip, HUnit, HsHyperEstraier, HsSVN, Lucu, base,

-        bytestring, containers, directory, utf8-string, filepath,
-        hslogger, hxt, magic, mtl, network, parsec, stm, time, unix,
-        zlib
+        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 8f32ddfc613420e005e898e24ac08be920cbee0e..04beabae3cb676cd138d1a0b447c818ba1ee5d0c 100644 (file)
--- a/Rakka/Authorization.hs
+++ b/Rakka/Authorization.hs
@@ -9,7 +9,7 @@ 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 qualified Data.Digest.SHA1 as SHA1
+import           Data.Digest.SHA2

 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


@@ -45,7 +45,7 @@ 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 = SHA1.hash (UTF8.encode pass)
+    = let hash = toOctets $ sha256 $ UTF8.encode pass

       in
         liftIO $ atomically $ do m <- readTVar (adbUserMap adb)
                                  return (M.lookup name m == Just hash)
       in
         liftIO $ atomically $ do m <- readTVar (adbUserMap adb)
                                  return (M.lookup name m == Just hash)


@@ -64,12 +64,12 @@ loadUserMap path
     where
       decodePair :: (String, String) -> (String, [Word8])
       decodePair (name, b64Hash)
     where
       decodePair :: (String, String) -> (String, [Word8])
       decodePair (name, b64Hash)

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

 
       initMap :: UserMap -> UserMap
       initMap m
           | M.null m  = let name = "root"
 
       initMap :: UserMap -> UserMap
       initMap m
           | M.null m  = let name = "root"

-                            hash = SHA1.hash []
+                            hash = toOctets $ sha256 ([] :: [Word8])

                         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 16835d5aafd79e247d227e557e93d77eb267e0ea..2785a201df626f216f27d309b88a3d46115902b3 100644 (file)
--- a/Rakka/Page.hs
+++ b/Rakka/Page.hs
@@ -344,7 +344,7 @@ parseEntity
           let (isBinary, content)
                   = case (textData, binaryData) of
                       (Just text, Nothing    ) -> (False, L.pack $ UTF8.encode text )
           let (isBinary, content)
                   = case (textData, binaryData) of
                       (Just text, Nothing    ) -> (False, L.pack $ UTF8.encode text )

-                      (Nothing  , Just binary) -> (True , L.pack $ B64.decode binary)
+                      (Nothing  , Just binary) -> (True , L.pack $ fromJust $ B64.decode 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 778ca2114dba15d8945674510b1c70abc70c3a55..c25ca586fc628cdafcd19dd176f19eec73342d3a 100644 (file)
--- a/Rakka/Resource/Render.hs
+++ b/Rakka/Resource/Render.hs
@@ -10,6 +10,7 @@ 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           Control.Monad.Trans
 import qualified Data.ByteString.Lazy as Lazy (ByteString, pack)
 import qualified Data.ByteString.Lazy.Char8 as L8 hiding (ByteString)

+import           Data.Maybe

 import           Network.HTTP.Lucu
 import           Network.HTTP.Lucu.Utils
 import           Rakka.Environment
 import           Network.HTTP.Lucu
 import           Network.HTTP.Lucu.Utils
 import           Rakka.Environment


@@ -67,7 +68,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 $ B64.decode $ L8.unpack entity
+                                  -> let b = Lazy.pack $ fromJust $ B64.decode $ L8.unpack entity

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