main..848acd8 · typeable/entropy

git.iko.soy/typeable/entropy

on 848acd8 help sign in

.github/workflows/haskell-ci.ymldeleted−264

since splitsnapshots

unifiedsplit

@@ -1,264 +0,0 @@

1−# This GitHub workflow config has been generated by a script via

2−#

3−# haskell-ci 'github' 'entropy.cabal'

4−#

5−# To regenerate the script (for example after adjusting tested-with) run

6−#

7−# haskell-ci regenerate

8−#

9−# For more information, see https://github.com/andreasabel/haskell-ci

10−#

11−# version: 0.19.20241219

12−#

13−# REGENDATA ("0.19.20241219",["github","entropy.cabal"])

14−#

15−name: Haskell-CI

16−on:

17− push:

18− branches:

19− - main

20− pull_request:

21− branches:

22− - main

23−jobs:

24− linux:

25− name: Haskell-CI - Linux - ${{ matrix.compiler }}

26− runs-on: ubuntu-20.04

27− timeout-minutes:

28− 60

29− container:

30− image: buildpack-deps:jammy

31− continue-on-error: ${{ matrix.allow-failure }}

32− strategy:

33− matrix:

34− include:

35− - compiler: ghc-9.12.1

36− compilerKind: ghc

37− compilerVersion: 9.12.1

38− setup-method: ghcup

39− allow-failure: false

40− - compiler: ghc-9.10.1

41− compilerKind: ghc

42− compilerVersion: 9.10.1

43− setup-method: ghcup

44− allow-failure: false

45− - compiler: ghc-9.8.4

46− compilerKind: ghc

47− compilerVersion: 9.8.4

48− setup-method: ghcup

49− allow-failure: false

50− - compiler: ghc-9.6.6

51− compilerKind: ghc

52− compilerVersion: 9.6.6

53− setup-method: ghcup

54− allow-failure: false

55− - compiler: ghc-9.4.8

56− compilerKind: ghc

57− compilerVersion: 9.4.8

58− setup-method: ghcup

59− allow-failure: false

60− - compiler: ghc-9.2.8

61− compilerKind: ghc

62− compilerVersion: 9.2.8

63− setup-method: ghcup

64− allow-failure: false

65− - compiler: ghc-9.0.2

66− compilerKind: ghc

67− compilerVersion: 9.0.2

68− setup-method: ghcup

69− allow-failure: false

70− - compiler: ghc-8.10.7

71− compilerKind: ghc

72− compilerVersion: 8.10.7

73− setup-method: ghcup

74− allow-failure: false

75− - compiler: ghc-8.8.4

76− compilerKind: ghc

77− compilerVersion: 8.8.4

78− setup-method: ghcup

79− allow-failure: false

80− - compiler: ghc-8.6.5

81− compilerKind: ghc

82− compilerVersion: 8.6.5

83− setup-method: ghcup

84− allow-failure: false

85− - compiler: ghc-8.4.4

86− compilerKind: ghc

87− compilerVersion: 8.4.4

88− setup-method: ghcup

89− allow-failure: false

90− - compiler: ghc-8.2.2

91− compilerKind: ghc

92− compilerVersion: 8.2.2

93− setup-method: ghcup

94− allow-failure: false

95− fail-fast: false

96− steps:

97− - name: apt-get install

98− run: |

99− apt-get update

100− apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 libnuma-dev

101− - name: Install GHCup

102− run: |

103− mkdir -p "$HOME/.ghcup/bin"

104− curl -sL https://downloads.haskell.org/ghcup/0.1.30.0/x86_64-linux-ghcup-0.1.30.0 > "$HOME/.ghcup/bin/ghcup"

105− chmod a+x "$HOME/.ghcup/bin/ghcup"

106− - name: Install cabal-install (prerelease)

107− run: |

108− "$HOME/.ghcup/bin/ghcup" config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.8.yaml;

