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:
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
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)
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
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
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
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