From: pho <pho@cielonegro.org>
Date: Wed, 23 Jan 2008 03:19:12 +0000 (+0900)
Subject: fix for interface change of Crypto
X-Git-Url: https://git.cielonegro.org/gitweb.cgi?a=commitdiff_plain;h=b444493e17ad49d60464bb5cf02898bd9198af3c;p=Rakka.git

fix for interface change of Crypto

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

diff --git a/Rakka.cabal b/Rakka.cabal
index 228f1a0..41ea367 100644
--- 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,
-        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:
diff --git a/Rakka/Authorization.hs b/Rakka/Authorization.hs
index 8f32ddf..04beaba 100644
--- 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 Data.Digest.SHA1 as SHA1
+import           Data.Digest.SHA2
 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
-    = 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)
@@ -64,12 +64,12 @@ loadUserMap path
     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"
-                            hash = SHA1.hash []
+                            hash = toOctets $ sha256 ([] :: [Word8])
                         in
                           M.singleton name hash
           | otherwise = m
diff --git a/Rakka/Page.hs b/Rakka/Page.hs
index 16835d5..2785a20 100644
--- 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 )
-                      (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
diff --git a/Rakka/Resource/Render.hs b/Rakka/Resource/Render.hs
index 778ca21..c25ca58 100644
--- 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           Data.Maybe
 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 b = Lazy.pack $ B64.decode $ L8.unpack entity
+                                  -> let b = Lazy.pack $ fromJust $ B64.decode $ L8.unpack entity
                                      in
                                        (b, guessMIMEType b)
                               Just t