clientsession 0.7.5 → 0.9.3.0
raw patch · 8 files changed
Files
- ChangeLog.md +13/−0
- LICENSE +17/−22
- README.md +6/−0
- bin/generate.hs +9/−0
- clientsession.cabal +32/−20
- src/System/LookupEnv.hs +6/−0
- src/Web/ClientSession.hs +162/−73
- tests/runtests.hs +23/−11
+ ChangeLog.md view
@@ -0,0 +1,13 @@+# ChangeLog for clientsession++## 0.9.3.0++* Migrate to crypton from cryptonite.++## 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
LICENSE view
@@ -1,25 +1,20 @@-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:+Copyright (c) 2008 Michael Snoyman, http://www.yesodweb.com/ -* Redistributions of source code must retain the above copyright notice, this- list of conditions and the following disclaimer.+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: -* 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.+The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software. -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 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.
+ README.md view
@@ -0,0 +1,6 @@+## 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.
+ bin/generate.hs view
@@ -0,0 +1,9 @@+module 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.cabal view
@@ -1,6 +1,6 @@ name: clientsession-version: 0.7.5-license: BSD3+version: 0.9.3.0+license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>, Felipe Lessa <felipe.lessa@gmail.com> maintainer: Michael Snoyman <michael@snoyman.com>@@ -10,42 +10,54 @@ encoding to avoid any issues with characters. category: Web stability: stable-cabal-version: >= 1.8+cabal-version: >= 1.10 build-type: Simple homepage: http://github.com/yesodweb/clientsession/tree/master-data-files: bench.hs-extra-source-files: tests/runtests.hs+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- build-depends: base >=4 && < 5- , bytestring >= 0.9 && < 0.10- , cereal >= 0.3 && < 0.4- , directory >= 1 && < 1.2+ default-language: Haskell2010+ build-depends: base >= 4.8 && < 5+ -- https://github.com/yesodweb/clientsession/commit/1221230770feff60f77ff676d52fc464cb77b2d9#r122087962+ -- Data.Bifunctor entered base in 4.8+ , bytestring >= 0.9+ , cereal >= 0.3+ , directory >= 1 , tagged >= 0.1- , crypto-api >= 0.8 && < 0.11- , cryptocipher >= 0.2.5- , skein >= 0.1 && < 0.2- , base64-bytestring >= 0.1.1.1 && < 0.2+ , crypto-api >= 0.8+ , skein == 1.0.*+ , base64-bytestring >= 0.1.1.1 , entropy >= 0.2.1- , cprng-aes >= 0.2+ , crypton >= 1.0+ , 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 >=4 && < 5- , bytestring >= 0.9 && < 0.10- , cryptocipher >= 0.2.5- , hspec >= 0.6 && < 0.10- , QuickCheck >= 2 && < 3+ build-depends: base+ , bytestring >= 0.9+ , hspec >= 1.3+ , QuickCheck >= 2 , HUnit , transformers , containers+ , cereal -- finally, our own package , clientsession ghc-options: -Wall@@ -54,4 +66,4 @@ source-repository head type: git- location: git://github.com/yesodweb/clientsession.git+ location: https://github.com/yesodweb/clientsession.git
+ src/System/LookupEnv.hs view
@@ -0,0 +1,6 @@+module System.LookupEnv (lookupEnv) where++import System.Environment (getEnvironment)++lookupEnv :: String -> IO (Maybe String)+lookupEnv envVar = fmap (lookup envVar) $ getEnvironment
src/Web/ClientSession.hs view
@@ -1,6 +1,9 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE PackageImports #-} --------------------------------------------------------- -- -- |@@ -38,14 +41,17 @@ --------------------------------------------------------- module Web.ClientSession ( -- * Automatic key generation- Key(..)+ Key , IV , randomIV , mkIV , getKey+ , getKeyEnv , defaultKeyFile , getDefaultKey , initKey+ , randomKey+ , randomKeyEnv -- * Actual encryption/decryption , encrypt , encryptIO@@ -53,32 +59,47 @@ ) where -- from base+import Control.Applicative ((<$>))+import Control.Concurrent (forkIO) import Control.Monad (guard, when)-import qualified Data.IORef as I+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 Control.Concurrent (forkIO)+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, decode)+import Data.Serialize (encode, 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+import Crypto.Classes (constTimeEq) --- from cryptocipher+-- from crypton import qualified Crypto.Cipher.AES as A+import Crypto.Cipher.Types(Cipher(..),BlockCipher(..),makeIV)+import Crypto.Error (eitherCryptoError)+import "crypton" Crypto.Random (ChaChaDRG,drgNew,randomBytesGenerate) -- from skein import Crypto.Skein (skeinMAC', Skein_512_256)@@ -86,43 +107,73 @@ -- 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).+-- 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+data Key = Key { aesKey ::+ !A.AES256 -- ^ AES key with 32 bytes.- , macKey :: S.ByteString -> Skein_512_256+ , 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+-- | The initialization vector used by AES. Must be exactly 16 -- bytes long.-type IV = Modes.IV A.AES256+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 = case (S.length bs, decode bs) of- (16, Right iv) -> Just iv- _ -> Nothing+mkIV bs | S.length bs == 16 = Just (unsafeMkIV bs)+ | otherwise = Nothing -- | Randomly construct a fresh initialization vector. You--- /should not/ reuse initialization vectors.+-- /MUST NOT/ reuse initialization vectors. randomIV :: IO IV-randomIV = aesRNG+randomIV = chaChaRNG -- | The default key file. defaultKeyFile :: FilePath@@ -149,6 +200,22 @@ 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.@@ -159,18 +226,42 @@ 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 = case buildKey preAesKey of- Nothing -> Left $ "Web.ClientSession.initKey: unknown error with buildKey."- Just k -> Right $ Key { aesKey = k- , macKey = skeinMAC' preMacKey }- where- (preMacKey, preAesKey) = S.splitAt 64 bs+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.@@ -187,12 +278,14 @@ -> 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+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@@ -207,59 +300,55 @@ 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+ 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 Modes.getIVIO,--- since it does not require /dev/urandom I/O for every call.+-- 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.+-- [now with crypton.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.-aesSeed :: IO AESState-aesSeed = do- rng <- makeSystem- return $! ASt rng 0+chaChaSeed :: IO ChaChaState+chaChaSeed = do+ drg <- drgNew+ return $! CCSt drg 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.+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.-aesRef :: I.IORef AESState-aesRef = unsafePerformIO $ aesSeed >>= I.newIORef-{-# NOINLINE aesRef #-}+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.-aesRNG :: IO IV-aesRNG = do+chaChaRNG :: IO IV+chaChaRNG = do (bs, count) <-- I.atomicModifyIORef aesRef $ \(ASt rng count) ->- let (bs', rng') = genRandomBytes rng 16- in (ASt rng' (succ count), (bs', count))- when (count == threshold) $ void $ forkIO aesReseed- either (error . show) return $ decode bs+ 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 ()
tests/runtests.hs view
@@ -1,11 +1,9 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# OPTIONS_GHC -fno-warn-orphans #-}-import Test.HUnit-import Test.Hspec.Monadic-import Test.QuickCheck hiding (property)-import Test.Hspec.QuickCheck-import Test.Hspec.HUnit ()+import Test.HUnit (assertBool)+import Test.Hspec+import Test.QuickCheck import Control.Monad (replicateM) import qualified Data.ByteString as S@@ -19,14 +17,18 @@ import Control.Monad.Trans.Class (lift) import Control.Monad (replicateM_) +import Data.Serialize (encode, decode)+ main :: IO ()-main = hspecX $ describe "client session" $ do+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@@ -35,6 +37,13 @@ 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@@ -48,16 +57,16 @@ propAESChanges :: MyKey -> MyIV -> S.ByteString -> Bool propAESChanges (MyKey key) (MyIV iv) bs = encrypt key iv bs /= bs -caseSpecific :: Assertion+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- Just s @=? decrypt key (encrypt key iv s)+ decrypt key (encrypt key iv s) `shouldBe` Just s let s' = S.concat $ replicate 500 s- Just s' @=? decrypt key (encrypt key iv s')+ decrypt key (encrypt key iv s') `shouldBe` Just s' -caseRandomIV :: Assertion+caseRandomIV :: Expectation caseRandomIV = do evalStateT (replicateM_ 10000 go) Set.empty where@@ -67,6 +76,9 @@ 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 @@ -78,7 +90,7 @@ either error (return . MyKey) $ initKey $ S.pack ws instance Show MyKey where- show _ = "<Key>"+ show (MyKey key) = "MyKey:" ++ show (encode key) newtype MyIV = MyIV IV