{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# OPTIONS_GHC -Wno-orphans #-}
-- |
-- Module      :  System.Random.Seed
-- Copyright   :  (c) Alexey Kuleshevich 2024
-- License     :  BSD-style (see the file LICENSE in the 'random' repository)
-- Maintainer  :  libraries@haskell.org
--

module System.Random.Seed
  ( SeedGen(..)
  , -- ** Seed
    Seed
  , seedSize
  , seedSizeProxy
  , mkSeed
  , unSeed
  , mkSeedFromByteString
  , unSeedToByteString
  , withSeed
  , withSeedM
  , withSeedFile
  , seedGenTypeName
  , nonEmptyToSeed
  , nonEmptyFromSeed
  ) where

import Control.Monad (unless)
import qualified Control.Monad.Fail as F
import Control.Monad.IO.Class
import Control.Monad.ST
import Control.Monad.State.Strict (get, put, runStateT)
import Data.Array.Byte (ByteArray(..))
import Data.Bits
import qualified Data.ByteString as BS
import qualified Data.ByteString.Short.Internal as SBS (fromShort, toShort)
import Data.Coerce
import Data.Functor.Identity (runIdentity)
import Data.List.NonEmpty as NE (NonEmpty(..), nonEmpty, toList)
import Data.Typeable
import Data.Word
import GHC.Exts (Proxy#, proxy#)
import GHC.TypeLits (Nat, KnownNat, natVal', type (<=))
import System.Random.Internal
import qualified System.Random.SplitMix as SM
import qualified System.Random.SplitMix32 as SM32


-- | Interface for converting a pure pseudo-random number generator to and from non-empty
-- sequence of bytes. Seeds are stored in Little-Endian order regardless of the platform
-- it is being used on, which provides cross-platform compatibility, while providing
-- optimal performance for the most common platform type.
--
-- Conversion to and from a `Seed` serves as a building block for implementing
-- serialization for any pure or frozen pseudo-random number generator.
--
-- It is not trivial to implement platform independence. For this reason this type class
-- has two alternative ways of creating an instance for this class. The easiest way for
-- constructing a platform indepent seed is by converting the inner state of a generator
-- to and from a list of 64 bit words using `toSeed64` and `fromSeed64` respectively. In
-- that case cross-platform support will be handled automaticaly.
--
-- >>> :set -XDataKinds -XTypeFamilies
-- >>> import Data.Word (Word8, Word32)
-- >>> import Data.Bits ((.|.), shiftR, shiftL)
-- >>> import Data.List.NonEmpty (NonEmpty ((:|)))
-- >>> data FiveByteGen = FiveByteGen Word8 Word32 deriving Show
-- >>> :{
-- instance SeedGen FiveByteGen where
--   type SeedSize FiveByteGen = 5
--   fromSeed64 (w64 :| _) =
--     FiveByteGen (fromIntegral (w64 `shiftR` 32)) (fromIntegral w64)
--   toSeed64 (FiveByteGen x1 x4) =
--     let w64 = (fromIntegral x1 `shiftL` 32) .|. fromIntegral x4
--      in (w64 :| [])
-- :}
--
-- >>> FiveByteGen 0x80 0x01020304
-- FiveByteGen 128 16909060
-- >>> fromSeed (toSeed (FiveByteGen 0x80 0x01020304))
-- FiveByteGen 128 16909060
-- >>> toSeed (FiveByteGen 0x80 0x01020304)
-- Seed [0x04, 0x03, 0x02, 0x01, 0x80]
-- >>> toSeed64 (FiveByteGen 0x80 0x01020304)
-- 549772722948 :| []
--
-- However, when performance is of utmost importance or default handling of cross platform
-- independence is not sufficient, then an adventurous developer can try implementing
-- conversion into bytes directly with `toSeed` and `fromSeed`.
--
-- Properties that must hold:
--
-- @
-- > fromSeed (toSeed gen) == gen
-- @
--
-- @
-- > fromSeed64 (toSeed64 gen) == gen
-- @
--
-- Note, that there is no requirement for every `Seed` to roundtrip, eg. this proprty does
-- not even hold for `StdGen`:
--
-- >>> let seed = nonEmptyToSeed (0xab :| [0xff00]) :: Seed StdGen
-- >>> seed == toSeed (fromSeed seed)
-- False
--
-- @since 1.3.0
class (KnownNat (SeedSize g), 1 <= SeedSize g, Typeable g) => SeedGen g where
  -- | Number of bytes that is required for storing the full state of a pseudo-random
  -- number generator. It should be big enough to satisfy the roundtrip property:
  --
  -- @
  -- > fromSeed (toSeed gen) == gen
  -- @
  --
  type SeedSize g :: Nat
  {-# MINIMAL (fromSeed, toSeed)|(fromSeed64, toSeed64) #-}

  -- | Convert from a binary representation to a pseudo-random number generator
  --
  -- @since 1.3.0
  fromSeed :: Seed g -> g
  fromSeed = NonEmpty Word64 -> g
forall g. SeedGen g => NonEmpty Word64 -> g
fromSeed64 (NonEmpty Word64 -> g)
-> (Seed g -> NonEmpty Word64) -> Seed g -> g
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seed g -> NonEmpty Word64
forall g. SeedGen g => Seed g -> NonEmpty Word64
nonEmptyFromSeed

  -- | Convert to a binary representation of a pseudo-random number generator
  --
  -- @since 1.3.0
  toSeed :: g -> Seed g
  toSeed = NonEmpty Word64 -> Seed g
forall g. SeedGen g => NonEmpty Word64 -> Seed g
nonEmptyToSeed (NonEmpty Word64 -> Seed g)
-> (g -> NonEmpty Word64) -> g -> Seed g
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> NonEmpty Word64
forall g. SeedGen g => g -> NonEmpty Word64
toSeed64

  -- | Construct pseudo-random number generator from a list of words. Whenever list does
  -- not have enough bytes to satisfy the `SeedSize` requirement, it will be padded with
  -- zeros. On the other hand when it has more than necessary, extra bytes will be dropped.
  --
  -- For example if `SeedSize` is set to 2, then only the lower 16 bits of the first
  -- element in the list will be used.
  --
  -- @since 1.3.0
  fromSeed64 :: NonEmpty Word64 -> g
  fromSeed64 = Seed g -> g
forall g. SeedGen g => Seed g -> g
fromSeed (Seed g -> g)
-> (NonEmpty Word64 -> Seed g) -> NonEmpty Word64 -> g
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Word64 -> Seed g
forall g. SeedGen g => NonEmpty Word64 -> Seed g
nonEmptyToSeed

  -- | Convert pseudo-random number generator to a list of words
  --
  -- In case when `SeedSize` is not a multiple of 8, then the upper bits of the last word
  -- in the list will be set to zero.
  --
  -- @since 1.3.0
  toSeed64 :: g -> NonEmpty Word64
  toSeed64 = Seed g -> NonEmpty Word64
forall g. SeedGen g => Seed g -> NonEmpty Word64
nonEmptyFromSeed (Seed g -> NonEmpty Word64)
-> (g -> Seed g) -> g -> NonEmpty Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> Seed g
forall g. SeedGen g => g -> Seed g
toSeed

instance SeedGen StdGen where
  type SeedSize StdGen = SeedSize SM.SMGen
  fromSeed :: Seed StdGen -> StdGen
fromSeed = (Seed SMGen -> SMGen) -> Seed StdGen -> StdGen
forall a b. Coercible a b => a -> b
coerce (Seed SMGen -> SMGen
forall g. SeedGen g => Seed g -> g
fromSeed :: Seed SM.SMGen -> SM.SMGen)
  toSeed :: StdGen -> Seed StdGen
toSeed = (SMGen -> Seed SMGen) -> StdGen -> Seed StdGen
forall a b. Coercible a b => a -> b
coerce (SMGen -> Seed SMGen
forall g. SeedGen g => g -> Seed g
toSeed :: SM.SMGen -> Seed SM.SMGen)

instance SeedGen g => SeedGen (StateGen g) where
  type SeedSize (StateGen g) = SeedSize g
  fromSeed :: Seed (StateGen g) -> StateGen g
fromSeed = (Seed g -> g) -> Seed (StateGen g) -> StateGen g
forall a b. Coercible a b => a -> b
coerce (Seed g -> g
forall g. SeedGen g => Seed g -> g
fromSeed :: Seed g -> g)
  toSeed :: StateGen g -> Seed (StateGen g)
toSeed = (g -> Seed g) -> StateGen g -> Seed (StateGen g)
forall a b. Coercible a b => a -> b
coerce (g -> Seed g
forall g. SeedGen g => g -> Seed g
toSeed :: g -> Seed g)

instance SeedGen SM.SMGen where
  type SeedSize SM.SMGen = 16
  fromSeed :: Seed SMGen -> SMGen
fromSeed (Seed ByteArray
ba) =
    Word64 -> Word64 -> SMGen
SM.seedSMGen (ByteArray -> Int -> Word64
indexWord64LE ByteArray
ba Int
0) (ByteArray -> Int -> Word64
indexWord64LE ByteArray
ba Int
8)
  toSeed :: SMGen -> Seed SMGen
toSeed SMGen
g =
    case SMGen -> (Word64, Word64)
SM.unseedSMGen SMGen
g of
      (Word64
seed, Word64
gamma) -> ByteArray -> Seed SMGen
forall g. ByteArray -> Seed g
Seed (ByteArray -> Seed SMGen) -> ByteArray -> Seed SMGen
forall a b. (a -> b) -> a -> b
$ (forall s. ST s ByteArray) -> ByteArray
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s ByteArray) -> ByteArray)
-> (forall s. ST s ByteArray) -> ByteArray
forall a b. (a -> b) -> a -> b
$ do
        MutableByteArray s
mba <- Int -> ST s (MutableByteArray s)
forall s. Int -> ST s (MutableByteArray s)
newMutableByteArray Int
16
        MutableByteArray s -> Int -> Word64 -> ST s ()
forall s. MutableByteArray s -> Int -> Word64 -> ST s ()
writeWord64LE MutableByteArray s
mba Int
0 Word64
seed
        MutableByteArray s -> Int -> Word64 -> ST s ()
forall s. MutableByteArray s -> Int -> Word64 -> ST s ()
writeWord64LE MutableByteArray s
mba Int
8 Word64
gamma
        MutableByteArray s -> ST s ByteArray
forall s. MutableByteArray s -> ST s ByteArray
freezeMutableByteArray MutableByteArray s
mba

instance SeedGen SM32.SMGen where
  type SeedSize SM32.SMGen = 8
  fromSeed :: Seed SMGen -> SMGen
fromSeed (Seed ByteArray
ba) =
    let x :: Word64
x = ByteArray -> Int -> Word64
indexWord64LE ByteArray
ba Int
0
        seed, gamma :: Word32
        seed :: Word32
seed = Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR Word64
x Int
32)
        gamma :: Word32
gamma = Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
x
    in Word32 -> Word32 -> SMGen
SM32.seedSMGen Word32
seed Word32
gamma
  toSeed :: SMGen -> Seed SMGen
toSeed SMGen
g =
    let seed, gamma :: Word32
        (Word32
seed, Word32
gamma) = SMGen -> (Word32, Word32)
SM32.unseedSMGen SMGen
g
    in ByteArray -> Seed SMGen
forall g. ByteArray -> Seed g
Seed (ByteArray -> Seed SMGen) -> ByteArray -> Seed SMGen
forall a b. (a -> b) -> a -> b
$ (forall s. ST s ByteArray) -> ByteArray
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s ByteArray) -> ByteArray)
-> (forall s. ST s ByteArray) -> ByteArray
forall a b. (a -> b) -> a -> b
$ do
        MutableByteArray s
