f693ea7...main · typeable/entropy

git.iko.soy/typeable/entropy

on main help sign in

.github/workflows/haskell-ci.ymlnew file+264

since splitsnapshots

unifiedsplit

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

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.ymldeleted−6

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

1−language: haskell

2−ghc:

3− - 8.6

4− - 8.4

5− - 8.2

6− - 8.0

README.md+2−2

@@ -2,8 +2,8 @@

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−`/dev/urandom`. Hardware RNGs (currently RDRAND, patches welcome) are supported

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

6−via the `hardwareRNG` function.

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

8## Quick Start

Setup.hs+74−16

@@ -20,23 +20,26 @@ 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− b <- canUseRDRAND cc

23+ lbiNew <- checkRDRAND cc lbi >>= checkGetrandom cc >>= checkGetentropy 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

27 buildHook simpleUserHooks pd lbiNew uh bf

24 buildHook simpleUserHooks pd lbiNew uh bf

28 }

25 }

30−cArgs :: [String]

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

31−cArgs = ["-DHAVE_RDRAND"]

28+compileCheck cc testName message sourceCode = do

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)

33−cArgsHC :: [String]

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

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

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

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

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

36−canUseRDRAND :: FilePath -> IO Bool

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

37−canUseRDRAND cc = do

41+checkRDRAND cc lbi = do

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

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

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

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

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

41 , "int main() {"

44 , "int main() {"

42 , " uint64_t therand;"

45 , " uint64_t therand;"

@@ -46,12 +49,67 @@ canUseRDRAND cc = do

46 , " return (!err);"

49 , " return (!err);"

47 , "}"

50 , "}"

48 ])

51 ])

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

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

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

53+ where cArgs = ["-DHAVE_RDRAND"]

51− return (ec == ExitSuccess)

54+

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

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

108myRawSystemExitCode :: 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

54−#if __GLASGOW_HASKELL__ >= 704

112+#elif __GLASGOW_HASKELL__ >= 704

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

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

56myRawSystemExitCode = rawSystemExitCode

114myRawSystemExitCode = rawSystemExitCode

57#else

115#else

System/Entropy.hs+2−5

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

11 - Windows via CryptoAPI

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

13 - Includes QNX

14− - Xen (only when RDRAND is available)

15 - ghcjs/browser via JavaScript crypto API.

14 - ghcjs/browser via JavaScript crypto API.

16-}

15-}

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

28import System.EntropyGhcjs

27import System.EntropyGhcjs

29#elif defined(isWindows)

28#elif defined(isWindows)

30import System.EntropyWindows

29import System.EntropyWindows

31−#elif XEN

32−import System.EntropyXen

33#else

30#else

34import System.EntropyNix

31import System.EntropyNix

35#endif

32#endif

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

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

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

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

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

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

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

43--

40--

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

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

45--

42--

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

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

47-- exhaustion in some situations.

44-- exhaustion in some situations.

48getEntropy :: Int -- ^ Number of bytes

45getEntropy :: Int -- ^ Number of bytes

49 -> IO B.ByteString

46 -> 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 (currentWindowUnchecked)

22+import GHCJS.DOM (globalThisUnchecked)

23import Language.Javascript.JSaddle.Object as JS

26-- |Handle for manual resource management

27newtype CryptHandle = CH Crypto

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

29+-- | Get random values from the hardware 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− w <- currentWindowUnchecked

39+ this <- globalThisUnchecked

40− CH <$> getCrypto w

40+ CH <$> getCrypto this

42-- |Close the `CryptHandle`

43closeHandle :: CryptHandle -> IO ()

System/EntropyNix.hs+58−9

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

16 , hardwareRandom

17 ) where

19+import Control.Exception

19import Control.Monad (liftM, when)

20import Control.Monad (liftM, when)

20import Data.ByteString as B

21import Data.ByteString as B

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

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

23+import System.IO.Unsafe

22import Data.Bits (xor)

24import Data.Bits (xor)

24import Foreign (allocaBytes)

26import Foreign (allocaBytes)

25import Foreign.Ptr

27import Foreign.Ptr

28+import Foreign.C.Error

26import Foreign.C.Types

29import Foreign.C.Types

27import Data.ByteString.Internal as B

30import Data.ByteString.Internal as B

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

31#undef HAVE_RDRAND

34#undef HAVE_RDRAND

32#endif

35#endif

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

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

36source :: FilePath

39source :: FilePath

37source = "/dev/urandom"

40source = "/dev/urandom"

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

39-- |Handle for manual resource management

42-- |Handle for manual resource management

40data CryptHandle

43data CryptHandle

41 = CH Fd

44 = CH Fd

45+#ifdef HAVE_GETRANDOM

46+ | UseGetRandom

47+#endif

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

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

44-- supported hardware RNG is available.

50-- supported hardware RNG is available.

45--

51--

46-- Supported hardware:

52-- Supported hardware:

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

50#ifdef HAVE_RDRAND

56#ifdef HAVE_RDRAND

51hardwareRandom n =

57hardwareRandom n =

52 do b <- cpuHasRdRand

58 do b <- cpuHasRdRand

53− if b

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

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

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

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

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

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

57 else pure Nothing

62 else pure Nothing

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

62-- |Open a `CryptHandle`

67-- |Open a `CryptHandle`

63openHandle :: IO CryptHandle

68openHandle :: IO CryptHandle

64−openHandle = do CH `fmap` nonRDRandHandle

69+openHandle =

