clientsession 0.8.0.3 → 0.8.1
raw patch · 6 files changed
+514/−510 lines, 6 filesdep ~cprng-aesdep ~crypto-apisetup-changedPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependency ranges changed: cprng-aes, crypto-api
API changes (from Hackage documentation)
- Web.ClientSession: instance BlockCipher AES256
- Web.ClientSession: instance Serialize AES256
- Web.ClientSession: type IV = IV AES256
+ Web.ClientSession: data IV
+ Web.ClientSession: instance Eq IV
+ Web.ClientSession: instance Ord IV
+ Web.ClientSession: instance Serialize IV
+ Web.ClientSession: instance Show IV
Files
- LICENSE +25/−25
- Setup.lhs +7/−7
- bench.hs +19/−19
- clientsession.cabal +57/−57
- src/Web/ClientSession.hs +311/−307
- tests/runtests.hs +95/−95
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,57 +1,57 @@-name: clientsession -version: 0.8.0.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/yesodweb/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 - , cereal >= 0.3 - , directory >= 1 - , tagged >= 0.1 - , crypto-api >= 0.8 - , skein >= 0.1 && < 0.2 - , base64-bytestring >= 0.1.1.1 - , entropy >= 0.2.1 - , cprng-aes >= 0.2 - , cipher-aes >= 0.1.7 - exposed-modules: Web.ClientSession - ghc-options: -Wall - hs-source-dirs: src - -test-suite runtests - type: exitcode-stdio-1.0 - build-depends: base - , bytestring >= 0.9 - , hspec >= 1.3 - , QuickCheck >= 2 - , HUnit - , transformers - , containers - , cereal - -- 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/yesodweb/clientsession.git +name: clientsession+version: 0.8.1+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/yesodweb/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+ , cereal >= 0.3+ , directory >= 1+ , tagged >= 0.1+ , crypto-api >= 0.8+ , skein >= 0.1 && < 0.2+ , base64-bytestring >= 0.1.1.1+ , entropy >= 0.2.1+ , cprng-aes >= 0.2+ , cipher-aes >= 0.1.7+ exposed-modules: Web.ClientSession+ ghc-options: -Wall+ hs-source-dirs: src++test-suite runtests+ type: exitcode-stdio-1.0+ build-depends: base+ , bytestring >= 0.9+ , hspec >= 1.3+ , QuickCheck >= 2+ , HUnit+ , transformers+ , containers+ , cereal+ -- 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/yesodweb/clientsession.git
src/Web/ClientSession.hs view
@@ -1,307 +1,311 @@-{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE ForeignFunctionInterface #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE CPP #-} ---------------------------------------------------------- --- --- | --- --- 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 - , randomKey - -- * Actual encryption/decryption - , encrypt - , encryptIO - , decrypt - ) where - --- from base -import Control.Monad (guard, when) -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, Serialize (put, get), getBytes, putByteString) - --- from tagged -import Data.Tagged (Tagged, untag) - --- from crypto-api -import Crypto.Classes (buildKey, constTimeEq) -import Crypto.Random (genSeedLength, reseed) -import Crypto.Types (ByteLength) -import qualified Crypto.Modes as Modes - --- from cipher-aes -import qualified Crypto.Cipher.AES as A - --- from skein -import Crypto.Skein (skeinMAC', Skein_512_256) - --- from entropy -import System.Entropy (getEntropy) - --- from cprng-aes -import Crypto.Random.AESCtr (AESRNG, makeSystem, genRandomBytes) - -import Crypto.Classes (BlockCipher(..)) -import Data.Tagged (Tagged(..)) - -newtype AES256 = A256 { unA256 :: A.Key } - -instance BlockCipher AES256 where - blockSize = Tagged 128 - encryptBlock = A.encryptECB . unA256 - decryptBlock = A.decryptECB . unA256 - buildKey = Just . A256 . A.initKey - keyLength = Tagged 256 - -instance Serialize AES256 where - put = putByteString . A.keyOfCtx . unA256 - get = do - raw <- getBytes (256 `div` 8) - return $ A256 $ A.initKey raw - --- | 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 :: 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''). - , keyRaw :: S.ByteString - } - -instance Eq Key where - Key a _ b == Key x _ y = encode a == encode x && b == y - -instance Serialize Key where - put = putByteString . keyRaw - get = either error id . initKey <$> getBytes 96 - --- | 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 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 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 <- getEntropy 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 - , keyRaw = bs - } - 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' `constTimeEq` 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 - --- Significantly more efficient random IV generation. Initial --- benchmarks placed it at 6.06 us versus 1.69 ms for Modes.getIVIO, --- since it does not require /dev/urandom I/O for every call. - -data AESState = - ASt {-# UNPACK #-} !AESRNG -- Our CPRNG using AES on CTR mode - {-# UNPACK #-} !Int -- How many IVs were generated with this - -- AESRNG. Used to control reseeding. - --- | Construct initial state of the CPRNG. -aesSeed :: IO AESState -aesSeed = do - rng <- makeSystem - return $! ASt rng 0 - --- | Reseed the CPRNG with new entropy from the system pool. -aesReseed :: IO () -aesReseed = do - let len :: Tagged AESRNG ByteLength - len = genSeedLength - ent <- getEntropy (untag len) - I.atomicModifyIORef aesRef $ - \(ASt rng _) -> - case reseed ent rng of - Right rng' -> (ASt rng' 0, ()) - Left _ -> (ASt rng 0, ()) - -- Use the old RNG, but force a reseed - -- after another 'threshold' uses of it. - -- In theory, we will never reach this - -- branch, but if we do, we're safe. - --- | 'IORef' that keeps the current state of the CPRNG. Yep, --- global state. Used in thread-safe was only, though. -aesRef :: I.IORef AESState -aesRef = unsafePerformIO $ aesSeed >>= I.newIORef -{-# NOINLINE aesRef #-} - --- | Construct a new 16-byte IV using our CPRNG. Forks another --- thread to reseed the CPRNG should its usage count reach a --- hardcoded threshold. -aesRNG :: IO IV -aesRNG = do - (bs, count) <- - I.atomicModifyIORef aesRef $ \(ASt rng count) -> -#if MIN_VERSION_cprng_aes(0, 3, 2) - let (bs', rng') = genRandomBytes 16 rng -#else - let (bs', rng') = genRandomBytes rng 16 -#endif - in (ASt rng' (succ count), (bs', count)) - when (count == threshold) $ void $ forkIO aesReseed - either (error . show) return $ decode bs - where - void f = f >> return () - --- | How many IVs should be generated before reseeding the CPRNG. --- This number depends basically on how paranoid you are. We --- think 100.000 is a good compromise: larger numbers give only a --- small performance advantage, while it still is a small number --- since we only generate 1.5 MiB of random data between reseeds. -threshold :: Int -threshold = 100000 +{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE CPP #-}+---------------------------------------------------------+--+-- |+--+-- 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+ , randomKey+ -- * Actual encryption/decryption+ , encrypt+ , encryptIO+ , decrypt+ ) where++-- from base+import Control.Applicative ((<$>))+import Control.Concurrent (forkIO)+import Control.Monad (guard, when)+import Data.Function (on)+import System.IO.Unsafe (unsafePerformIO)+import qualified Data.IORef as I++-- 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, Serialize (put, get), getBytes, putByteString)++-- from tagged+import Data.Tagged (Tagged, untag)++-- from crypto-api+import Crypto.Classes (constTimeEq)+import Crypto.Random (genSeedLength, reseed)+import Crypto.Types (ByteLength)++-- from cipher-aes+import qualified Crypto.Cipher.AES as A++-- from skein+import Crypto.Skein (skeinMAC', Skein_512_256)++-- from entropy+import System.Entropy (getEntropy)++-- from cprng-aes+import Crypto.Random.AESCtr (AESRNG, makeSystem, genRandomBytes)+++-- | 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.Key+ -- ^ 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'').+ , keyRaw :: !S.ByteString+ }++instance Eq Key where+ Key _ _ r1 == Key _ _ r2 = r1 == r2++instance Serialize Key where+ put = putByteString . keyRaw+ get = either error id . initKey <$> getBytes 96++-- | Dummy 'Show' instance.+instance Show Key where+ show _ = "<Web.ClientSession.Key>"++-- | The initialization vector used by AES. Should be exactly 16+-- bytes long.+newtype IV = IV A.IV++unsafeMkIV :: S.ByteString -> IV+unsafeMkIV bs = (IV (A.IV bs))++unIV :: IV -> S.ByteString+unIV (IV (A.IV bs)) = bs++instance Eq IV where+ (==) = (==) `on` unIV+ (/=) = (/=) `on` unIV++instance Ord IV where+ compare = compare `on` unIV+ (<=) = (<=) `on` unIV+ (<) = (<) `on` unIV+ (>=) = (>=) `on` unIV+ (>) = (>) `on` unIV++instance Show IV where+ show = show . unIV++instance Serialize IV where+ put = put . unIV+ get = unsafeMkIV <$> get++-- | Construct an initialization vector from a 'S.ByteString'.+-- Fails if there isn't exactly 16 bytes.+mkIV :: S.ByteString -> Maybe IV+mkIV bs | S.length bs == 16 = Just (unsafeMkIV bs)+ | otherwise = 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 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 <- getEntropy 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 = Right $ Key { aesKey = A.initKey preAesKey+ , macKey = skeinMAC' preMacKey+ , keyRaw = bs+ }+ 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 (A.IV iv)) x = B.encode final+ where+ encrypted = A.encryptCTR (aesKey key) (A.IV iv) x+ toBeAuthed = 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' `constTimeEq` auth)+ let (iv, encrypted) = S.splitAt 16 toBeAuthed+ return $! A.decryptCTR (aesKey key) (A.IV iv) encrypted+++-- Significantly more efficient random IV generation. Initial+-- benchmarks placed it at 6.06 us versus 1.69 ms for+-- Crypto.Modes.getIVIO, since it does not require /dev/urandom+-- I/O for every call.++data AESState =+ ASt {-# UNPACK #-} !AESRNG -- Our CPRNG using AES on CTR mode+ {-# UNPACK #-} !Int -- How many IVs were generated with this+ -- AESRNG. Used to control reseeding.++-- | Construct initial state of the CPRNG.+aesSeed :: IO AESState+aesSeed = do+ rng <- makeSystem+ return $! ASt rng 0++-- | Reseed the CPRNG with new entropy from the system pool.+aesReseed :: IO ()+aesReseed = do+ let len :: Tagged AESRNG ByteLength+ len = genSeedLength+ ent <- getEntropy (untag len)+ I.atomicModifyIORef aesRef $+ \(ASt rng _) ->+ case reseed ent rng of+ Right rng' -> (ASt rng' 0, ())+ Left _ -> (ASt rng 0, ())+ -- Use the old RNG, but force a reseed+ -- after another 'threshold' uses of it.+ -- In theory, we will never reach this+ -- branch, but if we do, we're safe.++-- | 'IORef' that keeps the current state of the CPRNG. Yep,+-- global state. Used in thread-safe was only, though.+aesRef :: I.IORef AESState+aesRef = unsafePerformIO $ aesSeed >>= I.newIORef+{-# NOINLINE aesRef #-}++-- | Construct a new 16-byte IV using our CPRNG. Forks another+-- thread to reseed the CPRNG should its usage count reach a+-- hardcoded threshold.+aesRNG :: IO IV+aesRNG = do+ (bs, count) <-+ I.atomicModifyIORef aesRef $ \(ASt rng count) ->+#if MIN_VERSION_cprng_aes(0, 3, 2)+ let (bs', rng') = genRandomBytes 16 rng+#else+ let (bs', rng') = genRandomBytes rng 16+#endif+ in (ASt rng' (succ count), (bs', count))+ when (count == threshold) $ void $ forkIO aesReseed+ return $! unsafeMkIV bs+ where+ void f = f >> return ()++-- | How many IVs should be generated before reseeding the CPRNG.+-- This number depends basically on how paranoid you are. We+-- think 100.000 is a good compromise: larger numbers give only a+-- small performance advantage, while it still is a small number+-- since we only generate 1.5 MiB of random data between reseeds.+threshold :: Int+threshold = 100000
tests/runtests.hs view
@@ -1,95 +1,95 @@-{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -import Test.HUnit (assertBool) -import Test.Hspec -import Test.QuickCheck -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_) - -import Data.Serialize (encode, decode) - -main :: IO () -main = hspec $ 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 - it "serialize instance" $ property propSerialize - -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 :: Expectation -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 - decrypt key (encrypt key iv s) `shouldBe` Just s - let s' = S.concat $ replicate 500 s - decrypt key (encrypt key iv s') `shouldBe` Just s' - -caseRandomIV :: Expectation -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 - -propSerialize :: MyKey -> Bool -propSerialize (MyKey key) = Right key == decode (encode key) - -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 (MyKey key) = "MyKey:" ++ show (encode 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 (assertBool)+import Test.Hspec+import Test.QuickCheck+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_)++import Data.Serialize (encode, decode)++main :: IO ()+main = hspec $ 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+ it "serialize instance" $ property propSerialize++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 :: Expectation+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+ decrypt key (encrypt key iv s) `shouldBe` Just s+ let s' = S.concat $ replicate 500 s+ decrypt key (encrypt key iv s') `shouldBe` Just s'++caseRandomIV :: Expectation+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++propSerialize :: MyKey -> Bool+propSerialize (MyKey key) = Right key == decode (encode key)++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 (MyKey key) = "MyKey:" ++ show (encode 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>"