clientsession 0.2.1 → 0.3.0

raw patch · 2 files changed

+62/−70 lines, 2 filesdep +SimpleAESdep +binarydep +directorydep −Cryptodep −randomPVP ok

version bump matches the API change (PVP)

Dependencies added: SimpleAES, binary, directory, pureMD5

Dependencies removed: Crypto, random

API changes (from Hackage documentation)

Files

• Web/ClientSession.hs +56/−66
• clientsession.cabal +6/−4

@@ -5,7 +5,7 @@ -- -- Module        : Web.ClientSession -- Copyright     : Michael Snoyman--- License       : BSD3+-- License       : SD3 -- -- Maintainer    : Michael Snoyman <michael@snoyman.com> -- 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

@@ -1,5 +1,5 @@ name:            clientsession-version:         0.2.1+version:         0.3.0 license:         BSD3 license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>@@ -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