mba <- Int -> ST s (MutableByteArray s)
forall s. Int -> ST s (MutableByteArray s)
newMutableByteArray Int
8
        let w64 :: Word64
            w64 :: Word64
w64 = Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
seed) Int
32 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
gamma
        MutableByteArray s -> Int -> Word64 -> ST s ()
forall s. MutableByteArray s -> Int -> Word64 -> ST s ()
writeWord64LE MutableByteArray s
mba Int
0 Word64
w64
        MutableByteArray s -> ST s ByteArray
forall s. MutableByteArray s -> ST s ByteArray
freezeMutableByteArray MutableByteArray s
mba

instance SeedGen g => Uniform (Seed g) where
  uniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m (Seed g)
uniformM = (ByteArray -> Seed g) -> m ByteArray -> m (Seed g)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteArray -> Seed g
forall g. ByteArray -> Seed g
Seed (m ByteArray -> m (Seed g))
-> (g -> m ByteArray) -> g -> m (Seed g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int -> g -> m ByteArray
forall g (m :: * -> *).
StatefulGen g m =>
Bool -> Int -> g -> m ByteArray
uniformByteArrayM Bool
False (forall g. SeedGen g => Int
seedSize @g)

-- | Get the expected size of the `Seed` in number bytes
--
-- @since 1.3.0
seedSize :: forall g. SeedGen g => Int
seedSize :: forall g. SeedGen g => Int
seedSize = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Proxy# (SeedSize g) -> Integer
forall (n :: Natural). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# (SeedSize g)
forall {k} (a :: k). Proxy# a
proxy# :: Proxy# (SeedSize g))

-- | Just like `seedSize`, except it accepts a proxy as an argument.
--
-- @since 1.3.0
seedSizeProxy :: forall proxy g. SeedGen g => proxy g -> Int
seedSizeProxy :: forall (proxy :: * -> *) g. SeedGen g => proxy g -> Int
seedSizeProxy proxy g
_px = forall g. SeedGen g => Int
seedSize @g

-- | Construct a `Seed` from a `ByteArray` of expected length. Whenever `ByteArray` does
-- not match the `SeedSize` specified by the pseudo-random generator, this function will
-- `F.fail`.
--
-- @since 1.3.0
mkSeed :: forall g m. (SeedGen g, F.MonadFail m) => ByteArray -> m (Seed g)
mkSeed :: forall g (m :: * -> *).
(SeedGen g, MonadFail m) =>
ByteArray -> m (Seed g)
mkSeed ByteArray
ba = do
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteArray -> Int
sizeOfByteArray ByteArray
ba Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== forall g. SeedGen g => Int
seedSize @g) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
F.fail (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Unexpected number of bytes: "
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (ByteArray -> Int
sizeOfByteArray ByteArray
ba)
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
". Exactly "
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (forall g. SeedGen g => Int
seedSize @g)
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" bytes is required by the "
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show (forall g. SeedGen g => String
seedGenTypeName @g)
  Seed g -> m (Seed g)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Seed g -> m (Seed g)) -> Seed g -> m (Seed g)
