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
data Hash160 = Hash160
!Word64
!Word64
!Word32
data Hash256 = Hash256
!Word64
!Word64
!Word64
!Word64
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
debugDoHash256 :: OctetStream a => a -> Hash256
debugDoHash256 x = Debug.Trace.trace (">>> " ++ toHexStringChars x ++ " <<<") $ doHash256 x
doHash256 :: OctetStream a => a -> Hash256
doHash256 = fromByteString . unSHA256 . sha256 . sha256
doHash160 :: OctetStream a => a -> Hash160
doHash160 = fromByteString . unRipEmd160 . ripemd160 . sha256
zeroHash160 :: Hash160
zeroHash160 = fromWord8List (replicate 20 0)
zeroHash256 :: Hash256
zeroHash256 = fromWord8List (replicate 32 0)
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"
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"