Permalink
Browse files

bring skein uptodate with other hashes

  • Loading branch information...
vincenthz committed Nov 7, 2012
1 parent 2bb771e commit 3bc6d955028687cda7e04e504ba9769d477e2dac
Showing with 98 additions and 66 deletions.
  1. +49 −33 Crypto/Hash/Skein256.hs
  2. +49 −33 Crypto/Hash/Skein512.hs
View
@@ -24,17 +24,15 @@ module Crypto.Hash.Skein256
) where
import Prelude hiding (init)
-import System.IO.Unsafe (unsafePerformIO)
-import Foreign.C.String
import Foreign.C.Types
import Foreign.Ptr
+import Foreign.ForeignPtr (withForeignPtr)
import Foreign.Storable
import Foreign.Marshal.Alloc
-import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import Data.ByteString (ByteString)
-import Data.ByteString.Unsafe (unsafeUseAsCString, unsafeUseAsCStringLen)
-import Data.ByteString.Internal (create, memcpy)
+import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
+import Data.ByteString.Internal (create, inlinePerformIO, toForeignPtr)
import Data.Word
import Data.Bits
@@ -65,68 +63,86 @@ data Skein256 = Digest !ByteString
deriving (Eq,Ord,Show)
sizeCtx :: Int
-sizeCtx = 100
+sizeCtx = 88
-instance Storable Ctx where
- sizeOf _ = sizeCtx
- alignment _ = 16
- poke ptr (Ctx b) = unsafeUseAsCString b (\cs -> memcpy (castPtr ptr) (castPtr cs) (fromIntegral sizeCtx))
-
- peek ptr = create sizeCtx (\bptr -> memcpy bptr (castPtr ptr) (fromIntegral sizeCtx)) >>= return . Ctx
-
-poke_hashlen :: Ptr Ctx -> IO Int
-poke_hashlen ptr = do
+peekHashlen :: Ptr Ctx -> IO Int
+peekHashlen ptr = do
let iptr = castPtr ptr :: Ptr CUInt
a <- peek iptr
- return $ fromIntegral a
+ return ((fromIntegral a + 7) `shiftR` 3)
+
+{-# 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..(12-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 "skein256.h skein256_init"
- c_skein256_init :: Ptr Ctx -> CUInt -> IO ()
+ c_skein256_init :: Ptr Ctx -> Word32 -> IO ()
foreign import ccall "skein256.h skein256_update"
- c_skein256_update :: Ptr Ctx -> CString -> Word32 -> IO ()
+ c_skein256_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO ()
foreign import ccall unsafe "skein256.h skein256_finalize"
- c_skein256_finalize :: Ptr Ctx -> CString -> IO ()
-
-allocInternal :: (Ptr Ctx -> IO a) -> IO a
-allocInternal = alloca
+ c_skein256_finalize :: Ptr Ctx -> Ptr Word8 -> IO ()
-allocInternalFrom :: Ctx -> (Ptr Ctx -> IO a) -> IO a
-allocInternalFrom ctx f = allocInternal $ \ptr -> (poke ptr ctx >> f ptr)
updateInternalIO :: Ptr Ctx -> ByteString -> IO ()
updateInternalIO ptr d =
- unsafeUseAsCStringLen d (\(cs, len) -> c_skein256_update ptr cs (fromIntegral len))
+ unsafeUseAsCStringLen d (\(cs, len) -> c_skein256_update ptr (castPtr cs) (fromIntegral len))
finalizeInternalIO :: Ptr Ctx -> IO ByteString
-finalizeInternalIO ptr = do
- digestSize <- fmap (\x -> (x + 7) `shiftR` 3) $ poke_hashlen ptr
- allocaBytes digestSize (\cs -> c_skein256_finalize ptr cs >> B.packCStringLen (cs, digestSize))
+finalizeInternalIO ptr =
+ peekHashlen ptr >>= \digestSize -> create digestSize (c_skein256_finalize ptr)
{-# NOINLINE init #-}
-- | init a context
init :: Int -> Ctx
-init hashlen = unsafePerformIO $ allocInternal $ \ptr -> do (c_skein256_init ptr (fromIntegral hashlen) >> peek ptr)
+init hashlen = inlinePerformIO $ withCtxNew $ \ptr -> c_skein256_init ptr (fromIntegral hashlen)
{-# NOINLINE update #-}
-- | update a context with a bytestring
update :: Ctx -> ByteString -> Ctx
-update ctx d = unsafePerformIO $ allocInternalFrom ctx $ \ptr -> do updateInternalIO ptr d >> peek ptr
+update ctx d = inlinePerformIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d
{-# NOINLINE finalize #-}
-- | finalize the context into a digest bytestring
finalize :: Ctx -> ByteString
-finalize ctx = unsafePerformIO $ allocInternalFrom ctx $ \ptr -> do finalizeInternalIO ptr
+finalize ctx = inlinePerformIO $ withCtxThrow ctx finalizeInternalIO
{-# NOINLINE hash #-}
-- | hash a strict bytestring into a digest bytestring
hash :: Int -> ByteString -> ByteString
-hash hashlen d = unsafePerformIO $ allocInternal $ \ptr -> do
+hash hashlen d = inlinePerformIO $ withCtxNewThrow $ \ptr -> do
c_skein256_init ptr (fromIntegral hashlen) >> updateInternalIO ptr d >> finalizeInternalIO ptr
{-# NOINLINE hashlazy #-}
-- | hash a lazy bytestring into a digest bytestring
hashlazy :: Int -> L.ByteString -> ByteString
-hashlazy hashlen l = unsafePerformIO $ allocInternal $ \ptr -> do
+hashlazy hashlen l = inlinePerformIO $ withCtxNewThrow $ \ptr -> do
c_skein256_init ptr (fromIntegral hashlen) >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr
View
@@ -24,17 +24,15 @@ module Crypto.Hash.Skein512
) where
import Prelude hiding (init)
-import System.IO.Unsafe (unsafePerformIO)
-import Foreign.C.String
import Foreign.C.Types
import Foreign.Ptr
+import Foreign.ForeignPtr (withForeignPtr)
import Foreign.Storable
import Foreign.Marshal.Alloc
-import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import Data.ByteString (ByteString)
-import Data.ByteString.Unsafe (unsafeUseAsCString, unsafeUseAsCStringLen)
-import Data.ByteString.Internal (create, memcpy)
+import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
+import Data.ByteString.Internal (create, inlinePerformIO, toForeignPtr)
import Data.Word
import Data.Bits
@@ -65,68 +63,86 @@ data Skein512 = Digest !ByteString
deriving (Eq,Ord,Show)
sizeCtx :: Int
-sizeCtx = 160
+sizeCtx = 152
-instance Storable Ctx where
- sizeOf _ = sizeCtx
- alignment _ = 16
- poke ptr (Ctx b) = unsafeUseAsCString b (\cs -> memcpy (castPtr ptr) (castPtr cs) (fromIntegral sizeCtx))
-
- peek ptr = create sizeCtx (\bptr -> memcpy bptr (castPtr ptr) (fromIntegral sizeCtx)) >>= return . Ctx
-
-poke_hashlen :: Ptr Ctx -> IO Int
-poke_hashlen ptr = do
+peekHashlen :: Ptr Ctx -> IO Int
+peekHashlen ptr = do
let iptr = castPtr ptr :: Ptr CUInt
a <- peek iptr
- return $ fromIntegral a
+ return ((fromIntegral a + 7) `shiftR` 3)
+
+{-# 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..(20-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 "skein512.h skein512_init"
- c_skein512_init :: Ptr Ctx -> CUInt -> IO ()
+ c_skein512_init :: Ptr Ctx -> Word32 -> IO ()
foreign import ccall "skein512.h skein512_update"
- c_skein512_update :: Ptr Ctx -> CString -> Word32 -> IO ()
+ c_skein512_update :: Ptr Ctx -> Ptr Word8 -> Word32 -> IO ()
foreign import ccall unsafe "skein512.h skein512_finalize"
- c_skein512_finalize :: Ptr Ctx -> CString -> IO ()
-
-allocInternal :: (Ptr Ctx -> IO a) -> IO a
-allocInternal = alloca
+ c_skein512_finalize :: Ptr Ctx -> Ptr Word8 -> IO ()
-allocInternalFrom :: Ctx -> (Ptr Ctx -> IO a) -> IO a
-allocInternalFrom ctx f = allocInternal $ \ptr -> (poke ptr ctx >> f ptr)
updateInternalIO :: Ptr Ctx -> ByteString -> IO ()
updateInternalIO ptr d =
- unsafeUseAsCStringLen d (\(cs, len) -> c_skein512_update ptr cs (fromIntegral len))
+ unsafeUseAsCStringLen d (\(cs, len) -> c_skein512_update ptr (castPtr cs) (fromIntegral len))
finalizeInternalIO :: Ptr Ctx -> IO ByteString
-finalizeInternalIO ptr = do
- digestSize <- fmap (\x -> (x + 7) `shiftR` 3) $ poke_hashlen ptr
- allocaBytes digestSize (\cs -> c_skein512_finalize ptr cs >> B.packCStringLen (cs, digestSize))
+finalizeInternalIO ptr =
+ peekHashlen ptr >>= \digestSize -> create digestSize (c_skein512_finalize ptr)
{-# NOINLINE init #-}
-- | init a context
init :: Int -> Ctx
-init hashlen = unsafePerformIO $ allocInternal $ \ptr -> do (c_skein512_init ptr (fromIntegral hashlen) >> peek ptr)
+init hashlen = inlinePerformIO $ withCtxNew $ \ptr -> c_skein512_init ptr (fromIntegral hashlen)
{-# NOINLINE update #-}
-- | update a context with a bytestring
update :: Ctx -> ByteString -> Ctx
-update ctx d = unsafePerformIO $ allocInternalFrom ctx $ \ptr -> do updateInternalIO ptr d >> peek ptr
+update ctx d = inlinePerformIO $ withCtxCopy ctx $ \ptr -> updateInternalIO ptr d
{-# NOINLINE finalize #-}
-- | finalize the context into a digest bytestring
finalize :: Ctx -> ByteString
-finalize ctx = unsafePerformIO $ allocInternalFrom ctx $ \ptr -> do finalizeInternalIO ptr
+finalize ctx = inlinePerformIO $ withCtxThrow ctx finalizeInternalIO
{-# NOINLINE hash #-}
-- | hash a strict bytestring into a digest bytestring
hash :: Int -> ByteString -> ByteString
-hash hashlen d = unsafePerformIO $ allocInternal $ \ptr -> do
+hash hashlen d = inlinePerformIO $ withCtxNewThrow $ \ptr -> do
c_skein512_init ptr (fromIntegral hashlen) >> updateInternalIO ptr d >> finalizeInternalIO ptr
{-# NOINLINE hashlazy #-}
-- | hash a lazy bytestring into a digest bytestring
hashlazy :: Int -> L.ByteString -> ByteString
-hashlazy hashlen l = unsafePerformIO $ allocInternal $ \ptr -> do
+hashlazy hashlen l = inlinePerformIO $ withCtxNewThrow $ \ptr -> do
c_skein512_init ptr (fromIntegral hashlen) >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr

0 comments on commit 3bc6d95

Please sign in to comment.