[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
) 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.ChaChaDRG
import Crypto.Random.Entropy
import Data.Memory.ByteArray (ScrubbedBytes)
import Data.ByteArray (ScrubbedBytes)
import Crypto.Internal.Imports
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
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : stable
@ -10,7 +10,7 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
module Data.Memory.ByteArray.Bytes
module Data.ByteArray.Bytes
( Bytes
) where
@ -19,8 +19,8 @@ import GHC.Prim
import GHC.Ptr
import Data.Memory.Internal.CompatPrim
import Data.Memory.Internal.Compat (unsafeDoIO)
import Data.Memory.ByteArray.Types
import Data.Memory.Encoding.Base16 (showHexadecimal)
import Data.ByteArray.Types
data Bytes = Bytes (MutableByteArray# RealWorld)
@ -37,9 +37,11 @@ instance ByteArray Bytes where
------------------------------------------------------------------------
newBytes :: Int -> IO Bytes
newBytes (I# sz) = IO $ \s ->
case newAlignedPinnedByteArray# sz 8# s of
(# s', mbarr #) -> (# s', Bytes mbarr #)
newBytes (I# sz)
| booleanPrim (sz <# 0#) = error "Bytes: size must be >= 0"
| otherwise = IO $ \s ->
case newAlignedPinnedByteArray# sz 8# s of
(# s', mbarr #) -> (# s', Bytes mbarr #)
touchBytes :: Bytes -> IO ()
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
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : stable
-- Portability : Good
--
module Data.Memory.ByteArray.MemView
module Data.ByteArray.MemView
( MemView(..)
) where
import Foreign.Ptr
import Data.Memory.ByteArray.Types
import Data.ByteArray.Types
import Data.Memory.Internal.Imports
data MemView = MemView !(Ptr Word8) !Int

View File

@ -1,15 +1,20 @@
-- |
-- Module : Data.Memory.ByteArray.Methods
-- Module : Data.ByteArray.Methods
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : stable
-- Portability : Good
--
{-# LANGUAGE BangPatterns #-}
module Data.Memory.ByteArray.Methods
module Data.ByteArray.Methods
( alloc
, allocAndFreeze
, create
, unsafeCreate
, pack
, unpack
, empty
, replicate
, zero
, copy
, take
@ -19,9 +24,10 @@ module Data.Memory.ByteArray.Methods
, copyAndFreeze
, split
, xor
, eq
, index
, eq
, constEq
, append
, concat
, toW64BE
, toW64LE
@ -31,7 +37,7 @@ module Data.Memory.ByteArray.Methods
import Data.Memory.Internal.Compat
import Data.Memory.Internal.Imports hiding (empty)
import Data.Memory.ByteArray.Types
import Data.ByteArray.Types
import Data.Memory.Endian
import Data.Memory.PtrMethods
import Data.Memory.ExtendedWords
@ -39,23 +45,48 @@ import Data.Memory.Encoding.Base16
import Foreign.Storable
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 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 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 = 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.
--
-- the returns byte array is the size of the smallest input.
xor :: (ByteArrayAccess a, ByteArrayAccess b, ByteArray c) => a -> b -> c
xor a b =
allocAndFreeze n $ \pc ->
unsafeCreate n $ \pc ->
withByteArray a $ \pa ->
withByteArray b $ \pb ->
memXor pc pa pb n
@ -80,14 +111,14 @@ split n bs
take :: ByteArray bs => Int -> bs -> 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
m = min len n
len = length bs
concat :: ByteArray bs => [bs] -> bs
concat [] = empty
concat allBs = allocAndFreeze total (loop allBs)
concat allBs = unsafeCreate total (loop allBs)
where
total = sum $ map length allBs
@ -97,6 +128,9 @@ concat allBs = allocAndFreeze total (loop allBs)
withByteArray b $ \p -> memCopy dst p 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 bs f =
alloc (length bs) $ \d -> do
@ -111,12 +145,19 @@ copyRet bs f =
copyAndFreeze :: (ByteArrayAccess bs1, ByteArray bs2) => bs1 -> (Ptr p -> IO ()) -> bs2
copyAndFreeze bs f =
allocAndFreeze (length bs) $ \d -> do
unsafeCreate (length bs) $ \d -> do
withByteArray bs $ \s -> memCopy d s (length bs)
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 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 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 f bs =
allocAndFreeze len $ \dst ->
withByteArray bs $ \src ->
unsafeCreate len $ \dst ->
withByteArray bs $ \src ->
loop (len `div` 16) dst src
where
len = length bs
@ -167,8 +208,8 @@ mapAsWord128 f bs =
mapAsWord64 :: ByteArray bs => (Word64 -> Word64) -> bs -> bs
mapAsWord64 f bs =
allocAndFreeze len $ \dst ->
withByteArray bs $ \src ->
unsafeCreate len $ \dst ->
withByteArray bs $ \src ->
loop (len `div` 8) dst src
where
len = length bs
@ -186,6 +227,6 @@ convert = flip copyAndFreeze (\_ -> return ())
convertHex :: (ByteArrayAccess bin, ByteArray bout) => bin -> bout
convertHex b =
allocAndFreeze (length b * 2) $ \bout ->
withByteArray b $ \bin ->
unsafeCreate (length b * 2) $ \bout ->
withByteArray b $ \bin ->
toHexadecimal bout bin (length b)

View File

@ -1,5 +1,5 @@
-- |
-- Module : Data.Memory.ByteArray.ScrubbedBytes
-- Module : Data.ByteArray.ScrubbedBytes
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : Stable
@ -9,7 +9,7 @@
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE CPP #-}
module Data.Memory.ByteArray.ScrubbedBytes
module Data.ByteArray.ScrubbedBytes
( ScrubbedBytes
) where
@ -19,7 +19,7 @@ import GHC.Ptr
import Data.Memory.Internal.CompatPrim
import Data.Memory.Internal.Compat (unsafeDoIO)
import Data.Memory.PtrMethods (memConstEqual)
import Data.Memory.ByteArray.Types
import Data.ByteArray.Types
-- | ScrubbedBytes is a memory chunk which have the properties of:
--
@ -46,7 +46,10 @@ instance ByteArray ScrubbedBytes where
newScrubbedBytes :: Int -> IO ScrubbedBytes
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 ->
case newAlignedPinnedByteArray# sz 8# s of
(# s1, mbarr #) ->

View File

@ -1,12 +1,12 @@
-- |
-- Module : Data.Memory.ByteArray.Types
-- Module : Data.ByteArray.Types
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : stable
-- Portability : Good
--
{-# LANGUAGE CPP #-}
module Data.Memory.ByteArray.Types
module Data.ByteArray.Types
( ByteArrayAccess(..)
, ByteArray(..)
) 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
if flag(builtin_memory)
Exposed-modules: Data.Memory.ByteArray
Exposed-modules: Data.ByteArray
Data.Memory.Endian
Data.Memory.PtrMethods
Data.Memory.ExtendedWords
@ -204,11 +204,11 @@ Library
Other-modules: Data.Memory.Internal.Compat
Data.Memory.Internal.CompatPrim
Data.Memory.Internal.Imports
Data.Memory.ByteArray.Types
Data.Memory.ByteArray.Bytes
Data.Memory.ByteArray.ScrubbedBytes
Data.Memory.ByteArray.Methods
Data.Memory.ByteArray.MemView
Data.ByteArray.Types
Data.ByteArray.Bytes
Data.ByteArray.ScrubbedBytes
Data.ByteArray.Methods
Data.ByteArray.MemView
CPP-options: -DWITH_BYTESTRING_SUPPORT
else
build-depends: memory

View File

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

View File

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

View File

@ -2,7 +2,7 @@
module KAT_Curve25519 ( tests ) where
import qualified Crypto.PubKey.Curve25519 as Curve25519
import Data.Memory.ByteArray as B
import Data.ByteArray as B
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)

View File

@ -7,7 +7,7 @@ import qualified Data.ByteString.Char8 as B ()
import Imports
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
show _ = "Auth"