clientsession-0.9.2.0/bin/0000755000000000000000000000000014455524002013501 5ustar0000000000000000clientsession-0.9.2.0/src/0000755000000000000000000000000014455524002013520 5ustar0000000000000000clientsession-0.9.2.0/src/System/0000755000000000000000000000000014455524002015004 5ustar0000000000000000clientsession-0.9.2.0/src/Web/0000755000000000000000000000000014455524002014235 5ustar0000000000000000clientsession-0.9.2.0/tests/0000755000000000000000000000000014455524002014073 5ustar0000000000000000clientsession-0.9.2.0/src/Web/ClientSession.hs0000644000000000000000000002730414455524002017361 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE NamedFieldPuns #-} {-# 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 , getKeyEnv , defaultKeyFile , getDefaultKey , initKey , randomKey , randomKeyEnv -- * Actual encryption/decryption , encrypt , encryptIO , decrypt ) where -- from base import Control.Applicative ((<$>)) import Control.Concurrent (forkIO) import Control.Monad (guard, when) import Data.Bifunctor (first) import Data.Function (on) #if MIN_VERSION_base(4,7,0) import System.Environment (lookupEnv, setEnv) #elif MIN_VERSION_base(4,6,0) import System.Environment (lookupEnv) import System.SetEnv (setEnv) #else import System.LookupEnv (lookupEnv) import System.SetEnv (setEnv) #endif 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.Char8 as C 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) -- from cryptonite import qualified Crypto.Cipher.AES as A import Crypto.Cipher.Types(Cipher(..),BlockCipher(..),makeIV) import Crypto.Error (eitherCryptoError) import "cryptonite" Crypto.Random (ChaChaDRG,drgNew,randomBytesGenerate) -- 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 must -- have exactly 32 bytes (256 bits) while Skein-MAC-512-256 must -- 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 _ _ 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. Must 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 -- /MUST NOT/ reuse initialization vectors. randomIV :: IO IV randomIV = chaChaRNG -- | 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' -- | Get the key from the named environment variable -- -- Assumes the value is a Base64-encoded string. If the variable is not set, a -- random key will be generated, set in the environment, and the Base64-encoded -- version printed on @/dev/stdout@. getKeyEnv :: String -- ^ Name of the environment variable -> IO Key -- ^ The actual key. getKeyEnv envVar = do mvalue <- lookupEnv envVar case mvalue of Just value -> either (const newKey) return $ initKey =<< decode value Nothing -> newKey where decode = B.decode . C.pack newKey = randomKeyEnv envVar -- | 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) -- | Generate a random 'Key', set a Base64-encoded version of it in the given -- environment variable, then return it. Also prints the generated string to -- @/dev/stdout@. randomKeyEnv :: String -> IO Key randomKeyEnv envVar = do (bs, key) <- randomKey let encoded = C.unpack $ B.encode bs setEnv envVar encoded putStrLn $ envVar ++ "=" ++ encoded return 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). -- -- Note that the input string is assumed to be uniformly chosen -- from the set of all 96-byte strings. In other words, each -- byte should be chosen from the set of all byte values (0-255) -- with the same probability. -- -- In particular, this function does not do any kind of key -- stretching. You should never feed it a password, for example. -- -- It's /highly/ recommended to feed @initKey@ only with values -- generated by 'randomKey', unless you really know what you're -- doing. 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 = do let (preMacKey, preAesKey) = S.splitAt 64 bs aesKey <- first show $ eitherCryptoError (cipherInit preAesKey) Right $ Key { aesKey , macKey = skeinMAC' preMacKey , keyRaw = 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 b) x = case makeIV b of Nothing -> error "Web.ClientSession.encrypt: Failed to makeIV" Just iv -> B.encode final where encrypted = ctrCombine (aesKey key) iv x toBeAuthed = b `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 iv' <- makeIV iv return $! ctrCombine (aesKey key) iv' encrypted -- [from when the code used cprng-aes.AESRNG] -- 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. -- [now with cryptonite.ChaChaDRG] -- I haven't run any benchmark; this conversion is a case of “code -- that doesn't crash trumps performance.” data ChaChaState = CCSt {-# UNPACK #-} !ChaChaDRG -- Our CPRNG using ChaCha {-# UNPACK #-} !Int -- How many IVs were generated with this -- CPRNG. Used to control reseeding. -- | Construct initial state of the CPRNG. chaChaSeed :: IO ChaChaState chaChaSeed = do drg <- drgNew return $! CCSt drg 0 -- | Reseed the CPRNG with new entropy from the system pool. chaChaReseed :: IO () chaChaReseed = do drg' <- drgNew I.writeIORef chaChaRef $ CCSt drg' 0 -- | 'IORef' that keeps the current state of the CPRNG. Yep, -- global state. Used in thread-safe was only, though. chaChaRef :: I.IORef ChaChaState chaChaRef = unsafePerformIO $ chaChaSeed >>= I.newIORef {-# NOINLINE chaChaRef #-} -- | Construct a new 16-byte IV using our CPRNG. Forks another -- thread to reseed the CPRNG should its usage count reach a -- hardcoded threshold. chaChaRNG :: IO IV chaChaRNG = do (bs, count) <- I.atomicModifyIORef chaChaRef $ \(CCSt drg count) -> let (bs', drg') = randomBytesGenerate 16 drg in (CCSt drg' (succ count), (bs', count)) when (count == threshold) $ void $ forkIO chaChaReseed 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 clientsession-0.9.2.0/src/System/LookupEnv.hs0000644000000000000000000000027114455524002017262 0ustar0000000000000000module System.LookupEnv (lookupEnv) where import System.Environment (getEnvironment) lookupEnv :: String -> IO (Maybe String) lookupEnv envVar = fmap (lookup envVar) $ getEnvironment clientsession-0.9.2.0/bin/generate.hs0000644000000000000000000000040414455524002015625 0ustar0000000000000000module Main where import Data.Maybe (fromMaybe, listToMaybe) import Control.Monad (void) import System.Environment (getArgs) import Web.ClientSession (randomKeyEnv) main :: IO () main = void $ randomKeyEnv . fromMaybe "SESSION_KEY" . listToMaybe =<< getArgs clientsession-0.9.2.0/tests/runtests.hs0000644000000000000000000000715014455524002016321 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 success (environment key)" $ property propEncDecEnv 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' propEncDecEnv :: S.ByteString -> Bool propEncDecEnv bs = unsafePerformIO $ do key <- getKeyEnv "SESSION_KEY" 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.2.0/bench.hs0000644000000000000000000000075314455524002014351 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.2.0/ChangeLog.md0000644000000000000000000000031214455524223015103 0ustar0000000000000000# ChangeLog for clientsession ## 0.9.2.0 * Migrate crypto-aes and cprng-aes to cryptonite. [#36](https://github.com/yesodweb/clientsession/pull/36) ## 0.9.1.2 * Clarify that we're using MIT license clientsession-0.9.2.0/README.md0000644000000000000000000000032614455524002014211 0ustar0000000000000000## clientsession Securely store session data in a client-side cookie. Achieves security through AES-CTR encryption and Skein-MAC-512-256 authentication. Uses Base64 encoding to avoid any issues with characters. clientsession-0.9.2.0/LICENSE0000644000000000000000000000207514455524002013742 0ustar0000000000000000Copyright (c) 2008 Michael Snoyman, http://www.yesodweb.com/ Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. clientsession-0.9.2.0/Setup.lhs0000755000000000000000000000016214455524002014543 0ustar0000000000000000#!/usr/bin/env runhaskell > module Main where > import Distribution.Simple > main :: IO () > main = defaultMain clientsession-0.9.2.0/clientsession.cabal0000644000000000000000000000450714455524323016613 0ustar0000000000000000name: clientsession version: 0.9.2.0 license: MIT 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.10 build-type: Simple homepage: http://github.com/yesodweb/clientsession/tree/master extra-source-files: tests/runtests.hs bench.hs ChangeLog.md README.md flag test description: Build the executable to run unit tests default: False executable clientsession-generate default-language: Haskell2010 main-is: generate.hs build-depends: base , clientsession ghc-options: -Wall hs-source-dirs: bin library default-language: Haskell2010 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 , cryptonite >= 0.15 , setenv exposed-modules: Web.ClientSession other-modules: System.LookupEnv ghc-options: -Wall hs-source-dirs: src test-suite runtests default-language: Haskell2010 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