forall a b. (a -> b) -> a -> b
$ ByteArray -> Seed g
forall g. ByteArray -> Seed g
Seed ByteArray
ba

-- | Helper function that allows for operating directly on the `Seed`, while supplying a
-- function that uses the pseudo-random number generator that is constructed from that
-- `Seed`.
--
-- ====__Example__
--
-- >>> :set -XTypeApplications
-- >>> import System.Random
-- >>> withSeed (nonEmptyToSeed (pure 2024) :: Seed StdGen) (uniform @Int)
-- (1039666877624726199,Seed [0xe9, 0x07, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00])
--
-- @since 1.3.0
withSeed :: SeedGen g => Seed g -> (g -> (a, g)) -> (a, Seed g)
withSeed :: forall g a. SeedGen g => Seed g -> (g -> (a, g)) -> (a, Seed g)
withSeed Seed g
seed g -> (a, g)
f = Identity (a, Seed g) -> (a, Seed g)
forall a. Identity a -> a
runIdentity (Seed g -> (g -> Identity (a, g)) -> Identity (a, Seed g)
forall g (f :: * -> *) a.
(SeedGen g, Functor f) =>
Seed g -> (g -> f (a, g)) -> f (a, Seed g)
withSeedM Seed g
seed ((a, g) -> Identity (a, g)
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a, g) -> Identity (a, g))
-> (g -> (a, g)) -> g -> Identity (a, g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> (a, g)
f))

