{-# 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" --------------------------------------------------------------------------------