SHA 1.0.4 → 1.2.0
raw patch · 4 files changed
+1038/−416 lines, 4 filesdep +arraydep +binarydep +directorydep ~basenew-component:exe:sha1new-component:exe:sha384PVP ok
version bump matches the API change (PVP)
Dependencies added: array, binary, directory
Dependency ranges changed: base
API changes (from Hackage documentation)
- Data.Digest.Pure.SHA: instance Show State64
Files
- Data/Digest/Pure/SHA.hs +971/−411
- Main.hs +39/−0
- SHA.cabal +28/−5
- Test.hs too large to diff
Data/Digest/Pure/SHA.hs view
@@ -14,414 +14,974 @@ #ifdef SHA_TEST , toBigEndianBS, fromBigEndianBS , find_k- , sha_1_256_pad, sha_384_512_pad-#endif- )- where--import Data.Bits-import Data.ByteString.Lazy(ByteString)-import qualified Data.ByteString.Lazy as BS-import Data.Char-import Data.Int-import Data.Word----- | An abstract datatype for digests.-newtype Digest = Digest ByteString deriving (Eq,Ord)--instance Show Digest where- show = showDigest---- -------------------------------------------------------------------------------- SHA-1------ ----------------------------------------------------------------------------data State32 = S32 !Word32 !Word32 !Word32 !Word32 - !Word32 !Word32 !Word32 !Word32---- |Compute the SHA-1 hash of the given ByteString. The output is guaranteed--- to be exactly 160 bits, or 20 bytes, long. This is a good default for--- programs that need a good, but not necessarily hyper-secure, hash function.-sha1 :: ByteString -> Digest-sha1 bs = Digest $ compute_sha1_hash sha1_initial_state chunked_bs- where- padded_bs = sha_1_256_pad bs- chunked_bs = chunk 512 padded_bs--compute_sha1_hash :: State32 -> [ByteString] -> ByteString-compute_sha1_hash (S32 a b c d e _ _ _) [] = - BS.concat $ map (toBigEndianBS 32) [a,b,c,d,e]-compute_sha1_hash ins@(S32 a b c d e _ _ _) (first:rest) =- compute_sha1_hash next rest- where- x = foldl tiny_step1 ins (zip3 (message_schedule_1 first) sha1_ks [0..79])- S32 a' b' c' d' e' _ _ _ = x- next = S32 (a+a') (b+b') (c+c') (d+d') (e+e') 0 0 0--message_schedule_1 :: ByteString -> [Word32]-message_schedule_1 bs = genSched (reverse $ map fromBigEndianBS $ chunk 32 bs)- where- genSched curs | length curs == 80 = reverse curs- | otherwise =- -- note that we keep curs in reversed order to make the indexing work out- let w_3 = curs !! 2- w_8 = curs !! 7- w_14 = curs !! 13- w_16 = curs !! 15- base = w_3 `xor` w_8 `xor` w_14 `xor` w_16- in genSched (rotate base 1 : curs) - -tiny_step1 :: State32 -> (Word32, Word32, Word32) -> State32-tiny_step1 (S32 a b c d e _ _ _) (w, k, t) = S32 a' b' c' d' e' 0 0 0- where- a' = (rotate a 5) + (sha1_f t b c d) + e + k + w- e' = d- d' = c- c' = rotate b 30- b' = a--sha1_f :: Word32 -> Word32 -> Word32 -> Word32 -> Word32-sha1_f t x y z - | t <= 19 = (x .&. y) `xor` ((complement x) .&. z)- | (t >= 20) && (t <= 39) = x `xor` y `xor` z- | (t >= 40) && (t <= 59) = (x .&. y) `xor` (x .&. z) `xor` (y .&. z)- | (t >= 60) && (t <= 79) = x `xor` y `xor` z- | otherwise = error $ "Illegal SHA-1 f function number "++show t--sha1_initial_state :: State32-sha1_initial_state = - S32 0x67452301 0xefcdab89 0x98badcfe 0x10325476 0xc3d2e1f0 0 0 0--sha1_ks :: [Word32]-sha1_ks = map gen_k [0 .. 79]- where- gen_k :: Int -> Word32 - gen_k x | x <= 19 = 0x5a827999- | (x >= 20) && (x <= 39) = 0x6ed9eba1- | (x >= 40) && (x <= 59) = 0x8f1bbcdc- | otherwise = 0xca62c1d6---- -------------------------------------------------------------------------------- SHA-224------ ------------------------------------------------------------------------------ |Compute the SHA-224 hash of the given ByteString. Note that SHA-224 and--- SHA-384 differ only slightly from SHA-256 and SHA-512, and use truncated--- versions of the resulting hashes. So using 224/384 may not, in fact, save--- you very much ...-sha224 :: ByteString -> Digest-sha224 bs = Digest $ BS.take 28- $ compute_sha256_hash sha224_initial_state chunked_bs- where- padded_bs = sha_1_256_pad bs- chunked_bs = chunk 512 padded_bs--sha224_initial_state :: State32-sha224_initial_state = S32 0xc1059ed8 0x367cd507 0x3070dd17 0xf70e5939- 0xffc00b31 0x68581511 0x64f98fa7 0xbefa4fa4- --- -------------------------------------------------------------------------------- SHA-256------ ------------------------------------------------------------------------------ |Compute the SHA-256 hash of the given ByteString. The output is guaranteed--- to be exactly 256 bits, or 32 bytes, long. If your security requirements --- are pretty serious, this is a good choice. For truly significant security--- concerns, however, you might try one of the bigger options.-sha256 :: ByteString -> Digest-sha256 bs = Digest $ compute_sha256_hash sha256_initial_state chunked_bs- where- padded_bs = sha_1_256_pad bs- chunked_bs = chunk 512 padded_bs--compute_sha256_hash :: State32 -> [ByteString] -> ByteString-compute_sha256_hash (S32 a b c d e f g h) [] =- BS.concat $ map (toBigEndianBS 32) [a,b,c,d,e,f,g,h]-compute_sha256_hash ins@(S32 a b c d e f g h) (first:rest) =- compute_sha256_hash next rest- where- x = foldl tiny_step256 ins (zip (message_schedule_256 first) sha256_ks)- S32 a' b' c' d' e' f' g' h' = x- next = S32 (a+a') (b+b') (c+c') (d+d') (e+e') (f+f') (g+g') (h+h')--message_schedule_256 :: ByteString -> [Word32]-message_schedule_256 bs = genSched (reverse $ map fromBigEndianBS $ chunk 32 bs)- where- genSched curs | length curs == 64 = reverse curs- | otherwise =- let sw2 = small_sigma_256_1 $ curs !! 1- w7 = curs !! 6- sw15 = small_sigma_256_0 $ curs !! 14- w16 = curs !! 15- new_guy = sw2 + w7 + sw15 + w16 - in genSched (new_guy : curs)--tiny_step256 :: State32 -> (Word32, Word32) -> State32-tiny_step256 (S32 a b c d e f g h) (w, k) = S32 a' b' c' d' e' f' g' h'- where- a' = t1 + t2- b' = a- c' = b- d' = c- e' = d + t1- f' = e- g' = f- h' = g- t1 = h + (big_sigma_256_1 e) + (ch256 e f g) + k + w- t2 = big_sigma_256_0 a + maj256 a b c--ch256 :: Word32 -> Word32 -> Word32 -> Word32-ch256 x y z = (x .&. y) `xor` ((complement x) .&. z)--maj256 :: Word32 -> Word32 -> Word32 -> Word32-maj256 x y z = (x .&. y) `xor` (x .&. z) `xor` (y .&. z)--big_sigma_256_0 :: Word32 -> Word32-big_sigma_256_0 x = - (x `rotate` (-2)) `xor` (x `rotate` (-13)) `xor` (x `rotate` (-22))--big_sigma_256_1 :: Word32 -> Word32-big_sigma_256_1 x = - (x `rotate` (-6)) `xor` (x `rotate` (-11)) `xor` (x `rotate` (-25))--small_sigma_256_0 :: Word32 -> Word32-small_sigma_256_0 x =- (x `rotate` (-7)) `xor` (x `rotate` (-18)) `xor` (x `shiftR` 3)--small_sigma_256_1 :: Word32 -> Word32-small_sigma_256_1 x =- (x `rotate` (-17)) `xor` (x `rotate` (-19)) `xor` (x `shiftR` 10)--sha256_initial_state :: State32-sha256_initial_state = - S32 0x6a09e667 0xbb67ae85 0x3c6ef372 0xa54ff53a- 0x510e527f 0x9b05688c 0x1f83d9ab 0x5be0cd19--sha256_ks :: [Word32]-sha256_ks = - [0x428a2f98, 0x71374491, 0xb5c0fbcf, 0xe9b5dba5, 0x3956c25b, 0x59f111f1,- 0x923f82a4, 0xab1c5ed5, 0xd807aa98, 0x12835b01, 0x243185be, 0x550c7dc3,- 0x72be5d74, 0x80deb1fe, 0x9bdc06a7, 0xc19bf174, 0xe49b69c1, 0xefbe4786,- 0x0fc19dc6, 0x240ca1cc, 0x2de92c6f, 0x4a7484aa, 0x5cb0a9dc, 0x76f988da,- 0x983e5152, 0xa831c66d, 0xb00327c8, 0xbf597fc7, 0xc6e00bf3, 0xd5a79147,- 0x06ca6351, 0x14292967, 0x27b70a85, 0x2e1b2138, 0x4d2c6dfc, 0x53380d13,- 0x650a7354, 0x766a0abb, 0x81c2c92e, 0x92722c85, 0xa2bfe8a1, 0xa81a664b,- 0xc24b8b70, 0xc76c51a3, 0xd192e819, 0xd6990624, 0xf40e3585, 0x106aa070,- 0x19a4c116, 0x1e376c08, 0x2748774c, 0x34b0bcb5, 0x391c0cb3, 0x4ed8aa4a,- 0x5b9cca4f, 0x682e6ff3, 0x748f82ee, 0x78a5636f, 0x84c87814, 0x8cc70208,- 0x90befffa, 0xa4506ceb, 0xbef9a3f7, 0xc67178f2]---- -------------------------------------------------------------------------------- SHA-384------ ----------------------------------------------------------------------------data State64 = S64 Word64 Word64 Word64 Word64 Word64 Word64 Word64 Word64--instance Show State64 where- show (S64 a b c d e f g h) =- "S64 " ++ concatMap ((++ " ") . showDigestBS . toBigEndianBS 64) [a,b,c,d,e,f,g,h]---- |Compute the SHA-384 hash of the given ByteString. Yup, you guessed it, --- the output will be exactly 384 bits, or 48 bytes, long.-sha384 :: ByteString -> Digest-sha384 bs = Digest $ BS.take 48- $ compute_sha512_hash sha384_initial_state chunked_bs- where- padded_bs = sha_384_512_pad bs- chunked_bs = chunk 1024 padded_bs--sha384_initial_state :: State64-sha384_initial_state =- S64 0xcbbb9d5dc1059ed8 0x629a292a367cd507 0x9159015a3070dd17 - 0x152fecd8f70e5939 0x67332667ffc00b31 0x8eb44a8768581511 - 0xdb0c2e0d64f98fa7 0x47b5481dbefa4fa4---- -------------------------------------------------------------------------------- SHA-512------ ------------------------------------------------------------------------------ |For those for whom only the biggest hashes will do, this computes the--- SHA-512 hash of the given ByteString. The output will be 64 bytes, or--- 512 bits, long.-sha512 :: ByteString -> Digest-sha512 bs = Digest $ compute_sha512_hash sha512_initial_state chunked_bs- where- padded_bs = sha_384_512_pad bs- chunked_bs = chunk 1024 padded_bs--compute_sha512_hash :: State64 -> [ByteString] -> ByteString-compute_sha512_hash (S64 a b c d e f g h) [] =- BS.concat $ map (toBigEndianBS 64) [a,b,c,d,e,f,g,h]-compute_sha512_hash ins@(S64 a b c d e f g h) (first:rest) =- compute_sha512_hash next rest- where- x = foldl tiny_step512 ins (zip (message_schedule_512 first) sha512_ks)- S64 a' b' c' d' e' f' g' h' = x- next = S64 (a+a') (b+b') (c+c') (d+d') (e+e') (f+f') (g+g') (h+h')--message_schedule_512 :: ByteString -> [Word64]-message_schedule_512 bs = genSched (reverse $ map fromBigEndianBS $ chunk 64 bs)- where- genSched curs | length curs == 80 = reverse curs- | otherwise =- let sw2 = small_sigma_512_1 $ curs !! 1- w7 = curs !! 6- sw15 = small_sigma_512_0 $ curs !! 14- w16 = curs !! 15- new_guy = sw2 + w7 + sw15 + w16- in genSched (new_guy : curs)--tiny_step512 :: State64 -> (Word64, Word64) -> State64-tiny_step512 (S64 a b c d e f g h) (k, w) = S64 a' b' c' d' e' f' g' h'- where- a' = t1 + t2- b' = a- c' = b- d' = c- e' = d + t1- f' = e- g' = f- h' = g- t1 = h + (big_sigma_512_1 e) + (ch512 e f g) + k + w- t2 = (big_sigma_512_0 a) + (maj512 a b c)--ch512 :: Word64 -> Word64 -> Word64 -> Word64-ch512 x y z = (x .&. y) `xor` ((complement x) .&. z)--maj512 :: Word64 -> Word64 -> Word64 -> Word64-maj512 x y z = (x .&. y) `xor` (x .&. z) `xor` (y .&. z)--big_sigma_512_0 :: Word64 -> Word64-big_sigma_512_0 x =- (x `rotate` (-28)) `xor` (x `rotate` (-34)) `xor` (x `rotate` (-39))--big_sigma_512_1 :: Word64 -> Word64-big_sigma_512_1 x =- (x `rotate` (-14)) `xor` (x `rotate` (-18)) `xor` (x `rotate` (-41))--small_sigma_512_0 :: Word64 -> Word64-small_sigma_512_0 x =- (x `rotate` (-1)) `xor` (x `rotate` (-8)) `xor` (x `shiftR` 7)--small_sigma_512_1 :: Word64 -> Word64-small_sigma_512_1 x =- (x `rotate` (-19)) `xor` (x `rotate` (-61)) `xor` (x `shiftR` 6)--sha512_initial_state :: State64-sha512_initial_state =- S64 0x6a09e667f3bcc908 0xbb67ae8584caa73b 0x3c6ef372fe94f82b - 0xa54ff53a5f1d36f1 0x510e527fade682d1 0x9b05688c2b3e6c1f - 0x1f83d9abfb41bd6b 0x5be0cd19137e2179--sha512_ks :: [Word64]-sha512_ks = [- 0x428a2f98d728ae22, 0x7137449123ef65cd, 0xb5c0fbcfec4d3b2f, 0xe9b5dba58189dbbc,- 0x3956c25bf348b538, 0x59f111f1b605d019, 0x923f82a4af194f9b, 0xab1c5ed5da6d8118,- 0xd807aa98a3030242, 0x12835b0145706fbe, 0x243185be4ee4b28c, 0x550c7dc3d5ffb4e2,- 0x72be5d74f27b896f, 0x80deb1fe3b1696b1, 0x9bdc06a725c71235, 0xc19bf174cf692694,- 0xe49b69c19ef14ad2, 0xefbe4786384f25e3, 0x0fc19dc68b8cd5b5, 0x240ca1cc77ac9c65,- 0x2de92c6f592b0275, 0x4a7484aa6ea6e483, 0x5cb0a9dcbd41fbd4, 0x76f988da831153b5,- 0x983e5152ee66dfab, 0xa831c66d2db43210, 0xb00327c898fb213f, 0xbf597fc7beef0ee4,- 0xc6e00bf33da88fc2, 0xd5a79147930aa725, 0x06ca6351e003826f, 0x142929670a0e6e70,- 0x27b70a8546d22ffc, 0x2e1b21385c26c926, 0x4d2c6dfc5ac42aed, 0x53380d139d95b3df,- 0x650a73548baf63de, 0x766a0abb3c77b2a8, 0x81c2c92e47edaee6, 0x92722c851482353b,- 0xa2bfe8a14cf10364, 0xa81a664bbc423001, 0xc24b8b70d0f89791, 0xc76c51a30654be30,- 0xd192e819d6ef5218, 0xd69906245565a910, 0xf40e35855771202a, 0x106aa07032bbd1b8,- 0x19a4c116b8d2d0c8, 0x1e376c085141ab53, 0x2748774cdf8eeb99, 0x34b0bcb5e19b48a8,- 0x391c0cb3c5c95a63, 0x4ed8aa4ae3418acb, 0x5b9cca4f7763e373, 0x682e6ff3d6b2b8a3,- 0x748f82ee5defb2fc, 0x78a5636f43172f60, 0x84c87814a1f0ab72, 0x8cc702081a6439ec,- 0x90befffa23631e28, 0xa4506cebde82bde9, 0xbef9a3f7b2c67915, 0xc67178f2e372532b,- 0xca273eceea26619c, 0xd186b8c721c0c207, 0xeada7dd6cde0eb1e, 0xf57d4f7fee6ed178,- 0x06f067aa72176fba, 0x0a637dc5a2c898a6, 0x113f9804bef90dae, 0x1b710b35131c471b,- 0x28db77f523047d84, 0x32caab7b40c72493, 0x3c9ebe0a15c9bebc, 0x431d67c49c100d4c,- 0x4cc5d4becb3e42b6, 0x597f299cfc657e2a, 0x5fcb6fab3ad6faec, 0x6c44198c4a475817- ]---- -------------------------------------------------------------------------------- OTHER------ ------------------------------------------------------------------------------- | Convert a digest to a string.--- The digest is rendered as fixed with hexadecimal number.-showDigest :: Digest -> String-showDigest (Digest bs) = showDigestBS bs---- |Prints out a bytestring in hexadecimal. Just for convenience.-showDigestBS :: ByteString -> String-showDigestBS bs = concatMap paddedShowHex $ BS.unpack bs- where- paddedShowHex x = toHex (x `shiftR` 4) ++ toHex (x .&. 0xf)- toHex x = ["0","1","2","3","4","5","6","7","8","9","a","b","c","d","e","f"]- !! (fromIntegral x)---- | Convert a digest to an Integer.-integerDigest :: Digest -> Integer-integerDigest (Digest bs) = BS.foldl' addShift 0 bs- where addShift n y = (n `shiftL` 8) .|. fromIntegral y---- | Convert a digest to a ByteString.-bytestringDigest :: Digest -> ByteString-bytestringDigest (Digest bs) = bs---- -------------------------------------------------------------------------------- INTERNAL ROUTINES------ ----------------------------------------------------------------------------sha_1_256_pad :: ByteString -> ByteString-sha_1_256_pad = generic_pad 448 512 64--sha_384_512_pad :: ByteString -> ByteString-sha_384_512_pad = generic_pad 896 1024 128--generic_pad :: Word64 -> Word64 -> Int -> ByteString -> ByteString-generic_pad a b lSize bs = BS.concat [bs, pad_bytes, pad_length]- where- l = fromIntegral $ BS.length bs * 8- k = find_k a b l- -- INVARIANT: k is necessarily > 0, and (k + 1) is a multiple of 8.- k_bytes = (k + 1) `div` 8- pad_bytes = BS.pack $ [0x80] ++ (take (fromIntegral $ k_bytes - 1) [0,0 ..])- pad_length = toBigEndianBS lSize l---- Given a, b, and l, find a k such that (l + 1 + k) mod b = a. This is an--- astoundingly brain-dead implementation.-find_k :: Word64 -> Word64 -> Word64 -> Word64-find_k a b l = try_k 7- where- try_k k | (l + 1 + k) `mod` b == a = k- | otherwise = try_k (k + 8)---- Turn an arbitrary-length message into a set of n-bit long chunks.-chunk :: Int64 -> ByteString -> [ByteString]-chunk sizeBits bs - | BS.length bs == 0 = []- | sizeBits `mod` 8 /= 0 = error "Invalid sizeBits to chunk"- | BS.length bs `mod` byteSize /= 0 = error "Non-aligned ByteString to chunk"- | otherwise = let (first,rest) = BS.splitAt byteSize bs- in first:(chunk sizeBits rest)- where byteSize = sizeBits `div` 8--toBigEndianBS :: (Integral a, Bits a) => Int -> a -> ByteString-toBigEndianBS s val = BS.pack $ map getBits [s - 8, s - 16 .. 0]- where - getBits x = fromIntegral $ (val `shiftR` x) .&. 0xFF--fromBigEndianBS :: (Integral a, Bits a) => ByteString -> a-fromBigEndianBS bs = - BS.foldl (\ acc x -> (acc `shiftL` 8) + (fromIntegral x)) 0 bs+ , padSHA1, padSHA512+#endif+ )+ where++import Data.Array.Unboxed+import Data.Binary.Get+import Data.Binary.Put+import Data.Bits+import Data.ByteString.Lazy(ByteString)+import qualified Data.ByteString.Lazy as BS+import Data.Char+import Data.Int+import Data.Word++-- | An abstract datatype for digests.+newtype Digest = Digest ByteString deriving (Eq,Ord)++instance Show Digest where+ show = showDigest++-- --------------------------------------------------------------------------+--+-- CONSTANT ARRAYS+--+-- --------------------------------------------------------------------------++-- The following arrays represent K_i.++sha256_k :: UArray Int Word32+sha256_k = listArray (0, 63) [+ 0x428a2f98, 0x71374491, 0xb5c0fbcf, 0xe9b5dba5, 0x3956c25b+ , 0x59f111f1, 0x923f82a4, 0xab1c5ed5, 0xd807aa98, 0x12835b01+ , 0x243185be, 0x550c7dc3, 0x72be5d74, 0x80deb1fe, 0x9bdc06a7+ , 0xc19bf174, 0xe49b69c1, 0xefbe4786, 0x0fc19dc6, 0x240ca1cc+ , 0x2de92c6f, 0x4a7484aa, 0x5cb0a9dc, 0x76f988da, 0x983e5152+ , 0xa831c66d, 0xb00327c8, 0xbf597fc7, 0xc6e00bf3, 0xd5a79147+ , 0x06ca6351, 0x14292967, 0x27b70a85, 0x2e1b2138, 0x4d2c6dfc+ , 0x53380d13, 0x650a7354, 0x766a0abb, 0x81c2c92e, 0x92722c85 + , 0xa2bfe8a1, 0xa81a664b, 0xc24b8b70, 0xc76c51a3, 0xd192e819+ , 0xd6990624, 0xf40e3585, 0x106aa070, 0x19a4c116, 0x1e376c08+ , 0x2748774c, 0x34b0bcb5, 0x391c0cb3, 0x4ed8aa4a, 0x5b9cca4f+ , 0x682e6ff3, 0x748f82ee, 0x78a5636f, 0x84c87814, 0x8cc70208+ , 0x90befffa, 0xa4506ceb, 0xbef9a3f7, 0xc67178f2+ ]++sha512_k :: UArray Int Word64+sha512_k = listArray (0, 79) [+ 0x428a2f98d728ae22, 0x7137449123ef65cd, 0xb5c0fbcfec4d3b2f+ , 0xe9b5dba58189dbbc, 0x3956c25bf348b538, 0x59f111f1b605d019+ , 0x923f82a4af194f9b, 0xab1c5ed5da6d8118, 0xd807aa98a3030242+ , 0x12835b0145706fbe, 0x243185be4ee4b28c, 0x550c7dc3d5ffb4e2+ , 0x72be5d74f27b896f, 0x80deb1fe3b1696b1, 0x9bdc06a725c71235+ , 0xc19bf174cf692694, 0xe49b69c19ef14ad2, 0xefbe4786384f25e3+ , 0x0fc19dc68b8cd5b5, 0x240ca1cc77ac9c65, 0x2de92c6f592b0275+ , 0x4a7484aa6ea6e483, 0x5cb0a9dcbd41fbd4, 0x76f988da831153b5+ , 0x983e5152ee66dfab, 0xa831c66d2db43210, 0xb00327c898fb213f+ , 0xbf597fc7beef0ee4, 0xc6e00bf33da88fc2, 0xd5a79147930aa725+ , 0x06ca6351e003826f, 0x142929670a0e6e70, 0x27b70a8546d22ffc+ , 0x2e1b21385c26c926, 0x4d2c6dfc5ac42aed, 0x53380d139d95b3df+ , 0x650a73548baf63de, 0x766a0abb3c77b2a8, 0x81c2c92e47edaee6+ , 0x92722c851482353b, 0xa2bfe8a14cf10364, 0xa81a664bbc423001+ , 0xc24b8b70d0f89791, 0xc76c51a30654be30, 0xd192e819d6ef5218+ , 0xd69906245565a910, 0xf40e35855771202a, 0x106aa07032bbd1b8+ , 0x19a4c116b8d2d0c8, 0x1e376c085141ab53, 0x2748774cdf8eeb99+ , 0x34b0bcb5e19b48a8, 0x391c0cb3c5c95a63, 0x4ed8aa4ae3418acb+ , 0x5b9cca4f7763e373, 0x682e6ff3d6b2b8a3, 0x748f82ee5defb2fc+ , 0x78a5636f43172f60, 0x84c87814a1f0ab72, 0x8cc702081a6439ec+ , 0x90befffa23631e28, 0xa4506cebde82bde9, 0xbef9a3f7b2c67915+ , 0xc67178f2e372532b, 0xca273eceea26619c, 0xd186b8c721c0c207+ , 0xeada7dd6cde0eb1e, 0xf57d4f7fee6ed178, 0x06f067aa72176fba+ , 0x0a637dc5a2c898a6, 0x113f9804bef90dae, 0x1b710b35131c471b+ , 0x28db77f523047d84, 0x32caab7b40c72493, 0x3c9ebe0a15c9bebc+ , 0x431d67c49c100d4c, 0x4cc5d4becb3e42b6, 0x597f299cfc657e2a+ , 0x5fcb6fab3ad6faec, 0x6c44198c4a475817+ ]++-- --------------------------------------------------------------------------+--+-- State Definitions and Initial States+--+-- --------------------------------------------------------------------------++data SHA1State = SHA1S !Word32 !Word32 !Word32 !Word32 !Word32++initialSHA1State :: SHA1State+initialSHA1State = SHA1S 0x67452301 0xefcdab89 0x98badcfe 0x10325476 0xc3d2e1f0++data SHA256State = SHA256S !Word32 !Word32 !Word32 !Word32+ !Word32 !Word32 !Word32 !Word32++initialSHA224State :: SHA256State+initialSHA224State = SHA256S 0xc1059ed8 0x367cd507 0x3070dd17 0xf70e5939+ 0xffc00b31 0x68581511 0x64f98fa7 0xbefa4fa4++initialSHA256State :: SHA256State+initialSHA256State = SHA256S 0x6a09e667 0xbb67ae85 0x3c6ef372 0xa54ff53a+ 0x510e527f 0x9b05688c 0x1f83d9ab 0x5be0cd19++data SHA512State = SHA512S !Word64 !Word64 !Word64 !Word64+ !Word64 !Word64 !Word64 !Word64++initialSHA384State :: SHA512State+initialSHA384State = SHA512S 0xcbbb9d5dc1059ed8 0x629a292a367cd507+ 0x9159015a3070dd17 0x152fecd8f70e5939+ 0x67332667ffc00b31 0x8eb44a8768581511+ 0xdb0c2e0d64f98fa7 0x47b5481dbefa4fa4++initialSHA512State :: SHA512State+initialSHA512State = SHA512S 0x6a09e667f3bcc908 0xbb67ae8584caa73b+ 0x3c6ef372fe94f82b 0xa54ff53a5f1d36f1+ 0x510e527fade682d1 0x9b05688c2b3e6c1f+ 0x1f83d9abfb41bd6b 0x5be0cd19137e2179++-- --------------------------------------------------------------------------+--+-- Synthesize of states to ByteStrings+--+-- --------------------------------------------------------------------------++synthesizeSHA1 :: SHA1State -> Put+synthesizeSHA1 (SHA1S a b c d e) = do+ putWord32be a+ putWord32be b+ putWord32be c+ putWord32be d+ putWord32be e++synthesizeSHA224 :: SHA256State -> Put+synthesizeSHA224 (SHA256S a b c d e f g _) = do+ putWord32be a+ putWord32be b+ putWord32be c+ putWord32be d+ putWord32be e+ putWord32be f+ putWord32be g++synthesizeSHA256 :: SHA256State -> Put+synthesizeSHA256 (SHA256S a b c d e f g h) = do+ putWord32be a+ putWord32be b+ putWord32be c+ putWord32be d+ putWord32be e+ putWord32be f+ putWord32be g+ putWord32be h++synthesizeSHA384 :: SHA512State -> Put+synthesizeSHA384 (SHA512S a b c d e f _ _) = do+ putWord64be a+ putWord64be b+ putWord64be c+ putWord64be d+ putWord64be e+ putWord64be f++synthesizeSHA512 :: SHA512State -> Put+synthesizeSHA512 (SHA512S a b c d e f g h) = do+ putWord64be a+ putWord64be b+ putWord64be c+ putWord64be d+ putWord64be e+ putWord64be f+ putWord64be g+ putWord64be h++-- --------------------------------------------------------------------------+--+-- Padding+--+-- --------------------------------------------------------------------------++padSHA1 :: ByteString -> ByteString+padSHA1 = generic_pad 448 512 64++padSHA512 :: ByteString -> ByteString+padSHA512 = generic_pad 896 1024 128++generic_pad :: Word64 -> Word64 -> Int -> ByteString -> ByteString+generic_pad a b lSize bs = BS.concat [bs, pad_bytes, pad_length]+ where+ l = fromIntegral $ BS.length bs * 8+ k = find_k a b l+ -- INVARIANT: k is necessarily > 0, and (k + 1) is a multiple of 8.+ k_bytes = (k + 1) `div` 8+ pad_bytes = BS.pack $ [0x80] ++ (take (fromIntegral $ k_bytes - 1) [0,0 ..])+ pad_length = toBigEndianBS lSize l++-- Given a, b, and l, find a k such that (l + 1 + k) mod b = a. This is an+-- astoundingly brain-dead implementation.+find_k :: Word64 -> Word64 -> Word64 -> Word64+find_k a b l = try_k 7+ where+ try_k k | (l + 1 + k) `mod` b == a = k+ | otherwise = try_k (k + 8)++toBigEndianBS :: (Integral a, Bits a) => Int -> a -> ByteString+toBigEndianBS s val = BS.pack $ map getBits [s - 8, s - 16 .. 0]+ where + getBits x = fromIntegral $ (val `shiftR` x) .&. 0xFF++#ifdef SHA_TEST+fromBigEndianBS :: (Integral a, Bits a) => ByteString -> a+fromBigEndianBS bs = + BS.foldl (\ acc x -> (acc `shiftL` 8) + (fromIntegral x)) 0 bs+#endif++-- --------------------------------------------------------------------------+--+-- SHA Functions+--+-- --------------------------------------------------------------------------++{-# SPECIALIZE ch :: Word32 -> Word32 -> Word32 -> Word32 #-}+{-# SPECIALIZE ch :: Word64 -> Word64 -> Word64 -> Word64 #-}+ch :: Bits a => a -> a -> a -> a+ch x y z = (x .&. y) `xor` ((complement x) .&. z)++{-# SPECIALIZE parity :: Word32 -> Word32 -> Word32 -> Word32 #-}+{-# SPECIALIZE parity :: Word64 -> Word64 -> Word64 -> Word64 #-}+parity :: Bits a => a -> a -> a -> a+parity x y z = x `xor` y `xor` z++{-# SPECIALIZE maj :: Word32 -> Word32 -> Word32 -> Word32 #-}+{-# SPECIALIZE maj :: Word64 -> Word64 -> Word64 -> Word64 #-}+maj :: Bits a => a -> a -> a -> a+maj x y z = (x .&. y) `xor` (x .&. z) `xor` (y .&. z)++bsig256_0 :: Word32 -> Word32+bsig256_0 x = (rotate x (-2)) `xor` (rotate x (-13)) `xor` (rotate x (-22))++bsig256_1 :: Word32 -> Word32+bsig256_1 x = (rotate x (-6)) `xor` (rotate x (-11)) `xor` (rotate x (-25))++lsig256_0 :: Word32 -> Word32+lsig256_0 x = (rotate x (-7)) `xor` (rotate x (-18)) `xor` (shiftR x 3)++lsig256_1 :: Word32 -> Word32+lsig256_1 x = (rotate x (-17)) `xor` (rotate x (-19)) `xor` (shiftR x 10) ++bsig512_0 :: Word64 -> Word64+bsig512_0 x = (rotate x (-28)) `xor` (rotate x (-34)) `xor` (rotate x (-39))++bsig512_1 :: Word64 -> Word64+bsig512_1 x = (rotate x (-14)) `xor` (rotate x (-18)) `xor` (rotate x (-41))++lsig512_0 :: Word64 -> Word64+lsig512_0 x = (rotate x (-1)) `xor` (rotate x (-8)) `xor` (shiftR x 7)++lsig512_1 :: Word64 -> Word64+lsig512_1 x = (rotate x (-19)) `xor` (rotate x (-61)) `xor` (shiftR x 6)++-- --------------------------------------------------------------------------+--+-- Message Schedules+--+-- --------------------------------------------------------------------------++data SHA1Sched = SHA1Sched !Word32 !Word32 !Word32 !Word32 !Word32 -- 0 - 4+ !Word32 !Word32 !Word32 !Word32 !Word32 -- 5 - 9+ !Word32 !Word32 !Word32 !Word32 !Word32 -- 10 - 14+ !Word32 !Word32 !Word32 !Word32 !Word32 -- 15 - 19+ !Word32 !Word32 !Word32 !Word32 !Word32 -- 20 - 24+ !Word32 !Word32 !Word32 !Word32 !Word32 -- 25 - 29+ !Word32 !Word32 !Word32 !Word32 !Word32 -- 30 - 34+ !Word32 !Word32 !Word32 !Word32 !Word32 -- 35 - 39+ !Word32 !Word32 !Word32 !Word32 !Word32 -- 40 - 44+ !Word32 !Word32 !Word32 !Word32 !Word32 -- 45 - 49+ !Word32 !Word32 !Word32 !Word32 !Word32 -- 50 - 54+ !Word32 !Word32 !Word32 !Word32 !Word32 -- 55 - 59+ !Word32 !Word32 !Word32 !Word32 !Word32 -- 60 - 64+ !Word32 !Word32 !Word32 !Word32 !Word32 -- 65 - 69+ !Word32 !Word32 !Word32 !Word32 !Word32 -- 70 - 74+ !Word32 !Word32 !Word32 !Word32 !Word32 -- 75 - 79++getSHA1Sched :: Get SHA1Sched+getSHA1Sched = do+ w00 <- getWord32be+ w01 <- getWord32be+ w02 <- getWord32be+ w03 <- getWord32be+ w04 <- getWord32be+ w05 <- getWord32be+ w06 <- getWord32be+ w07 <- getWord32be+ w08 <- getWord32be+ w09 <- getWord32be+ w10 <- getWord32be+ w11 <- getWord32be+ w12 <- getWord32be+ w13 <- getWord32be+ w14 <- getWord32be+ w15 <- getWord32be+ let w16 = rotate (w13 `xor` w08 `xor` w02 `xor` w00) 1+ w17 = rotate (w14 `xor` w09 `xor` w03 `xor` w01) 1+ w18 = rotate (w15 `xor` w10 `xor` w04 `xor` w02) 1+ w19 = rotate (w16 `xor` w11 `xor` w05 `xor` w03) 1+ w20 = rotate (w17 `xor` w12 `xor` w06 `xor` w04) 1+ w21 = rotate (w18 `xor` w13 `xor` w07 `xor` w05) 1+ w22 = rotate (w19 `xor` w14 `xor` w08 `xor` w06) 1+ w23 = rotate (w20 `xor` w15 `xor` w09 `xor` w07) 1+ w24 = rotate (w21 `xor` w16 `xor` w10 `xor` w08) 1+ w25 = rotate (w22 `xor` w17 `xor` w11 `xor` w09) 1+ w26 = rotate (w23 `xor` w18 `xor` w12 `xor` w10) 1+ w27 = rotate (w24 `xor` w19 `xor` w13 `xor` w11) 1+ w28 = rotate (w25 `xor` w20 `xor` w14 `xor` w12) 1+ w29 = rotate (w26 `xor` w21 `xor` w15 `xor` w13) 1+ w30 = rotate (w27 `xor` w22 `xor` w16 `xor` w14) 1+ w31 = rotate (w28 `xor` w23 `xor` w17 `xor` w15) 1+ w32 = rotate (w29 `xor` w24 `xor` w18 `xor` w16) 1+ w33 = rotate (w30 `xor` w25 `xor` w19 `xor` w17) 1+ w34 = rotate (w31 `xor` w26 `xor` w20 `xor` w18) 1+ w35 = rotate (w32 `xor` w27 `xor` w21 `xor` w19) 1+ w36 = rotate (w33 `xor` w28 `xor` w22 `xor` w20) 1+ w37 = rotate (w34 `xor` w29 `xor` w23 `xor` w21) 1+ w38 = rotate (w35 `xor` w30 `xor` w24 `xor` w22) 1+ w39 = rotate (w36 `xor` w31 `xor` w25 `xor` w23) 1+ w40 = rotate (w37 `xor` w32 `xor` w26 `xor` w24) 1+ w41 = rotate (w38 `xor` w33 `xor` w27 `xor` w25) 1+ w42 = rotate (w39 `xor` w34 `xor` w28 `xor` w26) 1+ w43 = rotate (w40 `xor` w35 `xor` w29 `xor` w27) 1+ w44 = rotate (w41 `xor` w36 `xor` w30 `xor` w28) 1+ w45 = rotate (w42 `xor` w37 `xor` w31 `xor` w29) 1+ w46 = rotate (w43 `xor` w38 `xor` w32 `xor` w30) 1+ w47 = rotate (w44 `xor` w39 `xor` w33 `xor` w31) 1+ w48 = rotate (w45 `xor` w40 `xor` w34 `xor` w32) 1+ w49 = rotate (w46 `xor` w41 `xor` w35 `xor` w33) 1+ w50 = rotate (w47 `xor` w42 `xor` w36 `xor` w34) 1+ w51 = rotate (w48 `xor` w43 `xor` w37 `xor` w35) 1+ w52 = rotate (w49 `xor` w44 `xor` w38 `xor` w36) 1+ w53 = rotate (w50 `xor` w45 `xor` w39 `xor` w37) 1+ w54 = rotate (w51 `xor` w46 `xor` w40 `xor` w38) 1+ w55 = rotate (w52 `xor` w47 `xor` w41 `xor` w39) 1+ w56 = rotate (w53 `xor` w48 `xor` w42 `xor` w40) 1+ w57 = rotate (w54 `xor` w49 `xor` w43 `xor` w41) 1+ w58 = rotate (w55 `xor` w50 `xor` w44 `xor` w42) 1+ w59 = rotate (w56 `xor` w51 `xor` w45 `xor` w43) 1+ w60 = rotate (w57 `xor` w52 `xor` w46 `xor` w44) 1+ w61 = rotate (w58 `xor` w53 `xor` w47 `xor` w45) 1+ w62 = rotate (w59 `xor` w54 `xor` w48 `xor` w46) 1+ w63 = rotate (w60 `xor` w55 `xor` w49 `xor` w47) 1+ w64 = rotate (w61 `xor` w56 `xor` w50 `xor` w48) 1+ w65 = rotate (w62 `xor` w57 `xor` w51 `xor` w49) 1+ w66 = rotate (w63 `xor` w58 `xor` w52 `xor` w50) 1+ w67 = rotate (w64 `xor` w59 `xor` w53 `xor` w51) 1+ w68 = rotate (w65 `xor` w60 `xor` w54 `xor` w52) 1+ w69 = rotate (w66 `xor` w61 `xor` w55 `xor` w53) 1+ w70 = rotate (w67 `xor` w62 `xor` w56 `xor` w54) 1+ w71 = rotate (w68 `xor` w63 `xor` w57 `xor` w55) 1+ w72 = rotate (w69 `xor` w64 `xor` w58 `xor` w56) 1+ w73 = rotate (w70 `xor` w65 `xor` w59 `xor` w57) 1+ w74 = rotate (w71 `xor` w66 `xor` w60 `xor` w58) 1+ w75 = rotate (w72 `xor` w67 `xor` w61 `xor` w59) 1+ w76 = rotate (w73 `xor` w68 `xor` w62 `xor` w60) 1+ w77 = rotate (w74 `xor` w69 `xor` w63 `xor` w61) 1+ w78 = rotate (w75 `xor` w70 `xor` w64 `xor` w62) 1+ w79 = rotate (w76 `xor` w71 `xor` w65 `xor` w63) 1+ return $ SHA1Sched w00 w01 w02 w03 w04 w05 w06 w07 w08 w09+ w10 w11 w12 w13 w14 w15 w16 w17 w18 w19+ w20 w21 w22 w23 w24 w25 w26 w27 w28 w29+ w30 w31 w32 w33 w34 w35 w36 w37 w38 w39+ w40 w41 w42 w43 w44 w45 w46 w47 w48 w49+ w50 w51 w52 w53 w54 w55 w56 w57 w58 w59+ w60 w61 w62 w63 w64 w65 w66 w67 w68 w69+ w70 w71 w72 w73 w74 w75 w76 w77 w78 w79++data SHA256Sched = SHA256Sched !Word32 !Word32 !Word32 !Word32 !Word32 -- 00-04+ !Word32 !Word32 !Word32 !Word32 !Word32 -- 05-09+ !Word32 !Word32 !Word32 !Word32 !Word32 -- 10-04+ !Word32 !Word32 !Word32 !Word32 !Word32 -- 15-09+ !Word32 !Word32 !Word32 !Word32 !Word32 -- 20-04+ !Word32 !Word32 !Word32 !Word32 !Word32 -- 25-09+ !Word32 !Word32 !Word32 !Word32 !Word32 -- 30-04+ !Word32 !Word32 !Word32 !Word32 !Word32 -- 35-09+ !Word32 !Word32 !Word32 !Word32 !Word32 -- 40-04+ !Word32 !Word32 !Word32 !Word32 !Word32 -- 45-09+ !Word32 !Word32 !Word32 !Word32 !Word32 -- 50-04+ !Word32 !Word32 !Word32 !Word32 !Word32 -- 55-09+ !Word32 !Word32 !Word32 !Word32 -- 60-63++getSHA256Sched :: Get SHA256Sched+getSHA256Sched = do+ w00 <- getWord32be+ w01 <- getWord32be+ w02 <- getWord32be+ w03 <- getWord32be+ w04 <- getWord32be+ w05 <- getWord32be+ w06 <- getWord32be+ w07 <- getWord32be+ w08 <- getWord32be+ w09 <- getWord32be+ w10 <- getWord32be+ w11 <- getWord32be+ w12 <- getWord32be+ w13 <- getWord32be+ w14 <- getWord32be+ w15 <- getWord32be+ let w16 = (lsig256_1 w14) + w09 + (lsig256_0 w01) + w00+ w17 = (lsig256_1 w15) + w10 + (lsig256_0 w02) + w01+ w18 = (lsig256_1 w16) + w11 + (lsig256_0 w03) + w02+ w19 = (lsig256_1 w17) + w12 + (lsig256_0 w04) + w03+ w20 = (lsig256_1 w18) + w13 + (lsig256_0 w05) + w04+ w21 = (lsig256_1 w19) + w14 + (lsig256_0 w06) + w05+ w22 = (lsig256_1 w20) + w15 + (lsig256_0 w07) + w06+ w23 = (lsig256_1 w21) + w16 + (lsig256_0 w08) + w07+ w24 = (lsig256_1 w22) + w17 + (lsig256_0 w09) + w08+ w25 = (lsig256_1 w23) + w18 + (lsig256_0 w10) + w09+ w26 = (lsig256_1 w24) + w19 + (lsig256_0 w11) + w10+ w27 = (lsig256_1 w25) + w20 + (lsig256_0 w12) + w11+ w28 = (lsig256_1 w26) + w21 + (lsig256_0 w13) + w12+ w29 = (lsig256_1 w27) + w22 + (lsig256_0 w14) + w13+ w30 = (lsig256_1 w28) + w23 + (lsig256_0 w15) + w14+ w31 = (lsig256_1 w29) + w24 + (lsig256_0 w16) + w15+ w32 = (lsig256_1 w30) + w25 + (lsig256_0 w17) + w16+ w33 = (lsig256_1 w31) + w26 + (lsig256_0 w18) + w17+ w34 = (lsig256_1 w32) + w27 + (lsig256_0 w19) + w18+ w35 = (lsig256_1 w33) + w28 + (lsig256_0 w20) + w19+ w36 = (lsig256_1 w34) + w29 + (lsig256_0 w21) + w20+ w37 = (lsig256_1 w35) + w30 + (lsig256_0 w22) + w21+ w38 = (lsig256_1 w36) + w31 + (lsig256_0 w23) + w22+ w39 = (lsig256_1 w37) + w32 + (lsig256_0 w24) + w23+ w40 = (lsig256_1 w38) + w33 + (lsig256_0 w25) + w24+ w41 = (lsig256_1 w39) + w34 + (lsig256_0 w26) + w25+ w42 = (lsig256_1 w40) + w35 + (lsig256_0 w27) + w26+ w43 = (lsig256_1 w41) + w36 + (lsig256_0 w28) + w27+ w44 = (lsig256_1 w42) + w37 + (lsig256_0 w29) + w28+ w45 = (lsig256_1 w43) + w38 + (lsig256_0 w30) + w29+ w46 = (lsig256_1 w44) + w39 + (lsig256_0 w31) + w30+ w47 = (lsig256_1 w45) + w40 + (lsig256_0 w32) + w31+ w48 = (lsig256_1 w46) + w41 + (lsig256_0 w33) + w32+ w49 = (lsig256_1 w47) + w42 + (lsig256_0 w34) + w33+ w50 = (lsig256_1 w48) + w43 + (lsig256_0 w35) + w34+ w51 = (lsig256_1 w49) + w44 + (lsig256_0 w36) + w35+ w52 = (lsig256_1 w50) + w45 + (lsig256_0 w37) + w36+ w53 = (lsig256_1 w51) + w46 + (lsig256_0 w38) + w37+ w54 = (lsig256_1 w52) + w47 + (lsig256_0 w39) + w38+ w55 = (lsig256_1 w53) + w48 + (lsig256_0 w40) + w39+ w56 = (lsig256_1 w54) + w49 + (lsig256_0 w41) + w40+ w57 = (lsig256_1 w55) + w50 + (lsig256_0 w42) + w41+ w58 = (lsig256_1 w56) + w51 + (lsig256_0 w43) + w42+ w59 = (lsig256_1 w57) + w52 + (lsig256_0 w44) + w43+ w60 = (lsig256_1 w58) + w53 + (lsig256_0 w45) + w44+ w61 = (lsig256_1 w59) + w54 + (lsig256_0 w46) + w45+ w62 = (lsig256_1 w60) + w55 + (lsig256_0 w47) + w46+ w63 = (lsig256_1 w61) + w56 + (lsig256_0 w48) + w47+ return $ SHA256Sched w00 w01 w02 w03 w04 w05 w06 w07 w08 w09+ w10 w11 w12 w13 w14 w15 w16 w17 w18 w19+ w20 w21 w22 w23 w24 w25 w26 w27 w28 w29+ w30 w31 w32 w33 w34 w35 w36 w37 w38 w39+ w40 w41 w42 w43 w44 w45 w46 w47 w48 w49+ w50 w51 w52 w53 w54 w55 w56 w57 w58 w59+ w60 w61 w62 w63++data SHA512Sched = SHA512Sched !Word64 !Word64 !Word64 !Word64 !Word64 -- 0- 4+ !Word64 !Word64 !Word64 !Word64 !Word64 -- 5- 9+ !Word64 !Word64 !Word64 !Word64 !Word64 -- 10-14+ !Word64 !Word64 !Word64 !Word64 !Word64 -- 15-19+ !Word64 !Word64 !Word64 !Word64 !Word64 -- 20-24+ !Word64 !Word64 !Word64 !Word64 !Word64 -- 25-29+ !Word64 !Word64 !Word64 !Word64 !Word64 -- 30-34+ !Word64 !Word64 !Word64 !Word64 !Word64 -- 35-39+ !Word64 !Word64 !Word64 !Word64 !Word64 -- 40-44+ !Word64 !Word64 !Word64 !Word64 !Word64 -- 45-49+ !Word64 !Word64 !Word64 !Word64 !Word64 -- 50-54+ !Word64 !Word64 !Word64 !Word64 !Word64 -- 55-59+ !Word64 !Word64 !Word64 !Word64 !Word64 -- 60-64+ !Word64 !Word64 !Word64 !Word64 !Word64 -- 65-69+ !Word64 !Word64 !Word64 !Word64 !Word64 -- 70-74+ !Word64 !Word64 !Word64 !Word64 !Word64 -- 75-79++getSHA512Sched :: Get SHA512Sched+getSHA512Sched = do+ w00 <- getWord64be+ w01 <- getWord64be+ w02 <- getWord64be+ w03 <- getWord64be+ w04 <- getWord64be+ w05 <- getWord64be+ w06 <- getWord64be+ w07 <- getWord64be+ w08 <- getWord64be+ w09 <- getWord64be+ w10 <- getWord64be+ w11 <- getWord64be+ w12 <- getWord64be+ w13 <- getWord64be+ w14 <- getWord64be+ w15 <- getWord64be+ let w16 = (lsig512_1 w14) + w09 + (lsig512_0 w01) + w00+ w17 = (lsig512_1 w15) + w10 + (lsig512_0 w02) + w01+ w18 = (lsig512_1 w16) + w11 + (lsig512_0 w03) + w02+ w19 = (lsig512_1 w17) + w12 + (lsig512_0 w04) + w03+ w20 = (lsig512_1 w18) + w13 + (lsig512_0 w05) + w04+ w21 = (lsig512_1 w19) + w14 + (lsig512_0 w06) + w05+ w22 = (lsig512_1 w20) + w15 + (lsig512_0 w07) + w06+ w23 = (lsig512_1 w21) + w16 + (lsig512_0 w08) + w07+ w24 = (lsig512_1 w22) + w17 + (lsig512_0 w09) + w08+ w25 = (lsig512_1 w23) + w18 + (lsig512_0 w10) + w09+ w26 = (lsig512_1 w24) + w19 + (lsig512_0 w11) + w10+ w27 = (lsig512_1 w25) + w20 + (lsig512_0 w12) + w11+ w28 = (lsig512_1 w26) + w21 + (lsig512_0 w13) + w12+ w29 = (lsig512_1 w27) + w22 + (lsig512_0 w14) + w13+ w30 = (lsig512_1 w28) + w23 + (lsig512_0 w15) + w14+ w31 = (lsig512_1 w29) + w24 + (lsig512_0 w16) + w15+ w32 = (lsig512_1 w30) + w25 + (lsig512_0 w17) + w16+ w33 = (lsig512_1 w31) + w26 + (lsig512_0 w18) + w17+ w34 = (lsig512_1 w32) + w27 + (lsig512_0 w19) + w18+ w35 = (lsig512_1 w33) + w28 + (lsig512_0 w20) + w19+ w36 = (lsig512_1 w34) + w29 + (lsig512_0 w21) + w20+ w37 = (lsig512_1 w35) + w30 + (lsig512_0 w22) + w21+ w38 = (lsig512_1 w36) + w31 + (lsig512_0 w23) + w22+ w39 = (lsig512_1 w37) + w32 + (lsig512_0 w24) + w23+ w40 = (lsig512_1 w38) + w33 + (lsig512_0 w25) + w24+ w41 = (lsig512_1 w39) + w34 + (lsig512_0 w26) + w25+ w42 = (lsig512_1 w40) + w35 + (lsig512_0 w27) + w26+ w43 = (lsig512_1 w41) + w36 + (lsig512_0 w28) + w27+ w44 = (lsig512_1 w42) + w37 + (lsig512_0 w29) + w28+ w45 = (lsig512_1 w43) + w38 + (lsig512_0 w30) + w29+ w46 = (lsig512_1 w44) + w39 + (lsig512_0 w31) + w30+ w47 = (lsig512_1 w45) + w40 + (lsig512_0 w32) + w31+ w48 = (lsig512_1 w46) + w41 + (lsig512_0 w33) + w32+ w49 = (lsig512_1 w47) + w42 + (lsig512_0 w34) + w33+ w50 = (lsig512_1 w48) + w43 + (lsig512_0 w35) + w34+ w51 = (lsig512_1 w49) + w44 + (lsig512_0 w36) + w35+ w52 = (lsig512_1 w50) + w45 + (lsig512_0 w37) + w36+ w53 = (lsig512_1 w51) + w46 + (lsig512_0 w38) + w37+ w54 = (lsig512_1 w52) + w47 + (lsig512_0 w39) + w38+ w55 = (lsig512_1 w53) + w48 + (lsig512_0 w40) + w39+ w56 = (lsig512_1 w54) + w49 + (lsig512_0 w41) + w40+ w57 = (lsig512_1 w55) + w50 + (lsig512_0 w42) + w41+ w58 = (lsig512_1 w56) + w51 + (lsig512_0 w43) + w42+ w59 = (lsig512_1 w57) + w52 + (lsig512_0 w44) + w43+ w60 = (lsig512_1 w58) + w53 + (lsig512_0 w45) + w44+ w61 = (lsig512_1 w59) + w54 + (lsig512_0 w46) + w45+ w62 = (lsig512_1 w60) + w55 + (lsig512_0 w47) + w46+ w63 = (lsig512_1 w61) + w56 + (lsig512_0 w48) + w47+ w64 = (lsig512_1 w62) + w57 + (lsig512_0 w49) + w48+ w65 = (lsig512_1 w63) + w58 + (lsig512_0 w50) + w49+ w66 = (lsig512_1 w64) + w59 + (lsig512_0 w51) + w50+ w67 = (lsig512_1 w65) + w60 + (lsig512_0 w52) + w51+ w68 = (lsig512_1 w66) + w61 + (lsig512_0 w53) + w52+ w69 = (lsig512_1 w67) + w62 + (lsig512_0 w54) + w53+ w70 = (lsig512_1 w68) + w63 + (lsig512_0 w55) + w54+ w71 = (lsig512_1 w69) + w64 + (lsig512_0 w56) + w55+ w72 = (lsig512_1 w70) + w65 + (lsig512_0 w57) + w56+ w73 = (lsig512_1 w71) + w66 + (lsig512_0 w58) + w57+ w74 = (lsig512_1 w72) + w67 + (lsig512_0 w59) + w58+ w75 = (lsig512_1 w73) + w68 + (lsig512_0 w60) + w59+ w76 = (lsig512_1 w74) + w69 + (lsig512_0 w61) + w60+ w77 = (lsig512_1 w75) + w70 + (lsig512_0 w62) + w61+ w78 = (lsig512_1 w76) + w71 + (lsig512_0 w63) + w62+ w79 = (lsig512_1 w77) + w72 + (lsig512_0 w64) + w63+ return $ SHA512Sched w00 w01 w02 w03 w04 w05 w06 w07 w08 w09 + w10 w11 w12 w13 w14 w15 w16 w17 w18 w19 + w20 w21 w22 w23 w24 w25 w26 w27 w28 w29 + w30 w31 w32 w33 w34 w35 w36 w37 w38 w39 + w40 w41 w42 w43 w44 w45 w46 w47 w48 w49 + w50 w51 w52 w53 w54 w55 w56 w57 w58 w59 + w60 w61 w62 w63 w64 w65 w66 w67 w68 w69 + w70 w71 w72 w73 w74 w75 w76 w77 w78 w79 ++-- --------------------------------------------------------------------------+--+-- SHA Block Processors+--+-- --------------------------------------------------------------------------++processSHA1Block :: SHA1State -> Get SHA1State+processSHA1Block s00@(SHA1S a00 b00 c00 d00 e00) = do+ (SHA1Sched w00 w01 w02 w03 w04 w05 w06 w07 w08 w09+ w10 w11 w12 w13 w14 w15 w16 w17 w18 w19+ w20 w21 w22 w23 w24 w25 w26 w27 w28 w29+ w30 w31 w32 w33 w34 w35 w36 w37 w38 w39+ w40 w41 w42 w43 w44 w45 w46 w47 w48 w49+ w50 w51 w52 w53 w54 w55 w56 w57 w58 w59+ w60 w61 w62 w63 w64 w65 w66 w67 w68 w69+ w70 w71 w72 w73 w74 w75 w76 w77 w78 w79) <- getSHA1Sched+ let !s01 = step1 s00 0x5a827999 ch w00+ !s02 = step1 s01 0x5a827999 ch w01+ !s03 = step1 s02 0x5a827999 ch w02+ !s04 = step1 s03 0x5a827999 ch w03+ !s05 = step1 s04 0x5a827999 ch w04+ !s06 = step1 s05 0x5a827999 ch w05+ !s07 = step1 s06 0x5a827999 ch w06+ !s08 = step1 s07 0x5a827999 ch w07+ !s09 = step1 s08 0x5a827999 ch w08+ !s10 = step1 s09 0x5a827999 ch w09+ !s11 = step1 s10 0x5a827999 ch w10+ !s12 = step1 s11 0x5a827999 ch w11+ !s13 = step1 s12 0x5a827999 ch w12+ !s14 = step1 s13 0x5a827999 ch w13+ !s15 = step1 s14 0x5a827999 ch w14+ !s16 = step1 s15 0x5a827999 ch w15+ !s17 = step1 s16 0x5a827999 ch w16+ !s18 = step1 s17 0x5a827999 ch w17+ !s19 = step1 s18 0x5a827999 ch w18+ !s20 = step1 s19 0x5a827999 ch w19+ !s21 = step1 s20 0x6ed9eba1 parity w20+ !s22 = step1 s21 0x6ed9eba1 parity w21+ !s23 = step1 s22 0x6ed9eba1 parity w22+ !s24 = step1 s23 0x6ed9eba1 parity w23+ !s25 = step1 s24 0x6ed9eba1 parity w24+ !s26 = step1 s25 0x6ed9eba1 parity w25+ !s27 = step1 s26 0x6ed9eba1 parity w26+ !s28 = step1 s27 0x6ed9eba1 parity w27+ !s29 = step1 s28 0x6ed9eba1 parity w28+ !s30 = step1 s29 0x6ed9eba1 parity w29+ !s31 = step1 s30 0x6ed9eba1 parity w30+ !s32 = step1 s31 0x6ed9eba1 parity w31+ !s33 = step1 s32 0x6ed9eba1 parity w32+ !s34 = step1 s33 0x6ed9eba1 parity w33+ !s35 = step1 s34 0x6ed9eba1 parity w34+ !s36 = step1 s35 0x6ed9eba1 parity w35+ !s37 = step1 s36 0x6ed9eba1 parity w36+ !s38 = step1 s37 0x6ed9eba1 parity w37+ !s39 = step1 s38 0x6ed9eba1 parity w38+ !s40 = step1 s39 0x6ed9eba1 parity w39+ !s41 = step1 s40 0x8f1bbcdc maj w40+ !s42 = step1 s41 0x8f1bbcdc maj w41+ !s43 = step1 s42 0x8f1bbcdc maj w42+ !s44 = step1 s43 0x8f1bbcdc maj w43+ !s45 = step1 s44 0x8f1bbcdc maj w44+ !s46 = step1 s45 0x8f1bbcdc maj w45+ !s47 = step1 s46 0x8f1bbcdc maj w46+ !s48 = step1 s47 0x8f1bbcdc maj w47+ !s49 = step1 s48 0x8f1bbcdc maj w48+ !s50 = step1 s49 0x8f1bbcdc maj w49+ !s51 = step1 s50 0x8f1bbcdc maj w50+ !s52 = step1 s51 0x8f1bbcdc maj w51+ !s53 = step1 s52 0x8f1bbcdc maj w52+ !s54 = step1 s53 0x8f1bbcdc maj w53+ !s55 = step1 s54 0x8f1bbcdc maj w54+ !s56 = step1 s55 0x8f1bbcdc maj w55+ !s57 = step1 s56 0x8f1bbcdc maj w56+ !s58 = step1 s57 0x8f1bbcdc maj w57+ !s59 = step1 s58 0x8f1bbcdc maj w58+ !s60 = step1 s59 0x8f1bbcdc maj w59+ !s61 = step1 s60 0xca62c1d6 parity w60+ !s62 = step1 s61 0xca62c1d6 parity w61+ !s63 = step1 s62 0xca62c1d6 parity w62+ !s64 = step1 s63 0xca62c1d6 parity w63+ !s65 = step1 s64 0xca62c1d6 parity w64+ !s66 = step1 s65 0xca62c1d6 parity w65+ !s67 = step1 s66 0xca62c1d6 parity w66+ !s68 = step1 s67 0xca62c1d6 parity w67+ !s69 = step1 s68 0xca62c1d6 parity w68+ !s70 = step1 s69 0xca62c1d6 parity w69+ !s71 = step1 s70 0xca62c1d6 parity w70+ !s72 = step1 s71 0xca62c1d6 parity w71+ !s73 = step1 s72 0xca62c1d6 parity w72+ !s74 = step1 s73 0xca62c1d6 parity w73+ !s75 = step1 s74 0xca62c1d6 parity w74+ !s76 = step1 s75 0xca62c1d6 parity w75+ !s77 = step1 s76 0xca62c1d6 parity w76+ !s78 = step1 s77 0xca62c1d6 parity w77+ !s79 = step1 s78 0xca62c1d6 parity w78+ !s80 = step1 s79 0xca62c1d6 parity w79+ SHA1S a80 b80 c80 d80 e80 = s80+ return $ SHA1S (a00 + a80) (b00 + b80) (c00 + c80) (d00 + d80) (e00 + e80)++{-# INLINE step1 #-}+step1 :: SHA1State -> Word32 -> + (Word32 -> Word32 -> Word32 -> Word32) -> Word32 -> + SHA1State+step1 (SHA1S a b c d e) !k !f !w = SHA1S a' b' c' d' e'+ where a' = (rotate a 5) + (f b c d) + e + k + w+ b' = a+ c' = rotate b 30+ d' = c+ e' = d+ +processSHA256Block :: SHA256State -> Get SHA256State+processSHA256Block !s00@(SHA256S a00 b00 c00 d00 e00 f00 g00 h00) = do+ (SHA256Sched w00 w01 w02 w03 w04 w05 w06 w07 w08 w09+ w10 w11 w12 w13 w14 w15 w16 w17 w18 w19+ w20 w21 w22 w23 w24 w25 w26 w27 w28 w29+ w30 w31 w32 w33 w34 w35 w36 w37 w38 w39+ w40 w41 w42 w43 w44 w45 w46 w47 w48 w49+ w50 w51 w52 w53 w54 w55 w56 w57 w58 w59+ w60 w61 w62 w63) <- getSHA256Sched+ let !s01 = step256 s00 (sha256_k ! 00) w00+ !s02 = step256 s01 (sha256_k ! 01) w01+ !s03 = step256 s02 (sha256_k ! 02) w02+ !s04 = step256 s03 (sha256_k ! 03) w03+ !s05 = step256 s04 (sha256_k ! 04) w04+ !s06 = step256 s05 (sha256_k ! 05) w05+ !s07 = step256 s06 (sha256_k ! 06) w06+ !s08 = step256 s07 (sha256_k ! 07) w07+ !s09 = step256 s08 (sha256_k ! 08) w08+ !s10 = step256 s09 (sha256_k ! 09) w09+ !s11 = step256 s10 (sha256_k ! 10) w10+ !s12 = step256 s11 (sha256_k ! 11) w11+ !s13 = step256 s12 (sha256_k ! 12) w12+ !s14 = step256 s13 (sha256_k ! 13) w13+ !s15 = step256 s14 (sha256_k ! 14) w14+ !s16 = step256 s15 (sha256_k ! 15) w15+ !s17 = step256 s16 (sha256_k ! 16) w16+ !s18 = step256 s17 (sha256_k ! 17) w17+ !s19 = step256 s18 (sha256_k ! 18) w18+ !s20 = step256 s19 (sha256_k ! 19) w19+ !s21 = step256 s20 (sha256_k ! 20) w20+ !s22 = step256 s21 (sha256_k ! 21) w21+ !s23 = step256 s22 (sha256_k ! 22) w22+ !s24 = step256 s23 (sha256_k ! 23) w23+ !s25 = step256 s24 (sha256_k ! 24) w24+ !s26 = step256 s25 (sha256_k ! 25) w25+ !s27 = step256 s26 (sha256_k ! 26) w26+ !s28 = step256 s27 (sha256_k ! 27) w27+ !s29 = step256 s28 (sha256_k ! 28) w28+ !s30 = step256 s29 (sha256_k ! 29) w29+ !s31 = step256 s30 (sha256_k ! 30) w30+ !s32 = step256 s31 (sha256_k ! 31) w31+ !s33 = step256 s32 (sha256_k ! 32) w32+ !s34 = step256 s33 (sha256_k ! 33) w33+ !s35 = step256 s34 (sha256_k ! 34) w34+ !s36 = step256 s35 (sha256_k ! 35) w35+ !s37 = step256 s36 (sha256_k ! 36) w36+ !s38 = step256 s37 (sha256_k ! 37) w37+ !s39 = step256 s38 (sha256_k ! 38) w38+ !s40 = step256 s39 (sha256_k ! 39) w39+ !s41 = step256 s40 (sha256_k ! 40) w40+ !s42 = step256 s41 (sha256_k ! 41) w41+ !s43 = step256 s42 (sha256_k ! 42) w42+ !s44 = step256 s43 (sha256_k ! 43) w43+ !s45 = step256 s44 (sha256_k ! 44) w44+ !s46 = step256 s45 (sha256_k ! 45) w45+ !s47 = step256 s46 (sha256_k ! 46) w46+ !s48 = step256 s47 (sha256_k ! 47) w47+ !s49 = step256 s48 (sha256_k ! 48) w48+ !s50 = step256 s49 (sha256_k ! 49) w49+ !s51 = step256 s50 (sha256_k ! 50) w50+ !s52 = step256 s51 (sha256_k ! 51) w51+ !s53 = step256 s52 (sha256_k ! 52) w52+ !s54 = step256 s53 (sha256_k ! 53) w53+ !s55 = step256 s54 (sha256_k ! 54) w54+ !s56 = step256 s55 (sha256_k ! 55) w55+ !s57 = step256 s56 (sha256_k ! 56) w56+ !s58 = step256 s57 (sha256_k ! 57) w57+ !s59 = step256 s58 (sha256_k ! 58) w58+ !s60 = step256 s59 (sha256_k ! 59) w59+ !s61 = step256 s60 (sha256_k ! 60) w60+ !s62 = step256 s61 (sha256_k ! 61) w61+ !s63 = step256 s62 (sha256_k ! 62) w62+ !s64 = step256 s63 (sha256_k ! 63) w63+ SHA256S a64 b64 c64 d64 e64 f64 g64 h64 = s64+ return $ SHA256S (a00 + a64) (b00 + b64) (c00 + c64) (d00 + d64)+ (e00 + e64) (f00 + f64) (g00 + g64) (h00 + h64)++{-# INLINE step256 #-}+step256 :: SHA256State -> Word32 -> Word32 -> SHA256State+step256 (SHA256S a b c d e f g h) k w = SHA256S a' b' c' d' e' f' g' h' + where+ t1 = h + bsig256_1 e + ch e f g + k + w+ t2 = bsig256_0 a + maj a b c+ h' = g+ g' = f+ f' = e+ e' = d + t1+ d' = c+ c' = b+ b' = a+ a' = t1 + t2++processSHA512Block :: SHA512State -> Get SHA512State+processSHA512Block !s00@(SHA512S a00 b00 c00 d00 e00 f00 g00 h00) = do+ (SHA512Sched w00 w01 w02 w03 w04 w05 w06 w07 w08 w09+ w10 w11 w12 w13 w14 w15 w16 w17 w18 w19+ w20 w21 w22 w23 w24 w25 w26 w27 w28 w29+ w30 w31 w32 w33 w34 w35 w36 w37 w38 w39+ w40 w41 w42 w43 w44 w45 w46 w47 w48 w49+ w50 w51 w52 w53 w54 w55 w56 w57 w58 w59+ w60 w61 w62 w63 w64 w65 w66 w67 w68 w69+ w70 w71 w72 w73 w74 w75 w76 w77 w78 w79) <- getSHA512Sched+ let !s01 = step512 s00 (sha512_k ! 00) w00+ !s02 = step512 s01 (sha512_k ! 01) w01+ !s03 = step512 s02 (sha512_k ! 02) w02+ !s04 = step512 s03 (sha512_k ! 03) w03+ !s05 = step512 s04 (sha512_k ! 04) w04+ !s06 = step512 s05 (sha512_k ! 05) w05+ !s07 = step512 s06 (sha512_k ! 06) w06+ !s08 = step512 s07 (sha512_k ! 07) w07+ !s09 = step512 s08 (sha512_k ! 08) w08+ !s10 = step512 s09 (sha512_k ! 09) w09+ !s11 = step512 s10 (sha512_k ! 10) w10+ !s12 = step512 s11 (sha512_k ! 11) w11+ !s13 = step512 s12 (sha512_k ! 12) w12+ !s14 = step512 s13 (sha512_k ! 13) w13+ !s15 = step512 s14 (sha512_k ! 14) w14+ !s16 = step512 s15 (sha512_k ! 15) w15+ !s17 = step512 s16 (sha512_k ! 16) w16+ !s18 = step512 s17 (sha512_k ! 17) w17+ !s19 = step512 s18 (sha512_k ! 18) w18+ !s20 = step512 s19 (sha512_k ! 19) w19+ !s21 = step512 s20 (sha512_k ! 20) w20+ !s22 = step512 s21 (sha512_k ! 21) w21+ !s23 = step512 s22 (sha512_k ! 22) w22+ !s24 = step512 s23 (sha512_k ! 23) w23+ !s25 = step512 s24 (sha512_k ! 24) w24+ !s26 = step512 s25 (sha512_k ! 25) w25+ !s27 = step512 s26 (sha512_k ! 26) w26+ !s28 = step512 s27 (sha512_k ! 27) w27+ !s29 = step512 s28 (sha512_k ! 28) w28+ !s30 = step512 s29 (sha512_k ! 29) w29+ !s31 = step512 s30 (sha512_k ! 30) w30+ !s32 = step512 s31 (sha512_k ! 31) w31+ !s33 = step512 s32 (sha512_k ! 32) w32+ !s34 = step512 s33 (sha512_k ! 33) w33+ !s35 = step512 s34 (sha512_k ! 34) w34+ !s36 = step512 s35 (sha512_k ! 35) w35+ !s37 = step512 s36 (sha512_k ! 36) w36+ !s38 = step512 s37 (sha512_k ! 37) w37+ !s39 = step512 s38 (sha512_k ! 38) w38+ !s40 = step512 s39 (sha512_k ! 39) w39+ !s41 = step512 s40 (sha512_k ! 40) w40+ !s42 = step512 s41 (sha512_k ! 41) w41+ !s43 = step512 s42 (sha512_k ! 42) w42+ !s44 = step512 s43 (sha512_k ! 43) w43+ !s45 = step512 s44 (sha512_k ! 44) w44+ !s46 = step512 s45 (sha512_k ! 45) w45+ !s47 = step512 s46 (sha512_k ! 46) w46+ !s48 = step512 s47 (sha512_k ! 47) w47+ !s49 = step512 s48 (sha512_k ! 48) w48+ !s50 = step512 s49 (sha512_k ! 49) w49+ !s51 = step512 s50 (sha512_k ! 50) w50+ !s52 = step512 s51 (sha512_k ! 51) w51+ !s53 = step512 s52 (sha512_k ! 52) w52+ !s54 = step512 s53 (sha512_k ! 53) w53+ !s55 = step512 s54 (sha512_k ! 54) w54+ !s56 = step512 s55 (sha512_k ! 55) w55+ !s57 = step512 s56 (sha512_k ! 56) w56+ !s58 = step512 s57 (sha512_k ! 57) w57+ !s59 = step512 s58 (sha512_k ! 58) w58+ !s60 = step512 s59 (sha512_k ! 59) w59+ !s61 = step512 s60 (sha512_k ! 60) w60+ !s62 = step512 s61 (sha512_k ! 61) w61+ !s63 = step512 s62 (sha512_k ! 62) w62+ !s64 = step512 s63 (sha512_k ! 63) w63+ !s65 = step512 s64 (sha512_k ! 64) w64+ !s66 = step512 s65 (sha512_k ! 65) w65+ !s67 = step512 s66 (sha512_k ! 66) w66+ !s68 = step512 s67 (sha512_k ! 67) w67+ !s69 = step512 s68 (sha512_k ! 68) w68+ !s70 = step512 s69 (sha512_k ! 69) w69+ !s71 = step512 s70 (sha512_k ! 70) w70+ !s72 = step512 s71 (sha512_k ! 71) w71+ !s73 = step512 s72 (sha512_k ! 72) w72+ !s74 = step512 s73 (sha512_k ! 73) w73+ !s75 = step512 s74 (sha512_k ! 74) w74+ !s76 = step512 s75 (sha512_k ! 75) w75+ !s77 = step512 s76 (sha512_k ! 76) w76+ !s78 = step512 s77 (sha512_k ! 77) w77+ !s79 = step512 s78 (sha512_k ! 78) w78+ !s80 = step512 s79 (sha512_k ! 79) w79+ SHA512S a80 b80 c80 d80 e80 f80 g80 h80 = s80+ return $ SHA512S (a00 + a80) (b00 + b80) (c00 + c80) (d00 + d80)+ (e00 + e80) (f00 + f80) (g00 + g80) (h00 + h80)++{-# INLINE step512 #-}+step512 :: SHA512State -> Word64 -> Word64 -> SHA512State +step512 (SHA512S a b c d e f g h) k w = SHA512S a' b' c' d' e' f' g' h'+ where+ t1 = h + bsig512_1 e + ch e f g + k + w+ t2 = bsig512_0 a + maj a b c+ h' = g+ g' = f+ f' = e+ e' = d + t1+ d' = c+ c' = b+ b' = a+ a' = t1 + t2++-- --------------------------------------------------------------------------+--+-- Run the routines+--+-- --------------------------------------------------------------------------++runSHA :: a -> (a -> Get a) -> ByteString -> a+runSHA s nextChunk input = runGet (getAll s) input+ where + getAll s_in = do+ done <- isEmpty+ if done+ then return s_in+ else do s_out <- nextChunk s_in+ getAll s_out++-- |Compute the SHA-1 hash of the given ByteString. The output is guaranteed+-- to be exactly 160 bits, or 20 bytes, long. This is a good default for +-- programs that need a good, but not necessarily hyper-secure, hash function.+sha1 :: ByteString -> Digest+sha1 bs_in = Digest bs_out+ where+ bs_pad = padSHA1 bs_in+ fstate = runSHA initialSHA1State processSHA1Block bs_pad+ bs_out = runPut $ synthesizeSHA1 fstate++-- |Compute the SHA-224 hash of the given ByteString. Note that SHA-224 and+-- SHA-384 differ only slightly from SHA-256 and SHA-512, and use truncated+-- versions of the resulting hashes. So using 224/384 may not, in fact, save+-- you very much ...+sha224 :: ByteString -> Digest+sha224 bs_in = Digest bs_out+ where+ bs_pad = padSHA1 bs_in+ fstate = runSHA initialSHA224State processSHA256Block bs_pad+ bs_out = runPut $ synthesizeSHA224 fstate++-- |Compute the SHA-256 hash of the given ByteString. The output is guaranteed+-- to be exactly 256 bits, or 32 bytes, long. If your security requirements +-- are pretty serious, this is a good choice. For truly significant security+-- concerns, however, you might try one of the bigger options.+sha256 :: ByteString -> Digest+sha256 bs_in = Digest bs_out+ where+ bs_pad = padSHA1 bs_in+ fstate = runSHA initialSHA256State processSHA256Block bs_pad+ bs_out = runPut $ synthesizeSHA256 fstate++-- |Compute the SHA-384 hash of the given ByteString. Yup, you guessed it, +-- the output will be exactly 384 bits, or 48 bytes, long.+sha384 :: ByteString -> Digest+sha384 bs_in = Digest bs_out+ where+ bs_pad = padSHA512 bs_in+ fstate = runSHA initialSHA384State processSHA512Block bs_pad+ bs_out = runPut $ synthesizeSHA384 fstate++-- |For those for whom only the biggest hashes will do, this computes the+-- SHA-512 hash of the given ByteString. The output will be 64 bytes, or+-- 512 bits, long.+sha512 :: ByteString -> Digest+sha512 bs_in = Digest bs_out+ where+ bs_pad = padSHA512 bs_in+ fstate = runSHA initialSHA512State processSHA512Block bs_pad+ bs_out = runPut $ synthesizeSHA512 fstate++-- --------------------------------------------------------------------------+--+-- OTHER+--+-- --------------------------------------------------------------------------+++-- | Convert a digest to a string.+-- The digest is rendered as fixed with hexadecimal number.+showDigest :: Digest -> String+showDigest (Digest bs) = showDigestBS bs++-- |Prints out a bytestring in hexadecimal. Just for convenience.+showDigestBS :: ByteString -> String+showDigestBS bs = concatMap paddedShowHex $ BS.unpack bs+ where+ paddedShowHex x = toHex (x `shiftR` 4) ++ toHex (x .&. 0xf)+ toHex x = ["0","1","2","3","4","5","6","7","8","9","a","b","c","d","e","f"]+ !! (fromIntegral x)++-- | Convert a digest to an Integer.+integerDigest :: Digest -> Integer+integerDigest (Digest bs) = BS.foldl' addShift 0 bs+ where addShift n y = (n `shiftL` 8) .|. fromIntegral y++-- | Convert a digest to a ByteString.+bytestringDigest :: Digest -> ByteString+bytestringDigest (Digest bs) = bs
+ Main.hs view
@@ -0,0 +1,39 @@+import Control.Monad+import Data.Digest.Pure.SHA+import qualified Data.ByteString.Lazy as BS+import System.Directory+import System.Environment+import System.Exit++main :: IO ()+main = do+ bname <- getProgName+ args <- getArgs+ case args of+ [] -> do+ inconts <- BS.getContents+ putStrLn $ show $ ALGORITHM inconts+ exitSuccess+ xs -> do+ exit_code <- foldM (sha_file bname) ExitSuccess xs+ exitWith exit_code ++sha_file :: String -> ExitCode -> String -> IO ExitCode+sha_file bname prevEC fname = do+ is_file <- doesFileExist fname+ is_dir <- doesDirectoryExist fname+ case (is_file, is_dir) of+ (False, False) -> do+ putStrLn $ bname ++ ": " ++ fname ++ ": No such file or directory"+ return $ ExitFailure 22 -- EINVAL+ (False, True) -> do+ putStrLn $ bname ++ ": " ++ fname ++ ": Is a directory"+ return $ ExitFailure 22 -- EINVAL+ (True, _) -> do+ conts <- BS.readFile fname+ putStrLn $ bname ++ " (" ++ fname ++ ") = " ++ show (ALGORITHM conts)+ return $ combineExitCodes prevEC ExitSuccess++combineExitCodes :: ExitCode -> ExitCode -> ExitCode+combineExitCodes ExitSuccess ExitSuccess = ExitSuccess+combineExitCodes _ _ = ExitFailure 22 -- EINVAL
SHA.cabal view
@@ -1,6 +1,6 @@ name: SHA category: Cryptography, Codec-version: 1.0.4+version: 1.2.0 license: BSD3 license-file: LICENSE author: Adam Wick <awick@galois.com>@@ -13,27 +13,50 @@ description: This library implements the SHA suite of message digest functions, according to NIST FIPS 180-2 (with the SHA-224 addendum). The functions have been tested against most of the NIST test vectors- for the various functions. However, only slight attention has- been paid to the speed of the functions. + for the various functions. While some attention has been paid to+ performance, these do not presently reach the speed of+ well-tuned libraries, like OpenSSL. Flag Test Description: Build the SHA test suite. Default: False +Flag exe+ Description: Build a SHA2-384 executable similar to 'md5sum'+ Default: False+ Library- build-depends: base >= 3, bytestring+ build-depends: base >= 3, bytestring, binary, array exposed-modules: Data.Digest.Pure.SHA GHC-Options: -O2 -Wall -fno-ignore-asserts -funbox-strict-fields extensions: CPP, BangPatterns Executable test_sha- build-depends: base >= 3, bytestring, QuickCheck >= 1 && < 2+ build-depends: base >= 3, bytestring, binary, array, QuickCheck >= 1 && < 2 GHC-Options: -O2 -Wall -fno-ignore-asserts -fno-warn-orphans -funbox-strict-fields cpp-options: -DSHA_TEST Main-Is: Test.hs Other-Modules: Data.Digest.Pure.SHA extensions: CPP, BangPatterns if !flag(test)+ buildable: False++Executable sha1+ build-depends: base >= 3, bytestring, binary, array, directory+ GHC-Options: -O2 -Wall -fno-ignore-asserts -funbox-strict-fields+ Main-Is: Main.hs+ extensions: CPP, BangPatterns+ cpp-options: -DALGORITHM=sha1+ if !flag(exe)+ buildable: False++Executable sha384+ build-depends: base >= 3, bytestring, binary, array, directory+ GHC-Options: -O2 -Wall -fno-ignore-asserts -funbox-strict-fields+ Main-Is: Main.hs+ extensions: CPP, BangPatterns+ cpp-options: -DALGORITHM=sha384+ if !flag(exe) buildable: False source-repository head
Test.hs view
file too large to diff