1module Foundation.Random.ChaChaDRG 2 ( State(..) 3 , keySize 4 ) where 5 6import Foundation.Class.Storable (peek) 7import Basement.Imports 8import Basement.Types.OffsetSize 9import Basement.Monad 10import Foundation.Random.Class 11import Foundation.Random.DRG 12import qualified Basement.UArray as A 13import qualified Basement.UArray.Mutable as A 14import GHC.ST 15import qualified Foreign.Marshal.Alloc (alloca) 16 17-- | RNG based on ChaCha core. 18-- 19-- The algorithm is identical to the arc4random found in recent BSDs, 20-- namely a ChaCha core provide 64 bytes of random from 32 bytes of 21-- key. 22newtype State = State (UArray Word8) 23 24instance RandomGen State where 25 randomNew = State <$> getRandomBytes keySize 26 randomNewFrom bs 27 | A.length bs == keySize = Just $ State bs 28 | otherwise = Nothing 29 randomGenerate = generate 30 randomGenerateWord64 = generateWord64 31 randomGenerateF32 = generateF32 32 randomGenerateF64 = generateF64 33 34keySize :: CountOf Word8 35keySize = 32 36 37generate :: CountOf Word8 -> State -> (UArray Word8, State) 38generate n (State key) = runST $ do 39 dst <- A.newPinned n 40 newKey <- A.newPinned keySize 41 A.withMutablePtr dst $ \dstP -> 42 A.withMutablePtr newKey $ \newKeyP -> 43 A.withPtr key $ \keyP -> do 44 _ <- unsafePrimFromIO $ c_rngv1_generate newKeyP dstP keyP n 45 return () 46 (,) <$> A.unsafeFreeze dst 47 <*> (State <$> A.unsafeFreeze newKey) 48 49generateWord64 :: State -> (Word64, State) 50generateWord64 (State key) = runST $ unsafePrimFromIO $ 51 Foreign.Marshal.Alloc.alloca $ \dst -> do 52 newKey <- A.newPinned keySize 53 A.withMutablePtr newKey $ \newKeyP -> 54 A.withPtr key $ \keyP -> 55 c_rngv1_generate_word64 newKeyP dst keyP *> return () 56 (,) <$> peek dst <*> (State <$> A.unsafeFreeze newKey) 57 58generateF32 :: State -> (Float, State) 59generateF32 (State key) = runST $ unsafePrimFromIO $ 60 Foreign.Marshal.Alloc.alloca $ \dst -> do 61 newKey <- A.newPinned keySize 62 A.withMutablePtr newKey $ \newKeyP -> 63 A.withPtr key $ \keyP -> 64 c_rngv1_generate_f32 newKeyP dst keyP *> return () 65 (,) <$> peek dst <*> (State <$> A.unsafeFreeze newKey) 66 67generateF64 :: State -> (Double, State) 68generateF64 (State key) = runST $ unsafePrimFromIO $ 69 Foreign.Marshal.Alloc.alloca $ \dst -> do 70 newKey <- A.newPinned keySize 71 A.withMutablePtr newKey $ \newKeyP -> 72 A.withPtr key $ \keyP -> 73 c_rngv1_generate_f64 newKeyP dst keyP *> return () 74 (,) <$> peek dst <*> (State <$> A.unsafeFreeze newKey) 75 76-- return 0 on success, !0 for failure 77foreign import ccall unsafe "foundation_rngV1_generate" 78 c_rngv1_generate :: Ptr Word8 -- new key 79 -> Ptr Word8 -- destination 80 -> Ptr Word8 -- current key 81 -> CountOf Word8 -- number of bytes to generate 82 -> IO Word32 83 84foreign import ccall unsafe "foundation_rngV1_generate_word64" 85 c_rngv1_generate_word64 :: Ptr Word8 -- new key 86 -> Ptr Word64 -- destination 87 -> Ptr Word8 -- current key 88 -> IO Word32 89 90foreign import ccall unsafe "foundation_rngV1_generate_f32" 91 c_rngv1_generate_f32 :: Ptr Word8 -- new key 92 -> Ptr Float -- destination 93 -> Ptr Word8 -- current key 94 -> IO Word32 95 96foreign import ccall unsafe "foundation_rngV1_generate_f64" 97 c_rngv1_generate_f64 :: Ptr Word8 -- new key 98 -> Ptr Double -- destination 99 -> Ptr Word8 -- current key 100 -> IO Word32 101