This repository has been archived by the owner on Sep 20, 2023. It is now read-only.
/
RIPEMD160.hs
145 lines (116 loc) · 4.51 KB
/
RIPEMD160.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
{-# LANGUAGE ForeignFunctionInterface, CPP, MultiParamTypeClasses #-}
-- |
-- Module : Crypto.Hash.RIPEMD160
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : unknown
--
-- A module containing RIPEMD160 bindings
--
module Crypto.Hash.RIPEMD160
( Ctx(..)
, RIPEMD160
-- * Incremental hashing Functions
, init -- :: Ctx
, update -- :: Ctx -> ByteString -> Ctx
, finalize -- :: Ctx -> ByteString
-- * Single Pass hashing
, hash -- :: ByteString -> ByteString
, hashlazy -- :: ByteString -> ByteString
) where
import Prelude hiding (init)
import Foreign.Ptr
import Foreign.ForeignPtr (withForeignPtr)
import Foreign.Storable
import Foreign.Marshal.Alloc
import qualified Data.ByteString.Lazy as L
import Data.ByteString (ByteString)
import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
import Data.ByteString.Internal (create, toForeignPtr, inlinePerformIO)
import Data.Word
#ifdef HAVE_CRYPTOAPI
import Control.Monad (liftM)
import Data.Serialize (Serialize(..))
import Data.Serialize.Get (getByteString)
import Data.Serialize.Put (putByteString)
import Data.Tagged (Tagged(..))
import qualified Crypto.Classes as C (Hash(..))
instance C.Hash Ctx RIPEMD160 where
outputLength = Tagged (20 * 8)
blockLength = Tagged (64 * 8)
initialCtx = init
updateCtx = update
finalize ctx bs = Digest . finalize $ update ctx bs
instance Serialize RIPEMD160 where
get = liftM Digest (getByteString digestSize)
put (Digest d) = putByteString d
#endif
data Ctx = Ctx !ByteString
data RIPEMD160 = Digest !ByteString
deriving (Eq,Ord,Show)
{-# INLINE digestSize #-}
digestSize :: Int
digestSize = 20
{-# INLINE sizeCtx #-}
sizeCtx :: Int
sizeCtx = 128
{-# INLINE withByteStringPtr #-}
withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a
withByteStringPtr b f =
withForeignPtr fptr $ \ptr -> f (ptr `plusPtr` off)
where (fptr, off, _) = toForeignPtr b
{-# INLINE memcopy64 #-}
memcopy64 :: Ptr Word64 -> Ptr Word64 -> IO ()
memcopy64 dst src = mapM_ peekAndPoke [0..(16-1)]
where peekAndPoke i = peekElemOff src i >>= pokeElemOff dst i
withCtxCopy :: Ctx -> (Ptr Ctx -> IO ()) -> IO Ctx
withCtxCopy (Ctx ctxB) f = Ctx `fmap` createCtx
where createCtx = create sizeCtx $ \dstPtr ->
withByteStringPtr ctxB $ \srcPtr -> do
memcopy64 (castPtr dstPtr) (castPtr srcPtr)
f (castPtr dstPtr)
withCtxThrow :: Ctx -> (Ptr Ctx -> IO a) -> IO a
withCtxThrow (Ctx ctxB) f =
allocaBytes sizeCtx $ \dstPtr ->
withByteStringPtr ctxB $ \srcPtr -> do
memcopy64 (castPtr dstPtr) (castPtr srcPtr)
f (castPtr dstPtr)
withCtxNew :: (Ptr Ctx -> IO ()) -> IO Ctx
withCtxNew f = Ctx `fmap` create sizeCtx (f . castPtr)
withCtxNewThrow :: (Ptr Ctx -> IO a) -> IO a
withCtxNewThrow f = allocaBytes sizeCtx (f . castPtr)
foreign import ccall unsafe "ripemd.h ripemd160_init"
c_ripemd160_init :: Ptr Ctx -> IO ()
foreign import ccall "ripemd.h ripemd160_update"
c_ripemd160_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO ()
foreign import ccall unsafe "ripemd.h ripemd160_finalize"
c_ripemd160_finalize :: Ptr Ctx -> Ptr Word8 -> IO ()
updateInternalIO :: Ptr Ctx -> ByteString -> IO ()
updateInternalIO ptr d =
unsafeUseAsCStringLen d (\(cs, len) -> c_ripemd160_update ptr (castPtr cs) (fromIntegral len))
finalizeInternalIO :: Ptr Ctx -> IO ByteString
finalizeInternalIO ptr =
create digestSize (c_ripemd160_finalize ptr)
{-# NOINLINE init #-}
-- | init a context
init :: Ctx
init = inlinePerformIO $ withCtxNew $ c_ripemd160_init
{-# NOINLINE update #-}
-- | update a context with a bytestring
update :: Ctx -> ByteString -> Ctx
update ctx d = inlinePerformIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d
{-# NOINLINE finalize #-}
-- | finalize the context into a digest bytestring
finalize :: Ctx -> ByteString
finalize ctx = inlinePerformIO $ withCtxThrow ctx finalizeInternalIO
{-# NOINLINE hash #-}
-- | hash a strict bytestring into a digest bytestring
hash :: ByteString -> ByteString
hash d = inlinePerformIO $ withCtxNewThrow $ \ptr -> do
c_ripemd160_init ptr >> updateInternalIO ptr d >> finalizeInternalIO ptr
{-# NOINLINE hashlazy #-}
-- | hash a lazy bytestring into a digest bytestring
hashlazy :: L.ByteString -> ByteString
hashlazy l = inlinePerformIO $ withCtxNewThrow $ \ptr -> do
c_ripemd160_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr