clientsession 0.8.0.2 → 0.8.0.3
raw patch · 6 files changed
+510/−493 lines, 6 filesdep +cipher-aesdep −cryptocipherdep ~cprng-aessetup-changedPVP: minor bump suggested
API additions: PVP suggests at least a minor version bump
Dependencies added: cipher-aes
Dependencies removed: cryptocipher
Dependency ranges changed: cprng-aes
API changes (from Hackage documentation)
+ Web.ClientSession: instance BlockCipher AES256
+ Web.ClientSession: instance Serialize AES256
Files
- LICENSE +25/−25
- Setup.lhs +7/−7
- bench.hs +19/−19
- clientsession.cabal +57/−58
- src/Web/ClientSession.hs +307/−289
- 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,58 +1,57 @@-name: clientsession-version: 0.8.0.2-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- , cryptocipher >= 0.2.5- , skein >= 0.1 && < 0.2- , base64-bytestring >= 0.1.1.1- , entropy >= 0.2.1- , cprng-aes >= 0.2- 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- , cryptocipher >= 0.2.5- , 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.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
src/Web/ClientSession.hs view
@@ -1,289 +1,307 @@-{-# 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 cryptocipher-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.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 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 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.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
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>"