bitcoin-hs-0.0.1: Bitcoin/Protocol/Hash.hs
{-# LANGUAGE CPP #-}
module Bitcoin.Protocol.Hash where
--------------------------------------------------------------------------------
import Data.Word
import Data.Maybe
import Text.Show
import Text.Read
import qualified Data.ByteString as B
import qualified Data.ByteString.Internal as BI
import Foreign
import Foreign.ForeignPtr
import Foreign.Marshal
import Foreign.Storable
import System.IO.Unsafe as Unsafe
import Bitcoin.Misc.BigInt
import Bitcoin.Misc.HexString
import Bitcoin.Misc.OctetStream
import Bitcoin.Misc.Endian
import Bitcoin.Crypto.Hash.SHA256
import Bitcoin.Crypto.Hash.RipEmd160
#ifdef __GLASGOW_HASKELL__
import GHC.ForeignPtr ( mallocPlainForeignPtrBytes )
#endif
import Debug.Trace
--------------------------------------------------------------------------------
{- ForeignPtr version
-- | Hash160(x) = RipEmd160(SHA256(x))
--
-- Note: the Show and Ord instances treat them as big-endian integers!
--
-- We use a ForeignPtr instead of a ByteString as it is 2 (or even 3?) words smaller.
newtype Hash160 = Hash160 { unHash160 :: ForeignPtr Word8 }
-- | Hash256(x) = SHA256(SHA256(x))
--
-- Note: the Show and Ord instances treat them as big-endian integers!
--
-- We use a ForeignPtr instead of a ByteString as it is 2 (or even 3?) words smaller.
newtype Hash256 = Hash256 { unHash256 :: ForeignPtr Word8 }
-}
--------------------------------------------------------------------------------
-- | Hash160(x) = RipEmd160(SHA256(x))
--
-- Note: the Show and Ord instances treat them as /big-endian/ integers!
--
-- It seems that the most compact representation is unpacked machine words
-- ('ForeignPtr' has too much overhead even with 'mallocPlainForeignPtr').
--
-- In memory representation: @Hash160 w1 w2 w3@ means that the w1 represent the
-- first 8 bytes, in little-endian representation, then w2 the second 8 bytes,
-- finally w3 the last 4 bytes. This way, the /big-endian/ comparison can be
-- done fast (first compare @w3@, if equal compare @w2@, if that is also equal compare @w1@)
data Hash160 = Hash160
{-# UNPACK #-} !Word64
{-# UNPACK #-} !Word64
{-# UNPACK #-} !Word32
-- | Hash256(x) = SHA256(SHA256(x))
--
-- Note: the Show and Ord instances treat them as /big-endian/ integers!
--
-- It seems that the most compact representation is unpacked machine words
-- ('ForeignPtr' has too much overhead even with 'mallocPlainForeignPtr').
--
data Hash256 = Hash256
{-# UNPACK #-} !Word64
{-# UNPACK #-} !Word64
{-# UNPACK #-} !Word64
{-# UNPACK #-} !Word64
--------------------------------------------------------------------------------
{- ForeignPtr
instance Eq Hash160 where a == b = (toWord8List a) == (toWord8List b)
instance Eq Hash256 where a == b = (toWord8List a) == (toWord8List b)
-}
{- ordering is big-endian!
instance Ord Hash160 where compare a b = compare (reverse $ toWord8List a) (reverse $ toWord8List b)
instance Ord Hash256 where compare a b = compare (reverse $ toWord8List a) (reverse $ toWord8List b)
-}
instance Eq Hash160 where (Hash160 a1 a2 a3 ) == (Hash160 b1 b2 b3 ) = a1==b1 && a2==b2 && a3==b3
instance Eq Hash256 where (Hash256 a1 a2 a3 a4) == (Hash256 b1 b2 b3 b4) = a1==b1 && a2==b2 && a3==b3 && a4==b4
instance Ord Hash160 where
compare (Hash160 a1 a2 a3) (Hash160 b1 b2 b3) = compare (a3,a2,a1) (b3,b2,b1)
instance Ord Hash256 where
compare (Hash256 a1 a2 a3 a4) (Hash256 b1 b2 b3 b4) = compare (a4,a3,a2,a1) (b4,b3,b2,b1)
--------------------------------------------------------------------------------
instance Show Hash160 where
showsPrec d h = showParen (d > 10) $
showString "hash160FromTextBE " . showChar '"' . showString (toHexStringChars (B.reverse $ toByteString h)) . showChar '"'
instance Show Hash256 where
showsPrec d h = showParen (d > 10) $
showString "hash256FromTextBE " . showChar '"' . showString (toHexStringChars (B.reverse $ toByteString h)) . showChar '"'
instance Read Hash160 where
readsPrec d r = readParen (d > 10)
(\r -> [ (fromWord8List (reverse $ fromJust mws) , t)
| ("hash160FromTextBE",s) <- lex r
, (m,t) <- readsPrec 11 s
, length m == 40
, let mws = safeHexDecode m
, isJust mws
]) r
instance Read Hash256 where
readsPrec d r = readParen (d > 10)
(\r -> [ (fromWord8List (reverse $ fromJust mws) , t)
| ("hash256FromTextBE",s) <- lex r
, (m,t) <- readsPrec 11 s
, length m == 64
, let mws = safeHexDecode m
, isJust mws
]) r
--------------------------------------------------------------------------------
partitionList20 :: [Word8] -> ( [Word8] , [Word8] , [Word8] )
partitionList20 ws = (a,b,c) where
(a,tmp1) = splitAt 8 ws
(b,c ) = splitAt 8 tmp1
partitionList32 :: [Word8] -> ( [Word8] , [Word8] , [Word8] , [Word8] )
partitionList32 ws = (a,b,c,d) where
(a,tmp1) = splitAt 8 ws
(b,tmp2) = splitAt 8 tmp1
(c,d ) = splitAt 8 tmp2
--------------------------------------------------------------------------------
instance OctetStream Hash160 where
toWord8List (Hash160 w1 w2 w3) = toLilEndBytes w1 ++ toLilEndBytes w2 ++ toLilEndBytes w3
fromWord8List ws = case length ws of
20 -> Hash160 w1 w2 w3 where
w1 = fromLilEndBytes xs1
w2 = fromLilEndBytes xs2
w3 = fromLilEndBytes xs3
(xs1,xs2,xs3) = partitionList20 ws
_ -> error "Hash160/fromWord8List: Hash160 is expected to be 20 bytes"
toByteString (Hash160 w1 w2 w3) = do
Unsafe.unsafePerformIO $ BI.create 20 $ \ptr -> do
poke (castPtr ptr :: Ptr Word64) $ swapByteOrderToLE w1
poke (castPtr (ptr `plusPtr` 8) :: Ptr Word64) $ swapByteOrderToLE w2
poke (castPtr (ptr `plusPtr` 16) :: Ptr Word32) $ swapByteOrderToLE w3
fromByteString bs = case B.length bs of
20 -> Unsafe.unsafePerformIO $ B.useAsCString bs $ \src -> do
w1 <- peek (castPtr src :: Ptr Word64)
w2 <- peek (castPtr (src `plusPtr` 8) :: Ptr Word64)
w3 <- peek (castPtr (src `plusPtr` 16) :: Ptr Word32)
return $ Hash160 (swapByteOrderToLE w1)
(swapByteOrderToLE w2)
(swapByteOrderToLE w3)
_ -> error "Hash160/fromByteString: Hash160 is expected to be 20 bytes"
fromIntegerLE = fromWord8List . littleEndianInteger20
fromIntegerBE = fromWord8List . bigEndianInteger20
----------------------------------------
instance OctetStream Hash256 where
toWord8List (Hash256 w1 w2 w3 w4) = toLilEndBytes w1 ++ toLilEndBytes w2 ++ toLilEndBytes w3 ++ toLilEndBytes w4
fromWord8List ws = case length ws of
32 -> Hash256 w1 w2 w3 w4 where
w1 = fromLilEndBytes xs1
w2 = fromLilEndBytes xs2
w3 = fromLilEndBytes xs3
w4 = fromLilEndBytes xs4
(xs1,xs2,xs3,xs4) = partitionList32 ws
_ -> error "Hash256/fromWord8List: Hash256 is expected to be 32 bytes"
toByteString (Hash256 w1 w2 w3 w4) = do
Unsafe.unsafePerformIO $ BI.create 32 $ \ptr -> do
poke (castPtr ptr :: Ptr Word64) $ swapByteOrderToLE w1
poke (castPtr (ptr `plusPtr` 8) :: Ptr Word64) $ swapByteOrderToLE w2
poke (castPtr (ptr `plusPtr` 16) :: Ptr Word64) $ swapByteOrderToLE w3
poke (castPtr (ptr `plusPtr` 24) :: Ptr Word64) $ swapByteOrderToLE w4
fromByteString bs = case B.length bs of
32 -> Unsafe.unsafePerformIO $ B.useAsCString bs $ \src -> do
w1 <- peek (castPtr src :: Ptr Word64)
w2 <- peek (castPtr (src `plusPtr` 8) :: Ptr Word64)
w3 <- peek (castPtr (src `plusPtr` 16) :: Ptr Word64)
w4 <- peek (castPtr (src `plusPtr` 24) :: Ptr Word64)
return $ Hash256 (swapByteOrderToLE w1)
(swapByteOrderToLE w2)
(swapByteOrderToLE w3)
(swapByteOrderToLE w4)
_ -> error "Hash256/fromByteString: Hash256 is expected to be 32 bytes"
fromIntegerLE = fromWord8List . littleEndianInteger32
fromIntegerBE = fromWord8List . bigEndianInteger32
--------------------------------------------------------------------------------
{- ForeignPtr version
instance OctetStream Hash160 where
toWord8List (Hash160 fptr) = Unsafe.unsafePerformIO $ withForeignPtr fptr $ \ptr -> peekArray 20 ptr
fromWord8List ws = case length ws of
20 -> Unsafe.unsafePerformIO $ do
#ifdef __GLASGOW_HASKELL__
fptr <- mallocPlainForeignPtrBytes 20
#else
fptr <- mallocForeignPtrBytes 20
#endif
withForeignPtr fptr $ \ptr -> pokeArray ptr ws
return (Hash160 fptr)
_ -> error "Hash160/fromWord8List: Hash160 is expected to by 20 bytes"
toByteString (Hash160 fptr) = Unsafe.unsafePerformIO $ withForeignPtr fptr $ \ptr -> B.packCStringLen (castPtr ptr, 20)
fromByteString bs = case B.length bs of
20 -> Unsafe.unsafePerformIO $ B.useAsCString bs $ \src -> do
#ifdef __GLASGOW_HASKELL__
fptr <- mallocPlainForeignPtrBytes 20
#else
fptr <- mallocForeignPtrBytes 20
#endif
withForeignPtr fptr $ \tgt -> copyBytes tgt (castPtr src) 20
return (Hash160 fptr)
_ -> error "Hash160/fromByteString: Hash160 is expected to by 20 bytes"
fromIntegerLE = fromWord8List . littleEndianInteger20
fromIntegerBE = fromWord8List . bigEndianInteger20
----------------------------------------
instance OctetStream Hash256 where
toWord8List (Hash256 fptr) = Unsafe.unsafePerformIO $ withForeignPtr fptr $ \ptr -> peekArray 32 ptr
fromWord8List ws = case length ws of
32 -> Unsafe.unsafePerformIO $ do
#ifdef __GLASGOW_HASKELL__
fptr <- mallocPlainForeignPtrBytes 32
#else
fptr <- mallocForeignPtrBytes 32
#endif
withForeignPtr fptr $ \ptr -> pokeArray ptr ws
return (Hash256 fptr)
_ -> error "Hash256/fromWord8List: Hash256 is expected to by 32 bytes"
toByteString (Hash256 fptr) = Unsafe.unsafePerformIO $ withForeignPtr fptr $ \ptr -> B.packCStringLen (castPtr ptr, 32)
fromByteString bs = case B.length bs of
32 -> Unsafe.unsafePerformIO $ B.useAsCString bs $ \src -> do
#ifdef __GLASGOW_HASKELL__
fptr <- mallocPlainForeignPtrBytes 32
#else
fptr <- mallocForeignPtrBytes 32
#endif
withForeignPtr fptr $ \tgt -> copyBytes tgt (castPtr src) 32
return (Hash256 fptr)
fromIntegerLE = fromWord8List . littleEndianInteger32
fromIntegerBE = fromWord8List . bigEndianInteger32
-}
--------------------------------------------------------------------------------
debugDoHash256 :: OctetStream a => a -> Hash256
debugDoHash256 x = Debug.Trace.trace (">>> " ++ toHexStringChars x ++ " <<<") $ doHash256 x
-- | SHA256(SHA256(x))
doHash256 :: OctetStream a => a -> Hash256
doHash256 = fromByteString . unSHA256 . sha256 . sha256
-- | RIPEMD160(SHA256(x))
doHash160 :: OctetStream a => a -> Hash160
doHash160 = fromByteString . unRipEmd160 . ripemd160 . sha256
--------------------------------------------------------------------------------
-- | The zero ripemd hash (not really used for anything)
zeroHash160 :: Hash160
zeroHash160 = fromWord8List (replicate 20 0)
-- | Generation (or \"coinbase\") transactions have hash set to zero
zeroHash256 :: Hash256
zeroHash256 = fromWord8List (replicate 32 0)
--------------------------------------------------------------------------------
-- | Creates a 256 bit hash from a /big-endian/ hex string (may fail with exception).
-- This is here primarily for convenience.
hash256FromTextBE :: String -> Hash256
hash256FromTextBE s
| length s == 64 = case safeHexDecode s of
Just ws -> fromWord8List $ reverse ws
Nothing -> error "hash256FromText: not a hex string"
| otherwise = error "hash256FromTextBE: length should be 64 characters"
-- | Creates a 160 bit hash from a /big-endian/ hex string (may fail with exception).
-- This is here primarily for convenience.
hash160FromTextBE :: String -> Hash160
hash160FromTextBE s
| length s == 40 = case safeHexDecode s of
Just ws -> fromWord8List $ reverse ws
Nothing -> error "hash160FromText: not a hex string"
| otherwise = error "hash160FromTextBE: length should be 40 characters"
--------------------------------------------------------------------------------