65− where

70+#ifdef HAVE_GETRANDOM

66− nonRDRandHandle :: IO Fd

71+ if systemHasGetRandom then return UseGetRandom else

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

67− nonRDRandHandle = openFd source ReadOnly Nothing defaultFileFlags

81+ openFd source ReadOnly Nothing defaultFileFlags

82+#endif

69-- |Close the `CryptHandle`

84-- |Close the `CryptHandle`

70closeHandle :: CryptHandle -> IO ()

85closeHandle :: CryptHandle -> IO ()

71closeHandle (CH h) = closeFd h

86closeHandle (CH h) = closeFd h

87+#ifdef HAVE_GETRANDOM

88+closeHandle UseGetRandom = return ()

89+#endif

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

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

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

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

75−hGetEntropy (CH h) = fdReadBS h

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

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

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

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

78fdReadBS fd n =

105fdReadBS fd n =

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

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

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

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

114 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+

89#ifdef HAVE_RDRAND

138#ifdef HAVE_RDRAND

90foreign import ccall unsafe "cpu_has_rdrand"

139foreign import ccall unsafe "cpu_has_rdrand"

91 c_cpu_has_rdrand :: IO CInt

140 c_cpu_has_rdrand :: IO CInt

System/EntropyWindows.hs+15−16

@@ -31,21 +31,20 @@ 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−-}

51#ifdef arch_i386

50#ifdef arch_i386

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

69 = CH HCRYPTPROV

68 = CH HCRYPTPROV

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

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

73-- supported hardware RNG is available.

72-- supported hardware RNG is available.

74--

73--

75-- Supported hardware:

74-- Supported hardware:

System/EntropyXen.hsdeleted−76

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

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

2−{-|

3− Maintainer: Thomas.DuBuisson@gmail.com

4− Stability: beta

5− Portability: portable

6−

7− Obtain entropy from RDRAND when available.

8−

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-cinew file+3

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

1+branches: main

2+cabal-check: False

3+haddock: >=8.2

cbits/getrandom.cnew file+52

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

1+#ifdef HAVE_GETRANDOM

3+#define _GNU_SOURCE

4+#include <errno.h>

6+#ifdef HAVE_LIBC_GETRANDOM

7+#include <sys/random.h>

8+#else

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.cnew file+58

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

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>

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+39−30

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

1+cabal-version: >=1.10

1name: entropy

2name: entropy

2−version: 0.4.1.4

3+version: 0.4.1.11

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

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

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

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

5 Users looking for cryptographically strong (number-theoretically

6 Users looking for cryptographically strong (number-theoretically

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

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

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

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

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

16stability: stable

17stability: stable

18−-- build-type: Simple

19−-- ^^ Used for HaLVM

20build-type: Custom

19build-type: Custom

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

23−cabal-version: >=1.10

24−tested-with: GHC == 8.2.2

21+tested-with:

25−-- data-files:

22+ GHC == 9.12.1

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

23+ GHC == 9.10.1

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

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

35+extra-source-files:

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

36+ ./cbits/getrandom.c

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

37+ ./cbits/random_initialized.c

31−flag halvm

38+ ./cbits/rdrand.c

32− description: Build for the HaLVM

39+ ./cbits/rdrand.h

33− default: False

40+ README.md

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

36custom-setup

48custom-setup

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

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

38 , base < 5

50 , base < 5

39− , filepath < 1.5

51+ , filepath < 1.6

40 , directory < 1.4

52 , directory < 1.4

41 , process < 1.7

53 , process < 1.7

43library

55library

44 ghc-options: -O2

56 ghc-options: -O2

45 exposed-modules: System.Entropy

57 exposed-modules: System.Entropy

46− if impl(ghcjs)

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

47 other-modules: System.EntropyGhcjs

59 other-modules: System.EntropyGhcjs

48 else {

60 else {

49 if os(windows)

61 if os(windows)

50 other-modules: System.EntropyWindows

62 other-modules: System.EntropyWindows

51 else {

63 else {

52− if os(halvm)

53− other-modules: System.EntropyXen

54− else

55− other-modules: System.EntropyNix

64+ other-modules: System.EntropyNix

56 }

65 }

57 }

66 }

58 other-extensions: CPP, ForeignFunctionInterface, BangPatterns,

67 other-extensions: CPP, ForeignFunctionInterface, BangPatterns,

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

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

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

62 default-language: Haskell2010

71 default-language: Haskell2010

63−

72+

64− if impl(ghcjs) {

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

65− build-depends: ghcjs-dom

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

66 , jsaddle

75 , jsaddle

67 }

76 }

68 else {

77 else {

69− if(os(halvm))

70− cpp-options: -DXEN -DHAVE_RDRAND

71− cc-options: -DXEN -DHAVE_RDRAND

72 if arch(x86_64)

78 if arch(x86_64)

73 cpp-options: -Darch_x86_64

79 cpp-options: -Darch_x86_64

74 cc-options: -Darch_x86_64 -O2

80 cc-options: -Darch_x86_64 -O2

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

84 cc-options: -DisWindows

90 cc-options: -DisWindows

85 extra-libraries: advapi32

91 extra-libraries: advapi32

86 else

92 else

87− if !os(halvm)

88− Build-Depends: unix

93+ Build-Depends: unix

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

95+ }

96+ if flag(DoNotGetEntropy) {

97+ cc-options: -DDO_NOT_USE_GET_ENTROPY

89 }

98 }

100