clientsession-0.9.0.3/0000755000000000000000000000000012210604073012724 5ustar0000000000000000clientsession-0.9.0.3/LICENSE0000644000000000000000000000253012210604073013731 0ustar0000000000000000The 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. clientsession-0.9.0.3/bench.hs0000644000000000000000000000075312210604073014344 0ustar0000000000000000import 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-0.9.0.3/Setup.lhs0000644000000000000000000000016212210604073014533 0ustar0000000000000000#!/usr/bin/env runhaskell > module Main where > import Distribution.Simple > main :: IO () > main = defaultMain clientsession-0.9.0.3/clientsession.cabal0000644000000000000000000000410112210604073016566 0ustar0000000000000000name: clientsession version: 0.9.0.3 license: BSD3 license-file: LICENSE author: Michael Snoyman , Felipe Lessa maintainer: Michael Snoyman 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 == 1.0.* , base64-bytestring >= 0.1.1.1 , entropy >= 0.2.1 , cprng-aes >= 0.2 , cipher-aes >= 0.1.7 , crypto-random 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 clientsession-0.9.0.3/tests/0000755000000000000000000000000012210604073014066 5ustar0000000000000000clientsession-0.9.0.3/tests/runtests.hs0000644000000000000000000000653012210604073016315 0ustar0000000000000000{-# 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 _ = "" clientsession-0.9.0.3/src/0000755000000000000000000000000012210604073013513 5ustar0000000000000000clientsession-0.9.0.3/src/Web/0000755000000000000000000000000012210604073014230 5ustar0000000000000000clientsession-0.9.0.3/src/Web/ClientSession.hs0000644000000000000000000002410612210604073017351 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE CPP #-} {-# LANGUAGE PackageImports #-} --------------------------------------------------------- -- -- | -- -- Module : Web.ClientSession -- Copyright : Michael Snoyman -- License : BSD3 -- -- Maintainer : Michael Snoyman -- 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-api" 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 #if MIN_VERSION_cprng_aes(0,5,0) import Crypto.Random.AESCtr (AESRNG, makeSystem) import "crypto-random" Crypto.Random (cprgGenerate) #else import Crypto.Random.AESCtr (AESRNG, makeSystem, genRandomBytes) #endif -- | 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 :: #if MIN_VERSION_cipher_aes(0, 2, 0) !A.AES #else !A.Key #endif -- ^ 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 _ = "" -- | The initialization vector used by AES. Should be exactly 16 -- bytes long. newtype IV = IV S.ByteString unsafeMkIV :: S.ByteString -> IV unsafeMkIV bs = (IV bs) unIV :: IV -> S.ByteString unIV (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 iv) x = B.encode final where #if MIN_VERSION_cipher_aes(0, 2, 0) encrypted = A.encryptCTR (aesKey key) iv x #else encrypted = A.encryptCTR (aesKey key) (A.IV iv) x #endif 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 #if MIN_VERSION_cipher_aes(0, 2, 0) let iv' = iv #else let iv' = A.IV iv #endif return $! A.decryptCTR (aesKey key) 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 rng' <- makeSystem I.writeIORef aesRef $ ASt rng' 0 -- | '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, 5, 0) let (bs', rng') = cprgGenerate 16 rng #elif 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