[Haskell-beginners] State help request
Joe
xe4mxee at gmail.com
Sat Dec 8 05:03:39 CET 2012
Hi,
below is an implementation of RC4, which I started after Andrew
Gwozdziewycz from NY Hack & Tell encouraged the group to write it. I
mostly followed the pseudocode on Wikipedia.
I'd appreciate any feedback, but I'm most distressed by the KSA
generation, and would like suggestions for making either version less
nasty.
Thanks.
import Data.Bits
import Data.Vector ((!),(//),Vector,fromList)
import Data.Char
import Control.Monad.State
type PRGA = (Vector Int,Int,Int)
type Key = [Int]
-- identity permutation
permId :: Vector Int
permId = fromList [0..255]
-- generate initial PRGA
ksa :: Key -> PRGA
ksa key = ksaStep permId key 0 0
-- I really don't like passing the counter every time,
ksaStep :: Vector Int -> Key -> Int -> Int -> PRGA
ksaStep s _ 255 _ = (s,0,0)
ksaStep s key i j = let j' = (j + (s!i) + (key !! (i `mod`
keylength))) `mod` 256 in
ksaStep (s // [(i, s!j'), (j',s!i)]) key (i+1) j'
where keylength = length key
-- but I tried wedging it into a State, and it's not any clearer
ksa' :: Key -> PRGA
ksa' key = genPRGA
where genPRGA = snd $ foldl (\s a -> snd $ runState (ksaStep' a) s)
(key,(permId,0,0)) [0..255]
ksaStep' :: Int -> State (Key,PRGA) ()
ksaStep' i = do
(key, (s,_,j)) <- get
let j' = (j + (s!i) + (key !! (i `mod` length(key)))) `mod` 256
s' = s // [(i, s!j'), (j',s!i)]
put (key,(s',i,j'))
-- a round of the PRGA
prgaStep :: State PRGA Int
prgaStep = do
(s,i,j) <- get
let i' = (i + 1) `mod` 256
j' = (j + (s!i')) `mod` 256
s' = s // [(i',s!j'), (j',s!i')]
put (s',i',j')
return (s!((s'!i' + s'!j') `mod` 256))
keyStream :: PRGA -> [Int]
keyStream p = let (i,p') = runState prgaStep p
in i : keyStream p'
crypt :: Key -> [Int] -> [Int]
crypt k m = zipWith xor m $ keyStream $ ksa k
pwCrypt :: String -> String -> [Int]
pwCrypt ks ms = crypt key msg
where key = map ord ks
msg = map ord ms
pwDecrypt :: String -> [Int] -> String
pwDecrypt k c = map chr $ crypt key c
where key = map ord k
More information about the Beginners
mailing list