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
|
{-# LANGUAGE ForeignFunctionInterface #-}
-- |
-- Module : Crypto.Hash.SHA512
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : unknown
--
-- A module containing SHA512 bindings
--
module Crypto.Hash.SHA512
( Ctx(..)
-- * Incremental hashing Functions
, init -- :: Ctx
, init_t -- :: Int -> Ctx
, update -- :: Ctx -> ByteString -> Ctx
, updates -- :: 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 qualified Data.ByteString as B
import Data.ByteString (ByteString)
import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
import Data.ByteString.Internal (create, toForeignPtr)
import Data.Word
import Crypto.Hash.Internal (unsafeDoIO)
-- | SHA512 Context
newtype Ctx = Ctx ByteString
{-# INLINE digestSize #-}
digestSize :: Int
digestSize = 64
{-# INLINE sizeCtx #-}
sizeCtx :: Int
sizeCtx = 256
{-# RULES "digestSize" B.length (finalize init) = digestSize #-}
{-# RULES "hash" forall b. finalize (update init b) = hash b #-}
{-# RULES "hash.list1" forall b. finalize (updates init [b]) = hash b #-}
{-# RULES "hashmany" forall b. finalize (foldl update init b) = hashlazy (L.fromChunks b) #-}
{-# RULES "hashlazy" forall b. finalize (foldl update init $ L.toChunks b) = hashlazy b #-}
{-# 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..(32-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 "sha512.h cryptohash_sha512_init"
c_sha512_init :: Ptr Ctx -> IO ()
foreign import ccall "sha512.h cryptohash_sha512_update"
c_sha512_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO ()
foreign import ccall unsafe "sha512.h cryptohash_sha512_finalize"
c_sha512_finalize :: Ptr Ctx -> Ptr Word8 -> IO ()
foreign import ccall unsafe "sha512.h cryptohash_sha512_init_t"
c_sha512_init_t :: Ptr Ctx -> Int -> IO ()
{-# NOINLINE init_t #-}
-- | init a context using FIPS 180-4 for truncated SHA512
init_t :: Int -> Ctx
init_t t = unsafeDoIO $ withCtxNew $ \ptr -> c_sha512_init_t ptr t
updateInternalIO :: Ptr Ctx -> ByteString -> IO ()
updateInternalIO ptr d =
unsafeUseAsCStringLen d (\(cs, len) -> c_sha512_update ptr (castPtr cs) (fromIntegral len))
finalizeInternalIO :: Ptr Ctx -> IO ByteString
finalizeInternalIO ptr = create digestSize (c_sha512_finalize ptr)
{-# NOINLINE init #-}
-- | init a context
init :: Ctx
init = unsafeDoIO $ withCtxNew $ c_sha512_init
{-# NOINLINE update #-}
-- | update a context with a bytestring
update :: Ctx -> ByteString -> Ctx
update ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d
{-# NOINLINE updates #-}
-- | updates a context with multiples bytestring
updates :: Ctx -> [ByteString] -> Ctx
updates ctx d = unsafeDoIO $ withCtxCopy ctx $ \ptr -> mapM_ (updateInternalIO ptr) d
{-# NOINLINE finalize #-}
-- | finalize the context into a digest bytestring
finalize :: Ctx -> ByteString
finalize ctx = unsafeDoIO $ withCtxThrow ctx finalizeInternalIO
{-# NOINLINE hash #-}
-- | hash a strict bytestring into a digest bytestring
hash :: ByteString -> ByteString
hash d = unsafeDoIO $ withCtxNewThrow $ \ptr -> do
c_sha512_init ptr >> updateInternalIO ptr d >> finalizeInternalIO ptr
{-# NOINLINE hashlazy #-}
-- | hash a lazy bytestring into a digest bytestring
hashlazy :: L.ByteString -> ByteString
hashlazy l = unsafeDoIO $ withCtxNewThrow $ \ptr -> do
c_sha512_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr
|