109− "$HOME/.ghcup/bin/ghcup" install cabal 3.15.0.0.2024.10.3 || (cat "$HOME"/.ghcup/logs/*.* && false)

110− echo "CABAL=$HOME/.ghcup/bin/cabal-3.15.0.0.2024.10.3 -vnormal+nowrap" >> "$GITHUB_ENV"

111− - name: Install GHC (GHCup)

112− if: matrix.setup-method == 'ghcup'

113− run: |

114− "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false)

115− HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER")

116− HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#')

117− HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#')

118− echo "HC=$HC" >> "$GITHUB_ENV"

119− echo "HCPKG=$HCPKG" >> "$GITHUB_ENV"

120− echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV"

121− env:

122− HCKIND: ${{ matrix.compilerKind }}

123− HCNAME: ${{ matrix.compiler }}

124− HCVER: ${{ matrix.compilerVersion }}

125− - name: Set PATH and environment variables

126− run: |

127− echo "$HOME/.cabal/bin" >> $GITHUB_PATH

128− echo "LANG=C.UTF-8" >> "$GITHUB_ENV"

129− echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV"

130− echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV"

131− HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')

132− echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV"

133− echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV"

134− echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV"

135− if [ $((HCNUMVER >= 91200)) -ne 0 ] ; then echo "HEADHACKAGE=true" >> "$GITHUB_ENV" ; else echo "HEADHACKAGE=false" >> "$GITHUB_ENV" ; fi

136− echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV"

137− env:

138− HCKIND: ${{ matrix.compilerKind }}

139− HCNAME: ${{ matrix.compiler }}

140− HCVER: ${{ matrix.compilerVersion }}

141− - name: env

142− run: |

143− env

144− - name: write cabal config

145− run: |

146− mkdir -p $CABAL_DIR

147− cat >> $CABAL_CONFIG <<EOF

148− remote-build-reporting: anonymous

149− write-ghc-environment-files: never

150− remote-repo-cache: $CABAL_DIR/packages

151− logs-dir: $CABAL_DIR/logs

152− world-file: $CABAL_DIR/world

153− extra-prog-path: $CABAL_DIR/bin

154− symlink-bindir: $CABAL_DIR/bin

155− installdir: $CABAL_DIR/bin

156− build-summary: $CABAL_DIR/logs/build.log

157− store-dir: $CABAL_DIR/store

158− install-dirs user

159− prefix: $CABAL_DIR

160− repository hackage.haskell.org

161− url: http://hackage.haskell.org/

162− EOF

163− if $HEADHACKAGE; then

164− cat >> $CABAL_CONFIG <<EOF

165− repository head.hackage.ghc.haskell.org

166− url: https://ghc.gitlab.haskell.org/head.hackage/

167− secure: True

168− root-keys: 7541f32a4ccca4f97aea3b22f5e593ba2c0267546016b992dfadcd2fe944e55d

169− 26021a13b401500c8eb2761ca95c61f2d625bfef951b939a8124ed12ecf07329

170− f76d08be13e9a61a377a85e2fb63f4c5435d40f8feb3e12eb05905edb8cdea89

171− key-threshold: 3

172− active-repositories: hackage.haskell.org, head.hackage.ghc.haskell.org:override

173− EOF

174− fi

175− cat >> $CABAL_CONFIG <<EOF

176− program-default-options

177− ghc-options: $GHCJOBS +RTS -M3G -RTS

178− EOF

179− cat $CABAL_CONFIG

180− - name: versions

181− run: |

182− $HC --version || true

183− $HC --print-project-git-commit-id || true

184− $CABAL --version || true

185− - name: update cabal index

186− run: |

187− $CABAL v2-update -v

188− - name: install cabal-plan

189− run: |

190− mkdir -p $HOME/.cabal/bin

191− curl -sL https://github.com/haskell-hvr/cabal-plan/releases/download/v0.7.3.0/cabal-plan-0.7.3.0-x86_64-linux.xz > cabal-plan.xz

192− echo 'f62ccb2971567a5f638f2005ad3173dba14693a45154c1508645c52289714cb2 cabal-plan.xz' | sha256sum -c -

193− xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan

194− rm -f cabal-plan.xz

195− chmod a+x $HOME/.cabal/bin/cabal-plan

196− cabal-plan --version

197− - name: checkout

198− uses: actions/checkout@v4

199− with:

200− path: source

201− - name: initial cabal.project for sdist

202− run: |

203− touch cabal.project

204− echo "packages: $GITHUB_WORKSPACE/source/." >> cabal.project

205− cat cabal.project

206− - name: sdist

207− run: |

208− mkdir -p sdist

209− $CABAL sdist all --output-dir $GITHUB_WORKSPACE/sdist

210− - name: unpack

211− run: |

212− mkdir -p unpacked

213− find sdist -maxdepth 1 -type f -name '*.tar.gz' -exec tar -C $GITHUB_WORKSPACE/unpacked -xzvf {} \;

214− - name: generate cabal.project

215− run: |

216− PKGDIR_entropy="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/entropy-[0-9.]*')"

217− echo "PKGDIR_entropy=${PKGDIR_entropy}" >> "$GITHUB_ENV"

218− rm -f cabal.project cabal.project.local

219− touch cabal.project

220− touch cabal.project.local

221− echo "packages: ${PKGDIR_entropy}" >> cabal.project

222− echo "package entropy" >> cabal.project

223− echo " ghc-options: -Werror=missing-methods" >> cabal.project

224− cat >> cabal.project <<EOF

225− EOF

226− if $HEADHACKAGE; then

227− echo "allow-newer: $($HCPKG list --simple-output | sed -E 's/([a-zA-Z-]+)-[0-9.]+/*:\1,/g')" >> cabal.project

228− fi

229− $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: any.$_ installed\n" unless /^(entropy)$/; }' >> cabal.project.local

230− cat cabal.project

231− cat cabal.project.local

232− - name: dump install plan

233− run: |

234− $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all

235− cabal-plan

236− - name: restore cache

237− uses: actions/cache/restore@v4

238− with:

239− key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}

240− path: ~/.cabal/store

241− restore-keys: ${{ runner.os }}-${{ matrix.compiler }}-

242− - name: install dependencies

243− run: |

244− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --dependencies-only -j2 all

245− $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dependencies-only -j2 all

246− - name: build w/o tests

247− run: |

248− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all

249− - name: build

250− run: |

251− $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --write-ghc-environment-files=always

252− - name: haddock

253− run: |

254− $CABAL v2-haddock --disable-documentation --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all

255− - name: unconstrained build

256− run: |

257− rm -f cabal.project.local

258− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all

259− - name: save cache

260− if: always()

261− uses: actions/cache/save@v4

262− with:

263− key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}

264− path: ~/.cabal/store

.travis.ymlnew file+6

@@ -0,0 +1,6 @@

1+language: haskell

2+ghc:

3+ - 8.6

4+ - 8.4

5+ - 8.2

6+ - 8.0

README.md+9−29

@@ -2,40 +2,20 @@

3This package allows Haskell users to easily acquire entropy for use in critical

4security applications by calling out to either windows crypto api, unix/linux's

5−`getrandom` and `/dev/urandom`. Hardware RNGs (currently RDRAND, patches

5+`/dev/urandom`. Hardware RNGs (currently RDRAND, patches welcome) are supported

6−welcome) are supported via the `hardwareRNG` function.

6+via the `hardwareRNG` function.

8−## Quick Start

8+If you wish to obtain an XOR of the hardware and system RNG consider:

9−

10−To simply get random bytes use `getEntropy`:

11−

12−```

13−#!/usr/bin/env cabal

14−{- cabal:

15− build-depends: base, entropy, bytestring

16−-}

17−import qualified Data.ByteString as BS

18−import System.Entropy

19−

20−main :: IO ()

21−main = print . BS.unpack =<< getEntropy 16

22−-- Example output: [241,191,215,193,225,27,121,244,16,155,252,41,131,38,6,100]

23−```

24−

25−## Faster Randoms from Hardware

26−

27−Most x86 systems include a hardware random number generator. These can be

28−faster but require more trust in the platform:

30```

10```

11+import Data.Bits (xor)

31import qualified Data.ByteString as B

12import qualified Data.ByteString as B

32−import System.Entropy

13+import qualified Control.Exception as X

33−

34−eitherRNG :: Int -> IO B.ByteString

35−eitherRNG sz = maybe (getEntropy sz) pure =<< getHardwareEntropy sz

37−main :: IO ()

15+xorRNG sz = do hw <- hardwareRNG sz

38−main = print . B.unpack =<< eitherRNG 32

16+ h <- openHandle

17+ sys <- hGetEntropy h `X.finally` closeHandle h

18+ pure $ B.pack $ B.zipWith xor hw sys

39```

19```

41This package supports Windows, {li,u}nix, QNX, and has preliminary support for HaLVM.

21This package supports Windows, {li,u}nix, QNX, and has preliminary support for HaLVM.

Setup.hs+16−74

@@ -20,26 +20,23 @@ main = defaultMainWithHooks hk

20 let mConf = lookupProgram ghcProgram (withPrograms lbi)

21 err = error "Could not determine C compiler"

22 cc = locationPath . programLocation . maybe err id $ mConf

23− lbiNew <- checkRDRAND cc lbi >>= checkGetrandom cc >>= checkGetentropy cc

23+ b <- canUseRDRAND cc

24+ let newWithPrograms1 = userSpecifyArgs "gcc" cArgs (withPrograms lbi)

25+ newWithPrograms = userSpecifyArgs "ghc" cArgsHC newWithPrograms1

26+ lbiNew = if b then (lbi {withPrograms = newWithPrograms }) else lbi

24 buildHook simpleUserHooks pd lbiNew uh bf

27 buildHook simpleUserHooks pd lbiNew uh bf

25 }

28 }

27−compileCheck :: FilePath -> String -> String -> String -> IO Bool

30+cArgs :: [String]

28−compileCheck cc testName message sourceCode = do

31+cArgs = ["-DHAVE_RDRAND"]

29− withTempDirectory normal "" testName $ \tmpDir -> do

30− writeFile (tmpDir ++ "/" ++ testName ++ ".c") sourceCode

31− ec <- myRawSystemExitCode normal cc [tmpDir </> testName ++ ".c", "-o", tmpDir ++ "/a","-no-hs-main"]

32− notice normal $ message ++ show (ec == ExitSuccess)

33− return (ec == ExitSuccess)

35−addOptions :: [String] -> [String] -> LocalBuildInfo -> LocalBuildInfo

33+cArgsHC :: [String]

36−addOptions cArgs hsArgs lbi = lbi {withPrograms = newWithPrograms }

34+cArgsHC = cArgs ++ map ("-optc" ++) cArgs

37− where newWithPrograms1 = userSpecifyArgs "gcc" cArgs (withPrograms lbi)

38− newWithPrograms = userSpecifyArgs "ghc" (hsArgs ++ map ("-optc" ++) cArgs) newWithPrograms1

40−checkRDRAND :: FilePath -> LocalBuildInfo -> IO LocalBuildInfo

36+canUseRDRAND :: FilePath -> IO Bool

41−checkRDRAND cc lbi = do

37+canUseRDRAND cc = do

42− b <- compileCheck cc "testRDRAND" "Result of RDRAND Test: "

38+ withTempDirectory normal "" "testRDRAND" $ \tmpDir -> do

39+ writeFile (tmpDir ++ "/testRDRAND.c")

43 (unlines [ "#include <stdint.h>"

40 (unlines [ "#include <stdint.h>"

44 , "int main() {"

41 , "int main() {"

45 , " uint64_t therand;"

42 , " uint64_t therand;"

@@ -49,67 +46,12 @@ checkRDRAND cc lbi = do

49 , " return (!err);"

46 , " return (!err);"

50 , "}"

47 , "}"

51 ])

48 ])

52− return $ if b then addOptions cArgs cArgs lbi else lbi

49+ ec <- myRawSystemExitCode normal cc [tmpDir </> "testRDRAND.c", "-o", tmpDir ++ "/a.o","-c"]

53− where cArgs = ["-DHAVE_RDRAND"]

50+ notice normal $ "Result of RDRAND Test: " ++ show (ec == ExitSuccess)

54−

51+ return (ec == ExitSuccess)

55−checkGetrandom :: FilePath -> LocalBuildInfo -> IO LocalBuildInfo

56−checkGetrandom cc lbi = do

57− libcGetrandom <- compileCheck cc "testLibcGetrandom" "Result of libc getrandom() Test: "

58− (unlines [ "#define _GNU_SOURCE"

59− , "#include <errno.h>"

60− , "#include <sys/random.h>"

61−

62− , "int main()"

63− , "{"

64− , " char tmp;"

65− , " return getrandom(&tmp, sizeof(tmp), GRND_NONBLOCK) != -1;"

66− , "}"

67− ])

68− if libcGetrandom then return $ addOptions cArgsLibc cArgsLibc lbi

69− else do

70− syscallGetrandom <- compileCheck cc "testSyscallGetrandom" "Result of syscall getrandom() Test: "

71− (unlines [ "#define _GNU_SOURCE"

72− , "#include <errno.h>"

73− , "#include <unistd.h>"

74− , "#include <sys/syscall.h>"

75− , "#include <sys/types.h>"

76− , "#include <linux/random.h>"

77−

78− , "static ssize_t getrandom(void* buf, size_t buflen, unsigned int flags)"

79− , "{"

80− , " return syscall(SYS_getrandom, buf, buflen, flags);"

81− , "}"

82−

83− , "int main()"

84− , "{"

85− , " char tmp;"

86− , " return getrandom(&tmp, sizeof(tmp), GRND_NONBLOCK) != -1;"

87− , "}"

88− ])

89− return $ if syscallGetrandom then addOptions cArgs cArgs lbi else lbi

90− where cArgs = ["-DHAVE_GETRANDOM"]

91− cArgsLibc = cArgs ++ ["-DHAVE_LIBC_GETRANDOM"]

92−

93−checkGetentropy :: FilePath -> LocalBuildInfo -> IO LocalBuildInfo

94−checkGetentropy cc lbi = do

95− b <- compileCheck cc "testGetentropy" "Result of getentropy() Test: "

96− (unlines [ "#define _GNU_SOURCE"

97− , "#include <unistd.h>"

98−

99− , "int main()"

100− , "{"

101− , " char tmp;"

102− , " return getentropy(&tmp, sizeof(tmp));"

103− , "}"

104− ])

105− return $ if b then addOptions cArgs cArgs lbi else lbi

106− where cArgs = ["-DHAVE_GETENTROPY"]

107

108myRawSystemExitCode :: Verbosity -> FilePath -> [String] -> IO ExitCode

53myRawSystemExitCode :: Verbosity -> FilePath -> [String] -> IO ExitCode

109−#if MIN_VERSION_Cabal(3,14,0)

110−myRawSystemExitCode verbosity program arguments =

111− rawSystemExitCode verbosity Nothing program arguments Nothing

112−#elif __GLASGOW_HASKELL__ >= 704

54+#if __GLASGOW_HASKELL__ >= 704

113-- We know for sure, that if GHC >= 7.4 implies Cabal >= 1.14

55-- We know for sure, that if GHC >= 7.4 implies Cabal >= 1.14

114myRawSystemExitCode = rawSystemExitCode

56myRawSystemExitCode = rawSystemExitCode

115#else

57#else

System/Entropy.hs+5−2

@@ -11,6 +11,7 @@

11 - Windows via CryptoAPI

12 - *nix systems via @\/dev\/urandom@

13 - Includes QNX

14+ - Xen (only when RDRAND is available)

14 - ghcjs/browser via JavaScript crypto API.

15 - ghcjs/browser via JavaScript crypto API.

15-}

16-}

@@ -27,6 +28,8 @@ module System.Entropy

27import System.EntropyGhcjs

28import System.EntropyGhcjs

28#elif defined(isWindows)

29#elif defined(isWindows)

29import System.EntropyWindows

30import System.EntropyWindows

31+#elif XEN

32+import System.EntropyXen

30#else

33#else

31import System.EntropyNix

34import System.EntropyNix

32#endif

35#endif

@@ -36,11 +39,11 @@ import Control.Exception (bracket)

37-- |Get a specific number of bytes of cryptographically

40-- |Get a specific number of bytes of cryptographically

38-- secure random data using the *system-specific* sources.

41-- secure random data using the *system-specific* sources.

39−-- (As of 0.4. Versions <0.4 mixed system and hardware sources)

42+-- (As of 0.4. Verions <0.4 mixed system and hardware sources)

40--

43--

41-- The returned random value is considered cryptographically secure but not true entropy.

44-- The returned random value is considered cryptographically secure but not true entropy.

42--

45--

43−-- On some platforms this requires a file handle which can lead to resource

46+-- On some platforms this requies a file handle which can lead to resource

44-- exhaustion in some situations.

47-- exhaustion in some situations.

45getEntropy :: Int -- ^ Number of bytes

48getEntropy :: Int -- ^ Number of bytes

46 -> IO B.ByteString

49 -> IO B.ByteString

System/EntropyGhcjs.hs+4−4

@@ -19,14 +19,14 @@ import Data.ByteString as B

19import GHCJS.DOM.Crypto as Crypto

20import GHCJS.DOM.Types (ArrayBufferView (..), fromJSValUnchecked)

21import GHCJS.DOM.GlobalCrypto (getCrypto)

22−import GHCJS.DOM (globalThisUnchecked)

22+import GHCJS.DOM (currentWindowUnchecked)

23import Language.Javascript.JSaddle.Object as JS

26-- |Handle for manual resource management

27newtype CryptHandle = CH Crypto

29−-- | Get random values from the hardware RNG or return Nothing if no

29+-- | Get random values from the hardward RNG or return Nothing if no

30-- supported hardware RNG is available.

31--

32-- Not supported on ghcjs.

@@ -36,8 +36,8 @@ hardwareRandom _ = pure Nothing

36-- |Open a `CryptHandle`

37openHandle :: IO CryptHandle

38openHandle = do

39− this <- globalThisUnchecked

39+ w <- currentWindowUnchecked

40− CH <$> getCrypto this

40+ CH <$> getCrypto w

42-- |Close the `CryptHandle`

43closeHandle :: CryptHandle -> IO ()

System/EntropyNix.hs+9−58

@@ -16,16 +16,13 @@ module System.EntropyNix

16 , hardwareRandom

17 ) where

19−import Control.Exception

20import Control.Monad (liftM, when)

19import Control.Monad (liftM, when)

21import Data.ByteString as B

20import Data.ByteString as B

22import System.IO.Error (mkIOError, eofErrorType, ioeSetErrorString)

21import System.IO.Error (mkIOError, eofErrorType, ioeSetErrorString)

23−import System.IO.Unsafe

24import Data.Bits (xor)

22import Data.Bits (xor)

26import Foreign (allocaBytes)

24import Foreign (allocaBytes)

27import Foreign.Ptr

25import Foreign.Ptr

28−import Foreign.C.Error

29import Foreign.C.Types

26import Foreign.C.Types

30import Data.ByteString.Internal as B

27import Data.ByteString.Internal as B

@@ -34,7 +31,7 @@ import Data.ByteString.Internal as B

34#undef HAVE_RDRAND

31#undef HAVE_RDRAND

35#endif

32#endif

37−import System.Posix (openFd, closeFd, fdReadBuf, OpenMode(..), defaultFileFlags, Fd, OpenFileFlags(..))

34+import System.Posix (openFd, closeFd, fdReadBuf, OpenMode(..), defaultFileFlags, Fd)

39source :: FilePath

36source :: FilePath

40source = "/dev/urandom"

37source = "/dev/urandom"

@@ -42,11 +39,8 @@ source = "/dev/urandom"

42-- |Handle for manual resource management

39-- |Handle for manual resource management

43data CryptHandle

40data CryptHandle

44 = CH Fd

41 = CH Fd

45−#ifdef HAVE_GETRANDOM

46− | UseGetRandom

47−#endif

49−-- | Get random values from the hardware RNG or return Nothing if no

43+-- | Get random values from the hardward RNG or return Nothing if no

50-- supported hardware RNG is available.

44-- supported hardware RNG is available.

51--

45--

52-- Supported hardware:

46-- Supported hardware:

@@ -56,7 +50,8 @@ hardwareRandom :: Int -> IO (Maybe B.ByteString)

56#ifdef HAVE_RDRAND

50#ifdef HAVE_RDRAND

57hardwareRandom n =

51hardwareRandom n =

58 do b <- cpuHasRdRand

52 do b <- cpuHasRdRand

53+ if b

59− if b then Just <$> B.create n (\ptr ->

54+ then Just <$> B.create n (\ptr ->

60 do r <- c_get_rand_bytes (castPtr ptr) (fromIntegral n)

55 do r <- c_get_rand_bytes (castPtr ptr) (fromIntegral n)

61 when (r /= 0) (fail "RDRand failed to gather entropy"))

56 when (r /= 0) (fail "RDRand failed to gather entropy"))

62 else pure Nothing

57 else pure Nothing

@@ -66,40 +61,18 @@ hardwareRandom _ = pure Nothing

67-- |Open a `CryptHandle`

62-- |Open a `CryptHandle`

68openHandle :: IO CryptHandle

63openHandle :: IO CryptHandle

69−openHandle =

64+openHandle = do CH `fmap` nonRDRandHandle

70−#ifdef HAVE_GETRANDOM

65+ where

71− if systemHasGetRandom then return UseGetRandom else

66+ nonRDRandHandle :: IO Fd

72−#endif

73− fmap CH openRandomFile

74−

75−openRandomFile :: IO Fd

76−openRandomFile = do

77− evaluate ensurePoolInitialized

78−#if MIN_VERSION_unix(2,8,0)

79− openFd source ReadOnly defaultFileFlags { creat = Nothing }

80−#else

81− openFd source ReadOnly Nothing defaultFileFlags

67+ nonRDRandHandle = openFd source ReadOnly Nothing defaultFileFlags

82−#endif

84-- |Close the `CryptHandle`

69-- |Close the `CryptHandle`

85closeHandle :: CryptHandle -> IO ()

70closeHandle :: CryptHandle -> IO ()

86closeHandle (CH h) = closeFd h

71closeHandle (CH h) = closeFd h

87−#ifdef HAVE_GETRANDOM

88−closeHandle UseGetRandom = return ()

89−#endif

91-- |Read random data from a `CryptHandle`

73-- |Read random data from a `CryptHandle`

92hGetEntropy :: CryptHandle -> Int -> IO B.ByteString

74hGetEntropy :: CryptHandle -> Int -> IO B.ByteString

93−hGetEntropy (CH h) n = fdReadBS h n

75+hGetEntropy (CH h) = fdReadBS h

94−#ifdef HAVE_GETRANDOM

95−hGetEntropy UseGetRandom n = do

96− bs <- B.createUptoN n (\ptr -> do

97− r <- c_entropy_getrandom (castPtr ptr) (fromIntegral n)

98− return $ if r == 0 then n else 0)

99− if B.length bs == n then return bs

100− -- getrandom somehow failed. Fall back on /dev/urandom instead.

101− else bracket openRandomFile closeFd $ flip fdReadBS n

102−#endif

103

104fdReadBS :: Fd -> Int -> IO B.ByteString

77fdReadBS :: Fd -> Int -> IO B.ByteString

105fdReadBS fd n =

78fdReadBS fd n =

@@ -113,28 +86,6 @@ fdReadBS fd n =

113 n' -> go buf (cnt - fromIntegral n')

86 n' -> go buf (cnt - fromIntegral n')

114 go _ _ = error "Impossible! The count of bytes left to read is greater than the request or less than zero!"

87 go _ _ = error "Impossible! The count of bytes left to read is greater than the request or less than zero!"

115

116−#ifdef HAVE_GETRANDOM

117−foreign import ccall unsafe "system_has_getrandom"

118− c_system_has_getrandom :: IO CInt

119−foreign import ccall safe "entropy_getrandom"

120− c_entropy_getrandom :: Ptr CUChar -> CSize -> IO CInt

121−

122−-- NOINLINE and unsafePerformIO are not totally necessary as getrandom will be

123−-- consistently either present or not, but it is cheaper not to check multiple

124−-- times.

125−systemHasGetRandom :: Bool

126−{-# NOINLINE systemHasGetRandom #-}

127−systemHasGetRandom = unsafePerformIO $ fmap (/= 0) c_system_has_getrandom

128−#endif

129−

130−foreign import ccall safe "ensure_pool_initialized"

131− c_ensure_pool_initialized :: IO CInt

132−

133−-- Similarly to systemHasGetRandom, NOINLINE is just an optimization.

134−ensurePoolInitialized :: CInt

135−{-# NOINLINE ensurePoolInitialized #-}

136−ensurePoolInitialized = unsafePerformIO $ throwErrnoIfMinus1 "ensurePoolInitialized" $ c_ensure_pool_initialized

137−

138#ifdef HAVE_RDRAND

89#ifdef HAVE_RDRAND

139foreign import ccall unsafe "cpu_has_rdrand"

90foreign import ccall unsafe "cpu_has_rdrand"

140 c_cpu_has_rdrand :: IO CInt

91 c_cpu_has_rdrand :: IO CInt

System/EntropyWindows.hs+16−15

@@ -31,20 +31,21 @@ import Foreign.Marshal.Alloc (alloca)

31import Foreign.Marshal.Utils (toBool)

32import Foreign.Storable (peek)

34−-- C example for windows rng - taken from a blog, can't recall which one but thank you!

34+{- C example for windows rng - taken from a blog, can't recall which one but thank you!

35−-- #include <Windows.h>

35+ #include <Windows.h>

36−-- #include <Wincrypt.h>

36+ #include <Wincrypt.h>

37−-- ...

37+ ...

38−-- //

38+ //

39−-- // DISCLAIMER: Don't forget to check your error codes!!

39+ // DISCLAIMER: Don't forget to check your error codes!!

40−-- // I am not checking as to make the example simple...

40+ // I am not checking as to make the example simple...

41−-- //

41+ //

42−-- HCRYPTPROV hCryptCtx = NULL;

42+ HCRYPTPROV hCryptCtx = NULL;

43−-- BYTE randomArray[128];

43+ BYTE randomArray[128];

44−--

44+

45−-- CryptAcquireContext(&hCryptCtx, NULL, MS_DEF_PROV, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT);

45+ CryptAcquireContext(&hCryptCtx, NULL, MS_DEF_PROV, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT);

46−-- CryptGenRandom(hCryptCtx, 128, randomArray);

46+ CryptGenRandom(hCryptCtx, 128, randomArray);

47−-- CryptReleaseContext(hCryptCtx, 0);

47+ CryptReleaseContext(hCryptCtx, 0);

48+-}

50#ifdef arch_i386

51#ifdef arch_i386

@@ -68,7 +69,7 @@ data CryptHandle

68 = CH HCRYPTPROV

69 = CH HCRYPTPROV

71−-- | Get random values from the hardware RNG or return Nothing if no

72+-- | Get random values from the hardward RNG or return Nothing if no

72-- supported hardware RNG is available.

73-- supported hardware RNG is available.

73--

74--

74-- Supported hardware:

75-- Supported hardware:

System/EntropyXen.hsnew file+76

@@ -0,0 +1,76 @@

1+{-# LANGUAGE CPP, ForeignFunctionInterface, BangPatterns, ScopedTypeVariables #-}

2+{-|

3+ Maintainer: Thomas.DuBuisson@gmail.com

4+ Stability: beta

5+ Portability: portable

7+ Obtain entropy from RDRAND when available.

9+-}

10+

11+module System.EntropyXen

12+ ( CryptHandle

13+ , openHandle

14+ , hGetEntropy

15+ , closeHandle

16+ , hardwardRNG

17+ ) where

18+

19+import Control.Monad (liftM, when)

20+import Data.ByteString as B

21+import System.IO.Error (mkIOError, eofErrorType, ioeSetErrorString)

22+

23+import Foreign (allocaBytes)

24+import Foreign.Ptr

25+import Foreign.C.Types

26+import Data.ByteString.Internal as B

27+

28+#ifdef arch_i386

29+-- See .cabal wrt GCC 4.8.2 asm compilation bug

30+#undef HAVE_RDRAND

31+#endif

32+

33+#ifndef HAVE_RDRAND

34+#error "The entropy package requires RDRAND support when using the halvm/Xen"

35+#endif

36+data CryptHandle = UseRdRand -- or die trying

37+

38+-- |Open a `CryptHandle`

39+openHandle :: IO CryptHandle

40+openHandle = do

41+ b <- cpuHasRdRand

42+ if b then return UseRdRand

43+ else nonRDRandHandle

44+ where

45+ nonRDRandHandle :: IO CryptHandle

46+ nonRDRandHandle = error "entropy: On halvm there is no entropy other than RDRAND."

47+

48+-- |Close the `CryptHandle`

49+closeHandle :: CryptHandle -> IO ()

50+closeHandle UseRdRand = return ()

51+

52+-- | Get random values from the hardward RNG or return Nothing if no

53+-- supported hardware RNG is available.

54+--

55+-- Supported hardware:

56+-- * RDRAND

57+-- * Patches welcome

58+hardwareRandom :: Int -> IO (Maybe B.ByteString)

59+hardwareRandom sz = Just <$> hGetEntropy UseRdRand sz

60+

61+-- |Read random data from a `CryptHandle`, which uses RDRAND (when on Xen)

62+hGetEntropy :: CryptHandle -> Int -> IO B.ByteString

63+hGetEntropy UseRdRand = \n -> do

64+ B.create n $ \ptr -> do

65+ r <- c_get_rand_bytes (castPtr ptr) (fromIntegral n)

66+ when (r /= 0)

67+ (fail "RDRand failed to gather entropy")

68+

69+foreign import ccall unsafe "cpu_has_rdrand"

70+ c_cpu_has_rdrand :: IO CInt

71+

72+foreign import ccall unsafe "get_rand_bytes"

73+ c_get_rand_bytes :: Ptr CUChar -> CSize -> IO CInt

74+

75+cpuHasRdRand :: IO Bool

76+cpuHasRdRand = (/= 0) `fmap` c_cpu_has_rdrand

cabal.haskell-cideleted−3

@@ -1,3 +0,0 @@

1−branches: main

2−cabal-check: False

3−haddock: >=8.2

cbits/getrandom.cdeleted−52

@@ -1,52 +0,0 @@

1−#ifdef HAVE_GETRANDOM

2−

3−#define _GNU_SOURCE

4−#include <errno.h>

5−

6−#ifdef HAVE_LIBC_GETRANDOM

7−#include <sys/random.h>

8−#else

9−

10−#include <unistd.h>

11−#include <sys/syscall.h>

12−#include <sys/types.h>

13−#include <linux/random.h>

14−

15−#ifndef SYS_getrandom

16−#define SYS_getrandom __NR_getrandom

17−#endif

18−

19−static ssize_t getrandom(void* buf, size_t buflen, unsigned int flags)

20−{

21− return syscall(SYS_getrandom, buf, buflen, flags);

22−}

23−

24−#endif

25−

26−int system_has_getrandom()

27−{

28− char tmp;

29− return getrandom(&tmp, sizeof(tmp), GRND_NONBLOCK) != -1 || errno != ENOSYS;

30−}

31−

32−// Returns 0 on success, non-zero on failure.

33−int entropy_getrandom(unsigned char* buf, size_t len)

34−{

35− while (len) {

36− ssize_t bytes_read = getrandom(buf, len, 0);

37−

38− if (bytes_read == -1) {

39− if (errno != EINTR)

40− return -1;

41− else

42− continue;

43− }

44−

45− len -= bytes_read;

46− buf += bytes_read;

47− }

48−

49− return 0;

50−}

51−

52−#endif

cbits/random_initialized.cdeleted−58

@@ -1,58 +0,0 @@

1−#define _GNU_SOURCE

2−#include <errno.h>

3−#include <fcntl.h>

4−#include <poll.h>

5−#include <sys/stat.h>

6−#include <unistd.h>

7−

8−#ifdef HAVE_GETENTROPY

9−#ifndef DO_NOT_USE_GET_ENTROPY

10−static int ensure_pool_initialized_getentropy()

11−{

12− char tmp;

13− return getentropy(&tmp, sizeof(tmp));

14−}

15−#endif

16−#endif

17−

18−// Poll /dev/random to wait for randomness. This is a proxy for the /dev/urandom

19−// pool being initialized.

20−static int ensure_pool_initialized_poll()

21−{

22− struct pollfd pfd;

23− int dev_random = open("/dev/random", O_RDONLY);

24− if (dev_random == -1)

25− return -1;

26−

27− pfd.fd = dev_random;

28− pfd.events = POLLIN;

29− pfd.revents = 0;

30−

31− while (1) {

32− int ret = poll(&pfd, 1, -1);

33− if (ret < 0 && (errno == EAGAIN || errno == EINTR))

34− continue;

35− if (ret != 1) {

36− close(dev_random);

37− errno = EIO;

38− return -1;

39− }

40−

41− break;

42− }

43−

44− return close(dev_random);

45−}

46−

47−// Returns 0 on success, non-zero on failure.

48−int ensure_pool_initialized()

49−{

50−#ifdef HAVE_GETENTROPY

51−#ifndef DO_NOT_USE_GET_ENTROPY

52− if (ensure_pool_initialized_getentropy() == 0)

53− return 0;

54−#endif

55−#endif

56−

57− return ensure_pool_initialized_poll();

58−}

entropy.cabal+30−39

@@ -1,7 +1,6 @@

1−cabal-version: >=1.10

2name: entropy

1name: entropy

3−version: 0.4.1.11

2+version: 0.4.1.4

4−description: A mostly platform independent method to obtain cryptographically strong entropy

3+description: A mostly platform independent (not GHCJS) method to obtain cryptographically strong entropy

5 (RDRAND, urandom, CryptAPI, and patches welcome)

4 (RDRAND, urandom, CryptAPI, and patches welcome)

6 Users looking for cryptographically strong (number-theoretically

5 Users looking for cryptographically strong (number-theoretically

7 sound) PRNGs should see the 'DRBG' package too.

6 sound) PRNGs should see the 'DRBG' package too.

@@ -16,52 +15,44 @@ homepage: https://github.com/TomMD/entropy

16bug-reports: https://github.com/TomMD/entropy/issues

15bug-reports: https://github.com/TomMD/entropy/issues

17stability: stable

16stability: stable

18+-- build-type: Simple

19+-- ^^ Used for HaLVM

19build-type: Custom

20build-type: Custom

22+-- ^^ Test for RDRAND support using 'ghc'

23+cabal-version: >=1.10

21−tested-with:

24+tested-with: GHC == 8.2.2

22− GHC == 9.12.1

25+-- data-files:

23− GHC == 9.10.1

26+extra-source-files: ./cbits/rdrand.c, ./cbits/rdrand.h, README.md

24− GHC == 9.8.4

25− GHC == 9.6.6

26− GHC == 9.4.8

27− GHC == 9.2.8

28− GHC == 9.0.2

29− GHC == 8.10.7

30− GHC == 8.8.4

31− GHC == 8.6.5

32− GHC == 8.4.4

33− GHC == 8.2.2

35−extra-source-files:

28+-- Notice to compile with HaLVM the above 'build-type' must be changed

36− ./cbits/getrandom.c

29+-- to 'Simple' instead of 'Custom'. The current build system naively

37− ./cbits/random_initialized.c

30+-- runs GHC to determine if the compiler supports RDRAND before proceeding.

38− ./cbits/rdrand.c

31+flag halvm

39− ./cbits/rdrand.h

32+ description: Build for the HaLVM

40− README.md

33+ default: False

42−Flag DoNotGetEntropy

43− Description: Avoid use of the getentropy() *nix function. By default getentropy will be used

44− if detected during compilation (this plays poorly with cross compilation).

45− Default: False

46− Manual: True

48custom-setup

36custom-setup

49− setup-depends: Cabal >= 1.10 && < 3.17

37+ setup-depends: Cabal >= 1.10 && < 3.1

50 , base < 5

38 , base < 5

51− , filepath < 1.6

39+ , filepath < 1.5

52 , directory < 1.4

40 , directory < 1.4

53 , process < 1.7

41 , process < 1.7

55library

43library

56 ghc-options: -O2

44 ghc-options: -O2

57 exposed-modules: System.Entropy

45 exposed-modules: System.Entropy

58− if impl(ghcjs) || os(ghcjs) || arch(wasm32)

46+ if impl(ghcjs)

59 other-modules: System.EntropyGhcjs

47 other-modules: System.EntropyGhcjs

60 else {

48 else {

61 if os(windows)

49 if os(windows)

62 other-modules: System.EntropyWindows

50 other-modules: System.EntropyWindows

63 else {

51 else {

52+ if os(halvm)

53+ other-modules: System.EntropyXen

54+ else

64− other-modules: System.EntropyNix

55+ other-modules: System.EntropyNix

65 }

56 }

66 }

57 }

67 other-extensions: CPP, ForeignFunctionInterface, BangPatterns,

58 other-extensions: CPP, ForeignFunctionInterface, BangPatterns,

@@ -69,12 +60,15 @@ library

69 build-depends: base >= 4.8 && < 5, bytestring

60 build-depends: base >= 4.8 && < 5, bytestring

71 default-language: Haskell2010

62 default-language: Haskell2010

72−

63+

73− if impl(ghcjs) || os(ghcjs) || arch(wasm32) {

64+ if impl(ghcjs) {

74− build-depends: ghcjs-dom >= 0.9.5.0 && < 1

65+ build-depends: ghcjs-dom

75 , jsaddle

66 , jsaddle

76 }

67 }

77 else {

68 else {

69+ if(os(halvm))

70+ cpp-options: -DXEN -DHAVE_RDRAND

71+ cc-options: -DXEN -DHAVE_RDRAND

78 if arch(x86_64)

72 if arch(x86_64)

79 cpp-options: -Darch_x86_64

73 cpp-options: -Darch_x86_64

80 cc-options: -Darch_x86_64 -O2

74 cc-options: -Darch_x86_64 -O2

@@ -90,11 +84,8 @@ library

90 cc-options: -DisWindows

84 cc-options: -DisWindows

91 extra-libraries: advapi32

85 extra-libraries: advapi32

92 else

86 else

93− Build-Depends: unix

87+ if !os(halvm)

94− c-sources: cbits/getrandom.c cbits/random_initialized.c

88+ Build-Depends: unix

95− }

96− if flag(DoNotGetEntropy) {

97− cc-options: -DDO_NOT_USE_GET_ENTROPY

98 }

89 }

100