diff --git a/Web/ClientSession.hs b/Web/ClientSession.hs --- a/Web/ClientSession.hs +++ b/Web/ClientSession.hs @@ -5,7 +5,7 @@ -- -- Module : Web.ClientSession -- Copyright : Michael Snoyman --- License : BSD3 +-- License : SD3 -- -- Maintainer : Michael Snoyman -- Stability : Stable @@ -22,101 +22,91 @@ -- * Actual encryption/decryption , encrypt , decrypt - -- * Key types and classes. - , Word256 - , AESKey -- * Exceptions - , ClientSessionException + , ClientSessionException (..) ) where -import Codec.Encryption.AES (AESKey) -import qualified Data.ByteString as BS +import Codec.Crypto.SimpleAES import Control.Failure import Control.Monad (unless) -import Data.LargeWord (Word256) -import Codec.Utils (listFromOctets, listToOctets) -import Data.Word (Word8) -import System.Random (getStdGen, randoms, Random, randomR, random) -import qualified Codec.Encryption.AES as AES +import qualified Codec.Crypto.SimpleAES as AES import qualified Codec.Binary.Base64Url as Base64 -import qualified Data.Digest.MD5 as MD5 +import qualified Data.Digest.Pure.MD5 as MD5 import Data.Typeable (Typeable) -import Control.Exception (Exception) +import Control.Exception +import System.Directory + +import qualified Data.ByteString as S +import qualified Data.ByteString.Lazy as L + +import Data.Binary + -- | The default key file. defaultKeyFile :: String defaultKeyFile = "client_session_key.aes" -- | Simply calls 'getKey' \"client_session_key.aes\" -getDefaultKey :: IO Word256 +getDefaultKey :: IO AES.Key getDefaultKey = getKey defaultKeyFile data ClientSessionException = - KeyTooSmall BS.ByteString + KeyTooSmall S.ByteString | InvalidBase64 String - | MismatchedHash { _expected :: [Word8] - , _actual :: [Word8] + | InvalidHash String + | MismatchedHash { expectedHash :: L.ByteString + , actualHash :: L.ByteString } - deriving (Show, Typeable) + deriving (Show, Typeable, Eq) instance Exception ClientSessionException --- | Get a 256-bit key from the given text file. --- If the file does not exist, or did not contain enough bits, --- a random key will be generated and stored in that file. +-- | Get a key from the given text file. +-- +-- If the file does not exist a random key will be generated and stored in that +-- file. getKey :: FilePath -- ^ File name where key is stored. - -> IO Word256 -- ^ The actual 256-bit key. -getKey keyFile = catch loadKeyFromFile $ const generateNewKey where - loadKeyFromFile :: IO Word256 - loadKeyFromFile = do - contents <- BS.readFile keyFile - if BS.length contents < 32 - then failure $ KeyTooSmall contents - else return $ head $ listFromOctets $ BS.unpack contents - generateNewKey :: IO Word256 - generateNewKey = do - stdGen <- getStdGen - let word8s = map unMyWord8 $ take 32 $ randoms stdGen - let newKey = head $ listFromOctets word8s - BS.writeFile keyFile $ BS.pack word8s - return newKey - -newtype MyWord8 = MyWord8 { unMyWord8 :: Word8 } - deriving (Integral, Real, Enum, Num, Ord, Eq, Show) -instance Random MyWord8 where - randomR (a,b) g = - let (x, g') = randomR (toInteger a, toInteger b) g - in (fromIntegral $ mod x 256, g') - random = randomR (MyWord8 minBound, MyWord8 maxBound) + -> IO AES.Key -- ^ The actual key. +getKey keyFile = do + exists <- doesFileExist keyFile + if exists + then S.readFile keyFile + else do + key <- AES.randomKey + S.writeFile keyFile key + return key -- | Encrypt with the given key and base-64 encode. -- A hash is stored inside the encrypted key so that, upon decryption, -- integrity can be guaranteed. -encrypt :: AES.AESKey k - => k -- ^ The key used for encryption. - -> BS.ByteString -- ^ The data to encrypt. - -> String -- ^ Encrypted and encoded data. -encrypt k x = - let unpacked = BS.unpack x - in Base64.encode . listToOctets . map (AES.encrypt k) . - listFromOctets $ MD5.hash unpacked ++ unpacked +encrypt :: AES.Key -- ^ The key used for encryption. + -> L.ByteString -- ^ The data to encrypt. + -> IO (String) -- ^ Encrypted and encoded data. +encrypt k bs = do + let withHash = encode (MD5.md5 bs) `L.append` bs + encrypted <- AES.encryptMsg mode k withHash + return $ Base64.encode $ L.unpack encrypted +mode :: AES.Mode +mode = ECB + -- | Base-64 decode and decrypt with the given key, if possible. Calls -- 'failure' if either the original string is not a valid base-64 encoded -- string, or the hash at the beginning of the decrypted string does not match. -decrypt :: (AES.AESKey k, Monad m, Failure ClientSessionException m) - => k -- ^ The key used for encryption. +decrypt :: (Monad m, Failure ClientSessionException m) + => AES.Key -- ^ The key used for encryption. -> String -- ^ Data to decrypt. - -> m BS.ByteString -- ^ The decrypted data, if possible. + -> m L.ByteString -- ^ The decrypted data, if possible. decrypt k x = do - decoded <- case Base64.decode x of - Nothing -> failure $ InvalidBase64 x - Just y -> return y - let decrypted = listToOctets $ map (AES.decrypt k) - $ listFromOctets decoded - let (expected, rest) = splitAt 16 decrypted - let actual = MD5.hash rest - unless (expected == actual) $ failure - $ MismatchedHash expected actual - return $ BS.pack rest + decoded <- case Base64.decode x of + Nothing -> failure $ InvalidBase64 x + Just y -> return y + decrypted <- case AES.decryptMsg' mode k $ L.pack decoded of + Left s -> failure $ InvalidHash s + Right z -> return z + let (expected, rest) = L.splitAt 16 decrypted + let actual = encode $ MD5.md5 rest + unless (expected == actual) $ failure + $ MismatchedHash expected actual + return rest diff --git a/clientsession.cabal b/clientsession.cabal --- a/clientsession.cabal +++ b/clientsession.cabal @@ -1,5 +1,5 @@ name: clientsession -version: 0.2.1 +version: 0.3.0 license: BSD3 license-file: LICENSE author: Michael Snoyman @@ -15,10 +15,12 @@ library build-depends: base >=4 && <5, - Crypto >= 4.2.0 && < 4.3, + SimpleAES >= 0.4.1 && < 0.5, + pureMD5 >= 1.1.0.0 && < 1.2, dataenc >= 0.13.0.2 && < 0.14, - random >= 1.0.0.1 && < 1.1, failure >= 0.0.0.2 && < 0.2, - bytestring >= 0.9 && < 0.10 + bytestring >= 0.9 && < 0.10, + directory >= 1 && < 1.1, + binary >= 0.5.0.2 && < 0.6 exposed-modules: Web.ClientSession ghc-options: -Wall