-- | Same as `withSeed`, except it is useful with monadic computation and frozen generators.
--
-- See `System.Random.Stateful.withSeedMutableGen` for a helper that also handles seeds
-- for mutable pseduo-random number generators.
--
-- @since 1.3.0
withSeedM :: (SeedGen g, Functor f) => Seed g -> (g -> f (a, g)) -> f (a, Seed g)
withSeedM :: forall g (f :: * -> *) a.
(SeedGen g, Functor f) =>
Seed g -> (g -> f (a, g)) -> f (a, Seed g)
withSeedM Seed g
seed g -> f (a, g)
f = (g -> Seed g) -> (a, g) -> (a, Seed g)
forall a b. (a -> b) -> (a, a) -> (a, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap g -> Seed g
forall g. SeedGen g => g -> Seed g
toSeed ((a, g) -> (a, Seed g)) -> f (a, g) -> f (a, Seed g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> g -> f (a, g)
f (Seed g -> g
forall g. SeedGen g => Seed g -> g
fromSeed Seed g
seed)

-- | This is a function that shows the name of the generator type, which is useful for
-- error reporting.
--
-- @since 1.3.0
seedGenTypeName :: forall g. SeedGen g => String
seedGenTypeName :: forall g. SeedGen g => String
seedGenTypeName = TypeRep -> String
forall a. Show a => a -> String
show (Proxy g -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @g))


-- | Just like `mkSeed`, but uses `ByteString` as argument. Results in a memcopy of the seed.
--
-- @since 1.3.0
mkSeedFromByteString :: (SeedGen g, F.MonadFail m) => BS.ByteString -> m (Seed g)
mkSeedFromByteString :: forall g (m :: * -> *).
(SeedGen g, MonadFail m) =>
ByteString -> m (Seed g)
mkSeedFromByteString = ByteArray -> m (Seed g)
forall g (m :: * -> *).
(SeedGen g, MonadFail m) =>
ByteArray -> m (Seed g)
mkSeed (ByteArray -> m (Seed g))
-> (ByteString -> ByteArray) -> ByteString -> m (Seed g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteArray
shortByteStringToByteArray (ShortByteString -> ByteArray)
-> (ByteString -> ShortByteString) -> ByteString -> ByteArray
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShortByteString
SBS.toShort

-- | Unwrap the `Seed` and get the underlying `ByteArray`
--
-- @since 1.3.0
unSeed :: Seed g -> ByteArray
unSeed :: forall g. Seed g -> ByteArray
unSeed (Seed ByteArray
ba) = ByteArray
ba

-- | Just like `unSeed`, but produced a `ByteString`. Results in a memcopy of the seed.
--
-- @since 1.3.0
unSeedToByteString :: Seed g -> BS.ByteString
unSeedToByteString :: forall g. Seed g -> ByteString
unSeedToByteString = ShortByteString -> ByteString
SBS.fromShort (ShortByteString -> ByteString)
-> (Seed g -> ShortByteString) -> Seed g -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteArray -> ShortByteString
byteArrayToShortByteString (ByteArray -> ShortByteString)
-> (Seed g -> ByteArray) -> Seed g -> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seed g -> ByteArray
forall g. Seed g -> ByteArray
unSeed


-- | Read the seed from a file and use it for constructing a pseudo-random number
-- generator. After supplied action has been applied to the constructed generator, the
-- resulting generator will be converted back to a seed and written to the same file.
--
-- @since 1.3.0
withSeedFile :: (SeedGen g, MonadIO m) => FilePath -> (Seed g -> m (a, Seed g)) -> m a
withSeedFile :: forall g (m :: * -> *) a.
(SeedGen g, MonadIO m) =>
String -> (Seed g -> m (a, Seed g)) -> m a
withSeedFile String
fileName Seed g -> m (a, Seed g)
action = do
  ByteString
bs <- IO ByteString -> m ByteString
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
BS.readFile String
fileName
  Seed g
seed <- IO (Seed g) -> m (Seed g)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Seed g) -> m (Seed g)) -> IO (Seed g) -> m (Seed g)
forall a b. (a -> b) -> a -> b
$ ByteString -> IO (Seed g)
forall g (m :: * -> *).
(SeedGen g, MonadFail m) =>
ByteString -> m (Seed g)
mkSeedFromByteString ByteString
bs
  (a
res, Seed g
seed') <- Seed g -> m (a, Seed g)
action Seed g
seed
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString -> IO ()
BS.writeFile String
fileName (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Seed g -> ByteString
forall g. Seed g -> ByteString
unSeedToByteString Seed g
seed'
  a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
res

-- | Construct a seed from a list of 64-bit words. At most `SeedSize` many bytes will be used.
--
-- @since 1.3.0
nonEmptyToSeed :: forall g. SeedGen g => NonEmpty Word64 -> Seed g
nonEmptyToSeed :: forall g. SeedGen g => NonEmpty Word64 -> Seed g
nonEmptyToSeed NonEmpty Word64
xs = ByteArray -> Seed g
forall g. ByteArray -> Seed g
Seed (ByteArray -> Seed g) -> ByteArray -> Seed g
forall a b. (a -> b) -> a -> b
$ (forall s. ST s ByteArray) -> ByteArray
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s ByteArray) -> ByteArray)
-> (forall s. ST s ByteArray) -> ByteArray
forall a b. (a -> b) -> a -> b
$ do
  let n :: Int
