[internal] update memory to latest

This commit is contained in:
Vincent Hanquez 2015-05-14 10:04:16 +01:00
parent 26ec954a48
commit c5f9ab2d35
14 changed files with 113 additions and 65 deletions

View File

@ -11,4 +11,4 @@ module Crypto.Internal.ByteArray
( module X ( module X
) where ) where
import Data.Memory.ByteArray as X import Data.ByteArray as X

View File

@ -20,7 +20,7 @@ module Crypto.Random
import Crypto.Random.Types import Crypto.Random.Types
import Crypto.Random.ChaChaDRG import Crypto.Random.ChaChaDRG
import Crypto.Random.Entropy import Crypto.Random.Entropy
import Data.Memory.ByteArray (ScrubbedBytes) import Data.ByteArray (ScrubbedBytes)
import Crypto.Internal.Imports import Crypto.Internal.Imports
drgNew :: IO ChaChaDRG drgNew :: IO ChaChaDRG

24
Data/ByteArray.hs Normal file
View File

@ -0,0 +1,24 @@
-- |
-- Module : Data.ByteArray
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : stable
-- Portability : Good
--
-- Simple and efficient byte array types
--
-- This module should be imported qualified.
--
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Data.ByteArray
( module X
) where
import Data.ByteArray.Types as X
import Data.ByteArray.Methods as X
import Data.ByteArray.ScrubbedBytes as X (ScrubbedBytes)
import Data.ByteArray.Bytes as X (Bytes)
import Data.ByteArray.MemView as X (MemView(..))

View File

