git.iko.soy/typeable/entropy
on c682fcd help sign in
14 files changed+196−697
since splitsnapshots
unifiedsplit
.github/workflows/haskell-ci.yml−264 .gitignore−2 .travis.yml+5 README.md+9−29 Setup.hs+16−74 System/Entropy.hs+9−8 System/EntropyGhcjs.hs−51 System/EntropyNix.hs+9−58 System/EntropyWindows.hs+30−31 System/EntropyXen.hs+76 cabal.haskell-ci−3 cbits/getrandom.c−52 cbits/random_initialized.c−58 entropy.cabal+42−67
.github/workflows/haskell-ci.ymldeleted−264
@@ -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
.gitignoredeleted−2
@@ -1,2 +0,0 @@
1−dist
2−dist-newstyle
.travis.ymlnew file+5
@@ -0,0 +1,5 @@
1+language: haskell
2+ghc:
3+ - 8.2
4+ - 8.0
5+ - 7.10
README.md+9−29
@@ -2,40 +2,20 @@
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−`getrandom` and `/dev/urandom`. Hardware RNGs (currently RDRAND, patches
6−welcome) are supported via the `hardwareRNG` function.
5+`/dev/urandom`. Hardware RNGs (currently RDRAND, patches welcome) are supported
6+via the `hardwareRNG` function.
77
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:
8+If you wish to obtain an XOR of the hardware and system RNG consider:
299
3010```
11+import Data.Bits (xor)
3112import qualified Data.ByteString as B
32−import System.Entropy
33−
34−eitherRNG :: Int -> IO B.ByteString
35−eitherRNG sz = maybe (getEntropy sz) pure =<< getHardwareEntropy sz
13+import qualified Control.Exception as X
3614
37−main :: IO ()
38−main = print . B.unpack =<< eitherRNG 32
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
3919```
4020
4121This package supports Windows, {li,u}nix, QNX, and has preliminary support for HaLVM.
Setup.hs+16−74
@@ -20,26 +20,23 @@ 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− 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
2427 buildHook simpleUserHooks pd lbiNew uh bf
2528 }
2629
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)
30+cArgs :: [String]
31+cArgs = ["-DHAVE_RDRAND"]
3432
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
33+cArgsHC :: [String]
34+cArgsHC = cArgs ++ map ("-optc" ++) cArgs
3935
40−checkRDRAND :: FilePath -> LocalBuildInfo -> IO LocalBuildInfo
41−checkRDRAND cc lbi = do
42− b <- compileCheck cc "testRDRAND" "Result of RDRAND Test: "
36+canUseRDRAND :: FilePath -> IO Bool
37+canUseRDRAND cc = do
38+ withTempDirectory normal "" "testRDRAND" $ \tmpDir -> do
39+ writeFile (tmpDir ++ "/testRDRAND.c")
4340 (unlines [ "#include <stdint.h>"
4441 , "int main() {"
4542 , " uint64_t therand;"
@@ -49,67 +46,12 @@ checkRDRAND cc lbi = do
4946 , " return (!err);"
5047 , "}"
5148 ])
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"]
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)
10752
10853myRawSystemExitCode :: 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
11355-- We know for sure, that if GHC >= 7.4 implies Cabal >= 1.14
11456myRawSystemExitCode = rawSystemExitCode
11557#else
System/Entropy.hs+9−8
@@ -11,7 +11,7 @@
1111 - Windows via CryptoAPI
1212 - *nix systems via @\/dev\/urandom@
1313 - Includes QNX
14− - ghcjs/browser via JavaScript crypto API.
14+ - Xen (only when RDRAND is available)
1515-}
1616
1717module System.Entropy
@@ -22,25 +22,26 @@ module System.Entropy
2222 hGetEntropy,
2323 closeHandle
2424 ) where
25−
26−#ifdef ghcjs_HOST_OS
27−import System.EntropyGhcjs
28−#elif defined(isWindows)
25+#if defined(isWindows)
2926import System.EntropyWindows
3027#else
28+#ifdef XEN
29+import System.EntropyXen
30+#else
3131import System.EntropyNix
3232#endif
33+#endif
3334
3435import qualified Data.ByteString as B
3536import Control.Exception (bracket)
3637
3738-- |Get a specific number of bytes of cryptographically
38−-- secure random data using the *system-specific* sources.
39−-- (As of 0.4. Versions <0.4 mixed system and hardware sources)
39+-- secure random data using the *system-specific* sources.
40+-- (As of 0.4. Verions <0.4 mixed system and hardware sources)
4041--
4142-- The returned random value is considered cryptographically secure but not true entropy.
4243--
43−-- On some platforms this requires a file handle which can lead to resource
44+-- On some platforms this requies a file handle which can lead to resource
4445-- exhaustion in some situations.
4546getEntropy :: Int -- ^ Number of bytes
4647 -> IO B.ByteString
System/EntropyGhcjs.hsdeleted−51
@@ -1,51 +0,0 @@
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+9−58
@@ -16,16 +16,13 @@ module System.EntropyNix
1616 , hardwareRandom
1717 ) where
1818
19−import Control.Exception
2019import Control.Monad (liftM, when)
2120import Data.ByteString as B
2221import System.IO.Error (mkIOError, eofErrorType, ioeSetErrorString)
23−import System.IO.Unsafe
2422import Data.Bits (xor)
2523
2624import Foreign (allocaBytes)
2725import Foreign.Ptr
28−import Foreign.C.Error
2926import Foreign.C.Types
3027import Data.ByteString.Internal as B
3128
@@ -34,7 +31,7 @@ import Data.ByteString.Internal as B
3431#undef HAVE_RDRAND
3532#endif
3633
37−import System.Posix (openFd, closeFd, fdReadBuf, OpenMode(..), defaultFileFlags, Fd, OpenFileFlags(..))
34+import System.Posix (openFd, closeFd, fdReadBuf, OpenMode(..), defaultFileFlags, Fd)
3835
3936source :: FilePath
4037source = "/dev/urandom"
@@ -42,11 +39,8 @@ source = "/dev/urandom"
4239-- |Handle for manual resource management
4340data CryptHandle
4441 = CH Fd
45−#ifdef HAVE_GETRANDOM
46− | UseGetRandom
47−#endif
4842
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
5044-- supported hardware RNG is available.
5145--
5246-- Supported hardware:
@@ -56,7 +50,8 @@ hardwareRandom :: Int -> IO (Maybe B.ByteString)
5650#ifdef HAVE_RDRAND
5751hardwareRandom n =
5852 do b <- cpuHasRdRand
59− if b then Just <$> B.create n (\ptr ->
53+ if b
54+ then Just <$> B.create n (\ptr ->
6055 do r <- c_get_rand_bytes (castPtr ptr) (fromIntegral n)
6156 when (r /= 0) (fail "RDRand failed to gather entropy"))
6257 else pure Nothing
@@ -66,40 +61,18 @@ hardwareRandom _ = pure Nothing
6661
6762-- |Open a `CryptHandle`
6863openHandle :: IO CryptHandle
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
64+openHandle = do CH `fmap` nonRDRandHandle
65+ where
66+ nonRDRandHandle :: IO Fd
67+ nonRDRandHandle = openFd source ReadOnly Nothing defaultFileFlags
8368
8469-- |Close the `CryptHandle`
8570closeHandle :: CryptHandle -> IO ()
8671closeHandle (CH h) = closeFd h
87−#ifdef HAVE_GETRANDOM
88−closeHandle UseGetRandom = return ()
89−#endif
9072
9173-- |Read random data from a `CryptHandle`
9274hGetEntropy :: CryptHandle -> Int -> IO B.ByteString
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
75+hGetEntropy (CH h) = fdReadBS h
10376
10477fdReadBS :: Fd -> Int -> IO B.ByteString
10578fdReadBS fd n =
@@ -113,28 +86,6 @@ fdReadBS fd n =
11386 n' -> go buf (cnt - fromIntegral n')
11487 go _ _ = error "Impossible! The count of bytes left to read is greater than the request or less than zero!"
11588
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−
13889#ifdef HAVE_RDRAND
13990foreign import ccall unsafe "cpu_has_rdrand"
14091 c_cpu_has_rdrand :: IO CInt
System/EntropyWindows.hs+30−31
@@ -17,7 +17,6 @@ module System.EntropyWindows
1717
1818import Control.Monad (liftM, when)
1919import System.IO.Error (mkIOError, eofErrorType, ioeSetErrorString)
20−import System.Win32.Types (ULONG_PTR, errorWin)
2120import Foreign (allocaBytes)
2221import Data.ByteString as B
2322import Data.ByteString.Internal as BI
@@ -31,20 +30,21 @@ import Foreign.Marshal.Alloc (alloca)
3130import Foreign.Marshal.Utils (toBool)
3231import Foreign.Storable (peek)
3332
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);
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+-}
4848
4949
5050#ifdef arch_i386
@@ -63,12 +63,11 @@ cpuHasRdRand :: IO Bool
6363cpuHasRdRand = (/= 0) `fmap` c_cpu_has_rdrand
6464#endif
6565
66−type HCRYPTPROV = ULONG_PTR
6766data CryptHandle
68− = CH HCRYPTPROV
67+ = CH Word32
6968
7069
71−-- | Get random values from the hardware RNG or return Nothing if no
70+-- | Get random values from the hardward RNG or return Nothing if no
7271-- supported hardware RNG is available.
7372--
7473-- Supported hardware:
@@ -87,7 +86,7 @@ hardwareRandom n =
8786hardwareRandom _ = pure Nothing
8887#endif
8988
90−-- Define the constants we need from WinCrypt.h
89+-- Define the constants we need from WinCrypt.h
9190msDefProv :: String
9291msDefProv = "Microsoft Base Cryptographic Provider v1.0"
9392provRSAFull :: Word32
@@ -95,37 +94,37 @@ provRSAFull = 1
9594cryptVerifyContext :: Word32
9695cryptVerifyContext = fromIntegral 0xF0000000
9796
98−-- Declare the required CryptoAPI imports
97+-- Declare the required CryptoAPI imports
9998foreign import stdcall unsafe "CryptAcquireContextA"
100− c_cryptAcquireCtx :: Ptr HCRYPTPROV -> CString -> CString -> Word32 -> Word32 -> IO Int32
99+ c_cryptAcquireCtx :: Ptr Word32 -> CString -> CString -> Word32 -> Word32 -> IO Int32
101100foreign import stdcall unsafe "CryptGenRandom"
102− c_cryptGenRandom :: HCRYPTPROV -> Word32 -> Ptr Word8 -> IO Int32
101+ c_cryptGenRandom :: Word32 -> Word32 -> Ptr Word8 -> IO Int32
103102foreign import stdcall unsafe "CryptReleaseContext"
104− c_cryptReleaseCtx :: HCRYPTPROV -> Word32 -> IO Int32
103+ c_cryptReleaseCtx :: Word32 -> Word32 -> IO Int32
105104
106−cryptAcquireCtx :: IO HCRYPTPROV
105+cryptAcquireCtx :: IO Word32
107106cryptAcquireCtx =
108− alloca $ \handlePtr ->
107+ alloca $ \handlePtr ->
109108 withCString msDefProv $ \provName -> do
110109 stat <- c_cryptAcquireCtx handlePtr nullPtr provName provRSAFull cryptVerifyContext
111110 if (toBool stat)
112111 then peek handlePtr
113− else errorWin "c_cryptAcquireCtx"
112+ else fail "c_cryptAcquireCtx"
114113
115−cryptGenRandom :: HCRYPTPROV -> Int -> IO B.ByteString
116−cryptGenRandom h i =
114+cryptGenRandom :: Word32 -> Int -> IO B.ByteString
115+cryptGenRandom h i =
117116 BI.create i $ \c_buffer -> do
118117 stat <- c_cryptGenRandom h (fromIntegral i) c_buffer
119118 if (toBool stat)
120119 then return ()
121− else errorWin "c_cryptGenRandom"
120+ else fail "c_cryptGenRandom"
122121
123−cryptReleaseCtx :: HCRYPTPROV -> IO ()
122+cryptReleaseCtx :: Word32 -> IO ()
124123cryptReleaseCtx h = do
125124 stat <- c_cryptReleaseCtx h 0
126125 if (toBool stat)
127126 then return ()
128− else errorWin "c_cryptReleaseCtx"
127+ else fail "c_cryptReleaseCtx"
129128
130129-- |Open a handle from which random data can be read
131130openHandle :: IO CryptHandle
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
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-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+42−67
@@ -1,7 +1,6 @@
1−cabal-version: >=1.10
21name: entropy
3−version: 0.4.1.11
4−description: A mostly platform independent method to obtain cryptographically strong entropy
2+version: 0.4.1.1
3+description: A mostly platform independent (not GHCJS) method to obtain cryptographically strong entropy
54 (RDRAND, urandom, CryptAPI, and patches welcome)
65 Users looking for cryptographically strong (number-theoretically
76 sound) PRNGs should see the 'DRBG' package too.
@@ -15,88 +14,64 @@ category: Data, Cryptography
1514homepage: https://github.com/TomMD/entropy
1615bug-reports: https://github.com/TomMD/entropy/issues
1716stability: stable
18−
17+-- build-type: Simple
18+-- ^^ Used for HaLVM
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
2025
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
34−
35−extra-source-files:
36− ./cbits/getrandom.c
37− ./cbits/random_initialized.c
38− ./cbits/rdrand.c
39− ./cbits/rdrand.h
40− README.md
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
4132
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
4733
4834custom-setup
49− setup-depends: Cabal >= 1.10 && < 3.17
35+ setup-depends: Cabal >= 1.10 && < 2.3
5036 , base < 5
51− , filepath < 1.6
37+ , filepath < 1.5
5238 , directory < 1.4
5339 , process < 1.7
5440
5541library
5642 ghc-options: -O2
5743 exposed-modules: System.Entropy
58− if impl(ghcjs) || os(ghcjs) || arch(wasm32)
59− other-modules: System.EntropyGhcjs
44+ if os(windows)
45+ other-modules: System.EntropyWindows
6046 else {
61− if os(windows)
62− other-modules: System.EntropyWindows
63− else {
64− other-modules: System.EntropyNix
65− }
47+ if os(halvm)
48+ other-modules: System.EntropyXen
49+ else
50+ other-modules: System.EntropyNix
6651 }
6752 other-extensions: CPP, ForeignFunctionInterface, BangPatterns,
6853 ScopedTypeVariables
6954 build-depends: base >= 4.8 && < 5, bytestring
70−
7155 default-language: Haskell2010
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−
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
10075
10176source-repository head
10277 type: git