summaryrefslogtreecommitdiff
path: root/Crypto/Cipher/SBox.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Crypto/Cipher/SBox.hs')
-rw-r--r--Crypto/Cipher/SBox.hs59
1 files changed, 59 insertions, 0 deletions
diff --git a/Crypto/Cipher/SBox.hs b/Crypto/Cipher/SBox.hs
new file mode 100644
index 0000000..d3de077
--- /dev/null
+++ b/Crypto/Cipher/SBox.hs
@@ -0,0 +1,59 @@
1{-# LANGUAGE TemplateHaskell #-}
2module Crypto.Cipher.SBox (SBox,(#),sbox,pbox,bytes,parseBox,parseBytes) where
3
4import Language.Haskell.TH
5import Language.Haskell.TH.Quote
6import Data.Bits
7import Data.Binary
8import Data.Char
9import Data.Word
10import Data.List
11import qualified Data.Vector.Unboxed as V
12import qualified Data.ByteString as S
13
14unsupported _ = fail "not supported."
15
16str = QuasiQuoter {
17 quoteExp = stringE,
18 quotePat = unsupported,
19 quoteDec = unsupported,
20 quoteType = unsupported
21 }
22sbox = str { quoteExp = sboxExp }
23pbox = sbox
24bytes = str { quoteExp = bytesExp }
25
26sboxExp st = let w=mkName "parseBox" in return $ AppE (VarE w) (LitE (StringL st))
27bytesExp st = let w=mkName "parseBytes" in return $ AppE (VarE w) (LitE (StringL st))
28
29type SBox = V.Vector Word32
30
31{-# INLINE (#) #-}
32(#) :: SBox -> Word8 -> Word32
33v # i = v V.! (fromIntegral i )
34
35
36parseBox :: String -> SBox
37parseBox xs = V.fromList $ (map (read . ("0x"++) {- . reverseNibbles -} ) . words $ xs :: [Word32])
38 where
39 reverseNibbles = concat . reverse . group2 (\a b->[a,b])
40
41 group2 f (x:y:ys) = f x y : group2 f ys
42 group2 _ _ = []
43
44parseBytes bs = S.pack . parseHex' . concat . words $ bs
45 where
46 parseHex' bs =
47 let (dnib,ts) = splitAt 2 bs
48 parseNibble x = group2 toW8 $ map (hexDigit . ord8) x
49 hexDigit d = d - (if d>0x39 then if d<0x61 then 0x37 else 0x57 else 0x30)
50 group2 f (x:y:ys) = f x y : group2 f ys
51 group2 _ _ = []
52 toW8 a b = shift a 4 .|. b
53 ord8 c = fromIntegral . ord $ c :: Word8
54 in parseNibble dnib ++
55 if null ts
56 then []
57 else parseHex' ts
58
59