module Data.HMAC(
hmac, hmac_sha1, hmac_md5,
HashMethod(HashMethod, digest, input_blocksize),
) where
import Data.Digest.SHA1 as SHA1
import Data.Digest.MD5 as MD5
import Data.Word (Word32)
import Data.Bits (shiftR, xor, bitSize, Bits)
import Codec.Utils (Octet)
data HashMethod =
HashMethod {
HashMethod -> [Octet] -> [Octet]
digest :: [Octet] -> [Octet],
HashMethod -> Int
input_blocksize :: Int}
sha1_hm :: HashMethod
sha1_hm = ([Octet] -> [Octet]) -> Int -> HashMethod
HashMethod (Word160 -> [Octet]
w160_to_w8s forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Octet] -> Word160
SHA1.hash) Int
512
md5_hm :: HashMethod
md5_hm = ([Octet] -> [Octet]) -> Int -> HashMethod
HashMethod [Octet] -> [Octet]
MD5.hash Int
512
hmac_sha1 :: [Octet]
-> [Octet]
-> [Octet]
hmac_sha1 :: [Octet] -> [Octet] -> [Octet]
hmac_sha1 = HashMethod -> [Octet] -> [Octet] -> [Octet]
hmac HashMethod
sha1_hm
hmac_md5 :: [Octet]
-> [Octet]
-> [Octet]
hmac_md5 :: [Octet] -> [Octet] -> [Octet]
hmac_md5 = HashMethod -> [Octet] -> [Octet] -> [Octet]
hmac HashMethod
md5_hm
w160_to_w8s :: Word160 -> [Octet]
w160_to_w8s :: Word160 -> [Octet]
w160_to_w8s Word160
w = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Word32 -> [Octet]
w32_to_w8s (Word160 -> [Word32]
w160_to_w32s Word160
w)
w160_to_w32s :: Word160 -> [Word32]
w160_to_w32s :: Word160 -> [Word32]
w160_to_w32s (Word160 Word32
a Word32
b Word32
c Word32
d Word32
e) = Word32
a forall a. a -> [a] -> [a]
: Word32
b forall a. a -> [a] -> [a]
: Word32
c forall a. a -> [a] -> [a]
: Word32
d forall a. a -> [a] -> [a]
: Word32
e forall a. a -> [a] -> [a]
: []
w32_to_w8s :: Word32 -> [Octet]
w32_to_w8s :: Word32 -> [Octet]
w32_to_w8s Word32
a = (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word32
a Int
24)) forall a. a -> [a] -> [a]
:
(forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word32
a Int
16)) forall a. a -> [a] -> [a]
:
(forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word32
a Int
8)) forall a. a -> [a] -> [a]
:
(forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
a) forall a. a -> [a] -> [a]
: []
hmac :: HashMethod
-> [Octet]
-> [Octet]
-> [Octet]
hmac :: HashMethod -> [Octet] -> [Octet] -> [Octet]
hmac HashMethod
h [Octet]
uk [Octet]
m = [Octet] -> [Octet]
hash ([Octet]
opad forall a. [a] -> [a] -> [a]
++ ([Octet] -> [Octet]
hash ([Octet]
ipad forall a. [a] -> [a] -> [a]
++ [Octet]
m)))
where hash :: [Octet] -> [Octet]
hash = HashMethod -> [Octet] -> [Octet]
digest HashMethod
h
([Octet]
opad, [Octet]
ipad) = [Octet] -> [Octet] -> [Octet] -> ([Octet], [Octet])
process_pads [Octet]
key
(Int -> Octet -> [Octet]
make_start_pad Int
bs Octet
opad_pattern)
(Int -> Octet -> [Octet]
make_start_pad Int
bs Octet
ipad_pattern)
bs :: Int
bs = HashMethod -> Int
input_blocksize HashMethod
h
key :: [Octet]
key = HashMethod -> [Octet] -> [Octet]
key_from_user HashMethod
h [Octet]
uk
key_from_user :: HashMethod -> [Octet] -> [Octet]
key_from_user :: HashMethod -> [Octet] -> [Octet]
key_from_user HashMethod
h [Octet]
uk =
case (forall a. Ord a => a -> a -> Ordering
compare ([Octet] -> Int
bitcount [Octet]
uk) (HashMethod -> Int
input_blocksize HashMethod
h)) of
Ordering
GT -> [Octet] -> [Octet]
fill_key ((HashMethod -> [Octet] -> [Octet]
digest HashMethod
h) [Octet]
uk)
Ordering
LT -> [Octet] -> [Octet]
fill_key [Octet]
uk
Ordering
EQ -> [Octet]
uk
where fill_key :: [Octet] -> [Octet]
fill_key [Octet]
kd =
[Octet]
kd forall a. [a] -> [a] -> [a]
++ (forall a. Int -> [a] -> [a]
take (((HashMethod -> Int
input_blocksize HashMethod
h) forall a. Num a => a -> a -> a
- ([Octet] -> Int
bitcount [Octet]
kd)) forall a. Integral a => a -> a -> a
`div` Int
8)
(forall a. a -> [a]
repeat Octet
0x0))
process_pads :: [Octet]
-> [Octet]
-> [Octet]
-> ([Octet], [Octet])
process_pads :: [Octet] -> [Octet] -> [Octet] -> ([Octet], [Octet])
process_pads [Octet]
ks [Octet]
os [Octet]
is =
forall a b. [(a, b)] -> ([a], [b])
unzip forall a b. (a -> b) -> a -> b
$ forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 (\Octet
k Octet
o Octet
i -> (Octet
k forall a. Bits a => a -> a -> a
`xor` Octet
o, Octet
k forall a. Bits a => a -> a -> a
`xor` Octet
i)) [Octet]
ks [Octet]
os [Octet]
is
make_start_pad :: Int -> Octet -> [Octet]
make_start_pad :: Int -> Octet -> [Octet]
make_start_pad Int
size Octet
pad = forall a. Int -> [a] -> [a]
take (Int
size forall a. Integral a => a -> a -> a
`div` (forall a. Bits a => a -> Int
bitSize Octet
pad)) forall a b. (a -> b) -> a -> b
$ forall a. a -> [a]
repeat Octet
pad
opad_pattern :: Octet
opad_pattern = Octet
0x5c :: Octet
ipad_pattern :: Octet
ipad_pattern = Octet
0x36 :: Octet
bitcount :: [Octet] -> Int
bitcount :: [Octet] -> Int
bitcount [Octet]
k = (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Octet]
k) forall a. Num a => a -> a -> a
* (forall a. Bits a => a -> Int
bitSize (forall a. [a] -> a
head [Octet]
k))