module Network.Haskoin.Crypto.Hash
( Hash512
, Hash256
, Hash160
, CheckSum32
, hash512
, hash256
, hash160
, hash512BS
, hash256BS
, hash160BS
, doubleHash256
, doubleHash256BS
, chksum32
, hmac512
, hmac512BS
, hmac256
, hmac256BS
, hmacDRBGNew
, hmacDRBGUpd
, hmacDRBGRsd
, hmacDRBGGen
, WorkingState
, split512
, join512
) where
import Data.Word (Word16, Word32)
import Crypto.Hash
( Digest
, SHA512
, SHA256
, RIPEMD160
, hash
)
import Crypto.MAC.HMAC (hmac)
import Data.Byteable (toBytes)
import Data.Binary (Binary, get, put)
import Data.Bits (shiftL, shiftR)
import Control.Applicative ((<$>))
import qualified Data.ByteString as BS
( ByteString
, null
, append
, cons
, concat
, take
, empty
, length
, replicate
)
import Network.Haskoin.Util (runGet', decode')
import Network.Haskoin.Crypto.Ring
( Hash512
, Hash256
, Hash160
, toMod512
)
newtype CheckSum32 = CheckSum32 Word32 deriving (Show, Eq)
instance Binary CheckSum32 where
get = CheckSum32 <$> get
put (CheckSum32 w) = put w
run512 :: BS.ByteString -> BS.ByteString
run512 = (toBytes :: Digest SHA512 -> BS.ByteString) . hash
run256 :: BS.ByteString -> BS.ByteString
run256 = (toBytes :: Digest SHA256 -> BS.ByteString) . hash
run160 :: BS.ByteString -> BS.ByteString
run160 = (toBytes :: Digest RIPEMD160 -> BS.ByteString) . hash
hash512 :: BS.ByteString -> Hash512
hash512 bs = runGet' get (run512 bs)
hash512BS :: BS.ByteString -> BS.ByteString
hash512BS bs = run512 bs
hash256 :: BS.ByteString -> Hash256
hash256 bs = runGet' get (run256 bs)
hash256BS :: BS.ByteString -> BS.ByteString
hash256BS bs = run256 bs
hash160 :: BS.ByteString -> Hash160
hash160 bs = runGet' get (run160 bs)
hash160BS :: BS.ByteString -> BS.ByteString
hash160BS bs = run160 bs
doubleHash256 :: BS.ByteString -> Hash256
doubleHash256 bs = runGet' get (run256 $ run256 bs)
doubleHash256BS :: BS.ByteString -> BS.ByteString
doubleHash256BS bs = run256 $ run256 bs
chksum32 :: BS.ByteString -> CheckSum32
chksum32 bs = CheckSum32 $ fromIntegral $ (doubleHash256 bs) `shiftR` 224
hmac512 :: BS.ByteString -> BS.ByteString -> Hash512
hmac512 key = decode' . (hmac512BS key)
hmac512BS :: BS.ByteString -> BS.ByteString -> BS.ByteString
hmac512BS key msg = hmac hash512BS 128 key msg
hmac256 :: BS.ByteString -> BS.ByteString -> Hash256
hmac256 key = decode' . (hmac256BS key)
hmac256BS :: BS.ByteString -> BS.ByteString -> BS.ByteString
hmac256BS key msg = hmac hash256BS 64 key msg
split512 :: Hash512 -> (Hash256, Hash256)
split512 i = (fromIntegral $ i `shiftR` 256, fromIntegral i)
join512 :: (Hash256, Hash256) -> Hash512
join512 (a,b) = ((toMod512 a) `shiftL` 256) + (toMod512 b)
type WorkingState = (BS.ByteString, BS.ByteString, Word16)
type AdditionalInput = BS.ByteString
type ProvidedData = BS.ByteString
type EntropyInput = BS.ByteString
type Nonce = BS.ByteString
type PersString = BS.ByteString
hmacDRBGUpd :: ProvidedData -> BS.ByteString -> BS.ByteString
-> (BS.ByteString, BS.ByteString)
hmacDRBGUpd info k0 v0
| BS.null info = (k1,v1)
| otherwise = (k2,v2)
where
k1 = hmac256BS k0 $ v0 `BS.append` (0 `BS.cons` info)
v1 = hmac256BS k1 v0
k2 = hmac256BS k1 $ v1 `BS.append` (1 `BS.cons` info)
v2 = hmac256BS k2 v1
hmacDRBGNew :: EntropyInput -> Nonce -> PersString -> WorkingState
hmacDRBGNew seed nonce info
| (BS.length seed + BS.length nonce) * 8 < 384 = error $
"Entropy + nonce input length must be at least 384 bit"
| (BS.length seed + BS.length nonce) * 8 > 1000 = error $
"Entropy + nonce input length can not be greater than 1000 bit"
| BS.length info * 8 > 256 = error $
"Maximum personalization string length is 256 bit"
| otherwise = (k1,v1,1)
where
s = BS.concat [seed, nonce, info]
k0 = BS.replicate 32 0
v0 = BS.replicate 32 1
(k1,v1) = hmacDRBGUpd s k0 v0
hmacDRBGRsd :: WorkingState -> EntropyInput -> AdditionalInput -> WorkingState
hmacDRBGRsd (k,v,_) seed info
| BS.length seed * 8 < 256 = error $
"Entropy input length must be at least 256 bit"
| BS.length seed * 8 > 1000 = error $
"Entropy input length can not be greater than 1000 bit"
| otherwise = (k0,v0,1)
where
s = seed `BS.append` info
(k0,v0) = hmacDRBGUpd s k v
hmacDRBGGen :: WorkingState -> Word16 -> AdditionalInput
-> (WorkingState, Maybe BS.ByteString)
hmacDRBGGen (k0,v0,c0) bytes info
| bytes * 8 > 7500 = error "Maximum bits per request is 7500"
| c0 > 10000 = ((k0,v0,c0), Nothing)
| otherwise = ((k2,v3,c1), Just res)
where
(k1,v1) | BS.null info = (k0,v0)
| otherwise = hmacDRBGUpd info k0 v0
(tmp,v2) = go (fromIntegral bytes) k1 v1 BS.empty
res = BS.take (fromIntegral bytes) tmp
(k2,v3) = hmacDRBGUpd info k1 v2
c1 = c0 + 1
go l k v acc | BS.length acc >= l = (acc,v)
| otherwise = let vn = hmac256BS k v
in go l k vn (acc `BS.append` vn)