add comments and description
This commit is contained in:
parent
393b159d5f
commit
92343f856a
@ -89,6 +89,7 @@ instance BlockCipher128 AES where
|
|||||||
xtsEncrypt = encryptXTS
|
xtsEncrypt = encryptXTS
|
||||||
xtsDecrypt = decryptXTS
|
xtsDecrypt = decryptXTS
|
||||||
|
|
||||||
|
-- | Create an AES AEAD implementation for GCM
|
||||||
gcmMode :: AES -> AEADModeImpl AESGCM
|
gcmMode :: AES -> AEADModeImpl AESGCM
|
||||||
gcmMode aes = AEADModeImpl
|
gcmMode aes = AEADModeImpl
|
||||||
{ aeadImplAppendHeader = gcmAppendAAD
|
{ aeadImplAppendHeader = gcmAppendAAD
|
||||||
@ -97,6 +98,7 @@ gcmMode aes = AEADModeImpl
|
|||||||
, aeadImplFinalize = gcmFinish aes
|
, aeadImplFinalize = gcmFinish aes
|
||||||
}
|
}
|
||||||
|
|
||||||
|
-- | Create an AES AEAD implementation for OCB
|
||||||
ocbMode :: AES -> AEADModeImpl AESOCB
|
ocbMode :: AES -> AEADModeImpl AESOCB
|
||||||
ocbMode aes = AEADModeImpl
|
ocbMode aes = AEADModeImpl
|
||||||
{ aeadImplAppendHeader = ocbAppendAAD aes
|
{ aeadImplAppendHeader = ocbAppendAAD aes
|
||||||
|
|||||||
@ -37,8 +37,16 @@ data Context = BF (Int -> Word32) -- p
|
|||||||
(Int -> Word32) -- sbox2
|
(Int -> Word32) -- sbox2
|
||||||
(Int -> Word32) -- sbox2
|
(Int -> Word32) -- sbox2
|
||||||
|
|
||||||
encrypt, decrypt :: ByteArray ba => Context -> ba -> ba
|
-- | Encrypt blocks
|
||||||
|
--
|
||||||
|
-- Input need to be a multiple of 8 bytes
|
||||||
|
encrypt :: ByteArray ba => Context -> ba -> ba
|
||||||
encrypt = cipher
|
encrypt = cipher
|
||||||
|
|
||||||
|
-- | Decrypt blocks
|
||||||
|
--
|
||||||
|
-- Input need to be a multiple of 8 bytes
|
||||||
|
decrypt :: ByteArray ba => Context -> ba -> ba
|
||||||
decrypt = cipher . decryptContext
|
decrypt = cipher . decryptContext
|
||||||
|
|
||||||
decryptContext :: Context -> Context
|
decryptContext :: Context -> Context
|
||||||
@ -50,6 +58,9 @@ cipher ctx b
|
|||||||
| B.length b `mod` 8 /= 0 = error "invalid data length"
|
| B.length b `mod` 8 /= 0 = error "invalid data length"
|
||||||
| otherwise = B.mapAsWord64 (coreCrypto ctx) b
|
| otherwise = B.mapAsWord64 (coreCrypto ctx) b
|
||||||
|
|
||||||
|
-- | Initialize a new Blowfish context from a key.
|
||||||
|
--
|
||||||
|
-- key need to be between 0 to 448 bits.
|
||||||
initBlowfish :: ByteArrayAccess key => key -> CryptoFailable Context
|
initBlowfish :: ByteArrayAccess key => key -> CryptoFailable Context
|
||||||
initBlowfish key
|
initBlowfish key
|
||||||
| len > (448 `div` 8) = CryptoFailed $ CryptoError_KeySizeInvalid
|
| len > (448 `div` 8) = CryptoFailed $ CryptoError_KeySizeInvalid
|
||||||
|
|||||||
@ -107,6 +107,7 @@ rotl128 v@(Word128 x1 x2) w
|
|||||||
(x1high, x1low) = splitBits (x1 `rotateL` w)
|
(x1high, x1low) = splitBits (x1 `rotateL` w)
|
||||||
(x2high, x2low) = splitBits (x2 `rotateL` w)
|
(x2high, x2low) = splitBits (x2 `rotateL` w)
|
||||||
|
|
||||||
|
-- | Camellia context
|
||||||
data Camellia = Camellia
|
data Camellia = Camellia
|
||||||
{ k :: Array64
|
{ k :: Array64
|
||||||
, kw :: Array64
|
, kw :: Array64
|
||||||
@ -135,9 +136,9 @@ setKeyInterim keyseed = (w64tow128 kL, w64tow128 kR, w64tow128 kA, w64tow128 kB)
|
|||||||
in (d4, d3)
|
in (d4, d3)
|
||||||
|
|
||||||
-- | Initialize a 128-bit key
|
-- | Initialize a 128-bit key
|
||||||
|
--
|
||||||
-- Return the initialized key or a error message if the given
|
-- Return the initialized key or a error message if the given
|
||||||
-- keyseed was not 16-bytes in length.
|
-- keyseed was not 16-bytes in length.
|
||||||
--
|
|
||||||
initCamellia :: ByteArray key
|
initCamellia :: ByteArray key
|
||||||
=> key -- ^ The key to create the camellia context
|
=> key -- ^ The key to create the camellia context
|
||||||
-> CryptoFailable Camellia
|
-> CryptoFailable Camellia
|
||||||
|
|||||||
@ -11,12 +11,16 @@
|
|||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
|
|
||||||
|
|
||||||
module Crypto.Cipher.DES.Primitive (encrypt, decrypt, Block(..)) where
|
module Crypto.Cipher.DES.Primitive
|
||||||
|
( encrypt
|
||||||
|
, decrypt
|
||||||
|
, Block(..)
|
||||||
|
) where
|
||||||
|
|
||||||
import Data.Word
|
import Data.Word
|
||||||
import Data.Bits
|
import Data.Bits
|
||||||
import Data.Memory.Endian
|
|
||||||
|
|
||||||
|
-- | a DES block (64 bits)
|
||||||
newtype Block = Block { unBlock :: Word64 }
|
newtype Block = Block { unBlock :: Word64 }
|
||||||
|
|
||||||
type Rotation = Int
|
type Rotation = Int
|
||||||
@ -210,12 +214,10 @@ takeDrop n (x:xs) = (x:ys, zs)
|
|||||||
|
|
||||||
-- | Basic DES encryption which takes a key and a block of plaintext
|
-- | Basic DES encryption which takes a key and a block of plaintext
|
||||||
-- and returns the encrypted block of ciphertext according to the standard.
|
-- and returns the encrypted block of ciphertext according to the standard.
|
||||||
|
|
||||||
encrypt :: Word64 -> Block -> Block
|
encrypt :: Word64 -> Block -> Block
|
||||||
encrypt = flip des_enc
|
encrypt = flip des_enc
|
||||||
|
|
||||||
-- | Basic DES decryption which takes a key and a block of ciphertext and
|
-- | Basic DES decryption which takes a key and a block of ciphertext and
|
||||||
-- returns the decrypted block of plaintext according to the standard.
|
-- returns the decrypted block of plaintext according to the standard.
|
||||||
|
|
||||||
decrypt :: Word64 -> Block -> Block
|
decrypt :: Word64 -> Block -> Block
|
||||||
decrypt = flip des_dec
|
decrypt = flip des_dec
|
||||||
|
|||||||
@ -16,6 +16,7 @@ import Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray)
|
|||||||
import qualified Crypto.Internal.ByteArray as B
|
import qualified Crypto.Internal.ByteArray as B
|
||||||
import Crypto.Internal.Imports
|
import Crypto.Internal.Imports
|
||||||
|
|
||||||
|
-- | AEAD Implementation
|
||||||
data AEADModeImpl st = AEADModeImpl
|
data AEADModeImpl st = AEADModeImpl
|
||||||
{ aeadImplAppendHeader :: forall ba . ByteArrayAccess ba => st -> ba -> st
|
{ aeadImplAppendHeader :: forall ba . ByteArrayAccess ba => st -> ba -> st
|
||||||
, aeadImplEncrypt :: forall ba . ByteArray ba => st -> ba -> (ba, st)
|
, aeadImplEncrypt :: forall ba . ByteArray ba => st -> ba -> (ba, st)
|
||||||
@ -29,15 +30,19 @@ data AEAD cipher = forall st . AEAD
|
|||||||
, aeadState :: st
|
, aeadState :: st
|
||||||
}
|
}
|
||||||
|
|
||||||
|
-- | Append some header information to an AEAD context
|
||||||
aeadAppendHeader :: ByteArrayAccess aad => AEAD cipher -> aad -> AEAD cipher
|
aeadAppendHeader :: ByteArrayAccess aad => AEAD cipher -> aad -> AEAD cipher
|
||||||
aeadAppendHeader (AEAD impl st) aad = AEAD impl $ (aeadImplAppendHeader impl) st aad
|
aeadAppendHeader (AEAD impl st) aad = AEAD impl $ (aeadImplAppendHeader impl) st aad
|
||||||
|
|
||||||
|
-- | Encrypt some data and update the AEAD context
|
||||||
aeadEncrypt :: ByteArray ba => AEAD cipher -> ba -> (ba, AEAD cipher)
|
aeadEncrypt :: ByteArray ba => AEAD cipher -> ba -> (ba, AEAD cipher)
|
||||||
aeadEncrypt (AEAD impl st) ba = second (AEAD impl) $ (aeadImplEncrypt impl) st ba
|
aeadEncrypt (AEAD impl st) ba = second (AEAD impl) $ (aeadImplEncrypt impl) st ba
|
||||||
|
|
||||||
|
-- | Decrypt some data and update the AEAD context
|
||||||
aeadDecrypt :: ByteArray ba => AEAD cipher -> ba -> (ba, AEAD cipher)
|
aeadDecrypt :: ByteArray ba => AEAD cipher -> ba -> (ba, AEAD cipher)
|
||||||
aeadDecrypt (AEAD impl st) ba = second (AEAD impl) $ (aeadImplDecrypt impl) st ba
|
aeadDecrypt (AEAD impl st) ba = second (AEAD impl) $ (aeadImplDecrypt impl) st ba
|
||||||
|
|
||||||
|
-- | Finalize the AEAD context and return the authentication tag
|
||||||
aeadFinalize :: AEAD cipher -> Int -> AuthTag
|
aeadFinalize :: AEAD cipher -> Int -> AuthTag
|
||||||
aeadFinalize (AEAD impl st) n = (aeadImplFinalize impl) st n
|
aeadFinalize (AEAD impl st) n = (aeadImplFinalize impl) st n
|
||||||
|
|
||||||
|
|||||||
@ -58,6 +58,7 @@ instance BlockCipher c => ByteArrayAccess (IV c) where
|
|||||||
instance Eq (IV c) where
|
instance Eq (IV c) where
|
||||||
(IV a) == (IV b) = B.eq a b
|
(IV a) == (IV b) = B.eq a b
|
||||||
|
|
||||||
|
-- | XTS callback
|
||||||
type XTS ba cipher = (cipher, cipher)
|
type XTS ba cipher = (cipher, cipher)
|
||||||
-> IV cipher -- ^ Usually represent the Data Unit (e.g. disk sector)
|
-> IV cipher -- ^ Usually represent the Data Unit (e.g. disk sector)
|
||||||
-> DataUnitOffset -- ^ Offset in the data unit in number of blocks
|
-> DataUnitOffset -- ^ Offset in the data unit in number of blocks
|
||||||
|
|||||||
@ -20,6 +20,8 @@ import Foreign.Storable
|
|||||||
import Foreign.Ptr
|
import Foreign.Ptr
|
||||||
import Data.Bits
|
import Data.Bits
|
||||||
|
|
||||||
|
-- | Compute the gfmul with the XTS polynomial
|
||||||
|
--
|
||||||
-- block size need to be 128 bits.
|
-- block size need to be 128 bits.
|
||||||
--
|
--
|
||||||
-- FIXME: add support for big endian.
|
-- FIXME: add support for big endian.
|
||||||
|
|||||||
@ -12,6 +12,7 @@ module Crypto.Cipher.Types.Utils where
|
|||||||
import Crypto.Internal.ByteArray (ByteArray)
|
import Crypto.Internal.ByteArray (ByteArray)
|
||||||
import qualified Crypto.Internal.ByteArray as B
|
import qualified Crypto.Internal.ByteArray as B
|
||||||
|
|
||||||
|
-- | Chunk some input byte array into @sz byte list of byte array.
|
||||||
chunk :: ByteArray b => Int -> b -> [b]
|
chunk :: ByteArray b => Int -> b -> [b]
|
||||||
chunk sz bs = split bs
|
chunk sz bs = split bs
|
||||||
where split b | B.length b <= sz = [b]
|
where split b | B.length b <= sz = [b]
|
||||||
|
|||||||
@ -99,9 +99,14 @@ hashFinalize c = doFinalize undefined (B.copy c) (B.allocAndFreeze)
|
|||||||
hashInitWith :: HashAlgorithm alg => alg -> Context alg
|
hashInitWith :: HashAlgorithm alg => alg -> Context alg
|
||||||
hashInitWith _ = hashInit
|
hashInitWith _ = hashInit
|
||||||
|
|
||||||
|
-- | Run the 'hash' function but takes an explicit hash algorithm parameter
|
||||||
hashWith :: (ByteArrayAccess ba, HashAlgorithm alg) => alg -> ba -> Digest alg
|
hashWith :: (ByteArrayAccess ba, HashAlgorithm alg) => alg -> ba -> Digest alg
|
||||||
hashWith _ = hash
|
hashWith _ = hash
|
||||||
|
|
||||||
|
-- | Try to transform a bytearray into a Digest of specific algorithm.
|
||||||
|
--
|
||||||
|
-- If the digest is not the right size for the algorithm specified, then
|
||||||
|
-- Nothing is returned.
|
||||||
digestFromByteString :: (HashAlgorithm a, ByteArrayAccess ba) => ba -> Maybe (Digest a)
|
digestFromByteString :: (HashAlgorithm a, ByteArrayAccess ba) => ba -> Maybe (Digest a)
|
||||||
digestFromByteString = from undefined
|
digestFromByteString = from undefined
|
||||||
where
|
where
|
||||||
|
|||||||
@ -45,6 +45,8 @@ le32Prim w = w
|
|||||||
le32Prim = byteswap32Prim
|
le32Prim = byteswap32Prim
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
-- | Simple compatibility for byteswap the lower 32 bits of a Word#
|
||||||
|
-- at the primitive level
|
||||||
byteswap32Prim :: Word# -> Word#
|
byteswap32Prim :: Word# -> Word#
|
||||||
#if __GLASGOW_HASKELL__ >= 708
|
#if __GLASGOW_HASKELL__ >= 708
|
||||||
byteswap32Prim w = byteSwap32# w
|
byteswap32Prim w = byteSwap32# w
|
||||||
@ -74,6 +76,9 @@ convert4To32 a b c d = or# (or# c1 c2) (or# c3 c4)
|
|||||||
!c4 = a
|
!c4 = a
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
-- | Simple wrapper to handle pre 7.8 and future, where
|
||||||
|
-- most comparaison functions don't returns a boolean
|
||||||
|
-- anymore.
|
||||||
#if __GLASGOW_HASKELL__ >= 708
|
#if __GLASGOW_HASKELL__ >= 708
|
||||||
booleanPrim :: Int# -> Bool
|
booleanPrim :: Int# -> Bool
|
||||||
booleanPrim v = tagToEnum# v
|
booleanPrim v = tagToEnum# v
|
||||||
|
|||||||
@ -1,119 +0,0 @@
|
|||||||
-- |
|
|
||||||
-- Module : Crypto.Internal.Hex
|
|
||||||
-- 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 Crypto.Internal.Hex
|
|
||||||
( showHexadecimal
|
|
||||||
, toHexadecimal
|
|
||||||
, toHexadecimal4
|
|
||||||
) where
|
|
||||||
|
|
||||||
import Crypto.Internal.Compat
|
|
||||||
import Crypto.Internal.CompatPrim
|
|
||||||
import Data.Word
|
|
||||||
import GHC.Prim
|
|
||||||
import GHC.Types
|
|
||||||
import GHC.Word
|
|
||||||
import Control.Monad
|
|
||||||
import Foreign.Storable
|
|
||||||
import Foreign.Ptr (Ptr, plusPtr)
|
|
||||||
|
|
||||||
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)
|
|
||||||
|
|
||||||
-- | convert to hexadecimal going 2 by 2
|
|
||||||
--
|
|
||||||
-- experimental. untested
|
|
||||||
toHexadecimal4 :: Ptr Word32 -> Ptr Word8 -> Int -> IO ()
|
|
||||||
toHexadecimal4 bout bin n = loop 0
|
|
||||||
where loop i
|
|
||||||
| i == n = return ()
|
|
||||||
| otherwise = do
|
|
||||||
(W8# w1) <- peekByteOff bin i
|
|
||||||
(W8# w2) <- peekByteOff bin (i+1)
|
|
||||||
let r = W32# (convertByte4 w1 w2)
|
|
||||||
poke (bout `plusPtr` (i * 2)) r
|
|
||||||
loop (i+2)
|
|
||||||
|
|
||||||
convertByte4 :: Word# -> Word# -> Word#
|
|
||||||
convertByte4 a b = convert4To32 b2 b1 a2 a1
|
|
||||||
where
|
|
||||||
!(# a1, a2 #) = convertByte a
|
|
||||||
!(# b1, b2 #) = convertByte b
|
|
||||||
|
|
||||||
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 #-}
|
|
||||||
@ -40,17 +40,23 @@ import GHC.Prim
|
|||||||
import GHC.Types
|
import GHC.Types
|
||||||
import GHC.Word
|
import GHC.Word
|
||||||
|
|
||||||
|
-- | Array of Word8
|
||||||
data Array8 = Array8 Addr#
|
data Array8 = Array8 Addr#
|
||||||
|
|
||||||
|
-- | Array of Word32
|
||||||
data Array32 = Array32 ByteArray#
|
data Array32 = Array32 ByteArray#
|
||||||
|
|
||||||
|
-- | Array of Word64
|
||||||
data Array64 = Array64 ByteArray#
|
data Array64 = Array64 ByteArray#
|
||||||
|
|
||||||
|
-- | Array of mutable Word32
|
||||||
data MutableArray32 = MutableArray32 (MutableByteArray# RealWorld)
|
data MutableArray32 = MutableArray32 (MutableByteArray# RealWorld)
|
||||||
|
|
||||||
|
-- | Create an array of Word8 aliasing an Addr#
|
||||||
array8 :: Addr# -> Array8
|
array8 :: Addr# -> Array8
|
||||||
array8 = Array8
|
array8 = Array8
|
||||||
|
|
||||||
|
-- | Create an Array of Word32 of specific size from a list of Word32
|
||||||
array32 :: Int -> [Word32] -> Array32
|
array32 :: Int -> [Word32] -> Array32
|
||||||
array32 (I# n) l = unsafeDoIO $ IO $ \s ->
|
array32 (I# n) l = unsafeDoIO $ IO $ \s ->
|
||||||
case newAlignedPinnedByteArray# (n *# 4#) 4# s of
|
case newAlignedPinnedByteArray# (n *# 4#) 4# s of
|
||||||
@ -67,6 +73,7 @@ array32 (I# n) l = unsafeDoIO $ IO $ \s ->
|
|||||||
(# st', b #) -> (# st', Array32 b #)
|
(# st', b #) -> (# st', Array32 b #)
|
||||||
{-# NOINLINE array32 #-}
|
{-# NOINLINE array32 #-}
|
||||||
|
|
||||||
|
-- | Create an Array of Word64 of specific size from a list of Word64
|
||||||
array64 :: Int -> [Word64] -> Array64
|
array64 :: Int -> [Word64] -> Array64
|
||||||
array64 (I# n) l = unsafeDoIO $ IO $ \s ->
|
array64 (I# n) l = unsafeDoIO $ IO $ \s ->
|
||||||
case newAlignedPinnedByteArray# (n *# 8#) 8# s of
|
case newAlignedPinnedByteArray# (n *# 8#) 8# s of
|
||||||
@ -83,6 +90,7 @@ array64 (I# n) l = unsafeDoIO $ IO $ \s ->
|
|||||||
(# st', b #) -> (# st', Array64 b #)
|
(# st', b #) -> (# st', Array64 b #)
|
||||||
{-# NOINLINE array64 #-}
|
{-# NOINLINE array64 #-}
|
||||||
|
|
||||||
|
-- | Create a Mutable Array of Word32 of specific size from a list of Word32
|
||||||
mutableArray32 :: Int -> [Word32] -> IO MutableArray32
|
mutableArray32 :: Int -> [Word32] -> IO MutableArray32
|
||||||
mutableArray32 (I# n) l = IO $ \s ->
|
mutableArray32 (I# n) l = IO $ \s ->
|
||||||
case newAlignedPinnedByteArray# (n *# 4#) 4# s of
|
case newAlignedPinnedByteArray# (n *# 4#) 4# s of
|
||||||
@ -95,6 +103,7 @@ mutableArray32 (I# n) l = IO $ \s ->
|
|||||||
let !st' = writeWord32Array# mb i x st
|
let !st' = writeWord32Array# mb i x st
|
||||||
in loop (i +# 1#) st' mb xs
|
in loop (i +# 1#) st' mb xs
|
||||||
|
|
||||||
|
-- | Create a Mutable Array of BE Word32 aliasing an Addr
|
||||||
mutableArray32FromAddrBE :: Int -> Addr# -> IO MutableArray32
|
mutableArray32FromAddrBE :: Int -> Addr# -> IO MutableArray32
|
||||||
mutableArray32FromAddrBE (I# n) a = IO $ \s ->
|
mutableArray32FromAddrBE (I# n) a = IO $ \s ->
|
||||||
case newAlignedPinnedByteArray# (n *# 4#) 4# s of
|
case newAlignedPinnedByteArray# (n *# 4#) 4# s of
|
||||||
@ -106,31 +115,40 @@ mutableArray32FromAddrBE (I# n) a = IO $ \s ->
|
|||||||
let !st' = writeWord32Array# mb i (be32Prim (indexWord32OffAddr# a i)) st
|
let !st' = writeWord32Array# mb i (be32Prim (indexWord32OffAddr# a i)) st
|
||||||
in loop (i +# 1#) st' mb
|
in loop (i +# 1#) st' mb
|
||||||
|
|
||||||
|
-- | freeze a Mutable Array of Word32 into a immutable Array of Word32
|
||||||
mutableArray32Freeze :: MutableArray32 -> IO Array32
|
mutableArray32Freeze :: MutableArray32 -> IO Array32
|
||||||
mutableArray32Freeze (MutableArray32 mb) = IO $ \st ->
|
mutableArray32Freeze (MutableArray32 mb) = IO $ \st ->
|
||||||
case unsafeFreezeByteArray# mb st of
|
case unsafeFreezeByteArray# mb st of
|
||||||
(# st', b #) -> (# st', Array32 b #)
|
(# st', b #) -> (# st', Array32 b #)
|
||||||
|
|
||||||
|
-- | Read a Word8 from an Array
|
||||||
arrayRead8 :: Array8 -> Int -> Word8
|
arrayRead8 :: Array8 -> Int -> Word8
|
||||||
arrayRead8 (Array8 a) (I# o) = W8# (indexWord8OffAddr# a o)
|
arrayRead8 (Array8 a) (I# o) = W8# (indexWord8OffAddr# a o)
|
||||||
{-# INLINE arrayRead8 #-}
|
{-# INLINE arrayRead8 #-}
|
||||||
|
|
||||||
|
-- | Read a Word32 from an Array
|
||||||
arrayRead32 :: Array32 -> Int -> Word32
|
arrayRead32 :: Array32 -> Int -> Word32
|
||||||
arrayRead32 (Array32 b) (I# o) = W32# (indexWord32Array# b o)
|
arrayRead32 (Array32 b) (I# o) = W32# (indexWord32Array# b o)
|
||||||
{-# INLINE arrayRead32 #-}
|
{-# INLINE arrayRead32 #-}
|
||||||
|
|
||||||
|
-- | Read a Word64 from an Array
|
||||||
arrayRead64 :: Array64 -> Int -> Word64
|
arrayRead64 :: Array64 -> Int -> Word64
|
||||||
arrayRead64 (Array64 b) (I# o) = W64# (indexWord64Array# b o)
|
arrayRead64 (Array64 b) (I# o) = W64# (indexWord64Array# b o)
|
||||||
{-# INLINE arrayRead64 #-}
|
{-# INLINE arrayRead64 #-}
|
||||||
|
|
||||||
|
-- | Read a Word32 from a Mutable Array of Word32
|
||||||
mutableArrayRead32 :: MutableArray32 -> Int -> IO Word32
|
mutableArrayRead32 :: MutableArray32 -> Int -> IO Word32
|
||||||
mutableArrayRead32 (MutableArray32 m) (I# o) = IO $ \s -> case readWord32Array# m o s of (# s', e #) -> (# s', W32# e #)
|
mutableArrayRead32 (MutableArray32 m) (I# o) = IO $ \s -> case readWord32Array# m o s of (# s', e #) -> (# s', W32# e #)
|
||||||
{-# INLINE mutableArrayRead32 #-}
|
{-# INLINE mutableArrayRead32 #-}
|
||||||
|
|
||||||
|
-- | Write a Word32 from a Mutable Array of Word32
|
||||||
mutableArrayWrite32 :: MutableArray32 -> Int -> Word32 -> IO ()
|
mutableArrayWrite32 :: MutableArray32 -> Int -> Word32 -> IO ()
|
||||||
mutableArrayWrite32 (MutableArray32 m) (I# o) (W32# w) = IO $ \s -> let !s' = writeWord32Array# m o w s in (# s', () #)
|
mutableArrayWrite32 (MutableArray32 m) (I# o) (W32# w) = IO $ \s -> let !s' = writeWord32Array# m o w s in (# s', () #)
|
||||||
{-# INLINE mutableArrayWrite32 #-}
|
{-# INLINE mutableArrayWrite32 #-}
|
||||||
|
|
||||||
|
-- | Write into the Mutable Array of Word32 by combining through xor the current value and the new value.
|
||||||
|
--
|
||||||
|
-- > x[i] = x[i] xor value
|
||||||
mutableArrayWriteXor32 :: MutableArray32 -> Int -> Word32 -> IO ()
|
mutableArrayWriteXor32 :: MutableArray32 -> Int -> Word32 -> IO ()
|
||||||
mutableArrayWriteXor32 m o w =
|
mutableArrayWriteXor32 m o w =
|
||||||
mutableArrayRead32 m o >>= \wOld -> mutableArrayWrite32 m o (wOld `xor` w)
|
mutableArrayRead32 m o >>= \wOld -> mutableArrayWrite32 m o (wOld `xor` w)
|
||||||
|
|||||||
@ -17,8 +17,10 @@ import Data.Word
|
|||||||
import Data.Bits
|
import Data.Bits
|
||||||
import Data.Memory.ExtendedWords
|
import Data.Memory.ExtendedWords
|
||||||
|
|
||||||
|
-- | Split a 'Word64' into the highest and lowest 'Word32'
|
||||||
w64to32 :: Word64 -> (Word32, Word32)
|
w64to32 :: Word64 -> (Word32, Word32)
|
||||||
w64to32 w = (fromIntegral (w `shiftR` 32), fromIntegral w)
|
w64to32 w = (fromIntegral (w `shiftR` 32), fromIntegral w)
|
||||||
|
|
||||||
|
-- | Reconstruct a 'Word64' from two 'Word32'
|
||||||
w32to64 :: (Word32, Word32) -> Word64
|
w32to64 :: (Word32, Word32) -> Word64
|
||||||
w32to64 (x1, x2) = ((fromIntegral x1) `shiftL` 32) .|. (fromIntegral x2)
|
w32to64 (x1, x2) = ((fromIntegral x1) `shiftL` 32) .|. (fromIntegral x2)
|
||||||
|
|||||||
@ -65,6 +65,7 @@ gcde a b = onGmpUnsupported (gmpGcde a b) $
|
|||||||
areEven :: [Integer] -> Bool
|
areEven :: [Integer] -> Bool
|
||||||
areEven = and . map even
|
areEven = and . map even
|
||||||
|
|
||||||
|
-- | Compute the binary logarithm of a integer
|
||||||
log2 :: Integer -> Int
|
log2 :: Integer -> Int
|
||||||
log2 n = onGmpUnsupported (gmpLog2 n) $ imLog 2 n
|
log2 n = onGmpUnsupported (gmpLog2 n) $ imLog 2 n
|
||||||
where
|
where
|
||||||
|
|||||||
@ -36,14 +36,17 @@ import GHC.Integer.Logarithms (integerLog2#)
|
|||||||
import Data.Word
|
import Data.Word
|
||||||
import GHC.Ptr (Ptr(..))
|
import GHC.Ptr (Ptr(..))
|
||||||
|
|
||||||
|
-- | GMP Supported / Unsupported
|
||||||
data GmpSupported a = GmpSupported a
|
data GmpSupported a = GmpSupported a
|
||||||
| GmpUnsupported
|
| GmpUnsupported
|
||||||
deriving (Show,Eq)
|
deriving (Show,Eq)
|
||||||
|
|
||||||
|
-- | Simple combinator in case the operation is not supported through GMP
|
||||||
onGmpUnsupported :: GmpSupported a -> a -> a
|
onGmpUnsupported :: GmpSupported a -> a -> a
|
||||||
onGmpUnsupported (GmpSupported a) _ = a
|
onGmpUnsupported (GmpSupported a) _ = a
|
||||||
onGmpUnsupported GmpUnsupported f = f
|
onGmpUnsupported GmpUnsupported f = f
|
||||||
|
|
||||||
|
-- | Compute the GCDE of a two integer through GMP
|
||||||
gmpGcde :: Integer -> Integer -> GmpSupported (Integer, Integer, Integer)
|
gmpGcde :: Integer -> Integer -> GmpSupported (Integer, Integer, Integer)
|
||||||
#if MIN_VERSION_integer_gmp(0,5,1)
|
#if MIN_VERSION_integer_gmp(0,5,1)
|
||||||
gmpGcde a b =
|
gmpGcde a b =
|
||||||
@ -54,6 +57,7 @@ gmpGcde a b =
|
|||||||
gmpGcde _ _ = GmpUnsupported
|
gmpGcde _ _ = GmpUnsupported
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
-- | Compute the binary logarithm of an integer through GMP
|
||||||
gmpLog2 :: Integer -> GmpSupported Int
|
gmpLog2 :: Integer -> GmpSupported Int
|
||||||
#if MIN_VERSION_integer_gmp(0,5,1)
|
#if MIN_VERSION_integer_gmp(0,5,1)
|
||||||
gmpLog2 0 = GmpSupported 0
|
gmpLog2 0 = GmpSupported 0
|
||||||
@ -62,6 +66,8 @@ gmpLog2 x = GmpSupported (I# (integerLog2# x))
|
|||||||
gmpLog2 _ = GmpUnsupported
|
gmpLog2 _ = GmpUnsupported
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
-- | Compute the power modulus using extra security to remain constant
|
||||||
|
-- time wise through GMP
|
||||||
gmpPowModSecInteger :: Integer -> Integer -> Integer -> GmpSupported Integer
|
gmpPowModSecInteger :: Integer -> Integer -> Integer -> GmpSupported Integer
|
||||||
#if MIN_VERSION_integer_gmp(1,0,0)
|
#if MIN_VERSION_integer_gmp(1,0,0)
|
||||||
gmpPowModSecInteger b e m = GmpUnsupported
|
gmpPowModSecInteger b e m = GmpUnsupported
|
||||||
@ -71,6 +77,7 @@ gmpPowModSecInteger b e m = GmpSupported (powModSecInteger b e m)
|
|||||||
gmpPowModSecInteger _ _ _ = GmpUnsupported
|
gmpPowModSecInteger _ _ _ = GmpUnsupported
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
-- | Compute the power modulus through GMP
|
||||||
gmpPowModInteger :: Integer -> Integer -> Integer -> GmpSupported Integer
|
gmpPowModInteger :: Integer -> Integer -> Integer -> GmpSupported Integer
|
||||||
#if MIN_VERSION_integer_gmp(0,5,1)
|
#if MIN_VERSION_integer_gmp(0,5,1)
|
||||||
gmpPowModInteger b e m = GmpSupported (powModInteger b e m)
|
gmpPowModInteger b e m = GmpSupported (powModInteger b e m)
|
||||||
@ -78,6 +85,7 @@ gmpPowModInteger b e m = GmpSupported (powModInteger b e m)
|
|||||||
gmpPowModInteger _ _ _ = GmpUnsupported
|
gmpPowModInteger _ _ _ = GmpUnsupported
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
-- | Inverse modulus of a number through GMP
|
||||||
gmpInverse :: Integer -> Integer -> GmpSupported (Maybe Integer)
|
gmpInverse :: Integer -> Integer -> GmpSupported (Maybe Integer)
|
||||||
#if MIN_VERSION_integer_gmp(0,5,1)
|
#if MIN_VERSION_integer_gmp(0,5,1)
|
||||||
gmpInverse g m
|
gmpInverse g m
|
||||||
@ -88,6 +96,7 @@ gmpInverse g m
|
|||||||
gmpInverse _ _ = GmpUnsupported
|
gmpInverse _ _ = GmpUnsupported
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
-- | Get the next prime from a specific value through GMP
|
||||||
gmpNextPrime :: Integer -> GmpSupported Integer
|
gmpNextPrime :: Integer -> GmpSupported Integer
|
||||||
#if MIN_VERSION_integer_gmp(0,5,1)
|
#if MIN_VERSION_integer_gmp(0,5,1)
|
||||||
gmpNextPrime n = GmpSupported (nextPrimeInteger n)
|
gmpNextPrime n = GmpSupported (nextPrimeInteger n)
|
||||||
@ -95,6 +104,7 @@ gmpNextPrime n = GmpSupported (nextPrimeInteger n)
|
|||||||
gmpNextPrime _ = GmpUnsupported
|
gmpNextPrime _ = GmpUnsupported
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
-- | Test if a number is prime using Miller Rabin
|
||||||
gmpTestPrimeMillerRabin :: Int -> Integer -> GmpSupported Bool
|
gmpTestPrimeMillerRabin :: Int -> Integer -> GmpSupported Bool
|
||||||
#if MIN_VERSION_integer_gmp(0,5,1)
|
#if MIN_VERSION_integer_gmp(0,5,1)
|
||||||
gmpTestPrimeMillerRabin (I# tries) !n = GmpSupported $
|
gmpTestPrimeMillerRabin (I# tries) !n = GmpSupported $
|
||||||
@ -105,6 +115,7 @@ gmpTestPrimeMillerRabin (I# tries) !n = GmpSupported $
|
|||||||
gmpTestPrimeMillerRabin _ _ = GmpUnsupported
|
gmpTestPrimeMillerRabin _ _ = GmpUnsupported
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
-- | Return the size in bytes of a integer
|
||||||
gmpSizeInBytes :: Integer -> GmpSupported Int
|
gmpSizeInBytes :: Integer -> GmpSupported Int
|
||||||
#if MIN_VERSION_integer_gmp(0,5,1)
|
#if MIN_VERSION_integer_gmp(0,5,1)
|
||||||
gmpSizeInBytes n = GmpSupported (I# (word2Int# (sizeInBaseInteger n 256#)))
|
gmpSizeInBytes n = GmpSupported (I# (word2Int# (sizeInBaseInteger n 256#)))
|
||||||
@ -112,6 +123,7 @@ gmpSizeInBytes n = GmpSupported (I# (word2Int# (sizeInBaseInteger n 256#)))
|
|||||||
gmpSizeInBytes _ = GmpUnsupported
|
gmpSizeInBytes _ = GmpUnsupported
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
-- | Export an integer to a memory
|
||||||
gmpExportInteger :: Integer -> Ptr Word8 -> GmpSupported (IO ())
|
gmpExportInteger :: Integer -> Ptr Word8 -> GmpSupported (IO ())
|
||||||
#if MIN_VERSION_integer_gmp(1,0,0)
|
#if MIN_VERSION_integer_gmp(1,0,0)
|
||||||
gmpExportInteger n (Ptr addr) = GmpSupported $ do
|
gmpExportInteger n (Ptr addr) = GmpSupported $ do
|
||||||
@ -125,6 +137,7 @@ gmpExportInteger n (Ptr addr) = GmpSupported $ IO $ \s ->
|
|||||||
gmpExportInteger _ _ = GmpUnsupported
|
gmpExportInteger _ _ = GmpUnsupported
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
-- | Import an integer from a memory
|
||||||
gmpImportInteger :: Int -> Ptr Word8 -> GmpSupported (IO Integer)
|
gmpImportInteger :: Int -> Ptr Word8 -> GmpSupported (IO Integer)
|
||||||
#if MIN_VERSION_integer_gmp(1,0,0)
|
#if MIN_VERSION_integer_gmp(1,0,0)
|
||||||
gmpImportInteger (I# n) (Ptr addr) = GmpSupported $
|
gmpImportInteger (I# n) (Ptr addr) = GmpSupported $
|
||||||
|
|||||||
@ -22,6 +22,7 @@ import Data.Bits ((.&.),(.|.),xor,shift,testBit)
|
|||||||
import Crypto.Number.Basic
|
import Crypto.Number.Basic
|
||||||
import Crypto.Internal.Imports
|
import Crypto.Internal.Imports
|
||||||
|
|
||||||
|
-- | Binary Polynomial represented by an integer
|
||||||
type BinaryPolynomial = Integer
|
type BinaryPolynomial = Integer
|
||||||
|
|
||||||
-- | Addition over F₂m. This is just a synonym of 'xor'.
|
-- | Addition over F₂m. This is just a synonym of 'xor'.
|
||||||
|
|||||||
@ -1,12 +1,22 @@
|
|||||||
module Crypto.PubKey.ECC.DH (
|
-- |
|
||||||
Curve
|
-- Module : Crypto.PubKey.ECC.DH
|
||||||
, PublicPoint
|
-- License : BSD-style
|
||||||
, PrivateNumber
|
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
|
||||||
, SharedKey(..)
|
-- Stability : experimental
|
||||||
, generatePrivate
|
-- Portability : unknown
|
||||||
, calculatePublic
|
--
|
||||||
, getShared
|
-- Elliptic curve Diffie Hellman
|
||||||
) where
|
--
|
||||||
|
module Crypto.PubKey.ECC.DH
|
||||||
|
(
|
||||||
|
Curve
|
||||||
|
, PublicPoint
|
||||||
|
, PrivateNumber
|
||||||
|
, SharedKey(..)
|
||||||
|
, generatePrivate
|
||||||
|
, calculatePublic
|
||||||
|
, getShared
|
||||||
|
) where
|
||||||
|
|
||||||
import Crypto.Number.Generate (generateMax)
|
import Crypto.Number.Generate (generateMax)
|
||||||
import Crypto.PubKey.ECC.Prim (pointMul)
|
import Crypto.PubKey.ECC.Prim (pointMul)
|
||||||
|
|||||||
@ -1,3 +1,4 @@
|
|||||||
|
-- |
|
||||||
-- Module : Crypto.Random
|
-- Module : Crypto.Random
|
||||||
-- License : BSD-style
|
-- License : BSD-style
|
||||||
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
|
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
|
||||||
@ -23,8 +24,16 @@ import Crypto.Random.Entropy
|
|||||||
import Data.ByteArray (ScrubbedBytes)
|
import Data.ByteArray (ScrubbedBytes)
|
||||||
import Crypto.Internal.Imports
|
import Crypto.Internal.Imports
|
||||||
|
|
||||||
|
-- | Create a new DRG from system entropy
|
||||||
drgNew :: IO ChaChaDRG
|
drgNew :: IO ChaChaDRG
|
||||||
drgNew = initialize <$> (getEntropy 40 :: IO ScrubbedBytes)
|
drgNew = initialize <$> (getEntropy 40 :: IO ScrubbedBytes)
|
||||||
|
|
||||||
|
-- | Create a new DRG from 5 Word64.
|
||||||
|
--
|
||||||
|
-- This is a convenient interface to create deterministic interface
|
||||||
|
-- for quickcheck style testing.
|
||||||
|
--
|
||||||
|
-- It can also be used in other contexts provided the input
|
||||||
|
-- has been properly randomly generated.
|
||||||
drgNewTest :: (Word64, Word64, Word64, Word64, Word64) -> ChaChaDRG
|
drgNewTest :: (Word64, Word64, Word64, Word64, Word64) -> ChaChaDRG
|
||||||
drgNewTest = initializeWords
|
drgNewTest = initializeWords
|
||||||
|
|||||||
@ -1,3 +1,10 @@
|
|||||||
|
-- |
|
||||||
|
-- Module : Crypto.Random.Entropy.Backend
|
||||||
|
-- License : BSD-style
|
||||||
|
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
|
||||||
|
-- Stability : stable
|
||||||
|
-- Portability : good
|
||||||
|
--
|
||||||
{-# LANGUAGE CPP #-}
|
{-# LANGUAGE CPP #-}
|
||||||
{-# LANGUAGE ExistentialQuantification #-}
|
{-# LANGUAGE ExistentialQuantification #-}
|
||||||
module Crypto.Random.Entropy.Backend
|
module Crypto.Random.Entropy.Backend
|
||||||
@ -18,6 +25,7 @@ import Crypto.Random.Entropy.Windows
|
|||||||
import Crypto.Random.Entropy.Unix
|
import Crypto.Random.Entropy.Unix
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
-- | All supported backends
|
||||||
supportedBackends :: [IO (Maybe EntropyBackend)]
|
supportedBackends :: [IO (Maybe EntropyBackend)]
|
||||||
supportedBackends =
|
supportedBackends =
|
||||||
[
|
[
|
||||||
@ -31,12 +39,18 @@ supportedBackends =
|
|||||||
#endif
|
#endif
|
||||||
]
|
]
|
||||||
|
|
||||||
|
-- | Any Entropy Backend
|
||||||
data EntropyBackend = forall b . EntropySource b => EntropyBackend b
|
data EntropyBackend = forall b . EntropySource b => EntropyBackend b
|
||||||
|
|
||||||
|
-- | Open a backend handle
|
||||||
openBackend :: EntropySource b => b -> IO (Maybe EntropyBackend)
|
openBackend :: EntropySource b => b -> IO (Maybe EntropyBackend)
|
||||||
openBackend b = fmap EntropyBackend `fmap` callOpen b
|
openBackend b = fmap EntropyBackend `fmap` callOpen b
|
||||||
where callOpen :: EntropySource b => b -> IO (Maybe b)
|
where callOpen :: EntropySource b => b -> IO (Maybe b)
|
||||||
callOpen _ = entropyOpen
|
callOpen _ = entropyOpen
|
||||||
|
|
||||||
gatherBackend :: EntropyBackend -> Ptr Word8 -> Int -> IO Int
|
-- | Gather randomness from an open handle
|
||||||
|
gatherBackend :: EntropyBackend -- ^ An open Entropy Backend
|
||||||
|
-> Ptr Word8 -- ^ Pointer to a buffer to write to
|
||||||
|
-> Int -- ^ number of bytes to write
|
||||||
|
-> IO Int -- ^ return the number of bytes actually written
|
||||||
gatherBackend (EntropyBackend backend) ptr n = entropyGather backend ptr n
|
gatherBackend (EntropyBackend backend) ptr n = entropyGather backend ptr n
|
||||||
|
|||||||
@ -14,7 +14,13 @@ import Data.Word (Word8)
|
|||||||
import Foreign.Ptr (Ptr, plusPtr)
|
import Foreign.Ptr (Ptr, plusPtr)
|
||||||
import Crypto.Random.Entropy.Backend
|
import Crypto.Random.Entropy.Backend
|
||||||
|
|
||||||
-- Refill the entropy in a buffer
|
-- | Refill the entropy in a buffer
|
||||||
|
--
|
||||||
|
-- call each entropy backend in turn until the buffer has
|
||||||
|
-- been replenish.
|
||||||
|
--
|
||||||
|
-- If the buffer cannot be refill after 3 loopings, this will raise
|
||||||
|
-- an User Error exception
|
||||||
replenish :: Int -> [EntropyBackend] -> Ptr Word8 -> IO ()
|
replenish :: Int -> [EntropyBackend] -> Ptr Word8 -> IO ()
|
||||||
replenish _ [] _ = fail "cryptonite: random: cannot get any source of entropy on this system"
|
replenish _ [] _ = fail "cryptonite: random: cannot get any source of entropy on this system"
|
||||||
replenish poolSize backends ptr = loop 0 backends ptr poolSize
|
replenish poolSize backends ptr = loop 0 backends ptr poolSize
|
||||||
|
|||||||
@ -8,6 +8,7 @@
|
|||||||
module Crypto.Random.Types
|
module Crypto.Random.Types
|
||||||
(
|
(
|
||||||
MonadRandom(..)
|
MonadRandom(..)
|
||||||
|
, MonadPseudoRandom
|
||||||
, DRG(..)
|
, DRG(..)
|
||||||
, withDRG
|
, withDRG
|
||||||
) where
|
) where
|
||||||
@ -16,15 +17,20 @@ import Crypto.Random.Entropy
|
|||||||
import Crypto.Internal.ByteArray
|
import Crypto.Internal.ByteArray
|
||||||
import Crypto.Internal.Imports
|
import Crypto.Internal.Imports
|
||||||
|
|
||||||
|
-- | A monad constraint that allows to generate random bytes
|
||||||
class (Functor m, Monad m) => MonadRandom m where
|
class (Functor m, Monad m) => MonadRandom m where
|
||||||
getRandomBytes :: ByteArray byteArray => Int -> m byteArray
|
getRandomBytes :: ByteArray byteArray => Int -> m byteArray
|
||||||
|
|
||||||
|
-- | A Deterministic Random Generator (DRG) class
|
||||||
class DRG gen where
|
class DRG gen where
|
||||||
|
-- | Generate N bytes of randomness from a DRG
|
||||||
randomBytesGenerate :: ByteArray byteArray => Int -> gen -> (byteArray, gen)
|
randomBytesGenerate :: ByteArray byteArray => Int -> gen -> (byteArray, gen)
|
||||||
|
|
||||||
instance MonadRandom IO where
|
instance MonadRandom IO where
|
||||||
getRandomBytes = getEntropy
|
getRandomBytes = getEntropy
|
||||||
|
|
||||||
|
-- | A simple Monad class very similar to a State Monad
|
||||||
|
-- with the state being a DRG.
|
||||||
newtype MonadPseudoRandom gen a = MonadPseudoRandom
|
newtype MonadPseudoRandom gen a = MonadPseudoRandom
|
||||||
{ runPseudoRandom :: gen -> (a, gen)
|
{ runPseudoRandom :: gen -> (a, gen)
|
||||||
}
|
}
|
||||||
@ -49,5 +55,7 @@ instance DRG gen => Monad (MonadPseudoRandom gen) where
|
|||||||
instance DRG gen => MonadRandom (MonadPseudoRandom gen) where
|
instance DRG gen => MonadRandom (MonadPseudoRandom gen) where
|
||||||
getRandomBytes n = MonadPseudoRandom (randomBytesGenerate n)
|
getRandomBytes n = MonadPseudoRandom (randomBytesGenerate n)
|
||||||
|
|
||||||
|
-- | Run a pure computation with a Deterministic Random Generator
|
||||||
|
-- in the 'MonadPseudoRandom'
|
||||||
withDRG :: DRG gen => gen -> MonadPseudoRandom gen a -> (a, gen)
|
withDRG :: DRG gen => gen -> MonadPseudoRandom gen a -> (a, gen)
|
||||||
withDRG gen m = runPseudoRandom m gen
|
withDRG gen m = runPseudoRandom m gen
|
||||||
|
|||||||
@ -126,7 +126,6 @@ Library
|
|||||||
Crypto.Internal.ByteArray
|
Crypto.Internal.ByteArray
|
||||||
Crypto.Internal.Compat
|
Crypto.Internal.Compat
|
||||||
Crypto.Internal.CompatPrim
|
Crypto.Internal.CompatPrim
|
||||||
Crypto.Internal.Hex
|
|
||||||
Crypto.Internal.Imports
|
Crypto.Internal.Imports
|
||||||
Crypto.Internal.Words
|
Crypto.Internal.Words
|
||||||
Crypto.Internal.WordArray
|
Crypto.Internal.WordArray
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user