clientsession 0.7.3.3 → 0.7.3.4
raw patch · 6 files changed
+448/−393 lines, 6 filesdep +containersdep +entropydep +transformerssetup-changedPVP ok
version bump matches the API change (PVP)
Dependencies added: containers, entropy, transformers
API changes (from Hackage documentation)
Files
- LICENSE +25/−25
- Setup.lhs +7/−7
- bench.hs +19/−19
- clientsession.cabal +55/−52
- src/Web/ClientSession.hs +251/−215
- tests/runtests.hs +91/−75
LICENSE view
@@ -1,25 +1,25 @@-The following license covers this documentation, and the source code, except -where otherwise indicated. - -Copyright 2008, Michael Snoyman. All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - -* Redistributions of source code must retain the above copyright notice, this - list of conditions and the following disclaimer. - -* Redistributions in binary form must reproduce the above copyright notice, - this list of conditions and the following disclaimer in the documentation - and/or other materials provided with the distribution. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR -IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF -MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO -EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT, -INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT -NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, -OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF -LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE -OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF -ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +The following license covers this documentation, and the source code, except+where otherwise indicated.++Copyright 2008, Michael Snoyman. All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice, this+ list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO+EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT+NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,+OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE+OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF+ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
Setup.lhs view
@@ -1,7 +1,7 @@-#!/usr/bin/env runhaskell - -> module Main where -> import Distribution.Simple - -> main :: IO () -> main = defaultMain +#!/usr/bin/env runhaskell++> module Main where+> import Distribution.Simple++> main :: IO ()+> main = defaultMain
bench.hs view
@@ -1,19 +1,19 @@-import qualified Data.ByteString as B -import Web.ClientSession -import Data.Maybe -import Data.Serialize - -import Criterion.Main -import Text.Printf - -Right key = initKey (B.replicate 96 0xFE) -Just iv = mkIV (B.replicate 16 0xB0) - -main :: IO () -main = - defaultMain - [ bgroup "encrypt then decrypt" - [ bench (printf "Message length = %d bytes" len) $ - whnf (fromJust . decrypt key . encrypt key iv) (B.replicate len 0xAA) - | len <- [0, 50, 100, 400, 2000, 80000]] - ] +import qualified Data.ByteString as B+import Web.ClientSession+import Data.Maybe+import Data.Serialize++import Criterion.Main+import Text.Printf++Right key = initKey (B.replicate 96 0xFE)+Just iv = mkIV (B.replicate 16 0xB0)++main :: IO ()+main =+ defaultMain+ [ bgroup "encrypt then decrypt"+ [ bench (printf "Message length = %d bytes" len) $+ whnf (fromJust . decrypt key . encrypt key iv) (B.replicate len 0xAA)+ | len <- [0, 50, 100, 400, 2000, 80000]]+ ]
clientsession.cabal view
@@ -1,52 +1,55 @@-name: clientsession -version: 0.7.3.3 -license: BSD3 -license-file: LICENSE -author: Michael Snoyman <michael@snoyman.com>, Felipe Lessa <felipe.lessa@gmail.com> -maintainer: Michael Snoyman <michael@snoyman.com> -synopsis: Securely store session data in a client-side cookie. -description: Achieves security through AES-CTR encryption and - Skein-MAC-512-256 authentication. Uses Base64 - encoding to avoid any issues with characters. -category: Web -stability: stable -cabal-version: >= 1.8 -build-type: Simple -homepage: http://github.com/snoyberg/clientsession/tree/master -data-files: bench.hs -extra-source-files: tests/runtests.hs - -flag test - description: Build the executable to run unit tests - default: False - -library - build-depends: base >=4 && < 5 - , bytestring >= 0.9 && < 0.10 - , cereal >= 0.3 && < 0.4 - , directory >= 1 && < 1.2 - , crypto-api >= 0.6.4 && < 0.9 - , cryptocipher >= 0.2.5 - , skein >= 0.1 && < 0.2 - , base64-bytestring >= 0.1.0.3 && < 0.2 - exposed-modules: Web.ClientSession - ghc-options: -Wall - hs-source-dirs: src - -test-suite runtests - type: exitcode-stdio-1.0 - build-depends: base >=4 && < 5 - , bytestring >= 0.9 && < 0.10 - , cryptocipher >= 0.2.5 && < 0.3 - , hspec == 0.6.* - , QuickCheck >= 2 && < 3 - , HUnit - -- finally, our own package - , clientsession - ghc-options: -Wall - hs-source-dirs: tests - main-is: runtests.hs - -source-repository head - type: git - location: git://github.com/snoyberg/clientsession.git +name: clientsession+version: 0.7.3.4+license: BSD3+license-file: LICENSE+author: Michael Snoyman <michael@snoyman.com>, Felipe Lessa <felipe.lessa@gmail.com>+maintainer: Michael Snoyman <michael@snoyman.com>+synopsis: Securely store session data in a client-side cookie.+description: Achieves security through AES-CTR encryption and+ Skein-MAC-512-256 authentication. Uses Base64+ encoding to avoid any issues with characters.+category: Web+stability: stable+cabal-version: >= 1.8+build-type: Simple+homepage: http://github.com/snoyberg/clientsession/tree/master+data-files: bench.hs+extra-source-files: tests/runtests.hs++flag test+ description: Build the executable to run unit tests+ default: False++library+ build-depends: base >=4 && < 5+ , bytestring >= 0.9 && < 0.10+ , cereal >= 0.3 && < 0.4+ , directory >= 1 && < 1.2+ , crypto-api >= 0.6.4 && < 0.9+ , cryptocipher >= 0.2.5+ , skein >= 0.1 && < 0.2+ , base64-bytestring >= 0.1.0.3 && < 0.2+ , entropy >= 0.2.1+ exposed-modules: Web.ClientSession+ ghc-options: -Wall+ hs-source-dirs: src++test-suite runtests+ type: exitcode-stdio-1.0+ build-depends: base >=4 && < 5+ , bytestring >= 0.9 && < 0.10+ , cryptocipher >= 0.2.5 && < 0.3+ , hspec == 0.6.*+ , QuickCheck >= 2 && < 3+ , HUnit+ , transformers+ , containers+ -- finally, our own package+ , clientsession+ ghc-options: -Wall+ hs-source-dirs: tests+ main-is: runtests.hs++source-repository head+ type: git+ location: git://github.com/snoyberg/clientsession.git
src/Web/ClientSession.hs view
@@ -1,215 +1,251 @@-{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE ForeignFunctionInterface #-} -{-# LANGUAGE TemplateHaskell #-} ---------------------------------------------------------- --- --- | --- --- Module : Web.ClientSession --- Copyright : Michael Snoyman --- License : BSD3 --- --- Maintainer : Michael Snoyman <michael@snoyman.com> --- Stability : Stable --- Portability : portable --- --- Stores session data in a client cookie. In order to do so, --- we: --- --- * Encrypt the cookie data using AES in CTR mode. This allows --- you to store sensitive information on the client side without --- worrying about eavesdropping. --- --- * Authenticate the encrypted cookie data using --- Skein-MAC-512-256. Besides detecting potential errors in --- storage or transmission of the cookies (integrity), the MAC --- also avoids malicious modifications of the cookie data by --- assuring you that the cookie data really was generated by this --- server (authenticity). --- --- * Encode everything using Base64. Thus we avoid problems with --- non-printable characters by giving the browser a simple --- string. --- --- Simple usage of the library involves just calling --- 'getDefaultKey' on the startup of your server, 'encryptIO' --- when serializing cookies and 'decrypt' when parsing then back. --- ---------------------------------------------------------- -module Web.ClientSession - ( -- * Automatic key generation - Key(..) - , IV - , randomIV - , mkIV - , getKey - , defaultKeyFile - , getDefaultKey - , initKey - -- * Actual encryption/decryption - , encrypt - , encryptIO - , decrypt - ) where - --- from base -import Control.Monad (guard) -import Data.Bits ((.|.), xor) -import Data.List (foldl') - --- from directory -import System.Directory (doesFileExist) - --- from bytestring -import qualified Data.ByteString as S -import qualified Data.ByteString.Base64 as B - --- from cereal -import Data.Serialize (encode, decode) - --- from crypto-api -import Crypto.Classes (buildKey) -import Crypto.Random (newGenIO, genBytes, SystemRandom) -import qualified Crypto.Modes as Modes - --- from cryptocipher -import qualified Crypto.Cipher.AES as A - --- from skein -import Crypto.Skein (skeinMAC', Skein_512_256) - --- | The keys used to store the cookies. We have an AES key used --- to encrypt the cookie and a Skein-MAC-512-256 key used verify --- the authencity and integrity of the cookie. The AES key needs --- to have exactly 32 bytes (256 bits) while Skein-MAC-512-256 --- should have 64 bytes (512 bits). --- --- See also 'getDefaultKey' and 'initKey'. -data Key = Key { aesKey :: A.AES256 - -- ^ AES key with 32 bytes. - , macKey :: S.ByteString -> Skein_512_256 - -- ^ Skein-MAC key. Instead of storing the key - -- data, we store a partially applied function - -- for calculating the MAC (see 'skeinMAC''). - } - --- | Dummy 'Show' instance. -instance Show Key where - show _ = "<Web.ClientSession.Key>" - --- | The initialization vector used by AES. Should be exactly 16 --- bytes long. -type IV = Modes.IV A.AES256 - --- | Construct an initialization vector from a 'S.ByteString'. --- Fails if there isn't exactly 16 bytes. -mkIV :: S.ByteString -> Maybe IV -mkIV bs = case (S.length bs, decode bs) of - (16, Right iv) -> Just iv - _ -> Nothing - --- | Randomly construct a fresh initialization vector. You --- /should not/ reuse initialization vectors. -randomIV :: IO IV -randomIV = Modes.getIVIO - --- | The default key file. -defaultKeyFile :: FilePath -defaultKeyFile = "client_session_key.aes" - --- | Simply calls 'getKey' 'defaultKeyFile'. -getDefaultKey :: IO Key -getDefaultKey = getKey defaultKeyFile - --- | Get a key from the given text file. --- --- If the file does not exist or is corrupted a random key will --- be generated and stored in that file. -getKey :: FilePath -- ^ File name where key is stored. - -> IO Key -- ^ The actual key. -getKey keyFile = do - exists <- doesFileExist keyFile - if exists - then S.readFile keyFile >>= either (const newKey) return . initKey - else newKey - where - newKey = do - (bs, key') <- randomKey - S.writeFile keyFile bs - return key' - --- | Generate the given number of random bytes. -randomBytes :: Int -> IO S.ByteString -randomBytes len = do - g <- newGenIO - either (error . show) (return . fst) $ genBytes len (g :: SystemRandom) - --- | Generate a random 'Key'. Besides the 'Key', the --- 'ByteString' passed to 'initKey' is returned so that it can be --- saved for later use. -randomKey :: IO (S.ByteString, Key) -randomKey = do - bs <- randomBytes 96 - case initKey bs of - Left e -> error $ "Web.ClientSession.randomKey: never here, " ++ e - Right key -> return (bs, key) - --- | Initializes a 'Key' from a random 'S.ByteString'. Fails if --- there isn't exactly 96 bytes (256 bits for AES and 512 bits --- for Skein-MAC-512-512). -initKey :: S.ByteString -> Either String Key -initKey bs | S.length bs /= 96 = Left $ "Web.ClientSession.initKey: length of " ++ - show (S.length bs) ++ " /= 96." -initKey bs = case buildKey preAesKey of - Nothing -> Left $ "Web.ClientSession.initKey: unknown error with buildKey." - Just k -> Right $ Key { aesKey = k - , macKey = skeinMAC' preMacKey } - where - (preMacKey, preAesKey) = S.splitAt 64 bs - --- | Same as 'encrypt', however randomly generates the --- initialization vector for you. -encryptIO :: Key -> S.ByteString -> IO S.ByteString -encryptIO key x = do - iv <- randomIV - return $ encrypt key iv x - --- | Encrypt (AES-CTR), authenticate (Skein-MAC-512-256) and --- encode (Base64) the given cookie data. The returned byte --- string is ready to be used in a response header. -encrypt :: Key -- ^ Key of the server. - -> IV -- ^ New, random initialization vector (see 'randomIV'). - -> S.ByteString -- ^ Serialized cookie data. - -> S.ByteString -- ^ Encoded cookie data to be given to - -- the client browser. -encrypt key iv x = B.encode final - where - (encrypted, _) = Modes.ctr' Modes.incIV (aesKey key) iv x - toBeAuthed = encode iv `S.append` encrypted - auth = macKey key toBeAuthed - final = encode auth `S.append` toBeAuthed - --- | Decode (Base64), verify the integrity and authenticity --- (Skein-MAC-512-256) and decrypt (AES-CTR) the given encoded --- cookie data. Returns the original serialized cookie data. --- Fails if the data is corrupted. -decrypt :: Key -- ^ Key of the server. - -> S.ByteString -- ^ Encoded cookie data given by the browser. - -> Maybe S.ByteString -- ^ Serialized cookie data. -decrypt key dataBS64 = do - dataBS <- either (const Nothing) Just $ B.decode dataBS64 - guard (S.length dataBS >= 48) -- 16 bytes of IV + 32 bytes of Skein-MAC-512-256 - let (auth, toBeAuthed) = S.splitAt 32 dataBS - auth' = macKey key toBeAuthed - guard (encode auth' `compareHash` auth) - let (iv_e, encrypted) = S.splitAt 16 toBeAuthed - iv <- either (const Nothing) Just $ decode iv_e - let (x, _) = Modes.unCtr' Modes.incIV (aesKey key) iv encrypted - return x - --- | Compare two bytestrings. Always takes the same ammount of --- time, avoiding timing attacks. -compareHash :: S.ByteString -> S.ByteString -> Bool -compareHash s1 s2 = - S.length s1 == S.length s2 && - foldl' (.|.) 0 (S.zipWith xor s1 s2) == 0 +{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE TemplateHaskell #-}+---------------------------------------------------------+--+-- |+--+-- Module : Web.ClientSession+-- Copyright : Michael Snoyman+-- License : BSD3+--+-- Maintainer : Michael Snoyman <michael@snoyman.com>+-- Stability : Stable+-- Portability : portable+--+-- Stores session data in a client cookie. In order to do so,+-- we:+--+-- * Encrypt the cookie data using AES in CTR mode. This allows+-- you to store sensitive information on the client side without+-- worrying about eavesdropping.+--+-- * Authenticate the encrypted cookie data using+-- Skein-MAC-512-256. Besides detecting potential errors in+-- storage or transmission of the cookies (integrity), the MAC+-- also avoids malicious modifications of the cookie data by+-- assuring you that the cookie data really was generated by this+-- server (authenticity).+--+-- * Encode everything using Base64. Thus we avoid problems with+-- non-printable characters by giving the browser a simple+-- string.+--+-- Simple usage of the library involves just calling+-- 'getDefaultKey' on the startup of your server, 'encryptIO'+-- when serializing cookies and 'decrypt' when parsing then back.+--+---------------------------------------------------------+module Web.ClientSession+ ( -- * Automatic key generation+ Key(..)+ , IV+ , randomIV+ , mkIV+ , getKey+ , defaultKeyFile+ , getDefaultKey+ , initKey+ -- * Actual encryption/decryption+ , encrypt+ , encryptIO+ , decrypt+ ) where++-- from base+import Control.Monad (guard, when)+import Data.Bits ((.|.), xor)+import Data.List (foldl')+import qualified Data.IORef as I+import System.IO.Unsafe (unsafePerformIO)+import Control.Concurrent (forkIO)+import Control.Applicative ((<$>))++-- from directory+import System.Directory (doesFileExist)++-- from bytestring+import qualified Data.ByteString as S+import qualified Data.ByteString.Base64 as B++-- from cereal+import Data.Serialize (encode, decode)++-- from crypto-api+import Crypto.Classes (buildKey, encryptBlock)+import Crypto.Random (newGenIO, genBytes, SystemRandom)+import qualified Crypto.Modes as Modes++-- from cryptocipher+import qualified Crypto.Cipher.AES as A++-- from skein+import Crypto.Skein (skeinMAC', Skein_512_256)++-- from entropy+import System.Entropy (getEntropy)++-- | The keys used to store the cookies. We have an AES key used+-- to encrypt the cookie and a Skein-MAC-512-256 key used verify+-- the authencity and integrity of the cookie. The AES key needs+-- to have exactly 32 bytes (256 bits) while Skein-MAC-512-256+-- should have 64 bytes (512 bits).+--+-- See also 'getDefaultKey' and 'initKey'.+data Key = Key { aesKey :: A.AES256+ -- ^ AES key with 32 bytes.+ , macKey :: S.ByteString -> Skein_512_256+ -- ^ Skein-MAC key. Instead of storing the key+ -- data, we store a partially applied function+ -- for calculating the MAC (see 'skeinMAC'').+ }++-- | Dummy 'Show' instance.+instance Show Key where+ show _ = "<Web.ClientSession.Key>"++-- | The initialization vector used by AES. Should be exactly 16+-- bytes long.+type IV = Modes.IV A.AES256++-- | Construct an initialization vector from a 'S.ByteString'.+-- Fails if there isn't exactly 16 bytes.+mkIV :: S.ByteString -> Maybe IV+mkIV bs = case (S.length bs, decode bs) of+ (16, Right iv) -> Just iv+ _ -> Nothing++-- | Randomly construct a fresh initialization vector. You+-- /should not/ reuse initialization vectors.+randomIV :: IO IV+randomIV = aesRNG++-- | The default key file.+defaultKeyFile :: FilePath+defaultKeyFile = "client_session_key.aes"++-- | Simply calls 'getKey' 'defaultKeyFile'.+getDefaultKey :: IO Key+getDefaultKey = getKey defaultKeyFile++-- | Get a key from the given text file.+--+-- If the file does not exist or is corrupted a random key will+-- be generated and stored in that file.+getKey :: FilePath -- ^ File name where key is stored.+ -> IO Key -- ^ The actual key.+getKey keyFile = do+ exists <- doesFileExist keyFile+ if exists+ then S.readFile keyFile >>= either (const newKey) return . initKey+ else newKey+ where+ newKey = do+ (bs, key') <- randomKey+ S.writeFile keyFile bs+ return key'++-- | Generate the given number of random bytes.+randomBytes :: Int -> IO S.ByteString+randomBytes len = do+ g <- newGenIO+ either (error . show) (return . fst) $ genBytes len (g :: SystemRandom)++-- | Generate a random 'Key'. Besides the 'Key', the+-- 'ByteString' passed to 'initKey' is returned so that it can be+-- saved for later use.+randomKey :: IO (S.ByteString, Key)+randomKey = do+ bs <- randomBytes 96+ case initKey bs of+ Left e -> error $ "Web.ClientSession.randomKey: never here, " ++ e+ Right key -> return (bs, key)++-- | Initializes a 'Key' from a random 'S.ByteString'. Fails if+-- there isn't exactly 96 bytes (256 bits for AES and 512 bits+-- for Skein-MAC-512-512).+initKey :: S.ByteString -> Either String Key+initKey bs | S.length bs /= 96 = Left $ "Web.ClientSession.initKey: length of " +++ show (S.length bs) ++ " /= 96."+initKey bs = case buildKey preAesKey of+ Nothing -> Left $ "Web.ClientSession.initKey: unknown error with buildKey."+ Just k -> Right $ Key { aesKey = k+ , macKey = skeinMAC' preMacKey }+ where+ (preMacKey, preAesKey) = S.splitAt 64 bs++-- | Same as 'encrypt', however randomly generates the+-- initialization vector for you.+encryptIO :: Key -> S.ByteString -> IO S.ByteString+encryptIO key x = do+ iv <- randomIV+ return $ encrypt key iv x++-- | Encrypt (AES-CTR), authenticate (Skein-MAC-512-256) and+-- encode (Base64) the given cookie data. The returned byte+-- string is ready to be used in a response header.+encrypt :: Key -- ^ Key of the server.+ -> IV -- ^ New, random initialization vector (see 'randomIV').+ -> S.ByteString -- ^ Serialized cookie data.+ -> S.ByteString -- ^ Encoded cookie data to be given to+ -- the client browser.+encrypt key iv x = B.encode final+ where+ (encrypted, _) = Modes.ctr' Modes.incIV (aesKey key) iv x+ toBeAuthed = encode iv `S.append` encrypted+ auth = macKey key toBeAuthed+ final = encode auth `S.append` toBeAuthed++-- | Decode (Base64), verify the integrity and authenticity+-- (Skein-MAC-512-256) and decrypt (AES-CTR) the given encoded+-- cookie data. Returns the original serialized cookie data.+-- Fails if the data is corrupted.+decrypt :: Key -- ^ Key of the server.+ -> S.ByteString -- ^ Encoded cookie data given by the browser.+ -> Maybe S.ByteString -- ^ Serialized cookie data.+decrypt key dataBS64 = do+ dataBS <- either (const Nothing) Just $ B.decode dataBS64+ guard (S.length dataBS >= 48) -- 16 bytes of IV + 32 bytes of Skein-MAC-512-256+ let (auth, toBeAuthed) = S.splitAt 32 dataBS+ auth' = macKey key toBeAuthed+ guard (encode auth' `compareHash` auth)+ let (iv_e, encrypted) = S.splitAt 16 toBeAuthed+ iv <- either (const Nothing) Just $ decode iv_e+ let (x, _) = Modes.unCtr' Modes.incIV (aesKey key) iv encrypted+ return x++-- | Compare two bytestrings. Always takes the same ammount of+-- time, avoiding timing attacks.+compareHash :: S.ByteString -> S.ByteString -> Bool+compareHash s1 s2 =+ S.length s1 == S.length s2 &&+ foldl' (.|.) 0 (S.zipWith xor s1 s2) == 0++-- Significantly more efficien random IV generation. Initial benchmarks placed+-- it at 7.144764 us versus 1.686288 ms for Modes.getIVIO, since it does not+-- require /dev/urandom I/O for every call.++data AESState = ASt {-# UNPACK #-} !A.AES256+ {-# UNPACK #-} !(Modes.IV A.AES256)++aesSeed :: IO AESState+aesSeed = do+ Just key <- buildKey <$> getEntropy 32+ return $! ASt key Modes.zeroIV++aesRef :: I.IORef AESState+aesRef = unsafePerformIO $ aesSeed >>= I.newIORef++aesRNG :: IO IV+aesRNG = do+ ASt key count <-+ I.atomicModifyIORef aesRef $ \t@(ASt key' count') ->+ (ASt key' (Modes.incIV count'), t)+ when (count == threshold) $ void $ forkIO $ aesSeed >>= I.writeIORef aesRef+ let nextiv = encryptBlock key $ encode count+ either (error . show) return $ decode nextiv+ where+ void f = f >> return ()++threshold :: Modes.IV A.AES256+threshold = iterate Modes.incIV Modes.zeroIV !! 1000
tests/runtests.hs view
@@ -1,75 +1,91 @@-{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -import Test.HUnit -import Test.Hspec.Monadic -import Test.QuickCheck hiding (property) -import Test.Hspec.QuickCheck -import Test.Hspec.HUnit () -import Control.Monad (replicateM) - -import qualified Data.ByteString as S -import qualified Data.ByteString.Char8 as S8 - -import Web.ClientSession -import System.IO.Unsafe - -main :: IO () -main = hspecX $ describe "client session" $ do - it "encrypt/decrypt success" $ property propEncDec - it "encrypt/decrypt failure" $ property propEncDecFailure - it "AES encrypt/decrypt success" $ property propAES - it "AES encryption changes bs" $ property propAESChanges - it "specific values" caseSpecific - -propEncDec :: S.ByteString -> Bool -propEncDec bs = unsafePerformIO $ do - key <- getDefaultKey - s <- encryptIO key bs - let bs' = decrypt key s - return $ Just bs == bs' - -propEncDecFailure :: S.ByteString -> Bool -propEncDecFailure bs = unsafePerformIO $ do - key <- getDefaultKey - s <- encryptIO key bs - let bs' = decrypt key $ (S.head s + 1) `S.cons` S.drop 1 s - return $ Just bs /= bs' - -propAES :: MyKey -> MyIV -> S.ByteString -> Bool -propAES (MyKey key) (MyIV iv) bs = decrypt key (encrypt key iv bs) == Just bs - -propAESChanges :: MyKey -> MyIV -> S.ByteString -> Bool -propAESChanges (MyKey key) (MyIV iv) bs = encrypt key iv bs /= bs - -caseSpecific :: Assertion -caseSpecific = do - let s = S8.pack $ show [("lo\ENQ\143XAq","\DC2\207\226\DC1;.z56|\203\222"),("\USnu#\139\ETXB\201 ","l"),("\RS\b,zM2U\184\191F)\EOT\220S\NUL","O\\\GSd\247\246\n\EOT\SYN\182U2G"),("\219\NAK\217\CAN\252","ym\STX\188\232?\\\145"),("\239k","\vRZP\a\DC2F>"),("\FS\180P &\RS\174zSL\\?@","p\170\237vZ|\GS>\SYNk\176n\r"),("","\199D\DC3\200m)"),("6\152tVhB\246)9","\ENQdfU\SUB"),("I\ACK\181\NUL","\129\&6s\130q\US)oR1\197\FSp\US\SYN0"),("\183\200<\250","\211 \131g4\207N\155"),("\248O6k\CANK\135\234.","`\205!+&Z&9\DLE\244\214HP\SI\161"),("\"I'\ACK\149 \CAN\197","\141N\201\SO\204\\o.\128\148")] - key <- getDefaultKey - iv <- randomIV - Just s @=? decrypt key (encrypt key iv s) - let s' = S.concat $ replicate 500 s - Just s' @=? decrypt key (encrypt key iv s') - -instance Arbitrary S.ByteString where - arbitrary = S.pack `fmap` arbitrary - -newtype MyKey = MyKey Key - -instance Arbitrary MyKey where - arbitrary = do - ws <- replicateM 96 arbitrary - either error (return . MyKey) $ initKey $ S.pack ws - -instance Show MyKey where - show _ = "<Key>" - -newtype MyIV = MyIV IV - -instance Arbitrary MyIV where - arbitrary = do - ws <- replicateM 16 arbitrary - maybe (error "Invalid IV") (return . MyIV) $ mkIV $ S.pack ws - -instance Show MyIV where - show _ = "<Iv>" +{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+import Test.HUnit+import Test.Hspec.Monadic+import Test.QuickCheck hiding (property)+import Test.Hspec.QuickCheck+import Test.Hspec.HUnit ()+import Control.Monad (replicateM)++import qualified Data.ByteString as S+import qualified Data.ByteString.Char8 as S8++import Web.ClientSession+import System.IO.Unsafe++import qualified Data.Set as Set+import Control.Monad.Trans.State.Strict (evalStateT, get, put)+import Control.Monad.Trans.Class (lift)+import Control.Monad (replicateM_)++main :: IO ()+main = hspecX $ describe "client session" $ do+ it "encrypt/decrypt success" $ property propEncDec+ it "encrypt/decrypt failure" $ property propEncDecFailure+ it "AES encrypt/decrypt success" $ property propAES+ it "AES encryption changes bs" $ property propAESChanges+ it "specific values" caseSpecific+ it "randomIV is really random" caseRandomIV++propEncDec :: S.ByteString -> Bool+propEncDec bs = unsafePerformIO $ do+ key <- getDefaultKey+ s <- encryptIO key bs+ let bs' = decrypt key s+ return $ Just bs == bs'++propEncDecFailure :: S.ByteString -> Bool+propEncDecFailure bs = unsafePerformIO $ do+ key <- getDefaultKey+ s <- encryptIO key bs+ let bs' = decrypt key $ (S.head s + 1) `S.cons` S.drop 1 s+ return $ Just bs /= bs'++propAES :: MyKey -> MyIV -> S.ByteString -> Bool+propAES (MyKey key) (MyIV iv) bs = decrypt key (encrypt key iv bs) == Just bs++propAESChanges :: MyKey -> MyIV -> S.ByteString -> Bool+propAESChanges (MyKey key) (MyIV iv) bs = encrypt key iv bs /= bs++caseSpecific :: Assertion+caseSpecific = do+ let s = S8.pack $ show [("lo\ENQ\143XAq","\DC2\207\226\DC1;.z56|\203\222"),("\USnu#\139\ETXB\201 ","l"),("\RS\b,zM2U\184\191F)\EOT\220S\NUL","O\\\GSd\247\246\n\EOT\SYN\182U2G"),("\219\NAK\217\CAN\252","ym\STX\188\232?\\\145"),("\239k","\vRZP\a\DC2F>"),("\FS\180P &\RS\174zSL\\?@","p\170\237vZ|\GS>\SYNk\176n\r"),("","\199D\DC3\200m)"),("6\152tVhB\246)9","\ENQdfU\SUB"),("I\ACK\181\NUL","\129\&6s\130q\US)oR1\197\FSp\US\SYN0"),("\183\200<\250","\211 \131g4\207N\155"),("\248O6k\CANK\135\234.","`\205!+&Z&9\DLE\244\214HP\SI\161"),("\"I'\ACK\149 \CAN\197","\141N\201\SO\204\\o.\128\148")]+ key <- getDefaultKey+ iv <- randomIV+ Just s @=? decrypt key (encrypt key iv s)+ let s' = S.concat $ replicate 500 s+ Just s' @=? decrypt key (encrypt key iv s')++caseRandomIV :: Assertion+caseRandomIV = do+ evalStateT (replicateM_ 10000 go) Set.empty+ where+ go = do+ val <- lift randomIV+ set <- get+ lift $ assertBool "No duplicated keys" (not $ val `Set.member` set)+ put $ Set.insert val set++instance Arbitrary S.ByteString where+ arbitrary = S.pack `fmap` arbitrary++newtype MyKey = MyKey Key++instance Arbitrary MyKey where+ arbitrary = do+ ws <- replicateM 96 arbitrary+ either error (return . MyKey) $ initKey $ S.pack ws++instance Show MyKey where+ show _ = "<Key>"++newtype MyIV = MyIV IV++instance Arbitrary MyIV where+ arbitrary = do+ ws <- replicateM 16 arbitrary+ maybe (error "Invalid IV") (return . MyIV) $ mkIV $ S.pack ws++instance Show MyIV where+ show _ = "<Iv>"