haskell/cryptonite
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

[internal] update to latest memory, and remove builtin support as memory is now available

Browse Source
This commit is contained in:
Vincent Hanquez 2015-05-18 18:33:14 +01:00
parent c5f9ab2d35
commit 987f9e7bb6
19 changed files with 10 additions and 1085 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Crypto/Cipher/Types/Utils.hs
View File

@ -16,5 +16,5 @@ chunk :: ByteArray b => Int -> b -> [b]
chunk sz bs = split bs
where split b | B.length b <= sz = [b]
| otherwise =
let (b1, b2) = B.split sz b
let (b1, b2) = B.splitAt sz b
in b1 : split b2

2
Crypto/Hash/Types.hs
View File

@ -55,4 +55,4 @@ newtype Digest a = Digest Bytes
deriving (Eq,ByteArrayAccess)
instance Show (Digest a) where
show (Digest bs) = show (B.convertHex bs :: Bytes)
show (Digest bs) = show (B.convertToBase B.Base16 bs :: Bytes)

2
Crypto/Internal/ByteArray.hs
View File

@ -12,3 +12,5 @@ module Crypto.Internal.ByteArray
) where
import Data.ByteArray as X
import Data.ByteArray.Mapping as X
import Data.ByteArray.Encoding as X

24
Data/ByteArray.hs
View File

@ -1,24 +0,0 @@
-- |
-- 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(..))

125
Data/ByteArray/Bytes.hs
View File