n = forall g. SeedGen g => Int
seedSize @g
  MutableByteArray s
mba <- Int -> ST s (MutableByteArray s)
forall s. Int -> ST s (MutableByteArray s)
newMutableByteArray Int
n
  ((), [Word64])
_ <- (StateT [Word64] (ST s) () -> [Word64] -> ST s ((), [Word64]))
-> [Word64] -> StateT [Word64] (ST s) () -> ST s ((), [Word64])
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT [Word64] (ST s) () -> [Word64] -> ST s ((), [Word64])
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (NonEmpty Word64 -> [Word64]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty Word64
xs) (StateT [Word64] (ST s) () -> ST s ((), [Word64]))
-> StateT [Word64] (ST s) () -> ST s ((), [Word64])
forall a b. (a -> b) -> a -> b
$ do
    MutableByteArray s
-> Int
-> Int
-> StateT [Word64] (ST s) Word64
-> StateT [Word64] (ST s) ()
forall (t :: (* -> *) -> * -> *) s.
(Monad (t (ST s)), MonadTrans t) =>
MutableByteArray s -> Int -> Int -> t (ST s) Word64 -> t (ST s) ()
defaultUnsafeFillMutableByteArrayT MutableByteArray s
mba Int
0 Int
n (StateT [Word64] (ST s) Word64 -> StateT [Word64] (ST s) ())
-> StateT [Word64] (ST s) Word64 -> StateT [Word64] (ST s) ()
forall a b. (a -> b) -> a -> b
$ do
      StateT [Word64] (ST s) [Word64]
