From c5f9ab2d35435c702aa96720ec60de703bd2d22a Mon Sep 17 00:00:00 2001
From: Vincent Hanquez <vincent@snarc.org>
Date: Thu, 14 May 2015 10:04:16 +0100
Subject: [PATCH] [internal] update memory to latest

---
 Crypto/Internal/ByteArray.hs                 |  2 +-
 Crypto/Random.hs                             |  2 +-
 Data/ByteArray.hs                            | 24 +++++++
 Data/{Memory => }/ByteArray/Bytes.hs         | 14 ++--
 Data/{Memory => }/ByteArray/MemView.hs       |  6 +-
 Data/{Memory => }/ByteArray/Methods.hs       | 73 +++++++++++++++-----
 Data/{Memory => }/ByteArray/ScrubbedBytes.hs | 11 +--
 Data/{Memory => }/ByteArray/Types.hs         |  4 +-
 Data/Memory/ByteArray.hs                     | 22 ------
 cryptonite.cabal                             | 12 ++--
 tests/BlockCipher.hs                         |  2 +-
 tests/Hash.hs                                |  2 +-
 tests/KAT_Curve25519.hs                      |  2 +-
 tests/Poly1305.hs                            |  2 +-
 14 files changed, 113 insertions(+), 65 deletions(-)
 create mode 100644 Data/ByteArray.hs
 rename Data/{Memory => }/ByteArray/Bytes.hs (90%)
 rename Data/{Memory => }/ByteArray/MemView.hs (75%)
 rename Data/{Memory => }/ByteArray/Methods.hs (74%)
 rename Data/{Memory => }/ByteArray/ScrubbedBytes.hs (91%)
 rename Data/{Memory => }/ByteArray/Types.hs (92%)
 delete mode 100644 Data/Memory/ByteArray.hs

diff --git a/Crypto/Internal/ByteArray.hs b/Crypto/Internal/ByteArray.hs
index b242a66..11bc950 100644
--- a/Crypto/Internal/ByteArray.hs
+++ b/Crypto/Internal/ByteArray.hs
@@ -11,4 +11,4 @@ module Crypto.Internal.ByteArray
     ( module X
     ) where
 
-import Data.Memory.ByteArray as X
+import Data.ByteArray as X
diff --git a/Crypto/Random.hs b/Crypto/Random.hs
index 638f31c..6d67d85 100644
--- a/Crypto/Random.hs
+++ b/Crypto/Random.hs
@@ -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
diff --git a/Data/ByteArray.hs b/Data/ByteArray.hs
new file mode 100644
index 0000000..e0d1a36
--- /dev/null
+++ b/Data/ByteArray.hs
@@ -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(..))
diff --git a/Data/Memory/ByteArray/Bytes.hs b/Data/ByteArray/Bytes.hs
similarity index 90%
rename from Data/Memory/ByteArray/Bytes.hs
rename to Data/ByteArray/Bytes.hs
index eaa5a35..63f385f 100644
--- a/Data/Memory/ByteArray/Bytes.hs
+++ b/Data/ByteArray/Bytes.hs
@@ -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', () #)
diff --git a/Data/Memory/ByteArray/MemView.hs b/Data/ByteArray/MemView.hs
similarity index 75%
rename from Data/Memory/ByteArray/MemView.hs
rename to Data/ByteArray/MemView.hs
index 5663d60..9605993 100644
--- a/Data/Memory/ByteArray/MemView.hs
+++ b/Data/ByteArray/MemView.hs
@@ -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
diff --git a/Data/Memory/ByteArray/Methods.hs b/Data/ByteArray/Methods.hs
similarity index 74%
rename from Data/Memory/ByteArray/Methods.hs
rename to Data/ByteArray/Methods.hs
index 9c5ea3e..11f492c 100644
--- a/Data/Memory/ByteArray/Methods.hs
+++ b/Data/ByteArray/Methods.hs
@@ -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)
diff --git a/Data/Memory/ByteArray/ScrubbedBytes.hs b/Data/ByteArray/ScrubbedBytes.hs
similarity index 91%
rename from Data/Memory/ByteArray/ScrubbedBytes.hs
rename to Data/ByteArray/ScrubbedBytes.hs
index 7840122..917bfac 100644
--- a/Data/Memory/ByteArray/ScrubbedBytes.hs
+++ b/Data/ByteArray/ScrubbedBytes.hs
@@ -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 #) ->
diff --git a/Data/Memory/ByteArray/Types.hs b/Data/ByteArray/Types.hs
similarity index 92%
rename from Data/Memory/ByteArray/Types.hs
rename to Data/ByteArray/Types.hs
index 143e76f..fd2f5ce 100644
--- a/Data/Memory/ByteArray/Types.hs
+++ b/Data/ByteArray/Types.hs
@@ -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
diff --git a/Data/Memory/ByteArray.hs b/Data/Memory/ByteArray.hs
deleted file mode 100644
index 19ae285..0000000
--- a/Data/Memory/ByteArray.hs
+++ /dev/null
@@ -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(..))
diff --git a/cryptonite.cabal b/cryptonite.cabal
index 8591d49..58d5ebf 100644
--- a/cryptonite.cabal
+++ b/cryptonite.cabal
@@ -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
diff --git a/tests/BlockCipher.hs b/tests/BlockCipher.hs
index f7eb8c2..13d5bf9 100644
--- a/tests/BlockCipher.hs
+++ b/tests/BlockCipher.hs
@@ -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
 
 ------------------------------------------------------------------------
diff --git a/tests/Hash.hs b/tests/Hash.hs
index 75093ef..7c8562b 100644
--- a/tests/Hash.hs
+++ b/tests/Hash.hs
@@ -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
diff --git a/tests/KAT_Curve25519.hs b/tests/KAT_Curve25519.hs
index 6fce0f7..02a3836 100644
--- a/tests/KAT_Curve25519.hs
+++ b/tests/KAT_Curve25519.hs
@@ -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)
diff --git a/tests/Poly1305.hs b/tests/Poly1305.hs
index 53e71bb..505f9eb 100644
--- a/tests/Poly1305.hs
+++ b/tests/Poly1305.hs
@@ -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"