git.iko.soy/typeable/entropy
on main help sign in
14 files changed+697−196
since splitsnapshots
unifiedsplit
.github/workflows/haskell-ci.yml+264 .gitignore+2 .travis.yml−5 README.md+29−9 Setup.hs+74−16 System/Entropy.hs+8−9 System/EntropyGhcjs.hs+51 System/EntropyNix.hs+58−9 System/EntropyWindows.hs+31−30 System/EntropyXen.hs−76 cabal.haskell-ci+3 cbits/getrandom.c+52 cbits/random_initialized.c+58 entropy.cabal+67−42
.github/workflows/haskell-ci.ymlnew file+264
@@ -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
.gitignorenew file+2
@@ -0,0 +1,2 @@
1+dist
2+dist-newstyle
.travis.ymldeleted−5
@@ -1,5 +0,0 @@
1−language: haskell
2−ghc:
3− - 8.2
4− - 8.0
5− - 7.10
README.md+29−9
@@ -2,20 +2,40 @@
22
33This package allows Haskell users to easily acquire entropy for use in critical
44security applications by calling out to either windows crypto api, unix/linux's
5−`/dev/urandom`. Hardware RNGs (currently RDRAND, patches welcome) are supported
6−via the `hardwareRNG` function.
5+`getrandom` and `/dev/urandom`. Hardware RNGs (currently RDRAND, patches
6+welcome) are supported via the `hardwareRNG` function.
77
8−If you wish to obtain an XOR of the hardware and system RNG consider:
8+## Quick Start
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:
929
1030```
11−import Data.Bits (xor)
1231import qualified Data.ByteString as B
13−import qualified Control.Exception as X
32+import System.Entropy
33+
34+eitherRNG :: Int -> IO B.ByteString
35+eitherRNG sz = maybe (getEntropy sz) pure =<< getHardwareEntropy sz
1436
15−xorRNG sz = do hw <- hardwareRNG sz
16− h <- openHandle
17− sys <- hGetEntropy h `X.finally` closeHandle h
18− pure $ B.pack $ B.zipWith xor hw sys
37+main :: IO ()
38+main = print . B.unpack =<< eitherRNG 32
1939```
2040
2141This package supports Windows, {li,u}nix, QNX, and has preliminary support for HaLVM.
Setup.hs+74−16
@@ -20,23 +20,26 @@ main = defaultMainWithHooks hk
2020 let mConf = lookupProgram ghcProgram (withPrograms lbi)
2121 err = error "Could not determine C compiler"
2222 cc = locationPath . programLocation . maybe err id $ mConf
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
23+ lbiNew <- checkRDRAND cc lbi >>= checkGetrandom cc >>= checkGetentropy cc
2724 buildHook simpleUserHooks pd lbiNew uh bf
2825 }
2926
30−cArgs :: [String]
31−cArgs = ["-DHAVE_RDRAND"]
27+compileCheck :: FilePath -> String -> String -> String -> IO Bool
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)
3234
33−cArgsHC :: [String]
34−cArgsHC = cArgs ++ map ("-optc" ++) cArgs
35+addOptions :: [String] -> [String] -> LocalBuildInfo -> LocalBuildInfo
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
3539
36−canUseRDRAND :: FilePath -> IO Bool
37−canUseRDRAND cc = do
38− withTempDirectory normal "" "testRDRAND" $ \tmpDir -> do
39− writeFile (tmpDir ++ "/testRDRAND.c")
40+checkRDRAND :: FilePath -> LocalBuildInfo -> IO LocalBuildInfo
41+checkRDRAND cc lbi = do
42+ b <- compileCheck cc "testRDRAND" "Result of RDRAND Test: "
4043 (unlines [ "#include <stdint.h>"
4144 , "int main() {"
4245 , " uint64_t therand;"
@@ -46,12 +49,67 @@ canUseRDRAND cc = do
4649 , " return (!err);"
4750 , "}"
4851 ])
49− ec <- myRawSystemExitCode normal cc [tmpDir </> "testRDRAND.c", "-o", tmpDir ++ "/a.o","-c"]
50− notice normal $ "Result of RDRAND Test: " ++ show (ec == ExitSuccess)
51− return (ec == ExitSuccess)
52+ return $ if b then addOptions cArgs cArgs lbi else lbi
53+ where cArgs = ["-DHAVE_RDRAND"]
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"]
52107
53108myRawSystemExitCode :: Verbosity -> FilePath -> [String] -> IO ExitCode
54−#if __GLASGOW_HASKELL__ >= 704
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
55113-- We know for sure, that if GHC >= 7.4 implies Cabal >= 1.14
56114myRawSystemExitCode = rawSystemExitCode
57115#else
System/Entropy.hs+8−9
@@ -11,7 +11,7 @@
1111 - Windows via CryptoAPI
1212 - *nix systems via @\/dev\/urandom@
1313 - Includes QNX
14− - Xen (only when RDRAND is available)
14+ - ghcjs/browser via JavaScript crypto API.
1515-}
1616
1717module System.Entropy
@@ -22,26 +22,25 @@ module System.Entropy
2222 hGetEntropy,
2323 closeHandle
2424 ) where
25−#if defined(isWindows)
25+
26+#ifdef ghcjs_HOST_OS
27+import System.EntropyGhcjs
28+#elif defined(isWindows)
2629import System.EntropyWindows
2730#else
28−#ifdef XEN
29−import System.EntropyXen
30−#else
3131import System.EntropyNix
3232#endif
33−#endif
3433
3534import qualified Data.ByteString as B
3635import Control.Exception (bracket)
3736
3837-- |Get a specific number of bytes of cryptographically
39−-- secure random data using the *system-specific* sources.
40−-- (As of 0.4. Verions <0.4 mixed system and hardware sources)
38+-- secure random data using the *system-specific* sources.
39+-- (As of 0.4. Versions <0.4 mixed system and hardware sources)
4140--
4241-- The returned random value is considered cryptographically secure but not true entropy.
4342--
44−-- 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
4544-- exhaustion in some situations.
4645getEntropy :: Int -- ^ Number of bytes
4746 -> IO B.ByteString
System/EntropyGhcjs.hsnew file+51
@@ -0,0 +1,51 @@
1+{-|
2+ Maintainer: Thomas.DuBuisson@gmail.com
3+ Stability: beta
4+ Portability: portable
5+
6+ Obtain entropy from system sources or x86 RDRAND when available.
7+
8+-}
9+
10+module System.EntropyGhcjs
11+ ( CryptHandle
12+ , openHandle
13+ , hGetEntropy
14+ , closeHandle
15+ , hardwareRandom
16+ ) where
17+
18+import Data.ByteString as B
19+import GHCJS.DOM.Crypto as Crypto
20+import GHCJS.DOM.Types (ArrayBufferView (..), fromJSValUnchecked)
21+import GHCJS.DOM.GlobalCrypto (getCrypto)
22+import GHCJS.DOM (globalThisUnchecked)
23+import Language.Javascript.JSaddle.Object as JS
24+
25+
26+-- |Handle for manual resource management
27+newtype CryptHandle = CH Crypto
28+
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.
33+hardwareRandom :: Int -> IO (Maybe B.ByteString)
34+hardwareRandom _ = pure Nothing
35+
36+-- |Open a `CryptHandle`
37+openHandle :: IO CryptHandle
38+openHandle = do
39+ this <- globalThisUnchecked
40+ CH <$> getCrypto this
41+
42+-- |Close the `CryptHandle`
43+closeHandle :: CryptHandle -> IO ()
44+closeHandle _ = pure ()
45+
46+-- |Read random data from a `CryptHandle`
47+hGetEntropy :: CryptHandle -> Int -> IO B.ByteString
48+hGetEntropy (CH h) n = do
49+ arr <- JS.new (jsg "Int8Array") [n]
50+ getRandomValues_ h (ArrayBufferView arr)
51+ B.pack <$> fromJSValUnchecked arr
System/EntropyNix.hs+58−9
@@ -16,13 +16,16 @@ module System.EntropyNix
1616 , hardwareRandom
1717 ) where
1818
19+import Control.Exception
1920import Control.Monad (liftM, when)
2021import Data.ByteString as B
2122import System.IO.Error (mkIOError, eofErrorType, ioeSetErrorString)
23+import System.IO.Unsafe
2224import Data.Bits (xor)
2325
2426import Foreign (allocaBytes)
2527import Foreign.Ptr
28+import Foreign.C.Error
2629import Foreign.C.Types
2730import Data.ByteString.Internal as B
2831
@@ -31,7 +34,7 @@ import Data.ByteString.Internal as B
3134#undef HAVE_RDRAND
3235#endif
3336
34−import System.Posix (openFd, closeFd, fdReadBuf, OpenMode(..), defaultFileFlags, Fd)
37+import System.Posix (openFd, closeFd, fdReadBuf, OpenMode(..), defaultFileFlags, Fd, OpenFileFlags(..))
3538
3639source :: FilePath
3740source = "/dev/urandom"
@@ -39,8 +42,11 @@ source = "/dev/urandom"
3942-- |Handle for manual resource management
4043data CryptHandle
4144 = CH Fd
45+#ifdef HAVE_GETRANDOM
46+ | UseGetRandom
47+#endif
4248
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
4450-- supported hardware RNG is available.
4551--
4652-- Supported hardware:
@@ -50,8 +56,7 @@ hardwareRandom :: Int -> IO (Maybe B.ByteString)
5056#ifdef HAVE_RDRAND
5157hardwareRandom n =
5258 do b <- cpuHasRdRand
53− if b
54− then Just <$> B.create n (\ptr ->
59+ if b then Just <$> B.create n (\ptr ->
5560 do r <- c_get_rand_bytes (castPtr ptr) (fromIntegral n)
5661 when (r /= 0) (fail "RDRand failed to gather entropy"))
5762 else pure Nothing
@@ -61,18 +66,40 @@ hardwareRandom _ = pure Nothing
6166
6267-- |Open a `CryptHandle`
6368openHandle :: IO CryptHandle
64−openHandle = do CH `fmap` nonRDRandHandle
65− where
66− nonRDRandHandle :: IO Fd
67− nonRDRandHandle = openFd source ReadOnly Nothing defaultFileFlags
69+openHandle =
70+#ifdef HAVE_GETRANDOM
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
81+ openFd source ReadOnly Nothing defaultFileFlags
82+#endif
6883
6984-- |Close the `CryptHandle`
7085closeHandle :: CryptHandle -> IO ()
7186closeHandle (CH h) = closeFd h
87+#ifdef HAVE_GETRANDOM
88+closeHandle UseGetRandom = return ()
89+#endif
7290
7391-- |Read random data from a `CryptHandle`
7492hGetEntropy :: 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
76103
77104fdReadBS :: Fd -> Int -> IO B.ByteString
78105fdReadBS fd n =
@@ -86,6 +113,28 @@ fdReadBS fd n =
86113 n' -> go buf (cnt - fromIntegral n')
87114 go _ _ = error "Impossible! The count of bytes left to read is greater than the request or less than zero!"
88115
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+
89138#ifdef HAVE_RDRAND
90139foreign import ccall unsafe "cpu_has_rdrand"
91140 c_cpu_has_rdrand :: IO CInt
System/EntropyWindows.hs+31−30
@@ -17,6 +17,7 @@ module System.EntropyWindows
1717
1818import Control.Monad (liftM, when)
1919import System.IO.Error (mkIOError, eofErrorType, ioeSetErrorString)
20+import System.Win32.Types (ULONG_PTR, errorWin)
2021import Foreign (allocaBytes)
2122import Data.ByteString as B
2223import Data.ByteString.Internal as BI
@@ -30,21 +31,20 @@ import Foreign.Marshal.Alloc (alloca)
3031import Foreign.Marshal.Utils (toBool)
3132import Foreign.Storable (peek)
3233
33−{- C example for windows rng - taken from a blog, can't recall which one but thank you!
34− #include <Windows.h>
35− #include <Wincrypt.h>
36− ...
37− //
38− // DISCLAIMER: Don't forget to check your error codes!!
39− // I am not checking as to make the example simple...
40− //
41− HCRYPTPROV hCryptCtx = NULL;
42− BYTE randomArray[128];
43−
44− CryptAcquireContext(&hCryptCtx, NULL, MS_DEF_PROV, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT);
45− CryptGenRandom(hCryptCtx, 128, randomArray);
46− CryptReleaseContext(hCryptCtx, 0);
47−-}
34+-- C example for windows rng - taken from a blog, can't recall which one but thank you!
35+-- #include <Windows.h>
36+-- #include <Wincrypt.h>
37+-- ...
38+-- //
39+-- // DISCLAIMER: Don't forget to check your error codes!!
40+-- // I am not checking as to make the example simple...
41+-- //
42+-- HCRYPTPROV hCryptCtx = NULL;
43+-- BYTE randomArray[128];
44+--
45+-- CryptAcquireContext(&hCryptCtx, NULL, MS_DEF_PROV, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT);
46+-- CryptGenRandom(hCryptCtx, 128, randomArray);
47+-- CryptReleaseContext(hCryptCtx, 0);
4848
4949
5050#ifdef arch_i386
@@ -63,11 +63,12 @@ cpuHasRdRand :: IO Bool
6363cpuHasRdRand = (/= 0) `fmap` c_cpu_has_rdrand
6464#endif
6565
66+type HCRYPTPROV = ULONG_PTR
6667data CryptHandle
67− = CH Word32
68+ = CH HCRYPTPROV
6869
6970
70−-- | 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
7172-- supported hardware RNG is available.
7273--
7374-- Supported hardware:
@@ -86,7 +87,7 @@ hardwareRandom n =
8687hardwareRandom _ = pure Nothing
8788#endif
8889
89−-- Define the constants we need from WinCrypt.h
90+-- Define the constants we need from WinCrypt.h
9091msDefProv :: String
9192msDefProv = "Microsoft Base Cryptographic Provider v1.0"
9293provRSAFull :: Word32
@@ -94,37 +95,37 @@ provRSAFull = 1
9495cryptVerifyContext :: Word32
9596cryptVerifyContext = fromIntegral 0xF0000000
9697
97−-- Declare the required CryptoAPI imports
98+-- Declare the required CryptoAPI imports
9899foreign import stdcall unsafe "CryptAcquireContextA"
99− c_cryptAcquireCtx :: Ptr Word32 -> CString -> CString -> Word32 -> Word32 -> IO Int32
100+ c_cryptAcquireCtx :: Ptr HCRYPTPROV -> CString -> CString -> Word32 -> Word32 -> IO Int32
100101foreign import stdcall unsafe "CryptGenRandom"
101− c_cryptGenRandom :: Word32 -> Word32 -> Ptr Word8 -> IO Int32
102+ c_cryptGenRandom :: HCRYPTPROV -> Word32 -> Ptr Word8 -> IO Int32
102103foreign import stdcall unsafe "CryptReleaseContext"
103− c_cryptReleaseCtx :: Word32 -> Word32 -> IO Int32
104+ c_cryptReleaseCtx :: HCRYPTPROV -> Word32 -> IO Int32
104105
105−cryptAcquireCtx :: IO Word32
106+cryptAcquireCtx :: IO HCRYPTPROV
106107cryptAcquireCtx =
107− alloca $ \handlePtr ->
108+ alloca $ \handlePtr ->
108109 withCString msDefProv $ \provName -> do
109110 stat <- c_cryptAcquireCtx handlePtr nullPtr provName provRSAFull cryptVerifyContext
110111 if (toBool stat)
111112 then peek handlePtr
112− else fail "c_cryptAcquireCtx"
113+ else errorWin "c_cryptAcquireCtx"
113114
114−cryptGenRandom :: Word32 -> Int -> IO B.ByteString
115−cryptGenRandom h i =
115+cryptGenRandom :: HCRYPTPROV -> Int -> IO B.ByteString
116+cryptGenRandom h i =
116117 BI.create i $ \c_buffer -> do
117118 stat <- c_cryptGenRandom h (fromIntegral i) c_buffer
118119 if (toBool stat)
119120 then return ()
120− else fail "c_cryptGenRandom"
121+ else errorWin "c_cryptGenRandom"
121122
122−cryptReleaseCtx :: Word32 -> IO ()
123+cryptReleaseCtx :: HCRYPTPROV -> IO ()
123124cryptReleaseCtx h = do
124125 stat <- c_cryptReleaseCtx h 0
125126 if (toBool stat)
126127 then return ()
127− else fail "c_cryptReleaseCtx"
128+ else errorWin "c_cryptReleaseCtx"
128129
129130-- |Open a handle from which random data can be read
130131openHandle :: IO CryptHandle
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
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.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>
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+67−42
@@ -1,6 +1,7 @@
1+cabal-version: >=1.10
12name: entropy
2−version: 0.4.1.1
3−description: A mostly platform independent (not GHCJS) method to obtain cryptographically strong entropy
3+version: 0.4.1.11
4+description: A mostly platform independent method to obtain cryptographically strong entropy
45 (RDRAND, urandom, CryptAPI, and patches welcome)
56 Users looking for cryptographically strong (number-theoretically
67 sound) PRNGs should see the 'DRBG' package too.
@@ -14,64 +15,88 @@ category: Data, Cryptography
1415homepage: https://github.com/TomMD/entropy
1516bug-reports: https://github.com/TomMD/entropy/issues
1617stability: stable
17−-- build-type: Simple
18−-- ^^ Used for HaLVM
18+
1919build-type: Custom
20−-- ^^ Test for RDRAND support using 'ghc'
21−cabal-version: >=1.10
22−tested-with: GHC == 8.2.2
23−-- data-files:
24−extra-source-files: ./cbits/rdrand.c, ./cbits/rdrand.h, README.md
2520
26−-- Notice to compile with HaLVM the above 'build-type' must be changed
27−-- to 'Simple' instead of 'Custom'. The current build system naively
28−-- runs GHC to determine if the compiler supports RDRAND before proceeding.
29−flag halvm
30− description: Build for the HaLVM
31− default: False
21+tested-with:
22+ GHC == 9.12.1
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
3234
35+extra-source-files:
36+ ./cbits/getrandom.c
37+ ./cbits/random_initialized.c
38+ ./cbits/rdrand.c
39+ ./cbits/rdrand.h
40+ README.md
41+
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
3347
3448custom-setup
35− setup-depends: Cabal >= 1.10 && < 2.3
49+ setup-depends: Cabal >= 1.10 && < 3.17
3650 , base < 5
37− , filepath < 1.5
51+ , filepath < 1.6
3852 , directory < 1.4
3953 , process < 1.7
4054
4155library
4256 ghc-options: -O2
4357 exposed-modules: System.Entropy
44− if os(windows)
45− other-modules: System.EntropyWindows
58+ if impl(ghcjs) || os(ghcjs) || arch(wasm32)
59+ other-modules: System.EntropyGhcjs
4660 else {
47− if os(halvm)
48− other-modules: System.EntropyXen
49− else
50− other-modules: System.EntropyNix
61+ if os(windows)
62+ other-modules: System.EntropyWindows
63+ else {
64+ other-modules: System.EntropyNix
65+ }
5166 }
5267 other-extensions: CPP, ForeignFunctionInterface, BangPatterns,
5368 ScopedTypeVariables
5469 build-depends: base >= 4.8 && < 5, bytestring
70+
5571 default-language: Haskell2010
56− if(os(halvm))
57− cpp-options: -DXEN -DHAVE_RDRAND
58− cc-options: -DXEN -DHAVE_RDRAND
59− if arch(x86_64)
60− cpp-options: -Darch_x86_64
61− cc-options: -Darch_x86_64 -O2
62− -- gcc 4.8.2 on i386 fails to compile rdrand.c when using -fPIC!
63− c-sources: cbits/rdrand.c
64− include-dirs: cbits
65− if arch(i386)
66− cpp-options: -Darch_i386
67− cc-options: -Darch_i386 -O2
68− if os(windows)
69− cpp-options: -DisWindows
70− cc-options: -DisWindows
71− extra-libraries: advapi32
72− else
73− if !os(halvm)
74− Build-Depends: unix
72+
73+ if impl(ghcjs) || os(ghcjs) || arch(wasm32) {
74+ build-depends: ghcjs-dom >= 0.9.5.0 && < 1
75+ , jsaddle
76+ }
77+ else {
78+ if arch(x86_64)
79+ cpp-options: -Darch_x86_64
80+ cc-options: -Darch_x86_64 -O2
81+ -- gcc 4.8.2 on i386 fails to compile rdrand.c when using -fPIC!
82+ c-sources: cbits/rdrand.c
83+ include-dirs: cbits
84+ if arch(i386)
85+ cpp-options: -Darch_i386
86+ cc-options: -Darch_i386 -O2
87+ if os(windows)
88+ build-depends: Win32 >= 2.5
89+ cpp-options: -DisWindows
90+ cc-options: -DisWindows
91+ extra-libraries: advapi32
92+ else
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
98+ }
99+
75100
76101source-repository head
77102 type: git