forall s (m :: * -> *). MonadState s m => m s
get StateT [Word64] (ST s) [Word64]
-> ([Word64] -> StateT [Word64] (ST s) Word64)
-> StateT [Word64] (ST s) Word64
forall a b.
StateT [Word64] (ST s) a
-> (a -> StateT [Word64] (ST s) b) -> StateT [Word64] (ST s) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        [] -> Word64 -> StateT [Word64] (ST s) Word64
forall a. a -> StateT [Word64] (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word64
0
        Word64
w:[Word64]
ws -> Word64
w Word64
-> StateT [Word64] (ST s) () -> StateT [Word64] (ST s) Word64
forall a b.
a -> StateT [Word64] (ST s) b -> StateT [Word64] (ST s) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Word64] -> StateT [Word64] (ST s) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put [Word64]
ws
  MutableByteArray s -> ST s ByteArray
forall s. MutableByteArray s -> ST s ByteArray
freezeMutableByteArray MutableByteArray s
mba

-- | Convert a `Seed` to a list of 64bit words.
--
-- @since 1.3.0
nonEmptyFromSeed :: forall g. SeedGen g => Seed g -> NonEmpty Word64
nonEmptyFromSeed :: forall g. SeedGen g => Seed g -> NonEmpty Word64
nonEmptyFromSeed (Seed ByteArray
ba) =
  case [Word64] -> Maybe (NonEmpty Word64)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([Word64] -> Maybe (NonEmpty Word64))
-> [Word64] -> Maybe (NonEmpty Word64)
forall a b. (a -> b) -> a -> b
$ [Word64] -> [Word64]
forall a. [a] -> [a]
reverse ([Word64] -> [Word64]) -> [Word64] -> [Word64]
forall a b. (a -> b) -> a -> b
$ Int -> [Word64] -> [Word64]
goWord64 Int
0 [] of
    Just NonEmpty Word64
ne -> NonEmpty Word64
ne
    Maybe (NonEmpty Word64)
Nothing -> -- Seed is at least 1 byte in size, so it can't be empty
      String -> NonEmpty Word64
forall a. HasCallStack => String -> a
error (String -> NonEmpty Word64) -> String -> NonEmpty Word64
forall a b. (a -> b) -> a -> b
$ String
"Impossible: Seed for "
           String -> String -> String
forall a. [a] -> [a] -> [a]
++ forall g. SeedGen g => String
seedGenTypeName @g
           String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" must be at least: "
           String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (forall g. SeedGen g => Int
seedSize @g)
           String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" bytes, but got "
           String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
  where
    n :: Int
n = ByteArray -> Int
sizeOfByteArray ByteArray
ba
    n8 :: Int
n8 = Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
8)
    goWord64 :: Int -> [Word64] -> [Word64]
goWord64 Int
i ![Word64]
acc
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n8 = Int -> [Word64] -> [Word64]
goWord64 (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8) (ByteArray -> Int -> Word64
indexWord64LE ByteArray
ba Int
i Word64 -> [Word64] -> [Word64]
forall a. a -> [a] -> [a]
: [Word64]
acc)
      | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n = [Word64]
acc
      | Bool
otherwise = ByteArray -> Int -> Int -> Word64
indexByteSliceWord64LE ByteArray
ba Int
i Int
n Word64 -> [Word64] -> [Word64]
forall a. a -> [a] -> [a]
: [Word64]
acc