@ -1,125 +0,0 @@
-- |
-- Module : Data.ByteArray.Bytes
-- 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 #-}
module Data.ByteArray.Bytes
( Bytes
) where
import GHC.Types
import GHC.Prim
import GHC.Ptr
import Data.Memory.Internal.CompatPrim
import Data.Memory.Internal.Compat (unsafeDoIO)
import Data.Memory.Encoding.Base16 (showHexadecimal)
import Data.ByteArray.Types
data Bytes = Bytes (MutableByteArray# RealWorld)
instance Show Bytes where
show = bytesShowHex
instance Eq Bytes where
(==) = bytesEq
instance ByteArrayAccess Bytes where
length = bytesLength
withByteArray = withBytes
instance ByteArray Bytes where
allocRet = bytesAllocRet
------------------------------------------------------------------------
newBytes :: Int -> IO Bytes
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', () #)
sizeofBytes :: Bytes -> Int
sizeofBytes (Bytes mba) = I# (sizeofMutableByteArray# mba)
withPtr :: Bytes -> (Ptr p -> IO a) -> IO a
withPtr b@(Bytes mba) f = do
a <- f (Ptr (byteArrayContents# (unsafeCoerce# mba)))
touchBytes b
return a
------------------------------------------------------------------------
{-
bytesCopyAndModify :: Bytes -> (Ptr a -> IO ()) -> IO Bytes
bytesCopyAndModify src f = do
dst <- newBytes sz
withPtr dst $ \d -> do
withPtr src $ \s -> copyBytes (castPtr d) s sz
f d
return dst
where sz = sizeofBytes src
bytesTemporary :: Int -> (Ptr p -> IO a) -> IO a
bytesTemporary sz f = newBytes sz >>= \ba -> withPtr ba f
bytesCopyTemporary :: Bytes -> (Ptr p -> IO a) -> IO a
bytesCopyTemporary src f = do
dst <- newBytes (sizeofBytes src)
withPtr dst $ \d -> do
withPtr src $ \s -> copyBytes (castPtr d) s (sizeofBytes src)
f d
bytesAlloc :: Int -> (Ptr p -> IO ()) -> IO Bytes
bytesAlloc sz f = do
ba <- newBytes sz
withPtr ba f
return ba
-}
bytesAllocRet :: Int -> (Ptr p -> IO a) -> IO (a, Bytes)
bytesAllocRet sz f = do
ba <- newBytes sz
r <- withPtr ba f
return (r, ba)
bytesLength :: Bytes -> Int
bytesLength = sizeofBytes
withBytes :: Bytes -> (Ptr p -> IO a) -> IO a
withBytes = withPtr
bytesEq :: Bytes -> Bytes -> Bool
bytesEq b1@(Bytes m1) b2@(Bytes m2)
| l1 /= l2 = False
| otherwise = unsafeDoIO $ IO $ \s -> loop 0# s
where
!l1@(I# len) = bytesLength b1
!l2 = bytesLength b2
loop i s
| booleanPrim (i ==# len) = (# s, True #)
| otherwise =
case readWord8Array# m1 i s of
(# s', e1 #) -> case readWord8Array# m2 i s' of
(# s'', e2 #) ->
if booleanPrim (eqWord# e1 e2)
then loop (i +# 1#) s''
else (# s', False #)
{-
bytesIndex :: Bytes -> Int -> Word8
bytesIndex (Bytes m) (I# i) = unsafeDoIO $ IO $ \s ->
case readWord8Array# m i s of
(# s', e #) -> (# s', W8# e #)
{-# NOINLINE bytesIndex #-}
-}
bytesShowHex :: Bytes -> String
bytesShowHex b = showHexadecimal (withPtr b) (bytesLength b)
{-# NOINLINE bytesShowHex #-}

21
Data/ByteArray/MemView.hs
View File

@ -1,21 +0,0 @@
-- |
-- Module : Data.ByteArray.MemView
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : stable
-- Portability : Good
--
module Data.ByteArray.MemView
( MemView(..)
) where
import Foreign.Ptr
import Data.ByteArray.Types
import Data.Memory.Internal.Imports
data MemView = MemView !(Ptr Word8) !Int
instance ByteArrayAccess MemView where
length (MemView _ l) = l
withByteArray (MemView p _) f = f (castPtr p)

232
Data/ByteArray/Methods.hs
View File

@ -1,232 +0,0 @@
-- |
-- Module : Data.ByteArray.Methods
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : stable
-- Portability : Good
--
{-# LANGUAGE BangPatterns #-}
module Data.ByteArray.Methods
( alloc
, allocAndFreeze
, create
, unsafeCreate
, pack
, unpack
, empty
, replicate
, zero
, copy
, take
, convert
, convertHex
, copyRet
, copyAndFreeze
, split
, xor
, index
, eq
, constEq
, append
, concat
, toW64BE
, toW64LE
, mapAsWord64
, mapAsWord128
) where
import Data.Memory.Internal.Compat
import Data.Memory.Internal.Imports hiding (empty)
import Data.ByteArray.Types
import Data.Memory.Endian
import Data.Memory.PtrMethods
import Data.Memory.ExtendedWords
import Data.Memory.Encoding.Base16
import Foreign.Storable
import Foreign.Ptr
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 =
unsafeCreate n $ \pc ->
withByteArray a $ \pa ->
withByteArray b $ \pb ->
memXor pc pa pb n
where
n = min la lb
la = length a
lb = length b
index :: ByteArrayAccess a => a -> Int -> Word8
index b i = unsafeDoIO $ withByteArray b $ \p -> peek (p `plusPtr` i)
split :: ByteArray bs => Int -> bs -> (bs, bs)
split n bs
| n <= 0 = (empty, bs)
| n >= len = (bs, empty)
| otherwise = unsafeDoIO $ do
withByteArray bs $ \p -> do
b1 <- alloc n $ \r -> memCopy r p n
b2 <- alloc (len - n) $ \r -> memCopy r (p `plusPtr` n) (len - n)
return (b1, b2)
where len = length bs
take :: ByteArray bs => Int -> bs -> bs
take n bs =
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 = unsafeCreate total (loop allBs)
where
total = sum $ map length allBs
loop [] _ = return ()
loop (b:bs) dst = do
let sz = length b
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
withByteArray bs $ \s -> memCopy d s (length bs)
f (castPtr d)
copyRet :: (ByteArrayAccess bs1, ByteArray bs2) => bs1 -> (Ptr p -> IO a) -> IO (a, bs2)
copyRet bs f =
allocRet (length bs) $ \d -> do
withByteArray bs $ \s -> memCopy d s (length bs)
f (castPtr d)
copyAndFreeze :: (ByteArrayAccess bs1, ByteArray bs2) => bs1 -> (Ptr p -> IO ()) -> bs2
copyAndFreeze bs f =
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 0 = empty
zero n = unsafeCreate n $ \ptr -> memSet ptr 0 n
{-# NOINLINE zero #-}
eq :: (ByteArrayAccess bs1, ByteArrayAccess bs2) => bs1 -> bs2 -> Bool
eq b1 b2
| l1 /= l2 = False
| otherwise = unsafeDoIO $ withByteArray b1 $ \p1 -> withByteArray b2 $ \p2 -> memEqual p1 p2 l1
where
l1 = length b1
l2 = length b2
-- | A constant time equality test for 2 ByteArrayAccess values.
--
-- If values are of 2 different sizes, the function will abort early
-- without comparing any bytes.
--
-- compared to == , this function will go over all the bytes
-- present before yielding a result even when knowing the
-- overall result early in the processing.
constEq :: (ByteArrayAccess bs1, ByteArrayAccess bs2) => bs1 -> bs2 -> Bool
constEq b1 b2
| l1 /= l2 = False
| otherwise = unsafeDoIO $ withByteArray b1 $ \p1 -> withByteArray b2 $ \p2 -> memConstEqual p1 p2 l1
where
l1 = length b1
l2 = length b2
toW64BE :: ByteArrayAccess bs => bs -> Int -> BE Word64
toW64BE bs ofs = unsafeDoIO $ withByteArray bs $ \p -> peek (p `plusPtr` ofs)
toW64LE :: ByteArrayAccess bs => bs -> Int -> LE Word64
toW64LE bs ofs = unsafeDoIO $ withByteArray bs $ \p -> peek (p `plusPtr` ofs)
mapAsWord128 :: ByteArray bs => (Word128 -> Word128) -> bs -> bs
mapAsWord128 f bs =
unsafeCreate len $ \dst ->
withByteArray bs $ \src ->
loop (len `div` 16) dst src
where
len = length bs
loop :: Int -> Ptr (BE Word64) -> Ptr (BE Word64) -> IO ()
loop 0 _ _ = return ()
loop i d s = do
w1 <- peek s
w2 <- peek (s `plusPtr` 8)
let (Word128 r1 r2) = f (Word128 (fromBE w1) (fromBE w2))
poke d (toBE r1)
poke (d `plusPtr` 8) (toBE r2)
loop (i-1) (d `plusPtr` 16) (s `plusPtr` 16)
mapAsWord64 :: ByteArray bs => (Word64 -> Word64) -> bs -> bs
mapAsWord64 f bs =
unsafeCreate len $ \dst ->
withByteArray bs $ \src ->
loop (len `div` 8) dst src
where
len = length bs
loop :: Int -> Ptr (BE Word64) -> Ptr (BE Word64) -> IO ()
loop 0 _ _ = return ()
loop i d s = do
w <- peek s
let r = f (fromBE w)
poke d (toBE r)
loop (i-1) (d `plusPtr` 8) (s `plusPtr` 8)
convert :: (ByteArrayAccess bin, ByteArray bout) => bin -> bout
convert = flip copyAndFreeze (\_ -> return ())
convertHex :: (ByteArrayAccess bin, ByteArray bout) => bin -> bout
convertHex b =
unsafeCreate (length b * 2) $ \bout ->
withByteArray b $ \bin ->
toHexadecimal bout bin (length b)

106
Data/ByteArray/ScrubbedBytes.hs
View File

@ -1,106 +0,0 @@
-- |
-- Module : Data.ByteArray.ScrubbedBytes
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : Stable
-- Portability : GHC
--
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE CPP #-}
module Data.ByteArray.ScrubbedBytes
( ScrubbedBytes
) where
import GHC.Types
import GHC.Prim
import GHC.Ptr
import Data.Memory.Internal.CompatPrim
import Data.Memory.Internal.Compat (unsafeDoIO)
import Data.Memory.PtrMethods (memConstEqual)
import Data.ByteArray.Types
-- | ScrubbedBytes is a memory chunk which have the properties of:
--
-- * Being scrubbed after its goes out of scope.
--
-- * A Show instance that doesn't actually show any content
--
-- * A Eq instance that is constant time
--
data ScrubbedBytes = ScrubbedBytes (MutableByteArray# RealWorld)
instance Show ScrubbedBytes where
show _ = "<scrubbed-bytes>"
instance Eq ScrubbedBytes where
(==) = scrubbedBytesEq
instance ByteArrayAccess ScrubbedBytes where
length = sizeofScrubbedBytes
withByteArray = withPtr
instance ByteArray ScrubbedBytes where
allocRet = scrubbedBytesAllocRet
newScrubbedBytes :: Int -> IO ScrubbedBytes
newScrubbedBytes (I# sz)
| 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 #) ->
let !scrubber = getScrubber
!mba = ScrubbedBytes mbarr
in case mkWeak# mbarr () (scrubber (byteArrayContents# (unsafeCoerce# mbarr)) >> touchScrubbedBytes mba) s1 of
(# s2, _ #) -> (# s2, mba #)
where
getScrubber :: Addr# -> IO ()
getScrubber = eitherDivideBy8# sz scrubber64 scrubber8
scrubber64 :: Int# -> Addr# -> IO ()
scrubber64 sz64 addr = IO $ \s -> (# loop sz64 addr s, () #)
where loop :: Int# -> Addr# -> State# RealWorld -> State# RealWorld
loop n a s
| booleanPrim (n ==# 0#) = s
| otherwise =
case writeWord64OffAddr# a 0# 0## s of
s' -> loop (n -# 1#) (plusAddr# a 8#) s'
scrubber8 :: Int# -> Addr# -> IO ()
scrubber8 sz8 addr = IO $ \s -> (# loop sz8 addr s, () #)
where loop :: Int# -> Addr# -> State# RealWorld -> State# RealWorld
loop n a s
| booleanPrim (n ==# 0#) = s
| otherwise =
case writeWord8OffAddr# a 0# 0## s of
s' -> loop (n -# 1#) (plusAddr# a 1#) s'
scrubbedBytesAllocRet :: Int -> (Ptr p -> IO a) -> IO (a, ScrubbedBytes)
scrubbedBytesAllocRet sz f = do
ba <- newScrubbedBytes sz
r <- withPtr ba f
return (r, ba)
sizeofScrubbedBytes :: ScrubbedBytes -> Int
sizeofScrubbedBytes (ScrubbedBytes mba) = I# (sizeofMutableByteArray# mba)
withPtr :: ScrubbedBytes -> (Ptr p -> IO a) -> IO a
withPtr b@(ScrubbedBytes mba) f = do
a <- f (Ptr (byteArrayContents# (unsafeCoerce# mba)))
touchScrubbedBytes b
return a
touchScrubbedBytes :: ScrubbedBytes -> IO ()
touchScrubbedBytes (ScrubbedBytes mba) = IO $ \s -> case touch# mba s of s' -> (# s', () #)
scrubbedBytesEq :: ScrubbedBytes -> ScrubbedBytes -> Bool
scrubbedBytesEq a b
| l1 /= l2 = False
| otherwise = unsafeDoIO $ withPtr a $ \p1 -> withPtr b $ \p2 -> memConstEqual p1 p2 l1
where
l1 = sizeofScrubbedBytes a
l2 = sizeofScrubbedBytes b

41
Data/ByteArray/Types.hs
View File

@ -1,41 +0,0 @@
-- |
-- Module : Data.ByteArray.Types
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : stable
-- Portability : Good
--
{-# LANGUAGE CPP #-}
module Data.ByteArray.Types
( ByteArrayAccess(..)
, ByteArray(..)
) where
import Foreign.Ptr
#ifdef WITH_BYTESTRING_SUPPORT
import qualified Data.ByteString as B (length)
import qualified Data.ByteString.Internal as B
import Foreign.ForeignPtr (withForeignPtr)
#endif
class ByteArrayAccess ba where
length :: ba -> Int
withByteArray :: ba -> (Ptr p -> IO a) -> IO a
class ByteArrayAccess ba => ByteArray ba where
allocRet :: Int -> (Ptr p -> IO a) -> IO (a, ba)
#ifdef WITH_BYTESTRING_SUPPORT
instance ByteArrayAccess B.ByteString where
length = B.length
withByteArray b f = withForeignPtr fptr $ \ptr -> f (ptr `plusPtr` off)
where (fptr, off, _) = B.toForeignPtr b
instance ByteArray B.ByteString where
allocRet sz f = do
fptr <- B.mallocByteString sz
r <- withForeignPtr fptr (f . castPtr)
return (r, B.PS fptr 0 sz)
#endif

99
Data/Memory/Encoding/Base16.hs
View File

@ -1,99 +0,0 @@
-- |
-- Module : Data.Memory.Encoding.Base16
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : unknown
--
-- Hexadecimal escaper
--
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Rank2Types #-}
module Data.Memory.Encoding.Base16
( showHexadecimal
, toHexadecimal
) where
import Data.Memory.Internal.Compat
import Data.Word
import GHC.Prim
import GHC.Types
import GHC.Word
import Control.Monad
import Foreign.Storable
import Foreign.Ptr (Ptr)
showHexadecimal :: (forall a . (Ptr Word8 -> IO a) -> IO a)
-> Int
-> String
showHexadecimal withPtr = doChunks 0
where
doChunks ofs len
| len < 4 = doUnique ofs len
| otherwise = do
let !(W8# a, W8# b, W8# c, W8# d) = unsafeDoIO $ withPtr (read4 ofs)
!(# w1, w2 #) = convertByte a
!(# w3, w4 #) = convertByte b
!(# w5, w6 #) = convertByte c
!(# w7, w8 #) = convertByte d
in wToChar w1 : wToChar w2 : wToChar w3 : wToChar w4
: wToChar w5 : wToChar w6 : wToChar w7 : wToChar w8
: doChunks (ofs + 4) (len - 4)
doUnique ofs len
| len == 0 = []
| otherwise =
let !(W8# b) = unsafeDoIO $ withPtr (byteIndex ofs)
!(# w1, w2 #) = convertByte b
in wToChar w1 : wToChar w2 : doUnique (ofs + 1) (len - 1)
read4 :: Int -> Ptr Word8 -> IO (Word8, Word8, Word8, Word8)
read4 ofs p =
liftM4 (,,,) (byteIndex ofs p) (byteIndex (ofs+1) p)
(byteIndex (ofs+2) p) (byteIndex (ofs+3) p)
wToChar :: Word# -> Char
wToChar w = toEnum (I# (word2Int# w))
byteIndex :: Int -> Ptr Word8 -> IO Word8
byteIndex i p = peekByteOff p i
toHexadecimal :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()
toHexadecimal bout bin n = loop 0
where loop i
| i == n = return ()
| otherwise = do
(W8# w) <- peekByteOff bin i
let !(# w1, w2 #) = convertByte w
pokeByteOff bout (i * 2) (W8# w1)
pokeByteOff bout (i * 2 + 1) (W8# w2)
loop (i+1)
convertByte :: Word# -> (# Word#, Word# #)
convertByte b = (# r tableHi b, r tableLo b #)
where
r :: Addr# -> Word# -> Word#
r table index = indexWord8OffAddr# table (word2Int# index)
!tableLo =
"0123456789abcdef0123456789abcdef\
\0123456789abcdef0123456789abcdef\
\0123456789abcdef0123456789abcdef\
\0123456789abcdef0123456789abcdef\
\0123456789abcdef0123456789abcdef\
\0123456789abcdef0123456789abcdef\
\0123456789abcdef0123456789abcdef\
\0123456789abcdef0123456789abcdef"#
!tableHi =
"00000000000000001111111111111111\
\22222222222222223333333333333333\
\44444444444444445555555555555555\
\66666666666666667777777777777777\
\88888888888888889999999999999999\
\aaaaaaaaaaaaaaaabbbbbbbbbbbbbbbb\
\ccccccccccccccccdddddddddddddddd\
\eeeeeeeeeeeeeeeeffffffffffffffff"#
{-# INLINE convertByte #-}

114
Data/Memory/Endian.hs
View File

@ -1,114 +0,0 @@
-- |
-- Module : Data.Memory.Endian
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : stable
-- Portability : good
--
{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Data.Memory.Endian
( Endianness(..)
, getSystemEndianness
, BE(..), LE(..)
, fromBE, toBE
, fromLE, toLE
) where
import Data.Word (Word16, Word32, Word64)
import Foreign.Storable
#if !defined(ARCH_IS_LITTLE_ENDIAN) && !defined(ARCH_IS_BIG_ENDIAN)
import Data.Memory.Internal.Compat (unsafeDoIO)
#endif
import Data.Memory.Internal.Compat (byteSwap64, byteSwap32, byteSwap16)
-- | represent the CPU endianness
--
-- Big endian system stores bytes with the MSB as the first byte.
-- Little endian system stores bytes with the LSB as the first byte.
--
-- middle endian is purposely avoided.
data Endianness = LittleEndian
| BigEndian
deriving (Show,Eq)
-- | Return the system endianness
getSystemEndianness :: Endianness
#ifdef ARCH_IS_LITTLE_ENDIAN
getSystemEndianness = LittleEndian
#elif ARCH_IS_BIG_ENDIAN
getSystemEndianness = BigEndian
#else
getSystemEndianness
| isLittleEndian = LittleEndian
| isBigEndian = BigEndian
| otherwise = error "cannot determine endianness"
where
isLittleEndian = endianCheck == 2
isBigEndian = endianCheck == 1
endianCheck = unsafeDoIO $ alloca $ \p -> do
poke p (0x01000002 :: Word32)
peek (castPtr p :: Ptr Word8)
#endif
-- | Little Endian value
newtype LE a = LE { unLE :: a }
deriving (Show,Eq,Storable)
-- | Big Endian value
newtype BE a = BE { unBE :: a }
deriving (Show,Eq,Storable)
-- | Convert a value in cpu endianess to big endian
toBE :: ByteSwap a => a -> BE a
#ifdef ARCH_IS_LITTLE_ENDIAN
toBE = BE . byteSwap
#elif ARCH_IS_BIG_ENDIAN
toBE = BE
#else
toBE = BE . (if getSystemEndianness == LittleEndian then byteSwap else id)
#endif
{-# INLINE toBE #-}
-- | Convert from a big endian value to the cpu endianness
fromBE :: ByteSwap a => BE a -> a
#ifdef ARCH_IS_LITTLE_ENDIAN
fromBE (BE a) = byteSwap a
#elif ARCH_IS_BIG_ENDIAN
fromBE (BE a) = a
#else
fromBE (BE a) = if getSystemEndianness == LittleEndian then byteSwap a else a
#endif
{-# INLINE fromBE #-}
-- | Convert a value in cpu endianess to little endian
toLE :: ByteSwap a => a -> LE a
#ifdef ARCH_IS_LITTLE_ENDIAN
toLE = LE
#elif ARCH_IS_BIG_ENDIAN
toLE = LE . byteSwap
#else
toLE = LE . (if getSystemEndianness == LittleEndian then id else byteSwap)
#endif
{-# INLINE toLE #-}
-- | Convert from a little endian value to the cpu endianness
fromLE :: ByteSwap a => LE a -> a
#ifdef ARCH_IS_LITTLE_ENDIAN
fromLE (LE a) = a
#elif ARCH_IS_BIG_ENDIAN
fromLE (LE a) = byteSwap a
#else
fromLE (LE a) = if getSystemEndianness == LittleEndian then a else byteSwap a
#endif
{-# INLINE fromLE #-}
class Storable a => ByteSwap a where
byteSwap :: a -> a
instance ByteSwap Word16 where
byteSwap = byteSwap16
instance ByteSwap Word32 where
byteSwap = byteSwap32
instance ByteSwap Word64 where
byteSwap = byteSwap64

16
Data/Memory/ExtendedWords.hs
View File

@ -1,16 +0,0 @@
-- |
-- Module : Data.Memory.ExtendedWords
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : unknown
--
-- Extra Word size
--
module Data.Memory.ExtendedWords
( Word128(..)
) where
import Data.Word (Word64)
data Word128 = Word128 !Word64 !Word64 deriving (Show, Eq)

65
Data/Memory/Internal/Compat.hs
View File

@ -1,65 +0,0 @@
-- |
-- Module : Data.Memory.Internal.Compat
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : stable
-- Portability : Good
--
-- This module try to keep all the difference between versions of base
-- or other needed packages, so that modules don't need to use CPP
--
{-# LANGUAGE CPP #-}
module Data.Memory.Internal.Compat
( unsafeDoIO
, popCount
, byteSwap64
, byteSwap32
, byteSwap16
) where
import System.IO.Unsafe
import Data.Word
import Data.Bits
-- | perform io for hashes that do allocation and ffi.
-- unsafeDupablePerformIO is used when possible as the
-- computation is pure and the output is directly linked
-- to the input. we also do not modify anything after it has
-- been returned to the user.
unsafeDoIO :: IO a -> a
#if __GLASGOW_HASKELL__ > 704
unsafeDoIO = unsafeDupablePerformIO
#else
unsafeDoIO = unsafePerformIO
#endif
#if !(MIN_VERSION_base(4,5,0))
popCount :: Word64 -> Int
popCount n = loop 0 n
where loop c 0 = c
loop c i = loop (c + if testBit c 0 then 1 else 0) (i `shiftR` 1)
#endif
#if !(MIN_VERSION_base(4,7,0))
byteSwap64 :: Word64 -> Word64
byteSwap64 w =
(w `shiftR` 56) .|. (w `shiftL` 56)
.|. ((w `shiftR` 40) .&. 0xff00) .|. ((w .&. 0xff00) `shiftL` 40)
.|. ((w `shiftR` 24) .&. 0xff0000) .|. ((w .&. 0xff0000) `shiftL` 24)
.|. ((w `shiftR` 8) .&. 0xff000000) .|. ((w .&. 0xff000000) `shiftL` 8)
#endif
#if !(MIN_VERSION_base(4,7,0))
byteSwap32 :: Word32 -> Word32
byteSwap32 w =
(w `shiftR` 24)
.|. (w `shiftL` 24)
.|. ((w `shiftR` 8) .&. 0xff00)
.|. ((w .&. 0xff00) `shiftL` 8)
#endif
#if !(MIN_VERSION_base(4,7,0))
byteSwap16 :: Word16 -> Word16
byteSwap16 w =
(w `shiftR` 8) .|. (w `shiftL` 8)
#endif

84
Data/Memory/Internal/CompatPrim.hs
View File

@ -1,84 +0,0 @@
-- |
-- Module : Data.Memory.Internal.CompatPrim
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : stable
-- Portability : Compat
--
-- This module try to keep all the difference between versions of ghc primitive
-- or other needed packages, so that modules don't need to use CPP.
--
-- Note that MagicHash and CPP conflicts in places, making it "more interesting"
-- to write compat code for primitives
--
{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
module Data.Memory.Internal.CompatPrim
( be32Prim
, le32Prim
, byteswap32Prim
, booleanPrim
, eitherDivideBy8#
) where
import GHC.Prim
-- | byteswap Word# to or from Big Endian
--
-- on a big endian machine, this function is a nop.
be32Prim :: Word# -> Word#
#ifdef ARCH_IS_LITTLE_ENDIAN
be32Prim = byteswap32Prim
#else
be32Prim w = w
#endif
-- | byteswap Word# to or from Little Endian
--
-- on a little endian machine, this function is a nop.
le32Prim :: Word# -> Word#
#ifdef ARCH_IS_LITTLE_ENDIAN
le32Prim w = w
#else
le32Prim = byteswap32Prim
#endif
byteswap32Prim :: Word# -> Word#
#if __GLASGOW_HASKELL__ >= 708
byteswap32Prim w = byteSwap32# w
#else
byteswap32Prim w =
let !a = uncheckedShiftL# w 24#
!b = and# (uncheckedShiftL# w 8#) 0x00ff0000##
!c = and# (uncheckedShiftRL# w 8#) 0x0000ff00##
!d = and# (uncheckedShiftRL# w 24#) 0x000000ff##
in or# a (or# b (or# c d))
#endif
#if __GLASGOW_HASKELL__ >= 708
booleanPrim :: Int# -> Bool
booleanPrim v = tagToEnum# v
#else
booleanPrim :: Bool -> Bool
booleanPrim b = b
#endif
-- | Apply or or another function if 8 divides the number of bytes
eitherDivideBy8# :: Int# -- ^ number of bytes
-> (Int# -> a) -- ^ if it divided by 8, the argument is the number of 8 bytes words
-> (Int# -> a) -- ^ if it doesn't, just the number of bytes
-> a
#if __GLASGOW_HASKELL__ >= 740
eitherDivideBy8# v f8 f1 =
let !(# q, r #) = quotRemInt v 8#
in if booleanPrim (r ==# 0)
then f8 q
else f1 v
#else
eitherDivideBy8# v f8 f1 =
if booleanPrim ((remInt# v 8#) ==# 0#)
then f8 (quotInt# v 8#)
else f1 v
#endif

15
Data/Memory/Internal/Imports.hs
View File

@ -1,15 +0,0 @@
-- |
-- Module : Data.Memory.Internal.Imports
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : unknown
--
module Data.Memory.Internal.Imports
( module X
) where
import Data.Word as X
import Control.Applicative as X
import Control.Monad as X (forM, forM_, void)
import Control.Arrow as X (first, second)

110
Data/Memory/PtrMethods.hs
View File

@ -1,110 +0,0 @@
-- |
-- Module : Data.Memory.PtrMethods
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : unknown
--
-- methods to manipulate raw memory representation
--
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE ForeignFunctionInterface #-}
module Data.Memory.PtrMethods
( memCreateTemporary
, memXor
, memXorWith
, memCopy
, memSet
, memEqual
, memConstEqual
, memCompare
) where
import Data.Memory.Internal.Imports
import Foreign.Ptr (Ptr, plusPtr)
import Foreign.Storable (peek, poke, pokeByteOff, peekByteOff)
import Foreign.C.Types
import Foreign.Marshal.Alloc (allocaBytesAligned)
import Data.Bits (xor)
-- | Create a new temporary buffer
memCreateTemporary :: Int -> (Ptr Word8 -> IO a) -> IO a
memCreateTemporary size f = allocaBytesAligned size 8 f
-- | xor bytes from source1 and source2 to destination
--
-- d = s1 xor s2
--
-- s1, nor s2 are modified unless d point to s1 or s2
memXor :: Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memXor _ _ _ 0 = return ()
memXor d s1 s2 n = do
(xor <$> peek s1 <*> peek s2) >>= poke d
memXor (d `plusPtr` 1) (s1 `plusPtr` 1) (s2 `plusPtr` 1) (n-1)
-- | xor bytes from source with a specific value to destination
--
-- d = replicate (sizeof s) v `xor` s
memXorWith :: Ptr Word8 -> Word8 -> Ptr Word8 -> Int -> IO ()
memXorWith d v s n = loop 0
where
loop i
| i == n = return ()
| otherwise = do
(xor v <$> peekByteOff s i) >>= pokeByteOff d i
loop (i+1)
-- | Copy a set number of bytes from @src to @dst
memCopy :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memCopy dst src n = c_memcpy dst src (fromIntegral n)
-- | Set @n number of bytes to the same value @v
memSet :: Ptr Word8 -> Word8 -> Int -> IO ()
memSet start v n = c_memset start (fromIntegral v) (fromIntegral n) >>= \_ -> return ()
memEqual :: Ptr Word8 -> Ptr Word8 -> Int -> IO Bool
memEqual p1 p2 n = loop 0
where
loop i
| i == n = return True
| otherwise = do
e <- (==) <$> peekByteOff p1 i <*> (peekByteOff p2 i :: IO Word8)
if e then loop (i+1) else return False
memCompare :: Ptr Word8 -> Ptr Word8 -> Int -> IO Ordering
memCompare p1 p2 n = loop 0
where
loop i
| i == n = return EQ
| otherwise = do
e <- compare <$> peekByteOff p1 i <*> (peekByteOff p2 i :: IO Word8)
if e == EQ then loop (i+1) else return e
-- | A constant time equality test for 2 Memory buffers
--
-- compared to normal equality function, this function will go
-- 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
where
loop i !ret
| i == n = return ret
| 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
foreign import ccall unsafe "memset"
c_memset :: Ptr Word8 -> Word8 -> CSize -> IO ()
foreign import ccall unsafe "memcpy"
c_memcpy :: Ptr Word8 -> Ptr Word8 -> CSize -> IO ()

29
cryptonite.cabal
View File

@ -35,11 +35,6 @@ Flag support_pclmuldq
Default: False
Manual: True
Flag builtin_memory
Description: Build with a local snapshot of the memory package
Default: True
Manual: True
Flag integer-gmp
Description: Whether or not to use GMP for some functions
Default: True
@ -137,8 +132,7 @@ Library
Crypto.Internal.WordArray
Build-depends: base >= 4.3 && < 5
, bytestring
, securemem >= 0.1.7
, byteable
, memory
, ghc-prim
ghc-options: -Wall -fwarn-tabs -optc-O3
default-language: Haskell2010
@ -195,24 +189,6 @@ Library
else
Other-modules: Crypto.Random.Entropy.Unix
if flag(builtin_memory)
Exposed-modules: Data.ByteArray
Data.Memory.Endian
Data.Memory.PtrMethods
Data.Memory.ExtendedWords
Data.Memory.Encoding.Base16
Other-modules: Data.Memory.Internal.Compat
Data.Memory.Internal.CompatPrim
Data.Memory.Internal.Imports
Data.ByteArray.Types
Data.ByteArray.Bytes
Data.ByteArray.ScrubbedBytes
Data.ByteArray.Methods
Data.ByteArray.MemView
CPP-options: -DWITH_BYTESTRING_SUPPORT
else
build-depends: memory
if impl(ghc) && flag(integer-gmp)
Build-depends: integer-gmp
@ -222,13 +198,12 @@ Test-Suite test-cryptonite
Main-is: Tests.hs
Build-Depends: base >= 3 && < 5
, bytestring
, memory
, byteable
, tasty
, tasty-quickcheck
, tasty-hunit
, tasty-kat
, cryptonite
if !flag(builtin_memory)
Build-Depends: memory
ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures -rtsopts
default-language: Haskell2010

2
tests/BlockCipher.hs
View File

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

6
tests/Hash.hs
View File

@ -8,7 +8,7 @@ module Hash
import Crypto.Hash
import qualified Data.ByteString as B
import qualified Data.ByteArray as B (convertHex)
import qualified Data.ByteArray.Encoding as B (convertToBase, Base(..))
import Imports
v0,v1,v2 :: ByteString
@ -140,8 +140,8 @@ expected = [
"28e361fe8c56e617caa56c28c7c36e5c13be552b77081be82b642f08bb7ef085b9a81910fe98269386b9aacfd2349076c9506126e198f6f6ad44c12017ca77b1" ])
]
runhash (HashAlg hashAlg) v = B.convertHex $ hashWith hashAlg $ v
runhashinc (HashAlg hashAlg) v = B.convertHex $ hashinc $ v
runhash (HashAlg hashAlg) v = B.convertToBase B.Base16 $ hashWith hashAlg $ v
runhashinc (HashAlg hashAlg) v = B.convertToBase B.Base16 $ hashinc $ v
where hashinc = hashFinalize . foldl hashUpdate (hashInitWith hashAlg)
makeTestAlg (name, hashAlg, results) =