1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
|
{-# 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 _ = "<Iv>"
|
