diff options
Diffstat (limited to 'Crypto/Cipher/SBox.hs')
-rw-r--r-- | Crypto/Cipher/SBox.hs | 59 |
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 #-} | ||
2 | module Crypto.Cipher.SBox (SBox,(#),sbox,pbox,bytes,parseBox,parseBytes) where | ||
3 | |||
4 | import Language.Haskell.TH | ||
5 | import Language.Haskell.TH.Quote | ||
6 | import Data.Bits | ||
7 | import Data.Binary | ||
8 | import Data.Char | ||
9 | import Data.Word | ||
10 | import Data.List | ||
11 | import qualified Data.Vector.Unboxed as V | ||
12 | import qualified Data.ByteString as S | ||
13 | |||
14 | unsupported _ = fail "not supported." | ||
15 | |||
16 | str = QuasiQuoter { | ||
17 | quoteExp = stringE, | ||
18 | quotePat = unsupported, | ||
19 | quoteDec = unsupported, | ||
20 | quoteType = unsupported | ||
21 | } | ||
22 | sbox = str { quoteExp = sboxExp } | ||
23 | pbox = sbox | ||
24 | bytes = str { quoteExp = bytesExp } | ||
25 | |||
26 | sboxExp st = let w=mkName "parseBox" in return $ AppE (VarE w) (LitE (StringL st)) | ||
27 | bytesExp st = let w=mkName "parseBytes" in return $ AppE (VarE w) (LitE (StringL st)) | ||
28 | |||
29 | type SBox = V.Vector Word32 | ||
30 | |||
31 | {-# INLINE (#) #-} | ||
32 | (#) :: SBox -> Word8 -> Word32 | ||
33 | v # i = v V.! (fromIntegral i ) | ||
34 | |||
35 | |||
36 | parseBox :: String -> SBox | ||
37 | parseBox 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 | |||
44 | parseBytes 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 | |||