@ -1,5 +1,5 @@
-- | -- |
-- Module : Data.Memory.ByteArray.Bytes -- Module : Data.ByteArray.Bytes
-- License : BSD-style -- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org> -- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : stable -- Stability : stable
@ -10,7 +10,7 @@
{-# LANGUAGE BangPatterns #-} {-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-} {-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE UnboxedTuples #-}
module Data.Memory.ByteArray.Bytes module Data.ByteArray.Bytes
( Bytes ( Bytes
) where ) where
@ -19,8 +19,8 @@ import GHC.Prim
import GHC.Ptr import GHC.Ptr
import Data.Memory.Internal.CompatPrim import Data.Memory.Internal.CompatPrim
import Data.Memory.Internal.Compat (unsafeDoIO) import Data.Memory.Internal.Compat (unsafeDoIO)
import Data.Memory.ByteArray.Types
import Data.Memory.Encoding.Base16 (showHexadecimal) import Data.Memory.Encoding.Base16 (showHexadecimal)
import Data.ByteArray.Types
data Bytes = Bytes (MutableByteArray# RealWorld) data Bytes = Bytes (MutableByteArray# RealWorld)
@ -37,9 +37,11 @@ instance ByteArray Bytes where
------------------------------------------------------------------------ ------------------------------------------------------------------------
newBytes :: Int -> IO Bytes newBytes :: Int -> IO Bytes
newBytes (I# sz) = IO $ \s -> newBytes (I# sz)
case newAlignedPinnedByteArray# sz 8# s of | booleanPrim (sz <# 0#) = error "Bytes: size must be >= 0"
(# s', mbarr #) -> (# s', Bytes mbarr #) | otherwise = IO $ \s ->
case newAlignedPinnedByteArray# sz 8# s of
(# s', mbarr #) -> (# s', Bytes mbarr #)
touchBytes :: Bytes -> IO () touchBytes :: Bytes -> IO ()
touchBytes (Bytes mba) = IO $ \s -> case touch# mba s of s' -> (# s', () #) touchBytes (Bytes mba) = IO $ \s -> case touch# mba s of s' -> (# s', () #)

View File

@ -1,16 +1,16 @@
-- | -- |
-- Module : Data.Memory.ByteArray.MemView -- Module : Data.ByteArray.MemView
-- License : BSD-style -- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org> -- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : stable -- Stability : stable
-- Portability : Good -- Portability : Good
-- --
module Data.Memory.ByteArray.MemView module Data.ByteArray.MemView
( MemView(..) ( MemView(..)
) where ) where
import Foreign.Ptr import Foreign.Ptr
import Data.Memory.ByteArray.Types import Data.ByteArray.Types
import Data.Memory.Internal.Imports import Data.Memory.Internal.Imports
data MemView = MemView !(Ptr Word8) !Int data MemView = MemView !(Ptr Word8) !Int

View File

@ -1,15 +1,20 @@
-- | -- |
-- Module : Data.Memory.ByteArray.Methods -- Module : Data.ByteArray.Methods
-- License : BSD-style -- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org> -- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : stable -- Stability : stable
-- Portability : Good -- Portability : Good
-- --
{-# LANGUAGE BangPatterns #-} {-# LANGUAGE BangPatterns #-}
module Data.Memory.ByteArray.Methods module Data.ByteArray.Methods
( alloc ( alloc
, allocAndFreeze , allocAndFreeze
, create
, unsafeCreate
, pack
, unpack
, empty , empty
, replicate
, zero , zero
, copy , copy
, take , take
@ -19,9 +24,10 @@ module Data.Memory.ByteArray.Methods
, copyAndFreeze , copyAndFreeze
, split , split
, xor , xor
, eq
, index , index
, eq
, constEq , constEq
, append
, concat , concat
, toW64BE , toW64BE
, toW64LE , toW64LE
@ -31,7 +37,7 @@ module Data.Memory.ByteArray.Methods
import Data.Memory.Internal.Compat import Data.Memory.Internal.Compat
import Data.Memory.Internal.Imports hiding (empty) import Data.Memory.Internal.Imports hiding (empty)
import Data.Memory.ByteArray.Types import Data.ByteArray.Types
import Data.Memory.Endian import Data.Memory.Endian
import Data.Memory.PtrMethods import Data.Memory.PtrMethods
import Data.Memory.ExtendedWords import Data.Memory.ExtendedWords
@ -39,23 +45,48 @@ import Data.Memory.Encoding.Base16
import Foreign.Storable import Foreign.Storable
import Foreign.Ptr import Foreign.Ptr
import Prelude hiding (length, take, concat) import Prelude hiding (length, take, concat, replicate)
import qualified Prelude
alloc :: ByteArray ba => Int -> (Ptr p -> IO ()) -> IO ba alloc :: ByteArray ba => Int -> (Ptr p -> IO ()) -> IO ba
alloc n f = snd `fmap` allocRet n f alloc n f = snd `fmap` allocRet n f
create :: ByteArray ba => Int -> (Ptr p -> IO ()) -> IO ba
create n f = alloc n f
allocAndFreeze :: ByteArray a => Int -> (Ptr p -> IO ()) -> a allocAndFreeze :: ByteArray a => Int -> (Ptr p -> IO ()) -> a
allocAndFreeze sz f = unsafeDoIO (alloc sz f) allocAndFreeze sz f = unsafeDoIO (alloc sz f)
{-# NOINLINE allocAndFreeze #-}
unsafeCreate :: ByteArray a => Int -> (Ptr p -> IO ()) -> a
unsafeCreate sz f = unsafeDoIO (alloc sz f)
{-# NOINLINE unsafeCreate #-}
empty :: ByteArray a => a empty :: ByteArray a => a
empty = unsafeDoIO (alloc 0 $ \_ -> return ()) empty = unsafeDoIO (alloc 0 $ \_ -> return ())
-- | Pack a list of bytes into a bytearray
pack :: ByteArray a => [Word8] -> a
pack l = unsafeCreate (Prelude.length l) (fill 0 l)
where fill _ [] _ = return ()
fill i (x:xs) p = pokeByteOff p i x >> fill (i+1) xs p
-- | Un-pack a bytearray into a list of bytes
unpack :: ByteArrayAccess a => a -> [Word8]
unpack bs = loop 0
where !len = length bs
loop i
| i == len = []
| otherwise =
let !v = unsafeDoIO $ withByteArray bs (\p -> peekByteOff p i)
in v : loop (i+1)
-- | Create a xor of bytes between a and b. -- | Create a xor of bytes between a and b.
-- --
-- the returns byte array is the size of the smallest input. -- the returns byte array is the size of the smallest input.
xor :: (ByteArrayAccess a, ByteArrayAccess b, ByteArray c) => a -> b -> c xor :: (ByteArrayAccess a, ByteArrayAccess b, ByteArray c) => a -> b -> c
xor a b = xor a b =
allocAndFreeze n $ \pc -> unsafeCreate n $ \pc ->
withByteArray a $ \pa -> withByteArray a $ \pa ->
withByteArray b $ \pb -> withByteArray b $ \pb ->
memXor pc pa pb n memXor pc pa pb n
@ -80,14 +111,14 @@ split n bs
take :: ByteArray bs => Int -> bs -> bs take :: ByteArray bs => Int -> bs -> bs
take n bs = take n bs =
allocAndFreeze m $ \d -> withByteArray bs $ \s -> memCopy d s m unsafeCreate m $ \d -> withByteArray bs $ \s -> memCopy d s m
where where
m = min len n m = min len n
len = length bs len = length bs
concat :: ByteArray bs => [bs] -> bs concat :: ByteArray bs => [bs] -> bs
concat [] = empty concat [] = empty
concat allBs = allocAndFreeze total (loop allBs) concat allBs = unsafeCreate total (loop allBs)
where where
total = sum $ map length allBs total = sum $ map length allBs
@ -97,6 +128,9 @@ concat allBs = allocAndFreeze total (loop allBs)
withByteArray b $ \p -> memCopy dst p sz withByteArray b $ \p -> memCopy dst p sz
loop bs (dst `plusPtr` sz) loop bs (dst `plusPtr` sz)
append :: ByteArray bs => bs -> bs -> bs
append b1 b2 = concat [b1,b2]
copy :: (ByteArrayAccess bs1, ByteArray bs2) => bs1 -> (Ptr p -> IO ()) -> IO bs2 copy :: (ByteArrayAccess bs1, ByteArray bs2) => bs1 -> (Ptr p -> IO ()) -> IO bs2
copy bs f = copy bs f =
alloc (length bs) $ \d -> do alloc (length bs) $ \d -> do
@ -111,12 +145,19 @@ copyRet bs f =
copyAndFreeze :: (ByteArrayAccess bs1, ByteArray bs2) => bs1 -> (Ptr p -> IO ()) -> bs2 copyAndFreeze :: (ByteArrayAccess bs1, ByteArray bs2) => bs1 -> (Ptr p -> IO ()) -> bs2
copyAndFreeze bs f = copyAndFreeze bs f =
allocAndFreeze (length bs) $ \d -> do unsafeCreate (length bs) $ \d -> do
withByteArray bs $ \s -> memCopy d s (length bs) withByteArray bs $ \s -> memCopy d s (length bs)
f (castPtr d) f (castPtr d)
replicate :: ByteArray ba => Int -> Word8 -> ba
replicate 0 _ = empty
replicate n b = unsafeCreate n $ \ptr -> memSet ptr b n
{-# NOINLINE replicate #-}
zero :: ByteArray ba => Int -> ba zero :: ByteArray ba => Int -> ba
zero n = allocAndFreeze n $ \ptr -> memSet ptr 0 n zero 0 = empty
zero n = unsafeCreate n $ \ptr -> memSet ptr 0 n
{-# NOINLINE zero #-}
eq :: (ByteArrayAccess bs1, ByteArrayAccess bs2) => bs1 -> bs2 -> Bool eq :: (ByteArrayAccess bs1, ByteArrayAccess bs2) => bs1 -> bs2 -> Bool
eq b1 b2 eq b1 b2
@ -150,8 +191,8 @@ toW64LE bs ofs = unsafeDoIO $ withByteArray bs $ \p -> peek (p `plusPtr` ofs)
mapAsWord128 :: ByteArray bs => (Word128 -> Word128) -> bs -> bs mapAsWord128 :: ByteArray bs => (Word128 -> Word128) -> bs -> bs
mapAsWord128 f bs = mapAsWord128 f bs =
allocAndFreeze len $ \dst -> unsafeCreate len $ \dst ->
withByteArray bs $ \src -> withByteArray bs $ \src ->
loop (len `div` 16) dst src loop (len `div` 16) dst src
where where
len = length bs len = length bs
@ -167,8 +208,8 @@ mapAsWord128 f bs =
mapAsWord64 :: ByteArray bs => (Word64 -> Word64) -> bs -> bs mapAsWord64 :: ByteArray bs => (Word64 -> Word64) -> bs -> bs
mapAsWord64 f bs = mapAsWord64 f bs =
allocAndFreeze len $ \dst -> unsafeCreate len $ \dst ->
withByteArray bs $ \src -> withByteArray bs $ \src ->
loop (len `div` 8) dst src loop (len `div` 8) dst src
where where
len = length bs len = length bs
@ -186,6 +227,6 @@ convert = flip copyAndFreeze (\_ -> return ())
convertHex :: (ByteArrayAccess bin, ByteArray bout) => bin -> bout convertHex :: (ByteArrayAccess bin, ByteArray bout) => bin -> bout
convertHex b = convertHex b =
allocAndFreeze (length b * 2) $ \bout -> unsafeCreate (length b * 2) $ \bout ->
withByteArray b $ \bin -> withByteArray b $ \bin ->
toHexadecimal bout bin (length b) toHexadecimal bout bin (length b)

View File

@ -1,5 +1,5 @@
-- | -- |
-- Module : Data.Memory.ByteArray.ScrubbedBytes -- Module : Data.ByteArray.ScrubbedBytes
-- License : BSD-style -- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org> -- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : Stable -- Stability : Stable
@ -9,7 +9,7 @@
{-# LANGUAGE MagicHash #-} {-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
module Data.Memory.ByteArray.ScrubbedBytes module Data.ByteArray.ScrubbedBytes
( ScrubbedBytes ( ScrubbedBytes
) where ) where
@ -19,7 +19,7 @@ import GHC.Ptr
import Data.Memory.Internal.CompatPrim import Data.Memory.Internal.CompatPrim
import Data.Memory.Internal.Compat (unsafeDoIO) import Data.Memory.Internal.Compat (unsafeDoIO)
import Data.Memory.PtrMethods (memConstEqual) import Data.Memory.PtrMethods (memConstEqual)
import Data.Memory.ByteArray.Types import Data.ByteArray.Types
-- | ScrubbedBytes is a memory chunk which have the properties of: -- | ScrubbedBytes is a memory chunk which have the properties of:
-- --
@ -46,7 +46,10 @@ instance ByteArray ScrubbedBytes where
newScrubbedBytes :: Int -> IO ScrubbedBytes newScrubbedBytes :: Int -> IO ScrubbedBytes
newScrubbedBytes (I# sz) newScrubbedBytes (I# sz)
| booleanPrim (sz <=# 0#) = error "negative or null size for scrubbed array" -- TODO raise a proper exception | booleanPrim (sz <# 0#) = error "ScrubbedBytes: size must be >= 0"
| booleanPrim (sz ==# 0#) = IO $ \s ->
case newAlignedPinnedByteArray# 0# 8# s of
(# s2, mba #) -> (# s2, ScrubbedBytes mba #)
| otherwise = IO $ \s -> | otherwise = IO $ \s ->
case newAlignedPinnedByteArray# sz 8# s of case newAlignedPinnedByteArray# sz 8# s of
(# s1, mbarr #) -> (# s1, mbarr #) ->

View File

@ -1,12 +1,12 @@
-- | -- |
-- Module : Data.Memory.ByteArray.Types -- Module : Data.ByteArray.Types
-- License : BSD-style -- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org> -- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : stable -- Stability : stable
-- Portability : Good -- Portability : Good
-- --
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
module Data.Memory.ByteArray.Types module Data.ByteArray.Types
( ByteArrayAccess(..) ( ByteArrayAccess(..)
, ByteArray(..) , ByteArray(..)
) where ) where

View File

@ -1,22 +0,0 @@
-- |
-- Module : Data.Memory.ByteArray
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : stable
-- Portability : Good
--
-- Simple and efficient byte array types
--
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Data.Memory.ByteArray
( module X
) where
import Data.Memory.ByteArray.Types as X
import Data.Memory.ByteArray.Methods as X
import Data.Memory.ByteArray.ScrubbedBytes as X (ScrubbedBytes)
import Data.Memory.ByteArray.Bytes as X (Bytes)
import Data.Memory.ByteArray.MemView as X (MemView(..))

View File

@ -196,7 +196,7 @@ Library
Other-modules: Crypto.Random.Entropy.Unix Other-modules: Crypto.Random.Entropy.Unix
if flag(builtin_memory) if flag(builtin_memory)
Exposed-modules: Data.Memory.ByteArray Exposed-modules: Data.ByteArray
Data.Memory.Endian Data.Memory.Endian
Data.Memory.PtrMethods Data.Memory.PtrMethods
Data.Memory.ExtendedWords Data.Memory.ExtendedWords
@ -204,11 +204,11 @@ Library
Other-modules: Data.Memory.Internal.Compat Other-modules: Data.Memory.Internal.Compat
Data.Memory.Internal.CompatPrim Data.Memory.Internal.CompatPrim
Data.Memory.Internal.Imports Data.Memory.Internal.Imports
Data.Memory.ByteArray.Types Data.ByteArray.Types
Data.Memory.ByteArray.Bytes Data.ByteArray.Bytes
Data.Memory.ByteArray.ScrubbedBytes Data.ByteArray.ScrubbedBytes
Data.Memory.ByteArray.Methods Data.ByteArray.Methods
Data.Memory.ByteArray.MemView Data.ByteArray.MemView
CPP-options: -DWITH_BYTESTRING_SUPPORT CPP-options: -DWITH_BYTESTRING_SUPPORT
else else
build-depends: memory build-depends: memory

View File

@ -16,7 +16,7 @@ import Imports
import Data.Maybe import Data.Maybe
import Crypto.Error import Crypto.Error
import Crypto.Cipher.Types import Crypto.Cipher.Types
import Data.Memory.ByteArray as B import Data.ByteArray as B hiding (pack)
import qualified Data.ByteString as B import qualified Data.ByteString as B
------------------------------------------------------------------------ ------------------------------------------------------------------------

View File

@ -8,7 +8,7 @@ module Hash
import Crypto.Hash import Crypto.Hash
import qualified Data.ByteString as B import qualified Data.ByteString as B
import qualified Data.Memory.ByteArray as B (convertHex) import qualified Data.ByteArray as B (convertHex)
import Imports import Imports
v0,v1,v2 :: ByteString v0,v1,v2 :: ByteString

View File

@ -2,7 +2,7 @@
module KAT_Curve25519 ( tests ) where module KAT_Curve25519 ( tests ) where
import qualified Crypto.PubKey.Curve25519 as Curve25519 import qualified Crypto.PubKey.Curve25519 as Curve25519
import Data.Memory.ByteArray as B import Data.ByteArray as B
import Imports import Imports
alicePrivate = either error id $ Curve25519.secretKey ("\x77\x07\x6d\x0a\x73\x18\xa5\x7d\x3c\x16\xc1\x72\x51\xb2\x66\x45\xdf\x4c\x2f\x87\xeb\xc0\x99\x2a\xb1\x77\xfb\xa5\x1d\xb9\x2c\x2a" :: ByteString) alicePrivate = either error id $ Curve25519.secretKey ("\x77\x07\x6d\x0a\x73\x18\xa5\x7d\x3c\x16\xc1\x72\x51\xb2\x66\x45\xdf\x4c\x2f\x87\xeb\xc0\x99\x2a\xb1\x77\xfb\xa5\x1d\xb9\x2c\x2a" :: ByteString)

View File

@ -7,7 +7,7 @@ import qualified Data.ByteString.Char8 as B ()
import Imports import Imports
import qualified Crypto.MAC.Poly1305 as Poly1305 import qualified Crypto.MAC.Poly1305 as Poly1305
import qualified Data.Memory.ByteArray as B (convert) import qualified Data.ByteArray as B (convert)
instance Show Poly1305.Auth where instance Show Poly1305.Auth where
show _ = "Auth" show _ = "Auth"