diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -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. diff --git a/Setup.lhs b/Setup.lhs --- a/Setup.lhs +++ b/Setup.lhs @@ -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 diff --git a/bench.hs b/bench.hs --- a/bench.hs +++ b/bench.hs @@ -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]] + ] diff --git a/clientsession.cabal b/clientsession.cabal --- a/clientsession.cabal +++ b/clientsession.cabal @@ -1,52 +1,52 @@ -name: clientsession -version: 0.7.3.2 -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/snoyberg/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 && < 0.10 - , cereal >= 0.3 && < 0.4 - , directory >= 1 && < 1.2 - , crypto-api >= 0.6.4 && < 0.9 - , cryptocipher >= 0.2.5 && < 0.3 - , skein >= 0.1 && < 0.2 - , base64-bytestring >= 0.1.0.3 && < 0.2 - exposed-modules: Web.ClientSession - ghc-options: -Wall - hs-source-dirs: src - -test-suite runtests - type: exitcode-stdio-1.0 - build-depends: base >=4 && < 5 - , bytestring >= 0.9 && < 0.10 - , cryptocipher >= 0.2.5 && < 0.3 - , hspec == 0.6.* - , QuickCheck >= 2 && < 3 - , HUnit - -- 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/snoyberg/clientsession.git +name: clientsession +version: 0.7.3.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/snoyberg/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 && < 0.10 + , cereal >= 0.3 && < 0.4 + , directory >= 1 && < 1.2 + , crypto-api >= 0.6.4 && < 0.9 + , cryptocipher >= 0.2.5 + , skein >= 0.1 && < 0.2 + , base64-bytestring >= 0.1.0.3 && < 0.2 + exposed-modules: Web.ClientSession + ghc-options: -Wall + hs-source-dirs: src + +test-suite runtests + type: exitcode-stdio-1.0 + build-depends: base >=4 && < 5 + , bytestring >= 0.9 && < 0.10 + , cryptocipher >= 0.2.5 && < 0.3 + , hspec == 0.6.* + , QuickCheck >= 2 && < 3 + , HUnit + -- 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/snoyberg/clientsession.git diff --git a/src/Web/ClientSession.hs b/src/Web/ClientSession.hs --- a/src/Web/ClientSession.hs +++ b/src/Web/ClientSession.hs @@ -1,215 +1,215 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE ForeignFunctionInterface #-} -{-# LANGUAGE TemplateHaskell #-} ---------------------------------------------------------- --- --- | --- --- 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 - -- * Actual encryption/decryption - , encrypt - , encryptIO - , decrypt - ) where - --- from base -import Control.Monad (guard) -import Data.Bits ((.|.), xor) -import Data.List (foldl') - --- 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) - --- from crypto-api -import Crypto.Classes (buildKey) -import Crypto.Random (newGenIO, genBytes, SystemRandom) -import qualified Crypto.Modes as Modes - --- from cryptocipher -import qualified Crypto.Cipher.AES as A - --- from skein -import Crypto.Skein (skeinMAC', Skein_512_256) - --- | 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''). - } - --- | Dummy 'Show' instance. -instance Show Key where - show _ = "" - --- | 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 = Modes.getIVIO - --- | 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 the given number of random bytes. -randomBytes :: Int -> IO S.ByteString -randomBytes len = do - g <- newGenIO - either (error . show) (return . fst) $ genBytes len (g :: SystemRandom) - --- | 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 <- randomBytes 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 } - 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' `compareHash` 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 - --- | Compare two bytestrings. Always takes the same ammount of --- time, avoiding timing attacks. -compareHash :: S.ByteString -> S.ByteString -> Bool -compareHash s1 s2 = - S.length s1 == S.length s2 && - foldl' (.|.) 0 (S.zipWith xor s1 s2) == 0 +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE TemplateHaskell #-} +--------------------------------------------------------- +-- +-- | +-- +-- 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 + -- * Actual encryption/decryption + , encrypt + , encryptIO + , decrypt + ) where + +-- from base +import Control.Monad (guard) +import Data.Bits ((.|.), xor) +import Data.List (foldl') + +-- 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) + +-- from crypto-api +import Crypto.Classes (buildKey) +import Crypto.Random (newGenIO, genBytes, SystemRandom) +import qualified Crypto.Modes as Modes + +-- from cryptocipher +import qualified Crypto.Cipher.AES as A + +-- from skein +import Crypto.Skein (skeinMAC', Skein_512_256) + +-- | 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''). + } + +-- | Dummy 'Show' instance. +instance Show Key where + show _ = "" + +-- | 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 = Modes.getIVIO + +-- | 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 the given number of random bytes. +randomBytes :: Int -> IO S.ByteString +randomBytes len = do + g <- newGenIO + either (error . show) (return . fst) $ genBytes len (g :: SystemRandom) + +-- | 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 <- randomBytes 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 } + 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' `compareHash` 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 + +-- | Compare two bytestrings. Always takes the same ammount of +-- time, avoiding timing attacks. +compareHash :: S.ByteString -> S.ByteString -> Bool +compareHash s1 s2 = + S.length s1 == S.length s2 && + foldl' (.|.) 0 (S.zipWith xor s1 s2) == 0 diff --git a/tests/runtests.hs b/tests/runtests.hs --- a/tests/runtests.hs +++ b/tests/runtests.hs @@ -1,75 +1,75 @@ -{-# 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 Control.Monad (replicateM) - -import qualified Data.ByteString as S -import qualified Data.ByteString.Char8 as S8 - -import Web.ClientSession -import System.IO.Unsafe - -main :: IO () -main = hspecX $ 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 - -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 :: Assertion -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) - let s' = S.concat $ replicate 500 s - Just s' @=? decrypt key (encrypt key iv s') - -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 _ = "" - -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 _ = "" +{-# 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 Control.Monad (replicateM) + +import qualified Data.ByteString as S +import qualified Data.ByteString.Char8 as S8 + +import Web.ClientSession +import System.IO.Unsafe + +main :: IO () +main = hspecX $ 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 + +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 :: Assertion +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) + let s' = S.concat $ replicate 500 s + Just s' @=? decrypt key (encrypt key iv s') + +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 _ = "" + +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 _ = ""