clientsession 0.7.3.2 → 0.7.3.3
raw patch · 6 files changed
+393/−393 lines, 6 filesdep ~cryptociphersetup-changedPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: cryptocipher
API changes (from Hackage documentation)
Files
- LICENSE +25/−25
- Setup.lhs +7/−7
- bench.hs +19/−19
- clientsession.cabal +52/−52
- src/Web/ClientSession.hs +215/−215
- tests/runtests.hs +75/−75
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,52 +1,52 @@-name: clientsession-version: 0.7.3.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/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 <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/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
src/Web/ClientSession.hs view
@@ -1,215 +1,215 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ForeignFunctionInterface #-}-{-# LANGUAGE TemplateHaskell #-}---------------------------------------------------------------- |------ 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- -- * 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 _ = "<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 = 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 <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 + -- * 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 _ = "<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 = 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
tests/runtests.hs view
@@ -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 _ = "<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 +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 _ = "<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>"