Hello community, here is the log from the commit of package ghc-memory for openSUSE:Factory checked in at 2016-01-07 00:25:05 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-memory (Old) and /work/SRC/openSUSE:Factory/.ghc-memory.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-memory" Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-memory/ghc-memory.changes 2015-06-10 09:15:38.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-memory.new/ghc-memory.changes 2016-01-07 00:25:18.000000000 +0100 @@ -1,0 +2,9 @@ +Tue Dec 15 12:44:49 UTC 2015 - mimi...@gmail.com + +- update to 0.10 +* make memConstEqual more constant not using boolean comparaison +* memConstEqual was comparing length times the first byte instead of comparing + all the bytes one to one +* Add Base64 variants + +------------------------------------------------------------------- Old: ---- memory-0.7.tar.gz New: ---- memory-0.10.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-memory.spec ++++++ --- /var/tmp/diff_new_pack.o3MOVl/_old 2016-01-07 00:25:20.000000000 +0100 +++ /var/tmp/diff_new_pack.o3MOVl/_new 2016-01-07 00:25:20.000000000 +0100 @@ -21,7 +21,7 @@ %bcond_with tests Name: ghc-memory -Version: 0.7 +Version: 0.10 Release: 0 Summary: Memory and related abtraction stuff License: BSD-3-Clause ++++++ memory-0.7.tar.gz -> memory-0.10.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/memory-0.7/CHANGELOG.md new/memory-0.10/CHANGELOG.md --- old/memory-0.7/CHANGELOG.md 2015-06-02 14:52:15.000000000 +0200 +++ new/memory-0.10/CHANGELOG.md 2015-09-08 15:28:21.000000000 +0200 @@ -1,3 +1,16 @@ +## 0.10 + +* make memConstEqual more constant not using boolean comparaison + +## 0.9 + +* memConstEqual was comparing length times the first byte instead of comparing all the bytes one to one + +## 0.8 + +* Add Base64 variants (Luke Taylor) +* Fix compilation on Haiku (Jessica Hamilton) + ## 0.7 * Fix fixed sized scrubber written too hastily, that would zero out memory, as the index diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/memory-0.7/Data/ByteArray/Encoding.hs new/memory-0.10/Data/ByteArray/Encoding.hs --- old/memory-0.7/Data/ByteArray/Encoding.hs 2015-06-02 14:52:15.000000000 +0200 +++ new/memory-0.10/Data/ByteArray/Encoding.hs 2015-09-08 15:28:21.000000000 +0200 @@ -22,29 +22,42 @@ import Data.Memory.Encoding.Base64 -- | Different bases that can be used -data Base = Base16 -- ^ similar to hexadecimal +-- +-- See <http://tools.ietf.org/html/rfc4648 RFC4648> for details. +-- In particular, Base64 can be standard or +-- <http://tools.ietf.org/html/rfc4648#section-5 URL-safe>. URL-safe +-- encoding is often used in other specifications without +-- <http://tools.ietf.org/html/rfc4648#section-3.2 padding> characters. +data Base = Base16 -- ^ similar to hexadecimal | Base32 - | Base64 + | Base64 -- ^ standard Base64 + | Base64URLUnpadded -- ^ unpadded URL-safe Base64 + | Base64OpenBSD -- ^ Base64 as used in OpenBSD password encoding (such as bcrypt) deriving (Show,Eq) -- | Convert a bytearray to the equivalent representation in a specific Base convertToBase :: (ByteArrayAccess bin, ByteArray bout) => Base -> bin -> bout -convertToBase Base16 b = - B.unsafeCreate (B.length b * 2) $ \bout -> - B.withByteArray b $ \bin -> - toHexadecimal bout bin (B.length b) -convertToBase Base32 b = - B.unsafeCreate outLen $ \bout -> - B.withByteArray b $ \bin -> - toBase32 bout bin (B.length b) - where (q,r) = B.length b `divMod` 5 - outLen = 8 * (if r == 0 then q else q + 1) -convertToBase Base64 b = - B.unsafeCreate outLen $ \bout -> - withByteArray b $ \bin -> - toBase64 bout bin (B.length b) - where (q,r) = B.length b `divMod` 3 - outLen = 4 * (if r == 0 then q else q+1) +convertToBase base b = case base of + Base16 -> doConvert (binLength * 2) toHexadecimal + Base32 -> let (q,r) = binLength `divMod` 5 + outLen = 8 * (if r == 0 then q else q + 1) + in doConvert outLen toBase32 + Base64 -> doConvert base64Length toBase64 + -- Base64URL -> doConvert base64Length (toBase64URL True) + Base64URLUnpadded -> doConvert base64UnpaddedLength (toBase64URL False) + Base64OpenBSD -> doConvert base64UnpaddedLength toBase64OpenBSD + where + binLength = B.length b + + base64Length = let (q,r) = binLength `divMod` 3 + in 4 * (if r == 0 then q else q+1) + + base64UnpaddedLength = let (q,r) = binLength `divMod` 3 + in 4 * q + (if r == 0 then 0 else r+1) + doConvert l f = + B.unsafeCreate l $ \bout -> + B.withByteArray b $ \bin -> + f bout bin binLength -- | Try to Convert a bytearray from the equivalent representation in a specific Base convertFromBase :: (ByteArrayAccess bin, ByteArray bout) => Base -> bin -> Either String bout @@ -78,3 +91,22 @@ case ret of Nothing -> return $ Right out Just ofs -> return $ Left ("base64: input: invalid encoding at offset: " ++ show ofs) +convertFromBase Base64URLUnpadded b = unsafeDoIO $ + withByteArray b $ \bin -> + case unBase64LengthUnpadded (B.length b) of + Nothing -> return $ Left "base64URL unpadded: input: invalid length" + Just dstLen -> do + (ret, out) <- B.allocRet dstLen $ \bout -> fromBase64URLUnpadded bout bin (B.length b) + case ret of + Nothing -> return $ Right out + Just ofs -> return $ Left ("base64URL unpadded: input: invalid encoding at offset: " ++ show ofs) +convertFromBase Base64OpenBSD b = unsafeDoIO $ + withByteArray b $ \bin -> + case unBase64LengthUnpadded (B.length b) of + Nothing -> return $ Left "base64 unpadded: input: invalid length" + Just dstLen -> do + (ret, out) <- B.allocRet dstLen $ \bout -> fromBase64OpenBSD bout bin (B.length b) + case ret of + Nothing -> return $ Right out + Just ofs -> return $ Left ("base64 unpadded: input: invalid encoding at offset: " ++ show ofs) + diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/memory-0.7/Data/ByteArray/Methods.hs new/memory-0.10/Data/ByteArray/Methods.hs --- old/memory-0.7/Data/ByteArray/Methods.hs 2015-06-02 14:52:15.000000000 +0200 +++ new/memory-0.10/Data/ByteArray/Methods.hs 2015-09-08 15:28:21.000000000 +0200 @@ -15,6 +15,9 @@ , unpack , uncons , empty + , singleton + , cons + , snoc , null , replicate , zero @@ -30,6 +33,8 @@ , index , eq , constEq + , any + , all , append , concat ) where @@ -42,7 +47,7 @@ import Foreign.Storable import Foreign.Ptr -import Prelude hiding (length, take, drop, span, concat, replicate, splitAt, null, pred) +import Prelude hiding (length, take, drop, span, concat, replicate, splitAt, null, pred, last, any, all) import qualified Prelude -- | Allocate a new bytearray of specific size, and run the initializer on this memory @@ -70,7 +75,7 @@ empty = unsafeDoIO (alloc 0 $ \_ -> return ()) -- | Check if a byte array is empty -null :: ByteArray a => a -> Bool +null :: ByteArrayAccess a => a -> Bool null b = length b == 0 -- | Pack a list of bytes into a bytearray @@ -95,6 +100,24 @@ | null a = Nothing | otherwise = Just (index a 0, drop 1 a) +-- | Create a byte array from a single byte +singleton :: ByteArray a => Word8 -> a +singleton b = unsafeCreate 1 (\p -> pokeByteOff p 0 b) + +-- | prepend a single byte to a byte array +cons :: ByteArray a => Word8 -> a -> a +cons b ba = unsafeCreate (len + 1) $ \d -> withByteArray ba $ \s -> do + pokeByteOff d 0 b + memCopy (d `plusPtr` 1) s len + where len = length ba + +-- | append a single byte to a byte array +snoc :: ByteArray a => a -> Word8 -> a +snoc ba b = unsafeCreate (len + 1) $ \d -> withByteArray ba $ \s -> do + memCopy d s len + pokeByteOff d len b + where len = length ba + -- | Create a xor of bytes between a and b. -- -- the returns byte array is the size of the smallest input. @@ -127,7 +150,7 @@ return (b1, b2) where len = length bs --- | Take the first @n byte of a bytearray +-- | Take the first @n@ byte of a bytearray take :: ByteArray bs => Int -> bs -> bs take n bs | n <= 0 = empty @@ -136,7 +159,7 @@ m = min len n len = length bs --- | drop the first @n byte of a bytearray +-- | drop the first @n@ byte of a bytearray drop :: ByteArray bs => Int -> bs -> bs drop n bs | n <= 0 = bs @@ -147,7 +170,7 @@ nb = len - ofs len = length bs --- | Split a bytearray at the point where @pred becomes invalid +-- | Split a bytearray at the point where @pred@ becomes invalid span :: ByteArray bs => (Word8 -> Bool) -> bs -> (bs, bs) span pred bs | null bs = (bs, bs) @@ -238,6 +261,23 @@ l1 = length b1 l2 = length b2 +-- | Check if any element of a byte array satisfies a predicate +any :: (ByteArrayAccess ba) => (Word8 -> Bool) -> ba -> Bool +any f b + | null b = False + | otherwise = unsafeDoIO $ withByteArray b $ \p -> loop p 0 + where + len = length b + loop p i + | i == len = return False + | otherwise = do + w <- peekByteOff p i + if f w then return True else loop p (i+1) + +-- | Check if all elements of a byte array satisfy a predicate +all :: (ByteArrayAccess ba) => (Word8 -> Bool) -> ba -> Bool +all f b = not (any (not . f) b) + -- | Convert a bytearray to another type of bytearray convert :: (ByteArrayAccess bin, ByteArray bout) => bin -> bout convert = flip copyAndFreeze (\_ -> return ()) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/memory-0.7/Data/Memory/Encoding/Base64.hs new/memory-0.10/Data/Memory/Encoding/Base64.hs --- old/memory-0.7/Data/Memory/Encoding/Base64.hs 2015-06-02 14:52:15.000000000 +0200 +++ new/memory-0.10/Data/Memory/Encoding/Base64.hs 2015-09-08 15:28:21.000000000 +0200 @@ -14,8 +14,13 @@ {-# LANGUAGE Rank2Types #-} module Data.Memory.Encoding.Base64 ( toBase64 + , toBase64URL + , toBase64OpenBSD , unBase64Length + , unBase64LengthUnpadded , fromBase64 + , fromBase64URLUnpadded + , fromBase64OpenBSD ) where import Control.Monad @@ -28,14 +33,35 @@ import Foreign.Storable import Foreign.Ptr (Ptr) --- | Transform a number of bytes pointed by.@src in the base64 binary representation in @dst +-- | Transform a number of bytes pointed by @src@ to base64 binary representation in @dst@ -- --- destination memory need to be of correct size, otherwise it will lead +-- The destination memory need to be of correct size, otherwise it will lead -- to really bad things. toBase64 :: Ptr Word8 -> Ptr Word8 -> Int -> IO () -toBase64 dst src len = loop 0 0 +toBase64 dst src len = toBase64Internal set dst src len True where - eqChar = 0x3d + !set = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"# + +-- | Transform a number of bytes pointed by @src@ to, URL-safe base64 binary +-- representation in @dst@. The result will be either padded or unpadded, +-- depending on the boolean @padded@ argument. +-- +-- The destination memory need to be of correct size, otherwise it will lead +-- to really bad things. +toBase64URL :: Bool -> Ptr Word8 -> Ptr Word8 -> Int -> IO () +toBase64URL padded dst src len = toBase64Internal set dst src len padded + where + !set = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_"# + +toBase64OpenBSD :: Ptr Word8 -> Ptr Word8 -> Int -> IO () +toBase64OpenBSD dst src len = toBase64Internal set dst src len False + where + !set = "./ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"# + +toBase64Internal :: Addr# -> Ptr Word8 -> Ptr Word8 -> Int -> Bool -> IO () +toBase64Internal table dst src len padded = loop 0 0 + where + eqChar = 0x3d :: Word8 loop i di | i >= len = return () @@ -44,27 +70,34 @@ b <- if i + 1 >= len then return 0 else peekByteOff src (i+1) c <- if i + 2 >= len then return 0 else peekByteOff src (i+2) - let (w,x,y,z) = convert3 a b c + let (w,x,y,z) = convert3 table a b c pokeByteOff dst di w pokeByteOff dst (di+1) x - pokeByteOff dst (di+2) (if i + 1 >= len then eqChar else y) - pokeByteOff dst (di+3) (if i + 2 >= len then eqChar else z) + + if i + 1 < len + then + pokeByteOff dst (di+2) y + else + when padded (pokeByteOff dst (di+2) eqChar) + if i + 2 < len + then + pokeByteOff dst (di+3) z + else + when padded (pokeByteOff dst (di+3) eqChar) loop (i+3) (di+4) -convert3 :: Word8 -> Word8 -> Word8 -> (Word8, Word8, Word8, Word8) -convert3 (W8# a) (W8# b) (W8# c) = +convert3 :: Addr# -> Word8 -> Word8 -> Word8 -> (Word8, Word8, Word8, Word8) +convert3 table (W8# a) (W8# b) (W8# c) = let !w = narrow8Word# (uncheckedShiftRL# a 2#) !x = or# (and# (uncheckedShiftL# a 4#) 0x30##) (uncheckedShiftRL# b 4#) !y = or# (and# (uncheckedShiftL# b 2#) 0x3c##) (uncheckedShiftRL# c 6#) !z = and# c 0x3f## in (index w, index x, index y, index z) where - !set = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"# - index :: Word# -> Word8 - index idx = W8# (indexWord8OffAddr# set (word2Int# idx)) + index idx = W8# (indexWord8OffAddr# table (word2Int# idx)) -- | Get the length needed for the destination buffer for a base64 decoding. -- @@ -83,7 +116,140 @@ eqAscii :: Word8 eqAscii = fromIntegral (fromEnum '=') --- | convert from base64 in @src to binary in @dst, using the number of bytes specified +-- | Get the length needed for the destination buffer for an +-- <http://tools.ietf.org/html/rfc4648#section-3.2 unpadded> base64 decoding. +-- +-- If the length of the encoded string is a multiple of 4, plus one, Nothing is +-- returned. Any other value can be valid without padding. +unBase64LengthUnpadded :: Int -> Maybe Int +unBase64LengthUnpadded len = case r of + 0 -> Just (3*q) + 2 -> Just (3*q + 1) + 3 -> Just (3*q + 2) + _ -> Nothing + where (q, r) = len `divMod` 4 + +fromBase64OpenBSD :: Ptr Word8 -> Ptr Word8 -> Int -> IO (Maybe Int) +fromBase64OpenBSD dst src len = fromBase64Unpadded rsetOpenBSD dst src len + +fromBase64URLUnpadded :: Ptr Word8 -> Ptr Word8 -> Int -> IO (Maybe Int) +fromBase64URLUnpadded dst src len = fromBase64Unpadded rsetURL dst src len + +fromBase64Unpadded :: (Word8 -> Word8) -> Ptr Word8 -> Ptr Word8 -> Int -> IO (Maybe Int) +fromBase64Unpadded rset dst src len = loop 0 0 + where loop di i + | i == len = return Nothing + | i == len - 1 = return Nothing -- Shouldn't happen if len is valid + | i == len - 2 = do + a <- peekByteOff src i + b <- peekByteOff src (i+1) + + case decode2 a b of + Left ofs -> return $ Just (i + ofs) + Right x -> do + pokeByteOff dst di x + return Nothing + | i == len - 3 = do + a <- peekByteOff src i + b <- peekByteOff src (i+1) + c <- peekByteOff src (i+2) + + case decode3 a b c of + Left ofs -> return $ Just (i + ofs) + Right (x,y) -> do + pokeByteOff dst di x + pokeByteOff dst (di+1) y + return Nothing + | otherwise = do + a <- peekByteOff src i + b <- peekByteOff src (i+1) + c <- peekByteOff src (i+2) + d <- peekByteOff src (i+3) + + case decode4 a b c d of + Left ofs -> return $ Just (i + ofs) + Right (x,y,z) -> do + pokeByteOff dst di x + pokeByteOff dst (di+1) y + pokeByteOff dst (di+2) z + loop (di + 3) (i + 4) + + decode2 :: Word8 -> Word8 -> Either Int Word8 + decode2 a b = + case (rset a, rset b) of + (0xff, _ ) -> Left 0 + (_ , 0xff) -> Left 1 + (ra , rb ) -> Right ((ra `unsafeShiftL` 2) .|. (rb `unsafeShiftR` 4)) + + decode3 :: Word8 -> Word8 -> Word8 -> Either Int (Word8, Word8) + decode3 a b c = + case (rset a, rset b, rset c) of + (0xff, _ , _ ) -> Left 0 + (_ , 0xff, _ ) -> Left 1 + (_ , _ , 0xff) -> Left 2 + (ra , rb , rc ) -> + let x = (ra `unsafeShiftL` 2) .|. (rb `unsafeShiftR` 4) + y = (rb `unsafeShiftL` 4) .|. (rc `unsafeShiftR` 2) + in Right (x,y) + + + decode4 :: Word8 -> Word8 -> Word8 -> Word8 -> Either Int (Word8, Word8, Word8) + decode4 a b c d = + case (rset a, rset b, rset c, rset d) of + (0xff, _ , _ , _ ) -> Left 0 + (_ , 0xff, _ , _ ) -> Left 1 + (_ , _ , 0xff, _ ) -> Left 2 + (_ , _ , _ , 0xff) -> Left 3 + (ra , rb , rc , rd ) -> + let x = (ra `unsafeShiftL` 2) .|. (rb `unsafeShiftR` 4) + y = (rb `unsafeShiftL` 4) .|. (rc `unsafeShiftR` 2) + z = (rc `unsafeShiftL` 6) .|. rd + in Right (x,y,z) + +rsetURL :: Word8 -> Word8 +rsetURL (W8# w) + | booleanPrim (w `leWord#` 0xff##) = W8# (indexWord8OffAddr# rsetTable (word2Int# w)) + | otherwise = 0xff + where !rsetTable = "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ + \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ + \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\xff\xff\ + \\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\xff\xff\xff\xff\xff\xff\ + \\xff\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\ + \\x0f\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\xff\xff\xff\xff\x3f\ + \\xff\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\ + \\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\xff\xff\xff\xff\xff\ + \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ + \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ + \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ + \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ + \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ + \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ + \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ + \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# + +rsetOpenBSD :: Word8 -> Word8 +rsetOpenBSD (W8# w) + | booleanPrim (w `leWord#` 0xff##) = W8# (indexWord8OffAddr# rsetTable (word2Int# w)) + | otherwise = 0xff + where !rsetTable = "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ + \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ + \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\ + \\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\xff\xff\xff\xff\xff\xff\ + \\xff\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f\x10\ + \\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\xff\xff\xff\xff\xff\ + \\xff\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\ + \\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\xff\xff\xff\xff\xff\ + \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ + \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ + \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ + \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ + \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ + \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ + \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ + \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# + + +-- | convert from base64 in @src@ to binary in @dst@, using the number of bytes specified -- -- the user should use unBase64Length to compute the correct length, or check that -- the length specification is proper. no check is done here. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/memory-0.7/Data/Memory/MemMap/Posix.hsc new/memory-0.10/Data/Memory/MemMap/Posix.hsc --- old/memory-0.7/Data/Memory/MemMap/Posix.hsc 2015-06-02 14:52:15.000000000 +0200 +++ new/memory-0.10/Data/Memory/MemMap/Posix.hsc 2015-09-08 15:28:21.000000000 +0200 @@ -51,8 +51,13 @@ foreign import ccall unsafe "munmap" c_munmap :: Ptr a -> CSize -> IO CInt +#if defined(POSIX_MADV_NORMAL) +foreign import ccall unsafe "posix_madvise" + c_madvise :: Ptr a -> CSize -> CInt -> IO CInt +#else foreign import ccall unsafe "madvise" c_madvise :: Ptr a -> CSize -> CInt -> IO CInt +#endif foreign import ccall unsafe "msync" c_msync :: Ptr a -> CSize -> CInt -> IO CInt @@ -60,11 +65,21 @@ foreign import ccall unsafe "mprotect" c_mprotect :: Ptr a -> CSize -> CInt -> IO CInt +#ifndef __HAIKU__ foreign import ccall unsafe "mlock" c_mlock :: Ptr a -> CSize -> IO CInt +#else +c_mlock :: Ptr a -> CSize -> IO CInt +c_mlock _ _ = return (-1) +#endif +#ifndef __HAIKU__ foreign import ccall unsafe "munlock" c_munlock :: Ptr a -> CSize -> IO CInt +#else +c_munlock :: Ptr a -> CSize -> IO CInt +c_munlock _ _ = return (-1) +#endif foreign import ccall unsafe "sysconf" c_sysconf :: CInt -> CLong @@ -159,12 +174,19 @@ memoryAdvise :: Ptr a -> CSize -> MemoryAdvice -> IO () memoryAdvise ptr sz adv = throwErrnoIfMinus1_ "madvise" (c_madvise ptr sz cadv) where cadv = toAdvice adv - +#if defined(POSIX_MADV_NORMAL) + toAdvice MemoryAdviceNormal = (#const POSIX_MADV_NORMAL) + toAdvice MemoryAdviceRandom = (#const POSIX_MADV_RANDOM) + toAdvice MemoryAdviceSequential = (#const POSIX_MADV_SEQUENTIAL) + toAdvice MemoryAdviceWillNeed = (#const POSIX_MADV_WILLNEED) + toAdvice MemoryAdviceDontNeed = (#const POSIX_MADV_DONTNEED) +#else toAdvice MemoryAdviceNormal = (#const MADV_NORMAL) toAdvice MemoryAdviceRandom = (#const MADV_RANDOM) toAdvice MemoryAdviceSequential = (#const MADV_SEQUENTIAL) toAdvice MemoryAdviceWillNeed = (#const MADV_WILLNEED) toAdvice MemoryAdviceDontNeed = (#const MADV_DONTNEED) +#endif -- | lock a range of process address space -- diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/memory-0.7/Data/Memory/PtrMethods.hs new/memory-0.10/Data/Memory/PtrMethods.hs --- old/memory-0.7/Data/Memory/PtrMethods.hs 2015-06-02 14:52:15.000000000 +0200 +++ new/memory-0.10/Data/Memory/PtrMethods.hs 2015-09-08 15:28:21.000000000 +0200 @@ -27,7 +27,7 @@ import Foreign.Storable (peek, poke, pokeByteOff, peekByteOff) import Foreign.C.Types import Foreign.Marshal.Alloc (allocaBytesAligned) -import Data.Bits (xor) +import Data.Bits ((.|.), xor) -- | Create a new temporary buffer memCreateTemporary :: Int -> (Ptr Word8 -> IO a) -> IO a @@ -90,20 +90,13 @@ -- over all the bytes present before yielding a result even when -- knowing the overall result early in the processing. memConstEqual :: Ptr Word8 -> Ptr Word8 -> Int -> IO Bool -memConstEqual p1 p2 n = loop 0 True +memConstEqual p1 p2 n = loop 0 0 where - loop i !ret - | i == n = return ret + loop i !acc + | i == n = return $! acc == 0 | otherwise = do - e <- (==) <$> peek p1 <*> peek p2 - loop (i+1) (ret &&! e) - - -- Bool == Bool - (&&!) :: Bool -> Bool -> Bool - True &&! True = True - True &&! False = False - False &&! True = False - False &&! False = False + e <- xor <$> peekByteOff p1 i <*> (peekByteOff p2 i :: IO Word8) + loop (i+1) (acc .|. e) foreign import ccall unsafe "memset" c_memset :: Ptr Word8 -> Word8 -> CSize -> IO () diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/memory-0.7/README.md new/memory-0.10/README.md --- old/memory-0.7/README.md 2015-06-02 14:52:15.000000000 +0200 +++ new/memory-0.10/README.md 2015-09-08 15:28:21.000000000 +0200 @@ -17,7 +17,7 @@ Also provides some useful helpers: * Fast Hashing : [SipHash](https://131002.net/siphash/), [FNV1](http://en.wikipedia.org/wiki/Fowler%E2%80%93Noll%E2%80%93Vo_hash_function). -* Built-in base encoding : Base16, [Base64](http://en.wikipedia.org/wiki/Base64). +* Built-in base encoding : Base16, Base32, [Base64](http://en.wikipedia.org/wiki/Base64). Versioning ---------- @@ -37,7 +37,7 @@ Support ------- -memory supports the following platform: +Memory supports the following platform: * Windows >= 7 * OSX >= 10.8 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/memory-0.7/memory.cabal new/memory-0.10/memory.cabal --- old/memory-0.7/memory.cabal 2015-06-02 14:52:15.000000000 +0200 +++ new/memory-0.10/memory.cabal 2015-09-08 15:28:21.000000000 +0200 @@ -1,6 +1,6 @@ Name: memory -Version: 0.7 -Synopsis: memory and related abtraction stuff +Version: 0.10 +Synopsis: memory and related abstraction stuff Description: Chunk of memory, polymorphic byte array management and manipulation . @@ -11,6 +11,8 @@ * Raw memory IO operations (memory set, memory copy, ..) . * Aliasing with endianness support. + . + * Encoding : Base16, Base32, Base64. License: BSD3 License-file: LICENSE Copyright: Vincent Hanquez <vinc...@snarc.org> diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/memory-0.7/tests/Tests.hs new/memory-0.10/tests/Tests.hs --- old/memory-0.7/tests/Tests.hs 2015-06-02 14:52:15.000000000 +0200 +++ new/memory-0.10/tests/Tests.hs 2015-09-08 15:28:21.000000000 +0200 @@ -60,6 +60,17 @@ , ("sure.", "c3VyZS4=") ] +base64URLKats = + [ ("pleasure.", "cGxlYXN1cmUu") + , ("leasure.", "bGVhc3VyZS4") + , ("easure.", "ZWFzdXJlLg") + , ("asure.", "YXN1cmUu") + , ("sure.", "c3VyZS4") + , ("\DC4\251\156\ETX\217~", "FPucA9l-") -- From RFC4648 + , ("\DC4\251\156\ETX\217\DEL", "FPucA9l_") + , ("", "") + ] + base16Kats = [ ("this is a string", "74686973206973206120737472696e67") ] @@ -82,6 +93,10 @@ [ testGroup "encode-KAT" encodeKats64 , testGroup "decode-KAT" decodeKats64 ] + , testGroup "BASE64URL" + [ testGroup "encode-KAT" encodeKats64URLUnpadded + , testGroup "decode-KAT" decodeKats64URLUnpadded + ] , testGroup "BASE32" [ testGroup "encode-KAT" encodeKats32 , testGroup "decode-KAT" decodeKats32 @@ -98,6 +113,8 @@ decodeKats32 = map (toBackTest B.Base32) $ zip [1..] base32Kats encodeKats16 = map (toTest B.Base16) $ zip [1..] base16Kats decodeKats16 = map (toBackTest B.Base16) $ zip [1..] base16Kats + encodeKats64URLUnpadded = map (toTest B.Base64URLUnpadded) $ zip [1..] base64URLKats + decodeKats64URLUnpadded = map (toBackTest B.Base64URLUnpadded) $ zip [1..] base64URLKats toTest :: B.Base -> (Int, (String, String)) -> TestTree toTest base (i, (inp, out)) = testCase (show i) $ @@ -154,4 +171,19 @@ let chunks = map (witnessID . B.pack . unWords8) l expected = concatMap unWords8 l in B.pack expected == witnessID (B.concat chunks) + , testProperty "cons b bs == reverse (snoc (reverse bs) b)" $ \(Words8 l) b -> + let b1 = witnessID (B.pack l) + b2 = witnessID (B.pack (reverse l)) + expected = B.pack (reverse (B.unpack (B.snoc b2 b))) + in B.cons b b1 == expected + , testProperty "all == Prelude.all" $ \(Words8 l) b -> + let b1 = witnessID (B.pack l) + p = (/= b) + in B.all p b1 == all p l + , testProperty "any == Prelude.any" $ \(Words8 l) b -> + let b1 = witnessID (B.pack l) + p = (== b) + in B.any p b1 == any p l + , testProperty "singleton b == pack [b]" $ \b -> + witnessID (B.singleton b) == B.pack [b] ]
