Skip to content

Commit

Permalink
Some cleanup
Browse files Browse the repository at this point in the history
  • Loading branch information
phadej committed Jul 3, 2020
1 parent 43be6c9 commit 0eb71bf
Show file tree
Hide file tree
Showing 2 changed files with 17 additions and 15 deletions.
9 changes: 4 additions & 5 deletions cardano-crypto-class/src/Cardano/Crypto/Libsodium/Hash.hs
Expand Up @@ -25,10 +25,10 @@ import Data.Type.Equality ((:~:)(..))
import GHC.IO.Exception (ioException)
import GHC.TypeLits
import System.IO.Unsafe (unsafeDupablePerformIO)
import GHC.IO.Handle.Text (memcpy)

import qualified Data.ByteString as BS

import Cardano.Foreign
import Cardano.Crypto.Hash (HashAlgorithm(SizeHash), SHA256, Blake2b_256)
import Cardano.Crypto.FiniteBytes (FiniteBytes, ptrFbToSizedPtr)
import Cardano.Crypto.Libsodium.C
Expand All @@ -53,7 +53,7 @@ digestMLockedStorable
:: forall h a proxy. (SodiumHashAlgorithm h, Storable a)
=> proxy h -> Ptr a -> IO (MLockedFiniteBytes (SizeHash h))
digestMLockedStorable p ptr =
digestMLocked p ptr ((sizeOf (undefined :: a)))
digestMLocked p ptr ((sizeOf (undefined :: a)))

digestMLockedFB
:: forall h n proxy. (SodiumHashAlgorithm h, KnownNat n)
Expand All @@ -79,12 +79,12 @@ expandHash h (MLFB sfptr) = unsafeDupablePerformIO $ do
withMLockedForeignPtr sfptr $ \ptr -> do
l <- mlockedAlloca size1 $ \ptr' -> do
poke ptr' (1 :: Word8)
_ <- memcpy (castPtr (plusPtr ptr' 1)) ptr size
_ <- c_memcpy (castPtr (plusPtr ptr' 1)) ptr size
digestMLocked h ptr' (fromIntegral size1)

r <- mlockedAlloca size1 $ \ptr' -> do
poke ptr' (2 :: Word8)
_ <- memcpy (castPtr (plusPtr ptr' 1)) ptr size
_ <- c_memcpy (castPtr (plusPtr ptr' 1)) ptr size
digestMLocked h ptr' (fromIntegral size1)

return (l, r)
Expand All @@ -100,7 +100,6 @@ expandHash h (MLFB sfptr) = unsafeDupablePerformIO $ do
-------------------------------------------------------------------------------

instance SodiumHashAlgorithm SHA256 where

digestMLocked :: forall proxy a. proxy SHA256 -> Ptr a -> Int -> IO (MLockedFiniteBytes (SizeHash SHA256))
digestMLocked _ input inputlen = do
output <- allocMLockedForeignPtr
Expand Down
Expand Up @@ -17,7 +17,6 @@ import Data.Proxy (Proxy (..))
import Foreign.C.Types (CSize (..))
import Foreign.ForeignPtr (castForeignPtr)
import Foreign.Ptr (Ptr, castPtr)
import GHC.IO.Handle.Text (memcpy)
import GHC.TypeLits (KnownNat, natVal)
import System.IO.Unsafe (unsafeDupablePerformIO)
import Data.Word (Word8)
Expand Down Expand Up @@ -50,24 +49,28 @@ instance KnownNat n => Show (MLockedFiniteBytes n) where
showsPrec d _ = showParen (d > 10)
$ showString "_ :: MLockedFiniteBytes "
. showsPrec 11 (natVal (Proxy @n))

instance NFData (MLockedFiniteBytes n) where
rnf (MLFB p) = seq p ()

-- TODO: use memset
-- Note: this doesn't need to allocate mlocked memory,
-- but we should do that still for consistency
-- | Note: this doesn't need to allocate mlocked memory,
-- but we do that for consistency
mlfbZero :: forall n. KnownNat n => MLockedFiniteBytes n
mlfbZero = mlfbFromByteString (BS.pack (replicate size (0 :: Word8)))
mlfbZero = unsafeDupablePerformIO $ do
fptr <- allocMLockedForeignPtr
withMLockedForeignPtr fptr $ \ptr -> do
_ <- c_memset (castPtr ptr) 0 size
return ()
return (MLFB fptr)
where
size :: Int
size :: CSize
size = fromInteger (natVal (Proxy @n))

mlfbFromByteString :: forall n. KnownNat n => BS.ByteString -> MLockedFiniteBytes n
mlfbFromByteString bs = unsafeDupablePerformIO $ BS.useAsCStringLen bs $ \(ptrBS, len) -> do
fptr <- allocMLockedForeignPtr
withMLockedForeignPtr fptr $ \ptr -> do
_ <- memcpy (castPtr ptr) ptrBS (fromIntegral (min len size))
_ <- c_memcpy (castPtr ptr) ptrBS (fromIntegral (min len size))
return ()
return (MLFB fptr)
where
Expand All @@ -80,7 +83,7 @@ mlfbFromByteStringCheck bs
| otherwise = Just $ unsafeDupablePerformIO $ BS.useAsCStringLen bs $ \(ptrBS, len) -> do
fptr <- allocMLockedForeignPtr
withMLockedForeignPtr fptr $ \ptr -> do
_ <- memcpy (castPtr ptr) ptrBS (fromIntegral (min len size))
_ <- c_memcpy (castPtr ptr) ptrBS (fromIntegral (min len size))
return ()
return (MLFB fptr)
where
Expand All @@ -99,4 +102,4 @@ mlfbUseAsCPtr :: MLockedFiniteBytes n -> (Ptr Word8 -> IO r) -> IO r
mlfbUseAsCPtr (MLFB x) k = withMLockedForeignPtr x (k . castPtr)

mlfbUseAsSizedPtr :: MLockedFiniteBytes n -> (SizedPtr n -> IO r) -> IO r
mlfbUseAsSizedPtr (MLFB x) k = withMLockedForeignPtr x (k . SizedPtr . castPtr)
mlfbUseAsSizedPtr (MLFB x) k = withMLockedForeignPtr x (k . FB.ptrFbToSizedPtr)

0 comments on commit 0eb71bf

Please sign in to comment.