~ubuntu-branches/ubuntu/raring/haskell-clientsession/raring-proposed
» Revision
6
: src/Web/ClientSession.hs
« back to all changes in this revision
Viewing changes to src/Web/ClientSession.hs
- browse files at revision 6
- compare with another revision
- download diff
- download tarball
- view history from revision 6
- Committer: Package Import Robot
- Author(s): Iain Lane, Joachim Breitner, Iain Lane
- Date: 2011-10-05 13:57:33 UTC
- mfrom: (2.1.5 sid)
- Revision ID: package-import@ubuntu.com-20111005135733-yw72ctv12x5acyb1
[ Joachim Breitner ]
* New upstream release
[ Iain Lane ]
* Update BDs in line with cabal file
* New upstream release
[ Iain Lane ]
* Update BDs in line with cabal file
- files added:
- bench.hs
- src
- src/Web
- tests
- files removed:
- Web
- c
- files modified:
- clientsession.cabal
added
removed
src/Web/ClientSession.hs
1
{-# LANGUAGE FlexibleContexts #-}
2
{-# LANGUAGE ForeignFunctionInterface #-}
3
{-# LANGUAGE TemplateHaskell #-}
4
---------------------------------------------------------
5
--
6
-- |
7
--
8
-- Module : Web.ClientSession
9
-- Copyright : Michael Snoyman
10
-- License : BSD3
11
--
12
-- Maintainer : Michael Snoyman <michael@snoyman.com>
13
-- Stability : Stable
14
-- Portability : portable
15
--
16
-- Stores session data in a client cookie. In order to do so,
17
-- we:
18
--
19
-- * Encrypt the cookie data using AES in CTR mode. This allows
20
-- you to store sensitive information on the client side without
21
-- worrying about eavesdropping.
22
--
23
-- * Authenticate the encrypted cookie data using
24
-- Skein-MAC-512-256. Besides detecting potential errors in
25
-- storage or transmission of the cookies (integrity), the MAC
26
-- also avoids malicious modifications of the cookie data by
27
-- assuring you that the cookie data really was generated by this
28
-- server (authenticity).
29
--
30
-- * Encode everything using Base64. Thus we avoid problems with
31
-- non-printable characters by giving the browser a simple
32
-- string.
33
--
34
-- Simple usage of the library involves just calling
35
-- 'getDefaultKey' on the startup of your server, 'encryptIO'
36
-- when serializing cookies and 'decrypt' when parsing then back.
37
--
38
---------------------------------------------------------
39
module Web.ClientSession
40
( -- * Automatic key generation
41
Key(..)
42
, IV
43
, randomIV
44
, mkIV
45
, getKey
46
, defaultKeyFile
47
, getDefaultKey
48
, initKey
49
-- * Actual encryption/decryption
50
, encrypt
51
, encryptIO
52
, decrypt
53
) where
54
55
-- from base
56
import Control.Monad (guard)
57
import Data.Bits ((.|.), xor)
58
import Data.List (foldl')
59
60
-- from directory
61
import System.Directory (doesFileExist)
62
63
-- from bytestring
64
import qualified Data.ByteString as S
65
import qualified Data.ByteString.Base64 as B
66
67
-- from cereal
68
import Data.Serialize (encode, decode)
69
70
-- from crypto-api
71
import Crypto.Classes (buildKey)
72
import Crypto.Random (newGenIO, genBytes, SystemRandom)
73
import qualified Crypto.Modes as Modes
74
75
-- from cryptocipher
76
import qualified Crypto.Cipher.AES as A
77
78
-- from skein
79
import Crypto.Skein (skeinMAC', Skein_512_256)
80
81
-- | The keys used to store the cookies. We have an AES key used
82
-- to encrypt the cookie and a Skein-MAC-512-256 key used verify
83
-- the authencity and integrity of the cookie. The AES key needs
84
-- to have exactly 32 bytes (256 bits) while Skein-MAC-512-256
85
-- should have 64 bytes (512 bits).
86
--
87
-- See also 'getDefaultKey' and 'initKey'.
88
data Key = Key { aesKey :: A.AES256
89
-- ^ AES key with 32 bytes.
90
, macKey :: S.ByteString -> Skein_512_256
91
-- ^ Skein-MAC key. Instead of storing the key
92
-- data, we store a partially applied function
93
-- for calculating the MAC (see 'skeinMAC'').
94
}
95
96
-- | Dummy 'Show' instance.
97
instance Show Key where
98
show _ = "<Web.ClientSession.Key>"
99
100
-- | The initialization vector used by AES. Should be exactly 16
101
-- bytes long.
102
type IV = Modes.IV A.AES256
103
104
-- | Construct an initialization vector from a 'S.ByteString'.
105
-- Fails if there isn't exactly 16 bytes.
106
mkIV :: S.ByteString -> Maybe IV
107
mkIV bs = case (S.length bs, decode bs) of
108
(16, Right iv) -> Just iv
109
_ -> Nothing
110
111
-- | Randomly construct a fresh initialization vector. You
112
-- /should not/ reuse initialization vectors.
113
randomIV :: IO IV
114
randomIV = Modes.getIVIO
115
116
-- | The default key file.
117
defaultKeyFile :: FilePath
118
defaultKeyFile = "client_session_key.aes"
119
120
-- | Simply calls 'getKey' 'defaultKeyFile'.
121
getDefaultKey :: IO Key
122
getDefaultKey = getKey defaultKeyFile
123
124
-- | Get a key from the given text file.
125
--
126
-- If the file does not exist or is corrupted a random key will
127
-- be generated and stored in that file.
128
getKey :: FilePath -- ^ File name where key is stored.
129
-> IO Key -- ^ The actual key.
130
getKey keyFile = do
131
exists <- doesFileExist keyFile
132
if exists
133
then S.readFile keyFile >>= either (const newKey) return . initKey
134
else newKey
135
where
136
newKey = do
137
(bs, key') <- randomKey
138
S.writeFile keyFile bs
139
return key'
140
141
-- | Generate the given number of random bytes.
142
randomBytes :: Int -> IO S.ByteString
143
randomBytes len = do
144
g <- newGenIO
145
either (error . show) (return . fst) $ genBytes len (g :: SystemRandom)
146
147
-- | Generate a random 'Key'. Besides the 'Key', the
148
-- 'ByteString' passed to 'initKey' is returned so that it can be
149
-- saved for later use.
150
randomKey :: IO (S.ByteString, Key)
151
randomKey = do
152
bs <- randomBytes 96
153
case initKey bs of
154
Left e -> error $ "Web.ClientSession.randomKey: never here, " ++ e
155
Right key -> return (bs, key)
156
157
-- | Initializes a 'Key' from a random 'S.ByteString'. Fails if
158
-- there isn't exactly 96 bytes (256 bits for AES and 512 bits
159
-- for Skein-MAC-512-512).
160
initKey :: S.ByteString -> Either String Key
161
initKey bs | S.length bs /= 96 = Left $ "Web.ClientSession.initKey: length of " ++
162
show (S.length bs) ++ " /= 96."
163
initKey bs = case buildKey preAesKey of
164
Nothing -> Left $ "Web.ClientSession.initKey: unknown error with buildKey."
165
Just k -> Right $ Key { aesKey = k
166
, macKey = skeinMAC' preMacKey }
167
where
168
(preMacKey, preAesKey) = S.splitAt 64 bs
169
170
-- | Same as 'encrypt', however randomly generates the
171
-- initialization vector for you.
172
encryptIO :: Key -> S.ByteString -> IO S.ByteString
173
encryptIO key x = do
174
iv <- randomIV
175
return $ encrypt key iv x
176
177
-- | Encrypt (AES-CTR), authenticate (Skein-MAC-512-256) and
178
-- encode (Base64) the given cookie data. The returned byte
179
-- string is ready to be used in a response header.
180
encrypt :: Key -- ^ Key of the server.
181
-> IV -- ^ New, random initialization vector (see 'randomIV').
182
-> S.ByteString -- ^ Serialized cookie data.
183
-> S.ByteString -- ^ Encoded cookie data to be given to
184
-- the client browser.
185
encrypt key iv x = B.encode final
186
where
187
(encrypted, _) = Modes.ctr' Modes.incIV (aesKey key) iv x
188
toBeAuthed = encode iv `S.append` encrypted
189
auth = macKey key toBeAuthed
190
final = encode auth `S.append` toBeAuthed
191
192
-- | Decode (Base64), verify the integrity and authenticity
193
-- (Skein-MAC-512-256) and decrypt (AES-CTR) the given encoded
194
-- cookie data. Returns the original serialized cookie data.
195
-- Fails if the data is corrupted.
196
decrypt :: Key -- ^ Key of the server.
197
-> S.ByteString -- ^ Encoded cookie data given by the browser.
198
-> Maybe S.ByteString -- ^ Serialized cookie data.
199
decrypt key dataBS64 = do
200
dataBS <- either (const Nothing) Just $ B.decode dataBS64
201
guard (S.length dataBS >= 48) -- 16 bytes of IV + 32 bytes of Skein-MAC-512-256
202
let (auth, toBeAuthed) = S.splitAt 32 dataBS
203
auth' = macKey key toBeAuthed
204
guard (encode auth' `compareHash` auth)
205
let (iv_e, encrypted) = S.splitAt 16 toBeAuthed
206
iv <- either (const Nothing) Just $ decode iv_e
207
let (x, _) = Modes.unCtr' Modes.incIV (aesKey key) iv encrypted
208
return x
209
210
-- | Compare two bytestrings. Always takes the same ammount of
211
-- time, avoiding timing attacks.
212
compareHash :: S.ByteString -> S.ByteString -> Bool
213
compareHash s1 s2 =
214
S.length s1 == S.length s2 &&
215
foldl' (.|.) 0 (S.zipWith xor s1 s2) == 0
Loggerhead is a web-based interface for Breezy
Version: 2.0.1