git.iko.soy/typeable/uuid
on 07a7190 help sign in
49f50ae
swap
0 ahead, 163 behind
.git-blame-ignore-revsdeleted−2
since splitsnapshots
unifiedsplit
@@ -1,2 +0,0 @@
1−# Move code into subdirectories
2−bf1ac1bad848bb2c081f0cae1631bf53811ec05a
.github/workflows/haskell-ci-bench.ymldeleted−241
@@ -1,241 +0,0 @@
1−# This GitHub workflow config has been generated by a script via
2−#
3−# haskell-ci 'github' '--project' 'cabal.bench.project' '-o' '.github/workflows/haskell-ci-bench.yml' '--github-action-name' 'Benchmarks'
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/haskell-CI/haskell-ci
10−#
11−# version: 0.19.20240702
12−#
13−# REGENDATA ("0.19.20240702",["github","--project","cabal.bench.project","-o",".github/workflows/haskell-ci-bench.yml","--github-action-name","Benchmarks"])
14−#
15−name: Benchmarks
16−on:
17− push:
18− branches:
19− - master
20− pull_request:
21− branches:
22− - master
23−jobs:
24− linux:
25− name: Benchmarks - 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.10.1
36− compilerKind: ghc
37− compilerVersion: 9.10.1
38− setup-method: ghcup
39− allow-failure: false
40− - compiler: ghc-9.8.2
41− compilerKind: ghc
42− compilerVersion: 9.8.2
43− setup-method: ghcup
44− allow-failure: false
45− - compiler: ghc-9.6.6
46− compilerKind: ghc
47− compilerVersion: 9.6.6
48− setup-method: ghcup
49− allow-failure: false
50− - compiler: ghc-9.4.8
51− compilerKind: ghc
52− compilerVersion: 9.4.8
53− setup-method: ghcup
54− allow-failure: false
55− - compiler: ghc-9.2.8
56− compilerKind: ghc
57− compilerVersion: 9.2.8
58− setup-method: ghcup
59− allow-failure: false
60− - compiler: ghc-9.0.2
61− compilerKind: ghc
62− compilerVersion: 9.0.2
63− setup-method: ghcup
64− allow-failure: false
65− - compiler: ghc-8.10.7
66− compilerKind: ghc
67− compilerVersion: 8.10.7
68− setup-method: ghcup
69− allow-failure: false
70− - compiler: ghc-8.8.4
71− compilerKind: ghc
72− compilerVersion: 8.8.4
73− setup-method: ghcup
74− allow-failure: false
75− - compiler: ghc-8.6.5
76− compilerKind: ghc
77− compilerVersion: 8.6.5
78− setup-method: ghcup
79− allow-failure: false
80− fail-fast: false
81− steps:
82− - name: apt
83− run: |
84− apt-get update
85− apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5
86− mkdir -p "$HOME/.ghcup/bin"
87− curl -sL https://downloads.haskell.org/ghcup/0.1.20.0/x86_64-linux-ghcup-0.1.20.0 > "$HOME/.ghcup/bin/ghcup"
88− chmod a+x "$HOME/.ghcup/bin/ghcup"
89− "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false)
90− "$HOME/.ghcup/bin/ghcup" install cabal 3.12.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false)
91− env:
92− HCKIND: ${{ matrix.compilerKind }}
93− HCNAME: ${{ matrix.compiler }}
94− HCVER: ${{ matrix.compilerVersion }}
95− - name: Set PATH and environment variables
96− run: |
97− echo "$HOME/.cabal/bin" >> $GITHUB_PATH
98− echo "LANG=C.UTF-8" >> "$GITHUB_ENV"
99− echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV"
100− echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV"
101− HCDIR=/opt/$HCKIND/$HCVER
102− HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER")
103− HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#')
104− HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#')
105− echo "HC=$HC" >> "$GITHUB_ENV"
106− echo "HCPKG=$HCPKG" >> "$GITHUB_ENV"
107− echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV"
108− echo "CABAL=$HOME/.ghcup/bin/cabal-3.12.1.0 -vnormal+nowrap" >> "$GITHUB_ENV"
109− HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')
110− echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV"
111− echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV"
112− echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV"
113− echo "HEADHACKAGE=false" >> "$GITHUB_ENV"
114− echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV"
115− echo "GHCJSARITH=0" >> "$GITHUB_ENV"
116− env:
117− HCKIND: ${{ matrix.compilerKind }}
118− HCNAME: ${{ matrix.compiler }}
119− HCVER: ${{ matrix.compilerVersion }}
120− - name: env
121− run: |
122− env
123− - name: write cabal config
124− run: |
125− mkdir -p $CABAL_DIR
126− cat >> $CABAL_CONFIG <<EOF
127− remote-build-reporting: anonymous
128− write-ghc-environment-files: never
129− remote-repo-cache: $CABAL_DIR/packages
130− logs-dir: $CABAL_DIR/logs
131− world-file: $CABAL_DIR/world
132− extra-prog-path: $CABAL_DIR/bin
133− symlink-bindir: $CABAL_DIR/bin
134− installdir: $CABAL_DIR/bin
135− build-summary: $CABAL_DIR/logs/build.log
136− store-dir: $CABAL_DIR/store
137− install-dirs user
138− prefix: $CABAL_DIR
139− repository hackage.haskell.org
140− url: http://hackage.haskell.org/
141− EOF
142− cat >> $CABAL_CONFIG <<EOF
143− program-default-options
144− ghc-options: $GHCJOBS +RTS -M3G -RTS
145− EOF
146− cat $CABAL_CONFIG
147− - name: versions
148− run: |
149− $HC --version || true
150− $HC --print-project-git-commit-id || true
151− $CABAL --version || true
152− - name: update cabal index
153− run: |
154− $CABAL v2-update -v
155− - name: install cabal-plan
156− run: |
157− mkdir -p $HOME/.cabal/bin
158− 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
159− echo 'f62ccb2971567a5f638f2005ad3173dba14693a45154c1508645c52289714cb2 cabal-plan.xz' | sha256sum -c -
160− xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan
161− rm -f cabal-plan.xz
162− chmod a+x $HOME/.cabal/bin/cabal-plan
163− cabal-plan --version
164− - name: checkout
165− uses: actions/checkout@v4
166− with:
167− path: source
168− - name: initial cabal.project for sdist
169− run: |
170− touch cabal.project
171− echo "packages: $GITHUB_WORKSPACE/source/uuid-bench" >> cabal.project
172− cat cabal.project
173− - name: sdist
174− run: |
175− mkdir -p sdist
176− $CABAL sdist all --output-dir $GITHUB_WORKSPACE/sdist
177− - name: unpack
178− run: |
179− mkdir -p unpacked
180− find sdist -maxdepth 1 -type f -name '*.tar.gz' -exec tar -C $GITHUB_WORKSPACE/unpacked -xzvf {} \;
181− - name: generate cabal.project
182− run: |
183− PKGDIR_uuid_bench="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/uuid-bench-[0-9.]*')"
184− echo "PKGDIR_uuid_bench=${PKGDIR_uuid_bench}" >> "$GITHUB_ENV"
185− rm -f cabal.project cabal.project.local
186− touch cabal.project
187− touch cabal.project.local
188− echo "packages: ${PKGDIR_uuid_bench}" >> cabal.project
189− echo "package uuid-bench" >> cabal.project
190− echo " ghc-options: -Werror=missing-methods" >> cabal.project
191− cat >> cabal.project <<EOF
192− EOF
193− $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: any.$_ installed\n" unless /^(uuid-bench)$/; }' >> cabal.project.local
194− cat cabal.project
195− cat cabal.project.local
196− - name: dump install plan
197− run: |
198− $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all
199− cabal-plan
200− - name: restore cache
201− uses: actions/cache/restore@v4
202− with:
203− key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
204− path: ~/.cabal/store
205− restore-keys: ${{ runner.os }}-${{ matrix.compiler }}-
206− - name: install dependencies
207− run: |
208− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --dependencies-only -j2 all
209− $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dependencies-only -j2 all
210− - name: build w/o tests
211− run: |
212− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all
213− - name: build
214− run: |
215− $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --write-ghc-environment-files=always
216− - name: cabal check
217− run: |
218− cd ${PKGDIR_uuid_bench} || false
219− ${CABAL} -vnormal check
220− - name: haddock
221− run: |
222− $CABAL v2-haddock --disable-documentation --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all
223− - name: unconstrained build
224− run: |
225− rm -f cabal.project.local
226− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all
227− - name: prepare for constraint sets
228− run: |
229− rm -f cabal.project.local
230− - name: constraint set random-1.2
231− run: |
232− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='random==1.2.*' all --dry-run
233− cabal-plan topo | sort
234− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='random==1.2.*' --dependencies-only -j2 all
235− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='random==1.2.*' all
236− - name: save cache
237− uses: actions/cache/save@v4
238− if: always()
239− with:
240− key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
241− path: ~/.cabal/store
.github/workflows/haskell-ci.ymldeleted−262
@@ -1,262 +0,0 @@
1−# This GitHub workflow config has been generated by a script via
2−#
3−# haskell-ci 'github' 'cabal.project'
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/haskell-CI/haskell-ci
10−#
11−# version: 0.19.20241223
12−#
13−# REGENDATA ("0.19.20241223",["github","cabal.project"])
14−#
15−name: Haskell-CI
16−on:
17− push:
18− branches:
19− - master
20− pull_request:
21− branches:
22− - master
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− fail-fast: false
86− steps:
87− - name: apt-get install
88− run: |
89− apt-get update
90− apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5
91− - name: Install GHCup
92− run: |
93− mkdir -p "$HOME/.ghcup/bin"
94− curl -sL https://downloads.haskell.org/ghcup/0.1.30.0/x86_64-linux-ghcup-0.1.30.0 > "$HOME/.ghcup/bin/ghcup"
95− chmod a+x "$HOME/.ghcup/bin/ghcup"
96− - name: Install cabal-install
97− run: |
98− "$HOME/.ghcup/bin/ghcup" install cabal 3.14.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false)
99− echo "CABAL=$HOME/.ghcup/bin/cabal-3.14.1.0 -vnormal+nowrap" >> "$GITHUB_ENV"
100− - name: Install GHC (GHCup)
101− if: matrix.setup-method == 'ghcup'
102− run: |
103− "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false)
104− HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER")
105− HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#')
106− HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#')
107− echo "HC=$HC" >> "$GITHUB_ENV"
108− echo "HCPKG=$HCPKG" >> "$GITHUB_ENV"
109− echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV"
110− env:
111− HCKIND: ${{ matrix.compilerKind }}
112− HCNAME: ${{ matrix.compiler }}
113− HCVER: ${{ matrix.compilerVersion }}
114− - name: Set PATH and environment variables
115− run: |
116− echo "$HOME/.cabal/bin" >> $GITHUB_PATH
117− echo "LANG=C.UTF-8" >> "$GITHUB_ENV"
118− echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV"
119− echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV"
120− HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')
121− echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV"
122− echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV"
123− echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV"
124− echo "HEADHACKAGE=false" >> "$GITHUB_ENV"
125− echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV"
126− env:
127− HCKIND: ${{ matrix.compilerKind }}
128− HCNAME: ${{ matrix.compiler }}
129− HCVER: ${{ matrix.compilerVersion }}
130− - name: env
131− run: |
132− env
133− - name: write cabal config
134− run: |
135− mkdir -p $CABAL_DIR
136− cat >> $CABAL_CONFIG <<EOF
137− remote-build-reporting: anonymous
138− write-ghc-environment-files: never
139− remote-repo-cache: $CABAL_DIR/packages
140− logs-dir: $CABAL_DIR/logs
141− world-file: $CABAL_DIR/world
142− extra-prog-path: $CABAL_DIR/bin
143− symlink-bindir: $CABAL_DIR/bin
144− installdir: $CABAL_DIR/bin
145− build-summary: $CABAL_DIR/logs/build.log
146− store-dir: $CABAL_DIR/store
147− install-dirs user
148− prefix: $CABAL_DIR
149− repository hackage.haskell.org
150− url: http://hackage.haskell.org/
151− EOF
152− cat >> $CABAL_CONFIG <<EOF
153− program-default-options
154− ghc-options: $GHCJOBS +RTS -M3G -RTS
155− EOF
156− cat $CABAL_CONFIG
157− - name: versions
158− run: |
159− $HC --version || true
160− $HC --print-project-git-commit-id || true
161− $CABAL --version || true
162− - name: update cabal index
163− run: |
164− $CABAL v2-update -v
165− - name: install cabal-plan
166− run: |
167− mkdir -p $HOME/.cabal/bin
168− 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
169− echo 'f62ccb2971567a5f638f2005ad3173dba14693a45154c1508645c52289714cb2 cabal-plan.xz' | sha256sum -c -
170− xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan
171− rm -f cabal-plan.xz
172− chmod a+x $HOME/.cabal/bin/cabal-plan
173− cabal-plan --version
174− - name: checkout
175− uses: actions/checkout@v4
176− with:
177− path: source
178− - name: initial cabal.project for sdist
179− run: |
180− touch cabal.project
181− echo "packages: $GITHUB_WORKSPACE/source/uuid-types" >> cabal.project
182− echo "packages: $GITHUB_WORKSPACE/source/uuid" >> cabal.project
183− cat cabal.project
184− - name: sdist
185− run: |
186− mkdir -p sdist
187− $CABAL sdist all --output-dir $GITHUB_WORKSPACE/sdist
188− - name: unpack
189− run: |
190− mkdir -p unpacked
191− find sdist -maxdepth 1 -type f -name '*.tar.gz' -exec tar -C $GITHUB_WORKSPACE/unpacked -xzvf {} \;
192− - name: generate cabal.project
193− run: |
194− PKGDIR_uuid_types="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/uuid-types-[0-9.]*')"
195− echo "PKGDIR_uuid_types=${PKGDIR_uuid_types}" >> "$GITHUB_ENV"
196− PKGDIR_uuid="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/uuid-[0-9.]*')"
197− echo "PKGDIR_uuid=${PKGDIR_uuid}" >> "$GITHUB_ENV"
198− rm -f cabal.project cabal.project.local
199− touch cabal.project
200− touch cabal.project.local
201− echo "packages: ${PKGDIR_uuid_types}" >> cabal.project
202− echo "packages: ${PKGDIR_uuid}" >> cabal.project
203− echo "package uuid-types" >> cabal.project
204− echo " ghc-options: -Werror=missing-methods" >> cabal.project
205− echo "package uuid" >> cabal.project
206− echo " ghc-options: -Werror=missing-methods" >> cabal.project
207− cat >> cabal.project <<EOF
208− EOF
209− $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: any.$_ installed\n" unless /^(uuid|uuid-types)$/; }' >> cabal.project.local
210− cat cabal.project
211− cat cabal.project.local
212− - name: dump install plan
213− run: |
214− $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all
215− cabal-plan
216− - name: restore cache
217− uses: actions/cache/restore@v4
218− with:
219− key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
220− path: ~/.cabal/store
221− restore-keys: ${{ runner.os }}-${{ matrix.compiler }}-
222− - name: install dependencies
223− run: |
224− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --dependencies-only -j2 all
225− $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dependencies-only -j2 all
226− - name: build w/o tests
227− run: |
228− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all
229− - name: build
230− run: |
231− $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --write-ghc-environment-files=always
232− - name: tests
233− run: |
234− $CABAL v2-test $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --test-show-details=direct
235− - name: cabal check
236− run: |
237− cd ${PKGDIR_uuid_types} || false
238− ${CABAL} -vnormal check
239− cd ${PKGDIR_uuid} || false
240− ${CABAL} -vnormal check
241− - name: haddock
242− run: |
243− $CABAL v2-haddock --disable-documentation --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all
244− - name: unconstrained build
245− run: |
246− rm -f cabal.project.local
247− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all
248− - name: prepare for constraint sets
249− run: |
250− rm -f cabal.project.local
251− - name: constraint set random-1.2
252− run: |
253− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='random==1.2.*' all --dry-run
254− cabal-plan topo | sort
255− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='random==1.2.*' --dependencies-only -j2 all
256− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='random==1.2.*' all
257− - name: save cache
258− if: always()
259− uses: actions/cache/save@v4
260− with:
261− key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
262− path: ~/.cabal/store
.gitignoredeleted−13
@@ -1,13 +0,0 @@
1−# Sandboxing
2−.cabal-sandbox/
3−cabal.sandbox.config
4−
5−# Cabal stuff
6−dist/
7−cabal.config
8−dist-newstyle/
9−/cabal.project.local
10−.ghc.environment.*
11−
12−# Emacs
13−*~
CHANGESnew file+108
@@ -0,0 +1,108 @@
1+1.3.0
2+
3+- New functions for parsing and printing UUIDs to and from ASCII BytesStrings
4+- New module Data.UUID.Util. This module includes the type 'UnpackedUUID',
5+ whose fields correspond to the UUID fields described in RFC 4122.
6+- The Storable instance now stores a UUID in host byte-order instead of
7+ big endian.
8+- There is now an instance for 'Hashable UUID'.
9+
10+1.2.13
11+
12+Benchmark only changes:
13+
14+- Allow criterion 0.8.*
15+
16+1.2.12
17+
18+Test only changes:
19+
20+- Allow QuickCheck 2.6.*
21+
22+1.2.11
23+
24+- Allow binary 0.7.*
25+
26+1.2.10
27+
28+- Allow cryptohash version 0.9.*
29+- Cleanup tests
30+
31+1.2.9
32+
33+- Bumped dependency on 'cryptohash'.
34+
35+1.2.8
36+
37+- Bumped various dependencies and cleaned up dependencies in general.
38+
39+1.2.7
40+
41+- Added stricter constraints on 'random' package.
42+
43+1.2.6
44+
45+- Add module 'V4' to direct attention to our Random instance
46+
47+- In module 'V1' seed the generator with a random number
48+ if the hardware MAC address could not be discovered.
49+
50+- Fix and cleanup various haddocks.
51+
52+- In module docs, warn about MD5 use in Data.UUID.V3 and
53+ encourage the reader to use Data.UUID.V5 instead.
54+
55+1.2.5
56+
57+- Use 'cryptohash' package for MD5 and SHA1 instead of 'Crypto'
58+
59+1.2.4
60+
61+- Unpack Word32 values into UUID constructor.
62+
63+- Update test suite to QuickCheck 2
64+
65+- Bump other dependencies in tests/benchmarks
66+
67+1.2.3
68+
69+- The Read instance now drops leading spaces in the string to be parsed.
70+Thanks to Marc Ziegert for reporting this bug.
71+
72+- The tests have moved over to the new Cabal test running framework.
73+
74+1.2.2
75+
76+- Add functions fromWords/toWords
77+
78+The goal was to have a total function that can be used to construct
79+a UUID, primarily for use by uuid-th.
80+
81+1.2.1
82+
83+- Fix concurrency bug in Data.UUID.V1 (thanks to Neil Mitchell for reporting
84+and a test case)
85+
86+1.2.0
87+ (Contributors: Antoine Latter & Mark Lentczner)
88+
89+- added functions toByteString and fromByteString
90+- added 'nil' UUID
91+- added unit tests and benchmarks, built when configured -ftest
92+- major speed up of to/from functions (as well as in general)
93+- added version-3 generation (deterministic based on MD5)
94+- major changes to internal representation
95+ - now uses four strict Word32 values
96+ - internal ByteSource classes for easy construction (see Builder.hs)
97+- Storable instance now stores in memory as system libraries in C do:
98+ 16 bytes derived from the network order of the fields, no matter what
99+ the host native endianess is.
100+- fixed bugs in V1 time and clock stepping, and V1 generated values
101+- builds cleanly under GHC's -Wall
102+- added CHANGES file
103+
104+1.1.1
105+
106+- no longer exporting 'null' from the prelude
107+- add 'null' predicate on UUIDs
108+- documentation fix (thanks Mark Lentczner)
CONTRIBUTORS+1−5
@@ -8,8 +8,4 @@ Neil Mitchell
8Bas van Dijk
8Bas van Dijk
9Sergei Trofimovich
9Sergei Trofimovich
10davean
10davean
11−Francesco Mazzoli
11+Francesco Mazzoli
12−Michael Snoyman
13−Bardur Arantsson
14−Timo von Holtz
15−Oleg Grenrus
uuid/src/Data/UUID.hs → Data/UUID.hsrenamed+10−12
@@ -14,18 +14,19 @@ printing Universally Unique Identifiers.
14See <http://en.wikipedia.org/wiki/UUID> for the general idea.
14See <http://en.wikipedia.org/wiki/UUID> for the general idea.
15See <http://tools.ietf.org/html/rfc4122> for the specification.
15See <http://tools.ietf.org/html/rfc4122> for the specification.
16
16
17−* Use 'Data.UUID.V4.nextRandom' to generate secure random UUIDs, and your
17+* Random UUIDs may be generated using 'Data.UUID.V4.nextRandom' or
18−favorite instance of 'System.Random.Random' for faster but insecure
18+your favorite instance of 'System.Random.Random'.
19−generation of UUIDs.
19+
20+* We have an implementation of generating a UUID from the hardware
21+MAC address and current system time in "Data.UUID.V1".
20
22
21* For name-based generation of UUIDs using SHA-1 hashing see
23* For name-based generation of UUIDs using SHA-1 hashing see
22"Data.UUID.V5".
24"Data.UUID.V5".
23-}
25-}
26+
24module Data.UUID(UUID
27module Data.UUID(UUID
25 ,toString
28 ,toString
26 ,fromString
29 ,fromString
27− ,toText
28− ,fromText
29 ,toASCIIBytes
30 ,toASCIIBytes
30 ,fromASCIIBytes
31 ,fromASCIIBytes
31 ,toLazyASCIIBytes
32 ,toLazyASCIIBytes
@@ -34,16 +35,13 @@ module Data.UUID(UUID
34 ,fromByteString
35 ,fromByteString
35 ,toWords
36 ,toWords
36 ,fromWords
37 ,fromWords
37− ,toWords64
38− ,fromWords64
39 ,null
38 ,null
40 ,nil
39 ,nil
41 ) where
40 ) where
42
41
43import Prelude () -- we need to hide Prelude.null
42import Prelude () -- we need to hide Prelude.null
44−import Data.UUID.Types
43+import Data.UUID.Internal
45
44
46−-- We use explicit re-exports of everything from Data.UUID.Types in
45+-- Everything is really implemented in Data.UUID.Internal,
47−-- preference to just re-exporting the whole module. This is to avoid
46+-- but I don't want to export the constructors out of the
48−-- unforeseen transitive API breakage if the Data.UUID.Types module
47+-- package.
49−-- should change.
uuid-types/src/Data/UUID/Types/Internal/Builder.hs → Data/UUID/Builder.hsrenamed+5−21
@@ -1,9 +1,6 @@
1{-# LANGUAGE TypeFamilies #-}
1{-# LANGUAGE TypeFamilies #-}
2−{-# LANGUAGE Unsafe #-}
3
2
4−{-# OPTIONS_HADDOCK hide #-}
5−
6−-- | Module : Data.UUID.Types.Internal.Builder
3+-- Module : Data.UUID.Builder
7-- Copyright : (c) 2009 Mark Lentczner
4-- Copyright : (c) 2009 Mark Lentczner
8--
5--
9-- License : BSD-style
6-- License : BSD-style
@@ -13,14 +10,14 @@
13-- Portability : portable
10-- Portability : portable
14--
11--
15-- This module provides a system that can call a function that takes
12-- This module provides a system that can call a function that takes
16−-- a sequence of some number of Word8 arguments.
13+-- a sequence of some number of Word8 arguments.
17−--
14+--
18-- The twist is that the Word8 arguments can be supplied directly
15-- The twist is that the Word8 arguments can be supplied directly
19-- from Word8s, or from other sources that may provide more than
16-- from Word8s, or from other sources that may provide more than
20-- one Word8 apiece. Examples are Word16 and Word32 that supply
17-- one Word8 apiece. Examples are Word16 and Word32 that supply
21-- two and four Word8s respectively. Other ByteSource instances
18-- two and four Word8s respectively. Other ByteSource instances
22-- can be defined.
19-- can be defined.
23−--
20+--
24-- This module is admittedly overkill. There are only three places
21-- This module is admittedly overkill. There are only three places
25-- in the uuid package that need to call buildFromBytes with 16
22-- in the uuid package that need to call buildFromBytes with 16
26-- Word8 values, but each place uses Words of different lengths:
23-- Word8 values, but each place uses Words of different lengths:
@@ -31,7 +28,7 @@
31-- code was ungainly. Using this module makes the code very
28-- code was ungainly. Using this module makes the code very
32-- concise, and turns out to optimize to just as fast, or faster!
29-- concise, and turns out to optimize to just as fast, or faster!
33
30
34−module Data.UUID.Types.Internal.Builder
31+module Data.UUID.Builder
35 (ByteSource(..)
32 (ByteSource(..)
36 ,ByteSink
33 ,ByteSink
37 ,Takes1Byte
34 ,Takes1Byte
@@ -49,7 +46,6 @@ type Takes1Byte g = Word8 -> g
49type Takes2Bytes g = Word8 -> Word8 -> g
46type Takes2Bytes g = Word8 -> Word8 -> g
50type Takes3Bytes g = Word8 -> Word8 -> Word8 -> g
47type Takes3Bytes g = Word8 -> Word8 -> Word8 -> g
51type Takes4Bytes g = Word8 -> Word8 -> Word8 -> Word8 -> g
48type Takes4Bytes g = Word8 -> Word8 -> Word8 -> Word8 -> g
52−type Takes8Bytes g = Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> g
53
49
54-- | Type of function that a given ByteSource needs.
50-- | Type of function that a given ByteSource needs.
55-- This function must take as many Word8 arguments as the ByteSource provides
51-- This function must take as many Word8 arguments as the ByteSource provides
@@ -57,7 +53,6 @@ type family ByteSink w g
57type instance ByteSink Word8 g = Takes1Byte g
53type instance ByteSink Word8 g = Takes1Byte g
58type instance ByteSink Word16 g = Takes2Bytes g
54type instance ByteSink Word16 g = Takes2Bytes g
59type instance ByteSink Word32 g = Takes4Bytes g
55type instance ByteSink Word32 g = Takes4Bytes g
60−type instance ByteSink Word64 g = Takes8Bytes g
61type instance ByteSink Int g = Takes4Bytes g
56type instance ByteSink Int g = Takes4Bytes g
62
57
63
58
@@ -85,17 +80,6 @@ instance ByteSource Word32 where
85 b3 = fromIntegral (w `shiftR` 8)
80 b3 = fromIntegral (w `shiftR` 8)
86 b4 = fromIntegral w
81 b4 = fromIntegral w
87
82
88−instance ByteSource Word64 where
89− f /-/ w = f b1 b2 b3 b4 b5 b6 b7 b8
90− where b1 = fromIntegral (w `shiftR` 56)
91− b2 = fromIntegral (w `shiftR` 48)
92− b3 = fromIntegral (w `shiftR` 40)
93− b4 = fromIntegral (w `shiftR` 32)
94− b5 = fromIntegral (w `shiftR` 24)
95− b6 = fromIntegral (w `shiftR` 16)
96− b7 = fromIntegral (w `shiftR` 8)
97− b8 = fromIntegral w
98−
99instance ByteSource Int where
83instance ByteSource Int where
100 f /-/ w = f b1 b2 b3 b4
84 f /-/ w = f b1 b2 b3 b4
101 where b1 = fromIntegral (w `shiftR` 24)
85 where b1 = fromIntegral (w `shiftR` 24)
uuid-types/src/Data/UUID/Types/Internal.hs → Data/UUID/Internal.hsrenamed+168−224
@@ -1,86 +1,85 @@
1−{-# LANGUAGE CPP #-}
2−{-# LANGUAGE DeriveDataTypeable #-}
1+{-# LANGUAGE DeriveDataTypeable, TypeFamilies, CPP #-}
3−{-# LANGUAGE TypeFamilies #-}
4−{-# LANGUAGE ViewPatterns #-}
5−{-# LANGUAGE Unsafe #-}
6−{-# LANGUAGE DeriveLift #-}
7−{-# LANGUAGE StandaloneDeriving #-}
8−{-# OPTIONS_HADDOCK hide #-}
9
2
10-- |
3-- |
11−-- Module : Data.UUID.Types.Internal
4+-- Module : Data.UUID
12−-- Copyright : (c) 2017-2018 Herbert Valerio Riedel
13−-- (c) 2008-2009, 2012 Antoine Latter
5+-- Copyright : (c) 2008-2009, 2012 Antoine Latter
14-- (c) 2009 Mark Lentczner
6-- (c) 2009 Mark Lentczner
15--
7--
16-- License : BSD-style
8-- License : BSD-style
17--
9--
18−-- Maintainer : hvr@gnu.org
10+-- Maintainer : aslatter@gmail.com
11+-- Stability : experimental
19-- Portability : portable
12-- Portability : portable
20
13
21−module Data.UUID.Types.Internal
14+module Data.UUID.Internal
22− ( UUID(..)
15+ (UUID(..)
23− , null
16+ ,null
24− , nil
17+ ,nil
25− , fromByteString
18+ ,fromByteString
26− , toByteString
19+ ,toByteString
27− , fromString
20+ ,fromString
28− , toString
21+ ,toString
29− , fromText
30− , toText
31− , fromWords
22+ ,fromWords
32− , toWords
23+ ,toWords
33− , fromWords64
34− , toWords64
35− , toList
24+ ,toList
36− , buildFromBytes
25+ ,buildFromBytes
37− , buildFromWords
26+ ,buildFromWords
38− , fromASCIIBytes
27+ ,fromASCIIBytes
39− , toASCIIBytes
28+ ,toASCIIBytes
40− , fromLazyASCIIBytes
29+ ,fromLazyASCIIBytes
41− , toLazyASCIIBytes
30+ ,toLazyASCIIBytes
42− , UnpackedUUID(..)
31+ ,UnpackedUUID(..)
43− , pack
32+ ,pack
44− , unpack
33+ ,unpack
45 ) where
34 ) where
46
35
47−import Prelude hiding (null)
36+import Prelude hiding (null)
48−
37+
38+import Control.Applicative ((<*>))
49−import Control.DeepSeq (NFData (..))
39+import Control.DeepSeq (NFData(..))
50−import Control.Monad (guard, liftM2)
40+import Control.Monad (liftM4, guard)
51−import Data.Bits
41+import Data.Functor ((<$>))
52−import Data.Char
42+import Data.Char
53−import Data.Data
43+import Data.Bits
54−import Data.Hashable
44+import Data.Hashable
45+import Data.Maybe
55−import Data.List (elemIndices)
46+import Data.List (elemIndices)
56−import Foreign.Ptr (Ptr)
47+import Foreign.Ptr (Ptr)
57−
48+
49+#if MIN_VERSION_base(4,0,0)
50+import Data.Data
51+#else
52+import Data.Generics.Basics
53+#endif
54+
58−import Foreign.Storable
55+import Foreign.Storable
59−
56+
57+import Data.Binary
60−import Data.Binary
58+import Data.Binary.Put
61−import Data.Binary.Get
59+import Data.Binary.Get
62−import Data.Binary.Put
63−import qualified Data.ByteString as B
60+import qualified Data.ByteString as B
64−import qualified Data.ByteString.Internal as BI
61+import qualified Data.ByteString.Internal as BI
65−import qualified Data.ByteString.Lazy as BL
62+import qualified Data.ByteString.Lazy as BL
66−import qualified Data.ByteString.Unsafe as BU
63+import qualified Data.ByteString.Unsafe as BU
67−import Data.Text (Text)
64+
68−import qualified Data.Text.Encoding as T
69−
70−import Data.UUID.Types.Internal.Builder
65+import Data.UUID.Builder
71−
66+import Data.Word.Util
72−import System.Random (Random (..), uniform)
67+
73−import System.Random.Stateful (Uniform (..), uniformWord64)
68+import System.Random
74−
69+
75−import Language.Haskell.TH.Syntax (Lift)
70+
76−
71+-- |The UUID type. A 'Random' instance is provided which produces
77−-- | Type representing <https://en.wikipedia.org/wiki/UUID Universally Unique Identifiers (UUID)> as specified in
72+-- version 4 UUIDs as specified in RFC 4122. The 'Storable' and
78−-- <http://tools.ietf.org/html/rfc4122 RFC 4122>.
73+-- 'Binary' instances are compatible with RFC 4122, storing the fields
79−data UUID = UUID {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64
74+-- in network order as 16 bytes.
75+data UUID
76+ = UUID
77+ {-# UNPACK #-} !Word32
78+ {-# UNPACK #-} !Word32
79+ {-# UNPACK #-} !Word32
80+ {-# UNPACK #-} !Word32
80− deriving (Eq, Ord)
81+ deriving (Eq, Ord, Typeable)
81{-
82{-
82− Prior to uuid-types-1.0.4:
83− !Word32 !Word32 !Word32 !Word32
84 Other representations that we tried are:
83 Other representations that we tried are:
85 Mimic V1 structure: !Word32 !Word16 !Word16 !Word16
84 Mimic V1 structure: !Word32 !Word16 !Word16 !Word16
86 !Word8 !Word8 !Word8 !Word8 !Word8 !Word8
85 !Word8 !Word8 !Word8 !Word8 !Word8 !Word8
@@ -92,75 +91,40 @@ data UUID = UUID {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64
92 None was as fast, overall, as the representation used here.
91 None was as fast, overall, as the representation used here.
93-}
92-}
94
93
95−-- | Convert a 'UUID' into a sequence of 'Word32' values.
94+-- | Covert a 'UUID' into a sequence of 'Word32' values.
96−-- Useful for when you need to serialize a UUID and
95+-- Usefull for when you need to serialize a UUID and
97-- neither 'Storable' nor 'Binary' are appropriate.
96-- neither 'Storable' nor 'Binary' are appropriate.
98−--
97+-- Introduced in version 1.2.2.
99−-- >>> toWords <$> fromString "550e8400-e29b-41d4-a716-446655440000"
100−-- Just (1427014656,3801825748,2803254374,1430519808)
101−--
102−-- See also 'toWords64'.
103−--
104−-- /Since: @uuid-1.2.2@/
105−--
106−-- @since 1.0.0
107toWords :: UUID -> (Word32, Word32, Word32, Word32)
98toWords :: UUID -> (Word32, Word32, Word32, Word32)
108−toWords (UUID w12 w34) = (w1, w2, w3, w4)
99+toWords (UUID w1 w2 w3 w4) = (w1, w2, w3, w4)
109− where
110− w1 = fromIntegral (w12 `unsafeShiftR` 32)
111− w2 = fromIntegral w12
112− w3 = fromIntegral (w34 `unsafeShiftR` 32)
113− w4 = fromIntegral w34
114
100
115-- | Create a 'UUID' from a sequence of 'Word32'. The
101-- | Create a 'UUID' from a sequence of 'Word32'. The
116−-- inverse of 'toWords'. Useful when you need a total
102+-- opposite of 'toWords'. Useful when you need a total
117-- function for constructing 'UUID' values.
103-- function for constructing 'UUID' values.
118−--
104+-- Introduced in version 1.2.2.
119−-- See also 'fromWords64'.
120−--
121−-- /Since: @uuid-1.2.2@/
122−--
123−-- @since 1.0.0
124fromWords :: Word32 -> Word32 -> Word32 -> Word32 -> UUID
105fromWords :: Word32 -> Word32 -> Word32 -> Word32 -> UUID
125−fromWords w1 w2 w3 w4 = UUID (w32to64 w1 w2) (w32to64 w3 w4)
106+fromWords = UUID
126−
127−-- | Convert a 'UUID' into a pair of 'Word64's.
128−--
129−-- >>> toWords64 <$> fromString "550e8400-e29b-41d4-a716-446655440000"
130−-- Just (6128981282234515924,12039885860129472512)
131−--
132−-- See also 'toWords'.
133−--
134−-- @since 1.0.4
135−toWords64 :: UUID -> (Word64, Word64)
136−toWords64 (UUID w12 w34) = (w12,w34)
137−
138−-- | Create a 'UUID' from a pair of 'Word64's.
139−--
140−-- Inverse of 'toWords64'. See also 'fromWords'.
141−--
142−-- @since 1.0.4
143−fromWords64 :: Word64 -> Word64 -> UUID
144−fromWords64 = UUID
145
107
146data UnpackedUUID =
108data UnpackedUUID =
147 UnpackedUUID {
109 UnpackedUUID {
148− time_low :: Word32 -- 0-3
110+ time_low :: Word32 -- 0-3
149− , time_mid :: Word16 -- 4-5
111+ , time_mid :: Word16 -- 4-5
150 , time_hi_and_version :: Word16 -- 6-7
112 , time_hi_and_version :: Word16 -- 6-7
151− , clock_seq_hi_res :: Word8 -- 8
113+ , clock_seq_hi_res :: Word8 -- 8
152− , clock_seq_low :: Word8 -- 9
114+ , clock_seq_low :: Word8 -- 9
153− , node_0 :: Word8
115+ , node_0 :: Word8
154− , node_1 :: Word8
116+ , node_1 :: Word8
155− , node_2 :: Word8
117+ , node_2 :: Word8
156− , node_3 :: Word8
118+ , node_3 :: Word8
157− , node_4 :: Word8
119+ , node_4 :: Word8
158− , node_5 :: Word8
120+ , node_5 :: Word8
159 }
121 }
160 deriving (Read, Show, Eq, Ord)
122 deriving (Read, Show, Eq, Ord)
161
123
162unpack :: UUID -> UnpackedUUID
124unpack :: UUID -> UnpackedUUID
163−unpack (UUID w0 w1) = build /-/ w0 /-/ w1
125+unpack (UUID w0 w1 w2 w3) =
126+ build /-/ w0 /-/ w1 /-/ w2 /-/ w3
127+
164 where
128 where
165 build x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 xA xB xC xD xE xF =
129 build x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 xA xB xC xD xE xF =
166 UnpackedUUID {
130 UnpackedUUID {
@@ -179,13 +143,13 @@ unpack (UUID w0 w1) = build /-/ w0 /-/ w1
179
143
180pack :: UnpackedUUID -> UUID
144pack :: UnpackedUUID -> UUID
181pack unpacked =
145pack unpacked =
182− makeFromBytes /-/ (time_low unpacked)
146+ makeFromBytes /-/ (time_low unpacked)
183− /-/ (time_mid unpacked)
147+ /-/ (time_mid unpacked)
184− /-/ (time_hi_and_version unpacked)
148+ /-/ (time_hi_and_version unpacked)
185− /-/ (clock_seq_hi_res unpacked)
149+ /-/ (clock_seq_hi_res unpacked)
186 /-/ (clock_seq_low unpacked)
150 /-/ (clock_seq_low unpacked)
187− /-/ (node_0 unpacked) /-/ (node_1 unpacked)
151+ /-/ (node_0 unpacked) /-/ (node_1 unpacked)
188− /-/ (node_2 unpacked) /-/ (node_3 unpacked)
152+ /-/ (node_2 unpacked) /-/ (node_3 unpacked)
189 /-/ (node_4 unpacked) /-/ (node_5 unpacked)
153 /-/ (node_4 unpacked) /-/ (node_5 unpacked)
190
154
191
155
@@ -195,26 +159,15 @@ pack unpacked =
195
159
196-- |Build a Word32 from four Word8 values, presented in big-endian order
160-- |Build a Word32 from four Word8 values, presented in big-endian order
197word :: Word8 -> Word8 -> Word8 -> Word8 -> Word32
161word :: Word8 -> Word8 -> Word8 -> Word8 -> Word32
198−word a b c d = (fromIntegral a `unsafeShiftL` 24)
162+word a b c d = (fromIntegral a `shiftL` 24)
199− .|. (fromIntegral b `unsafeShiftL` 16)
163+ .|. (fromIntegral b `shiftL` 16)
200− .|. (fromIntegral c `unsafeShiftL` 8)
164+ .|. (fromIntegral c `shiftL` 8)
201− .|. (fromIntegral d )
165+ .|. (fromIntegral d )
202
166
203−-- |Extract a Word8 from a Word64. Bytes, high to low, are numbered from 7 to 0,
167+-- |Extract a Word8 from a Word32. Bytes, high to low, are numbered from 3 to 0,
204−byte :: Int -> Word64 -> Word8
168+byte :: Int -> Word32 -> Word8
205byte i w = fromIntegral (w `shiftR` (i * 8))
169byte i w = fromIntegral (w `shiftR` (i * 8))
206
170
207−-- |Build a Word16 from two Word8 values, presented in big-endian order.
208−w8to16 :: Word8 -> Word8 -> Word16
209−w8to16 w0s w1s =
210− (w0 `unsafeShiftL` 8) .|. w1
211− where
212− w0 = fromIntegral w0s
213− w1 = fromIntegral w1s
214−
215−-- | Construct 'Word64' from low/high 'Word32's
216−w32to64 :: Word32 -> Word32 -> Word64
217−w32to64 w0 w1 = (fromIntegral w0 `unsafeShiftL` 32) .|. (fromIntegral w1)
218
171
219-- |Make a UUID from sixteen Word8 values
172-- |Make a UUID from sixteen Word8 values
220makeFromBytes :: Word8 -> Word8 -> Word8 -> Word8
173makeFromBytes :: Word8 -> Word8 -> Word8 -> Word8
@@ -223,12 +176,16 @@ makeFromBytes :: Word8 -> Word8 -> Word8 -> Word8
223 -> Word8 -> Word8 -> Word8 -> Word8
176 -> Word8 -> Word8 -> Word8 -> Word8
224 -> UUID
177 -> UUID
225makeFromBytes b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf
178makeFromBytes b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf
226− = fromWords w0 w1 w2 w3
179+ = UUID w0 w1 w2 w3
227 where w0 = word b0 b1 b2 b3
180 where w0 = word b0 b1 b2 b3
228 w1 = word b4 b5 b6 b7
181 w1 = word b4 b5 b6 b7
229 w2 = word b8 b9 ba bb
182 w2 = word b8 b9 ba bb
230 w3 = word bc bd be bf
183 w3 = word bc bd be bf
231
184
185+-- |Make a UUID from four Word32 values
186+makeFromWords :: Word32 -> Word32 -> Word32 -> Word32 -> UUID
187+makeFromWords = UUID
188+
232-- |A Builder for constructing a UUID of a given version.
189-- |A Builder for constructing a UUID of a given version.
233buildFromBytes :: Word8
190buildFromBytes :: Word8
234 -> Word8 -> Word8 -> Word8 -> Word8
191 -> Word8 -> Word8 -> Word8 -> Word8
@@ -241,20 +198,20 @@ buildFromBytes v b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf =
241 where b6' = b6 .&. 0x0f .|. (v `shiftL` 4)
198 where b6' = b6 .&. 0x0f .|. (v `shiftL` 4)
242 b8' = b8 .&. 0x3f .|. 0x80
199 b8' = b8 .&. 0x3f .|. 0x80
243
200
244−-- |Build a UUID of a given version from 'Word32' values.
201+-- |Build a UUID of a given version from Word32 values.
245buildFromWords :: Word8 -> Word32 -> Word32 -> Word32 -> Word32 -> UUID
202buildFromWords :: Word8 -> Word32 -> Word32 -> Word32 -> Word32 -> UUID
246−buildFromWords v w0 w1 w2 w3 = fromWords w0 w1' w2' w3
203+buildFromWords v w0 w1 w2 w3 = makeFromWords w0 w1' w2' w3
247 where w1' = w1 .&. 0xffff0fff .|. ((fromIntegral v) `shiftL` 12)
204 where w1' = w1 .&. 0xffff0fff .|. ((fromIntegral v) `shiftL` 12)
248 w2' = w2 .&. 0x3fffffff .|. 0x80000000
205 w2' = w2 .&. 0x3fffffff .|. 0x80000000
249
206
250
207
251-- |Return the bytes that make up the UUID
208-- |Return the bytes that make up the UUID
252toList :: UUID -> [Word8]
209toList :: UUID -> [Word8]
253−toList (UUID w0 w1) =
210+toList (UUID w0 w1 w2 w3) =
254− [byte 7 w0, byte 6 w0, byte 5 w0, byte 4 w0,
211+ [byte 3 w0, byte 2 w0, byte 1 w0, byte 0 w0,
255− byte 3 w0, byte 2 w0, byte 1 w0, byte 0 w0,
212+ byte 3 w1, byte 2 w1, byte 1 w1, byte 0 w1,
256− byte 7 w1, byte 6 w1, byte 5 w1, byte 4 w1,
213+ byte 3 w2, byte 2 w2, byte 1 w2, byte 0 w2,
257− byte 3 w1, byte 2 w1, byte 1 w1, byte 0 w1]
214+ byte 3 w3, byte 2 w3, byte 1 w3, byte 0 w3]
258
215
259-- |Construct a UUID from a list of Word8. Returns Nothing if the list isn't
216-- |Construct a UUID from a list of Word8. Returns Nothing if the list isn't
260-- exactly sixteen bytes long
217-- exactly sixteen bytes long
@@ -275,10 +232,10 @@ null = (== nil)
275 -- null (UUID 0 0 0 0) = True
232 -- null (UUID 0 0 0 0) = True
276 -- null _ = False
233 -- null _ = False
277
234
278−-- |The 'nil' UUID, as defined in <http://tools.ietf.org/html/rfc4122 RFC 4122>.
235+-- |The nil UUID, as defined in RFC 4122.
279−-- It is a UUID of all zeros. @'null' u@ /iff/ @'u' == 'nil'@.
236+-- It is a UUID of all zeros. @'null' u@ iff @'u' == 'nil'@.
280nil :: UUID
237nil :: UUID
281−nil = UUID 0 0
238+nil = UUID 0 0 0 0
282
239
283-- |Extract a UUID from a 'ByteString' in network byte order.
240-- |Extract a UUID from a 'ByteString' in network byte order.
284-- The argument must be 16 bytes long, otherwise 'Nothing' is returned.
241-- The argument must be 16 bytes long, otherwise 'Nothing' is returned.
@@ -286,8 +243,6 @@ fromByteString :: BL.ByteString -> Maybe UUID
286fromByteString = fromList . BL.unpack
243fromByteString = fromList . BL.unpack
287
244
288-- |Encode a UUID into a 'ByteString' in network order.
245-- |Encode a UUID into a 'ByteString' in network order.
289−--
290−-- This uses the same encoding as the 'Binary' instance.
291toByteString :: UUID -> BL.ByteString
246toByteString :: UUID -> BL.ByteString
292toByteString = BL.pack . toList
247toByteString = BL.pack . toList
293
248
@@ -295,8 +250,9 @@ toByteString = BL.pack . toList
295-- The hyphens may not be omitted.
250-- The hyphens may not be omitted.
296-- Example:
251-- Example:
297--
252--
253+-- @
298−-- >>> fromString "c2cc10e1-57d6-4b6f-9899-38d972112d8c"
254+-- fromString \"c2cc10e1-57d6-4b6f-9899-38d972112d8c\"
299−-- Just c2cc10e1-57d6-4b6f-9899-38d972112d8c
255+-- @
300--
256--
301-- Hex digits may be upper or lower-case.
257-- Hex digits may be upper or lower-case.
302fromString :: String -> Maybe UUID
258fromString :: String -> Maybe UUID
@@ -311,7 +267,7 @@ fromString' s0 = do
311 (w2, s3) <- hexWord s2
267 (w2, s3) <- hexWord s2
312 (w3, s4) <- hexWord s3
268 (w3, s4) <- hexWord s3
313 if s4 /= "" then Nothing
269 if s4 /= "" then Nothing
314− else Just $ fromWords w0 w1 w2 w3
270+ else Just $ UUID w0 w1 w2 w3
315 where hexWord :: String -> Maybe (Word32, String)
271 where hexWord :: String -> Maybe (Word32, String)
316 hexWord s = Just (0, s) >>= hexByte >>= hexByte
272 hexWord s = Just (0, s) >>= hexByte >>= hexByte
317 >>= hexByte >>= hexByte
273 >>= hexByte >>= hexByte
@@ -328,39 +284,21 @@ fromString' s0 = do
328-- | Convert a UUID into a hypenated string using lower-case letters.
284-- | Convert a UUID into a hypenated string using lower-case letters.
329-- Example:
285-- Example:
330--
286--
287+-- @
331−-- >>> toString <$> fromString "550e8400-e29b-41d4-a716-446655440000"
288+-- toString \<$\> fromString \"550e8400-e29b-41d4-a716-446655440000\"
332−-- Just "550e8400-e29b-41d4-a716-446655440000"
289+-- @
333−--
334−--
335toString :: UUID -> String
290toString :: UUID -> String
336−toString uuid = hexw0 w0 $ hexw1 w1 ""
291+toString (UUID w0 w1 w2 w3) = hexw w0 $ hexw' w1 $ hexw' w2 $ hexw w3 ""
337− where hexw0 :: Word64 -> String -> String
292+ where hexw :: Word32 -> String -> String
338− hexw0 w s = hexn w 60 : hexn w 56 : hexn w 52 : hexn w 48
339− : hexn w 44 : hexn w 40 : hexn w 36 : hexn w 32
340− : '-' : hexn w 28 : hexn w 24 : hexn w 20 : hexn w 16
293+ hexw w s = hexn w 28 : hexn w 24 : hexn w 20 : hexn w 16
341− : '-' : hexn w 12 : hexn w 8 : hexn w 4 : hexn w 0
294+ : hexn w 12 : hexn w 8 : hexn w 4 : hexn w 0 : s
342− : s
343−
344− hexw1 :: Word64 -> String -> String
345− hexw1 w s = '-' : hexn w 60 : hexn w 56 : hexn w 52 : hexn w 48
346− : '-' : hexn w 44 : hexn w 40 : hexn w 36 : hexn w 32
347− : hexn w 28 : hexn w 24 : hexn w 20 : hexn w 16
348− : hexn w 12 : hexn w 8 : hexn w 4 : hexn w 0
349− : s
350−
351− hexn :: Word64 -> Int -> Char
352− hexn w r = intToDigit $ fromIntegral ((w `shiftR` r) .&. 0xf)
353
295
354− (w0,w1) = toWords64 uuid
296+ hexw' :: Word32 -> String -> String
297+ hexw' w s = '-' : hexn w 28 : hexn w 24 : hexn w 20 : hexn w 16
298+ : '-' : hexn w 12 : hexn w 8 : hexn w 4 : hexn w 0 : s
355
299
356−-- | If the passed in `Text` can be parsed as an ASCII representation of
300+ hexn :: Word32 -> Int -> Char
357−-- a `UUID`, it will be. The hyphens may not be omitted.
301+ hexn w r = intToDigit $ fromIntegral ((w `shiftR` r) .&. 0xf)
358−fromText :: Text -> Maybe UUID
359−fromText = fromASCIIBytes . T.encodeUtf8
360−
361−-- | Convert a UUID into a hyphentated string using lower-case letters.
362−toText :: UUID -> Text
363−toText = T.decodeLatin1 . toASCIIBytes
364
302
365-- | Convert a UUID into a hyphentated string using lower-case letters, packed
303-- | Convert a UUID into a hyphentated string using lower-case letters, packed
366-- as ASCII bytes into `B.ByteString`.
304-- as ASCII bytes into `B.ByteString`.
@@ -454,9 +392,7 @@ fromASCIIBytes bs = do
454
392
455-- | Similar to `toASCIIBytes` except we produce a lazy `BL.ByteString`.
393-- | Similar to `toASCIIBytes` except we produce a lazy `BL.ByteString`.
456toLazyASCIIBytes :: UUID -> BL.ByteString
394toLazyASCIIBytes :: UUID -> BL.ByteString
457−toLazyASCIIBytes =
395+toLazyASCIIBytes = BL.fromStrict . toASCIIBytes
458− BL.fromStrict
459− . toASCIIBytes
460
396
461-- | Similar to `fromASCIIBytes` except parses from a lazy `BL.ByteString`.
397-- | Similar to `fromASCIIBytes` except parses from a lazy `BL.ByteString`.
462fromLazyASCIIBytes :: BL.ByteString -> Maybe UUID
398fromLazyASCIIBytes :: BL.ByteString -> Maybe UUID
@@ -467,18 +403,27 @@ fromLazyASCIIBytes bs =
467-- Class Instances
403-- Class Instances
468--
404--
469
405
470−-- | This 'Random' instance produces __insecure__ version 4 UUIDs as
471−-- specified in <http://tools.ietf.org/html/rfc4122 RFC 4122>.
472instance Random UUID where
406instance Random UUID where
473− random = uniform
407+ random g = (fromGenNext w0 w1 w2 w3 w4, g4)
408+ where (w0, g0) = next g
409+ (w1, g1) = next g0
410+ (w2, g2) = next g1
411+ (w3, g3) = next g2
412+ (w4, g4) = next g3
474 randomR _ = random -- range is ignored
413 randomR _ = random -- range is ignored
475
414
476−-- @since 1.0.4
415+-- |Build a UUID from the results of five calls to next on a StdGen.
477−instance Uniform UUID where
416+-- While next on StdGet returns an Int, it doesn't provide 32 bits of
478− uniformM gen = do
417+-- randomness. This code relies on at last 28 bits of randomness in the
479− w0 <- uniformWord64 gen
418+-- and optimizes its use so as to make only five random values, not six.
480− w1 <- uniformWord64 gen
419+fromGenNext :: Int -> Int -> Int -> Int -> Int -> UUID
420+fromGenNext w0 w1 w2 w3 w4 =
481− pure $ buildFromBytes 4 /-/ w0 /-/ w1
421+ buildFromBytes 4 /-/ (ThreeByte w0)
422+ /-/ (ThreeByte w1)
423+ /-/ w2 -- use all 4 bytes because we know the version
424+ -- field will "cover" the upper, non-random bits
425+ /-/ (ThreeByte w3)
426+ /-/ (ThreeByte w4)
482
427
483-- |A ByteSource to extract only three bytes from an Int, since next on StdGet
428-- |A ByteSource to extract only three bytes from an Int, since next on StdGet
484-- only returns 31 bits of randomness.
429-- only returns 31 bits of randomness.
@@ -486,29 +431,24 @@ type instance ByteSink ThreeByte g = Takes3Bytes g
486newtype ThreeByte = ThreeByte Int
431newtype ThreeByte = ThreeByte Int
487instance ByteSource ThreeByte where
432instance ByteSource ThreeByte where
488 f /-/ (ThreeByte w) = f b1 b2 b3
433 f /-/ (ThreeByte w) = f b1 b2 b3
489− where b1 = fromIntegral (w `unsafeShiftR` 16)
434+ where b1 = fromIntegral (w `shiftR` 16)
490− b2 = fromIntegral (w `unsafeShiftR` 8)
435+ b2 = fromIntegral (w `shiftR` 8)
491 b3 = fromIntegral w
436 b3 = fromIntegral w
492
437
493instance NFData UUID where
438instance NFData UUID where
494− rnf = flip seq ()
439+ rnf = rnf . toWords
495
440
496instance Hashable UUID where
441instance Hashable UUID where
497− hash (toWords -> (w0,w1,w2,w3)) =
442+ hash (UUID w0 w1 w2 w3) =
498 hash w0 `hashWithSalt` w1
443 hash w0 `hashWithSalt` w1
499 `hashWithSalt` w2
444 `hashWithSalt` w2
500 `hashWithSalt` w3
445 `hashWithSalt` w3
501− hashWithSalt s (toWords -> (w0,w1,w2,w3)) =
446+ hashWithSalt s (UUID w0 w1 w2 w3) =
502 s `hashWithSalt` w0
447 s `hashWithSalt` w0
503 `hashWithSalt` w1
448 `hashWithSalt` w1
504 `hashWithSalt` w2
449 `hashWithSalt` w2
505 `hashWithSalt` w3
450 `hashWithSalt` w3
506
451
507−-- | Pretty prints a 'UUID' (without quotation marks). See also 'toString'.
508−--
509−-- >>> show nil
510−-- "00000000-0000-0000-0000-000000000000"
511−--
512instance Show UUID where
452instance Show UUID where
513 show = toString
453 show = toString
514
454
@@ -519,7 +459,7 @@ instance Read UUID where
519 Nothing -> []
459 Nothing -> []
520 Just u -> [(u,drop 36 noSpaces)]
460 Just u -> [(u,drop 36 noSpaces)]
521
461
522−-- | This 'Storable' instance uses the memory layout as described in <http://tools.ietf.org/html/rfc4122 RFC 4122>, but in contrast to the 'Binary' instance, __the fields are stored in host byte order__.
462+
523instance Storable UUID where
463instance Storable UUID where
524 sizeOf _ = 16
464 sizeOf _ = 16
525 alignment _ = 4
465 alignment _ = 4
@@ -556,10 +496,10 @@ instance Storable UUID where
556 pokeByteOff p (off+14) x9
496 pokeByteOff p (off+14) x9
557 pokeByteOff p (off+15) x10
497 pokeByteOff p (off+15) x10
558
498
559−-- | This 'Binary' instance is compatible with <http://tools.ietf.org/html/rfc4122 RFC 4122>, storing the fields in network order as 16 bytes.
560instance Binary UUID where
499instance Binary UUID where
561− put (UUID w0 w1) = putWord64be w0 >> putWord64be w1
500+ put (UUID w0 w1 w2 w3) =
562− get = liftM2 UUID getWord64be getWord64be
501+ putWord32be w0 >> putWord32be w1 >> putWord32be w2 >> putWord32be w3
502+ get = liftM4 UUID getWord32be getWord32be getWord32be getWord32be
563
503
564
504
565-- My goal with this instance was to make it work just enough to do what
505-- My goal with this instance was to make it work just enough to do what
@@ -570,6 +510,10 @@ instance Data UUID where
570 dataTypeOf _ = uuidType
510 dataTypeOf _ = uuidType
571
511
572uuidType :: DataType
512uuidType :: DataType
573−uuidType = mkNoRepType "Data.UUID.Types.UUID"
513+uuidType = mkNoRepType "Data.UUID.UUID"
514+
515+#if !(MIN_VERSION_base(4,2,0))
516+mkNoRepType :: String -> DataType
517+mkNoRepType = mkNorepType
518+#endif
574
519
575−deriving instance Lift UUID
uuid/src/Data/UUID/Named.hs → Data/UUID/Named.hsrenamed+1−1
@@ -26,7 +26,7 @@ module Data.UUID.Named
26 ,namespaceX500
26 ,namespaceX500
27 ) where
27 ) where
28
28
29−import Data.UUID.Types.Internal
29+import Data.UUID.Internal
30
30
31import Control.Applicative ((<*>),(<$>))
31import Control.Applicative ((<*>),(<$>))
32import Data.Binary.Get (runGet, getWord32be)
32import Data.Binary.Get (runGet, getWord32be)
Data/UUID/V1.hsnew file+138
@@ -0,0 +1,138 @@
1+{-# OPTIONS_GHC -fno-cse #-}
2+{-# LANGUAGE TypeFamilies #-}
3+
4+{- |
5+Module : Data.UUID.V1
6+Copyright : (c) 2008 Jason Dusek
7+ (c) 2009 Mark Lentczner
8+ (c) 2009-2010,2012 Antoine Latter
9+
10+License : BSD-style
11+
12+Maintainer : aslatter@gmail.com
13+Stability : experimental
14+Portability : portable
15+
16+RFC 4122 Version 1 UUID state machine.
17+
18+The generated UUID is based on the hardware MAC
19+address and the system clock.
20+
21+If we cannot lookup the MAC address we seed the
22+generator with a psuedo-random number.
23+-}
24+
25+module Data.UUID.V1(nextUUID)
26+where
27+
28+
29+import Data.Bits
30+import Data.Maybe
31+import Data.Time
32+import Data.Word
33+
34+import Control.Applicative ((<$>),(<*>))
35+import Control.Concurrent.MVar
36+import System.IO.Unsafe
37+
38+import qualified System.Random as R
39+
40+import Network.Info
41+
42+import Data.UUID.Builder
43+import Data.UUID.Internal
44+
45+-- | Returns a new UUID derived from the local hardware MAC
46+-- address and the current system time.
47+-- Is generated according to the Version 1 UUID sepcified in
48+-- RFC 4122.
49+--
50+-- Returns 'Nothing' if you request UUIDs too quickly.
51+nextUUID :: IO (Maybe UUID)
52+nextUUID = do
53+ res <- stepTime
54+ case res of
55+ Just (mac', c, t) -> return $ Just $ makeUUID t c mac'
56+ _ -> return Nothing
57+
58+
59+makeUUID :: Word64 -> Word16 -> MAC -> UUID
60+makeUUID time clock mac' =
61+ buildFromBytes 1 /-/ tLow /-/ tMid /-/ tHigh /-/ clock /-/ (MACSource mac')
62+ where tLow = (fromIntegral time) :: Word32
63+ tMid = (fromIntegral (time `shiftR` 32)) :: Word16
64+ tHigh = (fromIntegral (time `shiftR` 48)) :: Word16
65+
66+newtype MACSource = MACSource MAC
67+instance ByteSource MACSource where
68+ z /-/ (MACSource (MAC a b c d e f)) = z a b c d e f
69+type instance ByteSink MACSource g = Takes3Bytes (Takes3Bytes g)
70+
71+
72+-- |Approximates the clock algorithm in RFC 4122, section 4.2
73+-- Isn't system wide or thread safe, nor does it properly randomize
74+-- the clock value on initialization.
75+stepTime :: IO (Maybe (MAC, Word16, Word64))
76+stepTime = do
77+ h1 <- fmap hundredsOfNanosSinceGregorianReform getCurrentTime
78+ modifyMVar state $ \s@(State mac' c0 h0) ->
79+ if h1 > h0
80+ then
81+ return (State mac' c0 h1, Just (mac', c0, h1))
82+ else
83+ let
84+ c1 = succ c0
85+ in if c1 <= 0x3fff -- when clock is initially randomized,
86+ -- then this test will need to change
87+ then
88+ return (State mac' c1 h1, Just (mac', c1, h1))
89+ else
90+ return (s, Nothing)
91+
92+
93+{-# NOINLINE state #-}
94+state :: MVar State
95+state = unsafePerformIO $ do
96+ h0 <- fmap hundredsOfNanosSinceGregorianReform getCurrentTime
97+ mac' <- getMac
98+ newMVar $ State mac' 0 h0 -- the 0 should be a random number
99+
100+-- SysMAC.mac can fail on some machines.
101+-- In those cases we fake it with a random
102+-- 6 bytes seed.
103+getMac :: IO MAC
104+getMac =
105+ getNetworkInterfaces >>=
106+ return . listToMaybe . filter (minBound /=) . map mac >>=
107+ \macM -> case macM of
108+ Just m -> return m
109+ Nothing -> randomMac
110+
111+randomMac :: IO MAC
112+randomMac =
113+ -- I'm too lazy to thread through
114+ -- the random state ...
115+ MAC
116+ <$> (R.randomIO >>= return . (1 .|.)) -- We must set the multicast bit to True. See section 4.5 of the RFC.
117+ <*> R.randomIO
118+ <*> R.randomIO
119+ <*> R.randomIO
120+ <*> R.randomIO
121+ <*> R.randomIO
122+
123+data State = State
124+ {-# UNPACK #-} !MAC
125+ {-# UNPACK #-} !Word16
126+ {-# UNPACK #-} !Word64
127+ deriving (Show)
128+
129+
130+
131+hundredsOfNanosSinceGregorianReform :: UTCTime -> Word64
132+hundredsOfNanosSinceGregorianReform t = floor $ 10000000 * dt
133+ where
134+ gregorianReform = UTCTime (fromGregorian 1582 10 15) 0
135+ dt = t `diffUTCTime` gregorianReform
136+
137+
138+
uuid/src/Data/UUID/V3.hs → Data/UUID/V3.hsrenamed+3−2
@@ -8,7 +8,7 @@ Maintainer : aslatter@gmail.com
8Stability : experimental
8Stability : experimental
9Portability : portable
9Portability : portable
10
10
11−NOTE\: This module uses MD5 hashing. Unless you know
11+NOTE: This module uses MD5 hashing. Unless you know
12you need to use this module, you should probably be
12you need to use this module, you should probably be
13using "Data.UUID.V5", which offers the same sort of
13using "Data.UUID.V5", which offers the same sort of
14functionality as this module except implemented with
14functionality as this module except implemented with
@@ -33,7 +33,7 @@ module Data.UUID.V3
33
33
34import Data.Word
34import Data.Word
35
35
36−import Data.UUID.Types.Internal
36+import Data.UUID.Internal
37import qualified Data.UUID.Named as Shared
37import qualified Data.UUID.Named as Shared
38import qualified Crypto.Hash.MD5 as MD5
38import qualified Crypto.Hash.MD5 as MD5
39
39
@@ -47,3 +47,4 @@ generateNamed :: UUID -- ^Namespace
47 -> [Word8] -- ^Object
47 -> [Word8] -- ^Object
48 -> UUID
48 -> UUID
49generateNamed = Shared.generateNamed MD5.hash 3
49generateNamed = Shared.generateNamed MD5.hash 3
50+
Data/UUID/V4.hsnew file+29
@@ -0,0 +1,29 @@
1+{- |
2+ Module : Data.UUID.V4
3+ Copyright : (c) 2012 Antoine Latter
4+
5+ License : BSD-style
6+
7+ Maintainer : aslatter@gmail.com
8+ Stability : experimental
9+ Portability : portable
10+
11+ This module implements Version 4 UUIDs as specified
12+ in RFC 4122.
13+
14+ These UUIDs are generated from a psuedo-random generator.
15+ We use the System.Random 'R.StdGen' as our random source.
16+
17+ All of the logic is encapsulated in the 'R.Random' instance
18+ for the UUID type, so you are also free to use the random generator
19+ of your choice.
20+-}
21+module Data.UUID.V4 (nextRandom) where
22+
23+import Data.UUID
24+import qualified System.Random as R
25+
26+-- | Generate a random UUID. Introduced in version 1.2.6.
27+nextRandom :: IO UUID
28+nextRandom = R.randomIO
29+
uuid/src/Data/UUID/V5.hs → Data/UUID/V5.hsrenamed+2−1
@@ -28,7 +28,7 @@ module Data.UUID.V5
28
28
29import Data.Word
29import Data.Word
30
30
31−import Data.UUID.Types.Internal
31+import Data.UUID.Internal
32import qualified Data.UUID.Named as Shared
32import qualified Data.UUID.Named as Shared
33import qualified Crypto.Hash.SHA1 as SHA1
33import qualified Crypto.Hash.SHA1 as SHA1
34
34
@@ -42,3 +42,4 @@ generateNamed :: UUID -- ^Namespace
42 -> [Word8] -- ^Object
42 -> [Word8] -- ^Object
43 -> UUID
43 -> UUID
44generateNamed = Shared.generateNamed SHA1.hash 5
44generateNamed = Shared.generateNamed SHA1.hash 5
45+
uuid/Demo.hs → Demo.hsrenamed+1
@@ -13,3 +13,4 @@ main = sequence_ $ replicate count $ do
13 x <- newUUID
13 x <- newUUID
14 y <- newUUID
14 y <- newUUID
15 seq (x == y) $ return ()
15 seq (x == y) $ return ()
16+
uuid-bench/LICENSE → LICENSErenamed

The content is the same.

Policy.mddeleted−11
@@ -1,11 +0,0 @@
1−# Versioning
2−
3−Because many consumers of the `UUID` type receive the type
4−through the `uuid` package and not the `uuid-types` package
5−we need to be careful about removing instances from the `uuid`
6−type.
7−
8−If the `uuid-types` package has a major-version bump because of
9−the removal of a class instance then we must also bump the major
10−version of the `uuid` package when we update the package
11−description to pull in the new version of `uuid-types`.
README.mddeleted−12
@@ -1,12 +0,0 @@
1−# uuid [![Build Status](https://travis-ci.org/hvr/uuid.svg?branch=master)](https://travis-ci.org/hvr/uuid)
2−
3−This library is useful for creating, comparing, parsing and printing Universally
4−Unique Identifiers. See http://en.wikipedia.org/wiki/UUID for the general idea.
5−
6−We offer two different packages: `uuid` and `uuid-types`
7−
8−The `uuid` package aims to be a fully-featured library for working with UUIDs.
9−
10−However if you're developing a library and only want the `UUID` type to show up
11−in your APIs you may want to use the `uuid-types` library to minimize the number
12−of dependencies needed by users of your library.
uuid-types/Setup.hs → Setup.hsrenamed

The content is the same.

cabal.bench.projectdeleted−4
@@ -1,4 +0,0 @@
1−-- separate package for benchmarks
2−-- this way we can build criterion
3−packages: uuid-bench
4−benchmarks: True
cabal.haskell-cideleted−7
@@ -1,7 +0,0 @@
1−branches: master
2−-- jobs-selection: any
3−head-hackage: False
4−
5−constraint-set random-1.2
6− ghc: >=7.10
7− constraints: random==1.2.*
cabal.projectdeleted−15
@@ -1,15 +0,0 @@
1−-- see http://cabal.readthedocs.io/en/latest/nix-local-build.html
2−-- for more details
3−
4−packages: uuid-types/
5−packages: uuid/
6−
7−package uuid-types
8− tests: True
9− -- profiling: True
10− -- profiling-detail: toplevel-functions
11−
12−package uuid
13− tests: True
14− -- profiling: True
15− -- profiling-detail: toplevel-functions
gen-ci.shdeleted−5
@@ -1,5 +0,0 @@
1−#!/bin/sh
2−
3−# haskell-ci doesn't know how to regenerate multiple GHA workflows
4−haskell-ci github cabal.project
5−haskell-ci github --project cabal.bench.project -o .github/workflows/haskell-ci-bench.yml --github-action-name Benchmarks
tests/BenchByteString.hsnew file+82
@@ -0,0 +1,82 @@
1+import Control.Applicative ((<*>))
2+import Data.Functor ((<$>))
3+
4+import Data.ByteString (ByteString)
5+import qualified Data.ByteString.Char8 as BC8
6+import System.Random
7+import Test.QuickCheck
8+
9+import Criterion
10+import Criterion.Main
11+
12+import Data.UUID
13+
14+instance Arbitrary UUID where
15+ arbitrary =
16+ fromWords <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
17+
18+-- Testing what we do in the codebase
19+fromASCIIBytes_naive :: ByteString -> Maybe UUID
20+fromASCIIBytes_naive = fromString . BC8.unpack
21+
22+toASCIIBytes_naive :: UUID -> ByteString
23+toASCIIBytes_naive = BC8.pack . toString
24+
25+randomUUIDs :: IO [UUID]
26+randomUUIDs = sample' arbitrary
27+
28+randomCorrect :: IO [String]
29+randomCorrect = map toString <$> randomUUIDs
30+
31+randomSlightlyWrong :: IO [String]
32+randomSlightlyWrong = mapM screw =<< randomCorrect
33+ where
34+ screw s = do
35+ ix <- randomRIO (0, length s - 1)
36+ return (take ix s ++ "x" ++ drop (ix + 1) s)
37+
38+randomVeryWrong :: IO [String]
39+randomVeryWrong = sample' arbitrary
40+
41+main :: IO ()
42+main = do
43+ uuids <- randomUUIDs
44+ correct <- randomCorrect
45+ let correctBytes = map BC8.pack correct
46+ slightlyWrong <- randomSlightlyWrong
47+ let slightlyWrongBytes = map BC8.pack slightlyWrong
48+ veryWrong <- randomVeryWrong
49+ let veryWrongBytes = map BC8.pack veryWrong
50+
51+ defaultMain
52+ [ bgroup "decoding"
53+ [ bcompare
54+ [ bgroup "correct"
55+ [ bench "fromASCIIBytes" (nf (map fromASCIIBytes) correctBytes)
56+ , bench "fromString" (nf (map fromString) correct)
57+ , bench "fromASCIIBytes_naive" (nf (map fromASCIIBytes_naive) correctBytes)
58+ ]
59+ ]
60+ , bcompare
61+ [ bgroup "slightly wrong"
62+ [ bench "fromASCIIBytes" (nf (map fromASCIIBytes) slightlyWrongBytes)
63+ , bench "fromString" (nf (map fromString) slightlyWrong)
64+ , bench "fromASCIIBytes_naive" (nf (map fromASCIIBytes_naive) slightlyWrongBytes)
65+ ]
66+ ]
67+ , bcompare
68+ [ bgroup "very wrong"
69+ [ bench "fromASCIIBytes" (nf (map fromASCIIBytes) veryWrongBytes)
70+ , bench "fromString" (nf (map fromString) veryWrong)
71+ , bench "fromASCIIBytes_naive" (nf (map fromASCIIBytes_naive) veryWrongBytes)
72+ ]
73+ ]
74+ ]
75+ , bcompare
76+ [ bgroup "encoding"
77+ [ bench "toASCIIBytes" (nf (map toASCIIBytes) uuids)
78+ , bench "toString" (nf (map toString) uuids)
79+ , bench "toASCIIBytes_naive" (nf (map toASCIIBytes_naive) uuids)
80+ ]
81+ ]
82+ ]
uuid-bench/bench/uuid-types-benchmark.hs → tests/BenchUUID.hsrenamed+64−57
@@ -1,22 +1,26 @@
1{-# LANGUAGE CPP #-}
1{-# LANGUAGE CPP #-}
2
2
3#if !(MIN_VERSION_bytestring(0,10,0))
3#if !(MIN_VERSION_bytestring(0,10,0))
4−{-# OPTIONS_GHC -fno-warn-orphans #-}
5-- Needed for NFData instance
4-- Needed for NFData instance
6−import Control.DeepSeq
5+import Control.DeepSeq
7import qualified Data.ByteString.Lazy.Internal as BL
6import qualified Data.ByteString.Lazy.Internal as BL
8#endif
7#endif
9−import Criterion.Main
8+import Criterion.Main
9+import Data.Char (ord)
10+import Data.IORef
11+import Data.Maybe (fromJust)
12+import Data.Word
13+import qualified Data.Set as Set
10−import qualified Data.ByteString.Lazy as BL
14+import qualified Data.ByteString.Lazy as BL
11−import qualified Data.HashSet as HashSet
15+import qualified Data.UUID as U
12−import Data.Maybe (fromJust)
16+import qualified Data.UUID.V1 as U
13−import qualified Data.Set as Set
17+import qualified Data.UUID.V3 as U3
14−import qualified Data.UUID.Types as U
18+import qualified Data.UUID.V5 as U5
15−import Foreign (alloca, peek, poke)
19+import Foreign (alloca, peek, poke)
20+import System.Random
16−import System.Random
21+import System.Random.Mersenne.Pure64
17
22
18#if !(MIN_VERSION_bytestring(0,10,0))
23#if !(MIN_VERSION_bytestring(0,10,0))
19−-- orphan
20instance NFData BL.ByteString where
24instance NFData BL.ByteString where
21 rnf BL.Empty = ()
25 rnf BL.Empty = ()
22 rnf (BL.Chunk _ ts) = rnf ts
26 rnf (BL.Chunk _ ts) = rnf ts
@@ -24,60 +28,62 @@ instance NFData BL.ByteString where
24
28
25main :: IO ()
29main :: IO ()
26main = do
30main = do
27− u1 <- randomIO
31+ u1 <- randomIO
28− let s1 = U.toString u1
32+ let s1 = U.toString u1
29− b1 = U.toByteString u1
33+ b1 = U.toByteString u1
30− a1 = U.toASCIIBytes u1
34+ n1 = (map (fromIntegral . ord) "http://www.haskell.org/") :: [Word8]
31− t1 = U.toText u1
32− (w1a,w1b,w1c,w1d) = U.toWords u1
33− nil2 = fromJust $
35+ nil2 = fromJust $
34− U.fromString "00000000-0000-0000-0000-000000000000"
36+ U.fromString "00000000-0000-0000-0000-000000000000"
35− u2a = fromJust $ U.fromString "169a5a43-c051-4a16-98f4-08447ddd5dc0"
37+ u2a = fromJust $ U.fromString "169a5a43-c051-4a16-98f4-08447ddd5dc0"
36− u2b = fromJust $ U.fromByteString $
38+ u2b = fromJust $ U.fromByteString $
37− BL.pack [0x16, 0x9a, 0x5a, 0x43, 0xc0, 0x51, 0x4a, 0x16,
39+ BL.pack [0x16, 0x9a, 0x5a, 0x43, 0xc0, 0x51, 0x4a, 0x16,
38− 0x98, 0xf4, 0x08, 0x44, 0x7d, 0xdd, 0x5d, 0xc0]
40+ 0x98, 0xf4, 0x08, 0x44, 0x7d, 0xdd, 0x5d, 0xc0]
39− u3 = fromJust $ U.fromString "dea6f619-1038-438b-b4af-f1cdec1e6e23"
41+ u3 = fromJust $ U.fromString "dea6f619-1038-438b-b4af-f1cdec1e6e23"
40
42
41− -- setup for Storable benchmark
43+ -- setup for random generation
42− alloca $ \ uuidPtr -> do
44+ randomState <- newPureMT >>= newIORef
45+ let randomUUID = do
46+ state <- readIORef randomState
47+ let (uuid, state') = random state
48+ writeIORef randomState state'
49+ return uuid
43
50
51+ -- setup for Storable benchmark
44− poke uuidPtr u1
52+ alloca $ \ uuidPtr -> do
45
53
46− defaultMain [
54+ poke uuidPtr u1
47− bgroup "testing" [
48− bench "null non-nil" $ whnf U.null u1,
49− bench "null nil" $ whnf U.null U.nil,
50− bench "null nil2" $ whnf U.null nil2,
51− bench "eq same" $ whnf (==u2a) u2b,
52− bench "eq differ" $ whnf (==u2a) u3,
53− bench "compare same" $ whnf (compare u2a) u2b,
54− bench "compare differ" $ whnf (compare u2a) u3
55− ],
56− bgroup "conversion" [
57− bench "toString" $ nf U.toString u1,
58− bench "fromString" $ nf U.fromString s1,
59− bench "toByteString" $ nf U.toByteString u1,
60− bench "fromByteString" $ nf U.fromByteString b1,
61− bench "toASCIIBytes" $ nf U.toASCIIBytes u1,
62− bench "fromASCIIBytes" $ nf U.fromASCIIBytes a1,
63− bench "toWords" $ nf U.toWords u1,
64− bench "fromWords" $ nf (U.fromWords w1a w1b w1c) w1d,
65− bench "toText" $ nf U.toText u1,
66− bench "fromText" $ nf U.fromText t1
67− ],
68
55
69− bench "Set making" $ nf Set.fromList uuids,
56+ defaultMain [
57+ bgroup "testing" [
58+ bench "null non-nil" $ whnf U.null u1,
59+ bench "null nil" $ whnf U.null U.nil,
60+ bench "null nil2" $ whnf U.null nil2,
61+ bench "eq same" $ whnf (==u2a) u2b,
62+ bench "eq differ" $ whnf (==u2a) u3
63+ ],
64+ bgroup "conversion" [
65+ bench "toString" $ nf U.toString u1,
66+ bench "fromString" $ nf U.fromString s1,
67+ bench "toByteString" $ nf U.toByteString u1,
68+ bench "fromByteString" $ nf U.fromByteString b1
69+ ],
70+ bgroup "generation" [
71+ bench "V1" $ nfIO U.nextUUID,
72+ bench "V4" $ nfIO (randomUUID :: IO U.UUID),
73+ bench "V3" $ nf (U3.generateNamed U3.namespaceURL) n1,
74+ bench "V5" $ nf (U5.generateNamed U5.namespaceURL) n1
75+ ],
70− bench "HashSet making" $ nf HashSet.fromList uuids,
76+ bench "set making" $ nf Set.fromList uuids,
71−
77+
72− bgroup "storable" [
78+ bgroup "storable" [
73− bench "peek" $ nfIO (peek uuidPtr),
79+ bench "peek" $ nfIO (peek uuidPtr),
74− bench "poke" $ whnfIO $ poke uuidPtr u1
80+ bench "poke" $ poke uuidPtr u1
81+ ]
75 ]
82 ]
76− ]
77
83
78-- 50 uuids, so tests can be repeatable
84-- 50 uuids, so tests can be repeatable
79uuids :: [U.UUID]
85uuids :: [U.UUID]
80−uuids
86+uuids
81 = map (fromJust . U.fromString)
87 = map (fromJust . U.fromString)
82 [
88 [
83 "35d42593-1fca-4465-b588-a2e78cb996ba",
89 "35d42593-1fca-4465-b588-a2e78cb996ba",
@@ -131,3 +137,4 @@ uuids
131 "8091837c-6456-42c3-a686-f4731a41d4f9",
137 "8091837c-6456-42c3-a686-f4731a41d4f9",
132 "2a0e2efb-a11c-4a44-81ee-3efc37379b48"
138 "2a0e2efb-a11c-4a44-81ee-3efc37379b48"
133 ]
139 ]
140+
uuid-types/tests/TestUUID.hs → tests/TestUUID.hsrenamed+100−94
@@ -1,95 +1,86 @@
1{-# LANGUAGE ViewPatterns #-}
1{-# LANGUAGE ViewPatterns #-}
2−{-# LANGUAGE TemplateHaskell #-}
2+import Control.Monad (replicateM)
3+import Data.Bits
4+import qualified Data.ByteString.Lazy as BL
5+import qualified Data.ByteString.Char8 as BC8
6+import Data.Char (ord)
7+import Data.Functor ((<$>))
8+import Data.List (nub, (\\))
9+import Data.Maybe
10+import Data.Word
11+import qualified Data.UUID as U
12+import qualified Data.UUID.V1 as U
13+import qualified Data.UUID.V3 as U3
14+import qualified Data.UUID.V5 as U5
15+import Foreign (alloca, peek, poke)
16+import System.IO.Unsafe (unsafePerformIO)
17+import qualified Test.HUnit as H
18+import Test.HUnit hiding (Test)
19+import Test.QuickCheck hiding ((.&.))
20+import Test.Framework (defaultMain, Test)
21+import Test.Framework.Providers.HUnit (hUnitTestToTests)
22+import Test.Framework.Providers.QuickCheck2 (testProperty)
23+
24+
25+isValidVersion :: Int -> U.UUID -> Bool
26+isValidVersion v u = lenOK && variantOK && versionOK
27+ where bs = U.toByteString u
28+ lenOK = BL.length bs == 16
29+ variantOK = (BL.index bs 8) .&. 0xc0 == 0x80
30+ versionOK = (BL.index bs 6) .&. 0xf0 == fromIntegral (v `shiftL` 4)
3
31
4−{-# OPTIONS_GHC -fno-warn-orphans #-}
5
32
6−import Data.Binary (encode)
7−import qualified Data.ByteString.Char8 as BC8
8−import qualified Data.ByteString.Lazy as BL
9−import qualified Data.ByteString.Lazy.Char8 as BL8
10−import Data.Char (ord)
11−import Data.Functor ((<$>))
12−import qualified Data.UUID.Types as U
13−import Data.Word
14−import Foreign (alloca, castPtr, peek, poke,
15− sizeOf)
16−import GHC.ByteOrder (ByteOrder(..), targetByteOrder)
17−import System.IO.Unsafe (unsafePerformIO)
18−
19−import Test.QuickCheck (Arbitrary (arbitrary), choose)
20−
21−import Test.Tasty (TestTree, defaultMain, testGroup)
22−import Test.Tasty.HUnit (assertBool, testCase, (@=?), (@?=))
23−import Test.Tasty.QuickCheck (testProperty)
24−
25−
26−-- orphan
27instance Arbitrary U.UUID where
33instance Arbitrary U.UUID where
28 -- the UUID random instance ignores bounds
34 -- the UUID random instance ignores bounds
29 arbitrary = choose (U.nil, U.nil)
35 arbitrary = choose (U.nil, U.nil)
30
36
31−type Test = TestTree
32−
33−test_null :: Test
34−test_null =
35− testCase "nil is null" $
36− assertBool "" (U.null U.nil)
37
37
38−test_nil :: Test
38+test_null :: H.Test
39−test_nil = testGroup "nil" [
39+test_null = H.TestList [
40− testCase "nil string" $ U.toString U.nil @?= "00000000-0000-0000-0000-000000000000",
40+ "nil is null" ~: assertBool "" (U.null U.nil),
41− testCase "nil bytes" $ U.toByteString U.nil @?= BL.pack (replicate 16 0)
41+ "namespaceDNS is not null" ~: assertBool "" (not $ U.null U3.namespaceDNS)
42 ]
42 ]
43
43
44−test_lift :: Test
44+test_nil :: H.Test
45−test_lift = testCase "TH.Lift" $ do
45+test_nil = H.TestList [
46− let uuid = U.fromWords64 123456789 987654321
46+ "nil string" ~: U.toString U.nil @?= "00000000-0000-0000-0000-000000000000",
47− uuid @?= $( [| uuid |] )
47+ "nil bytes" ~: U.toByteString U.nil @?= BL.pack (replicate 16 0)
48+ ]
48
49
49−test_conv :: Test
50+test_conv :: H.Test
50−test_conv = testGroup "conversions" [
51+test_conv = H.TestList [
51− testCase "conv bytes to string" $
52+ "conv bytes to string" ~:
52 maybe "" (U.toString) (U.fromByteString b16) @?= s16,
53 maybe "" (U.toString) (U.fromByteString b16) @?= s16,
53− testCase "conv string to bytes" $
54+ "conv string to bytes" ~:
54 maybe BL.empty (U.toByteString) (U.fromString s16) @?= b16
55 maybe BL.empty (U.toByteString) (U.fromString s16) @?= b16
55 ]
56 ]
56 where b16 = BL.pack [1..16]
57 where b16 = BL.pack [1..16]
57 s16 = "01020304-0506-0708-090a-0b0c0d0e0f10"
58 s16 = "01020304-0506-0708-090a-0b0c0d0e0f10"
58
59
59−-- | Test fromByteString with a fixed-input.
60+test_v1 :: [Maybe U.UUID] -> H.Test
60−test_fromByteString :: Test
61+test_v1 v1s = H.TestList [
61−test_fromByteString =
62+ "V1 unique" ~: nub (v1s \\ nub v1s) @?= [],
62− testCase "UUID fromByteString" $
63+ "V1 not null" ~: H.TestList $ map (testUUID (not . U.null)) v1s,
63− Just inputUUID @=?
64+ "V1 valid" ~: H.TestList $ map (testUUID (isValidVersion 1)) v1s
64− U.fromByteString (BL8.pack "\xa5\xca\x85\x66\xd9\xc5\x48\x35\x99\xc8\xe1\xf1\x3e\x73\xb5\xe2")
65+ ]
65−
66+ where testUUID :: (U.UUID -> Bool) -> Maybe U.UUID -> H.Test
66−-- | Test fromWords with a fixed-input
67+ testUUID p u = maybe False p u ~? show u
67−test_fromWords :: Test
68−test_fromWords =
69− testCase "UUID fromWords" $
70− inputUUID @=? U.fromWords 0xa5ca8566 0xd9c54835 0x99c8e1f1 0x3e73b5e2
71−
72−
73−test_Storeable :: Test
74−test_Storeable =
75− testCase "UUID Storeable(poke)" $
76− case targetByteOrder of
77− LittleEndian -> BC8.pack "\x66\x85\xca\xa5\xc5\xd9\x35\x48\x99\xc8\xe1\xf1\x3e\x73\xb5\xe2" @=? pokeAsBS inputUUID
78− BigEndian -> BC8.pack "\xa5\xca\x85\x66\xd9\xc5\x48\x35\x99\xc8\xe1\xf1\x3e\x73\xb5\xe2" @=? pokeAsBS inputUUID
79− where
80− pokeAsBS :: U.UUID -> BC8.ByteString
81− pokeAsBS uuid = unsafePerformIO $ do
82− alloca $ \ptr -> do
83− poke ptr uuid
84− BC8.packCStringLen (castPtr ptr, sizeOf uuid)
85
68
86−test_Binary :: Test
69+test_v3 :: H.Test
87−test_Binary =
70+test_v3 = H.TestList [
88− testCase "UUID Binary(encode)" $
71+ "V3 computation" ~:
89− (BL8.pack "\xa5\xca\x85\x66\xd9\xc5\x48\x35\x99\xc8\xe1\xf1\x3e\x73\xb5\xe2") @=? encode inputUUID
72+ U3.generateNamed U3.namespaceDNS name @?= uV3
73+ ]
74+ where name = map (fromIntegral . ord) "www.widgets.com" :: [Word8]
75+ uV3 = fromJust $ U.fromString "3d813cbb-47fb-32ba-91df-831e1593ac29"
90
76
91−inputUUID :: U.UUID
77+test_v5 :: H.Test
92−inputUUID = read "a5ca8566-d9c5-4835-99c8-e1f13e73b5e2"
78+test_v5 = H.TestList [
79+ "V5 computation" ~:
80+ U5.generateNamed U5.namespaceDNS name @?= uV5
81+ ]
82+ where name = map (fromIntegral . ord) "www.widgets.com" :: [Word8]
83+ uV5 = fromJust $ U.fromString "21f7f8de-8051-5b89-8680-0195ef798b6a"
93
84
94prop_stringRoundTrip :: Test
85prop_stringRoundTrip :: Test
95prop_stringRoundTrip = testProperty "String round trip" stringRoundTrip
86prop_stringRoundTrip = testProperty "String round trip" stringRoundTrip
@@ -122,6 +113,31 @@ prop_randomNotNull = testProperty "Random not null" randomNotNull
122 where randomNotNull :: U.UUID -> Bool
113 where randomNotNull :: U.UUID -> Bool
123 randomNotNull = not. U.null
114 randomNotNull = not. U.null
124
115
116+prop_randomsValid :: Test
117+prop_randomsValid = testProperty "Random valid" randomsValid
118+ where randomsValid :: U.UUID -> Bool
119+ randomsValid = isValidVersion 4
120+
121+prop_v3NotNull :: Test
122+prop_v3NotNull = testProperty "V3 not null" v3NotNull
123+ where v3NotNull :: [Word8] -> Bool
124+ v3NotNull = not . U.null . U3.generateNamed U3.namespaceDNS
125+
126+prop_v3Valid :: Test
127+prop_v3Valid = testProperty "V3 valid" v3Valid
128+ where v3Valid :: [Word8] -> Bool
129+ v3Valid = isValidVersion 3 . U3.generateNamed U3.namespaceDNS
130+
131+prop_v5NotNull :: Test
132+prop_v5NotNull = testProperty "V5 not null" v5NotNull
133+ where v5NotNull :: [Word8] -> Bool
134+ v5NotNull = not . U.null . U5.generateNamed U5.namespaceDNS
135+
136+prop_v5Valid :: Test
137+prop_v5Valid = testProperty "V5 valid" v5Valid
138+ where v5Valid :: [Word8] -> Bool
139+ v5Valid = isValidVersion 5 . U5.generateNamed U5.namespaceDNS
140+
125prop_readShowRoundTrip :: Test
141prop_readShowRoundTrip :: Test
126prop_readShowRoundTrip = testProperty "Read/Show round-trip" prop
142prop_readShowRoundTrip = testProperty "Read/Show round-trip" prop
127 where -- we're using 'Maybe UUID' to add a bit of
143 where -- we're using 'Maybe UUID' to add a bit of
@@ -152,17 +168,6 @@ toASCIIBytes_fromASCIIBytes :: U.UUID -> Bool
152toASCIIBytes_fromASCIIBytes uuid =
168toASCIIBytes_fromASCIIBytes uuid =
153 Just uuid == U.fromASCIIBytes (U.toASCIIBytes uuid)
169 Just uuid == U.fromASCIIBytes (U.toASCIIBytes uuid)
154
170
155−toWords_fromWords :: U.UUID -> Bool
156−toWords_fromWords uuid =
157− uuid == myUncurry4 U.fromWords (U.toWords uuid)
158−
159−fromWords_toWords :: (Word32, Word32, Word32, Word32) -> Bool
160−fromWords_toWords wds =
161− wds == U.toWords (myUncurry4 U.fromWords wds)
162−
163−myUncurry4 :: (x1 -> x2 -> x3 -> x4 -> y) -> (x1, x2, x3, x4) -> y
164−myUncurry4 f (a,b,c,d) = f a b c d
165−
166prop_storableRoundTrip :: Test
171prop_storableRoundTrip :: Test
167prop_storableRoundTrip =
172prop_storableRoundTrip =
168 testProperty "Storeable round-trip" $ unsafePerformIO . prop
173 testProperty "Storeable round-trip" $ unsafePerformIO . prop
@@ -176,18 +181,16 @@ prop_storableRoundTrip =
176
181
177main :: IO ()
182main :: IO ()
178main = do
183main = do
184+ v1s <- replicateM 100 U.nextUUID
179 defaultMain $
185 defaultMain $
180− testGroup "tests" $
181 concat $
186 concat $
182− [ [
187+ [ hUnitTestToTests $ H.TestList [
183 test_null,
188 test_null,
184 test_nil,
189 test_nil,
185− test_lift,
186 test_conv,
190 test_conv,
187− test_fromByteString,
191+ test_v1 v1s,
188− test_fromWords,
192+ test_v3,
189− test_Storeable,
193+ test_v5
190− test_Binary
191 ]
194 ]
192 , [ prop_stringRoundTrip,
195 , [ prop_stringRoundTrip,
193 prop_readShowRoundTrip,
196 prop_readShowRoundTrip,
@@ -196,14 +199,17 @@ main = do
196 prop_stringLength,
199 prop_stringLength,
197 prop_byteStringLength,
200 prop_byteStringLength,
198 prop_randomsDiffer,
201 prop_randomsDiffer,
199− prop_randomNotNull
202+ prop_randomNotNull,
203+ prop_randomsValid,
204+ prop_v3NotNull,
205+ prop_v3Valid,
206+ prop_v5NotNull,
207+ prop_v5Valid
200 ]
208 ]
201 , [ testProperty "fromASCIIBytes_fromString1" fromASCIIBytes_fromString1
209 , [ testProperty "fromASCIIBytes_fromString1" fromASCIIBytes_fromString1
202 , testProperty "fromASCIIBytes_fromString2" fromASCIIBytes_fromString2
210 , testProperty "fromASCIIBytes_fromString2" fromASCIIBytes_fromString2
203 , testProperty "fromASCIIBytes_toString" toASCIIBytes_toString
211 , testProperty "fromASCIIBytes_toString" toASCIIBytes_toString
204 , testProperty "fromASCIIBytes_toASCIIBytes" fromASCIIBytes_toASCIIBytes
212 , testProperty "fromASCIIBytes_toASCIIBytes" fromASCIIBytes_toASCIIBytes
205 , testProperty "toASCIIBytes_fromASCIIBytes" toASCIIBytes_fromASCIIBytes
213 , testProperty "toASCIIBytes_fromASCIIBytes" toASCIIBytes_fromASCIIBytes
206− , testProperty "toWords_fromWords" toWords_fromWords
207− , testProperty "fromWords_toWords" fromWords_toWords
208 ]
214 ]
209 ]
215 ]
tests/summarize-bench-results.plnew file+14
@@ -0,0 +1,14 @@
1+#!/usr/bin/env perl
2+
3+
4+while(<>) {
5+ if (/^benchmarking (.*)$/) {
6+ $name = $1;
7+ }
8+ if (/^mean:\s*([\d.]*) (\w*),/) {
9+ $mean = 1 * $1;
10+ $units = $2;
11+
12+ printf "%-30s %10.2f %2s\n", $name, $mean, $units;
13+ }
14+}
uuid-bench/bench/uuid-benchmark.hsdeleted−33
@@ -1,33 +0,0 @@
1−import Criterion.Main
2−import Data.Char (ord)
3−import Data.IORef
4−import Data.Word
5−import qualified Data.UUID as U
6−import qualified Data.UUID.V4 as U
7−import qualified Data.UUID.V3 as U3
8−import qualified Data.UUID.V5 as U5
9−import System.Random
10−import System.Random.Mersenne.Pure64
11−
12−main :: IO ()
13−main = do
14− let n1 = (map (fromIntegral . ord) "http://www.haskell.org/") :: [Word8]
15−
16− -- setup for random generation
17− randomState <- newPureMT >>= newIORef
18− let randomUUID = do
19− state <- readIORef randomState
20− let (uuid, state') = random state
21− writeIORef randomState state'
22− return uuid
23−
24− -- benchmark UUID generation
25− defaultMain [
26− bgroup "generation" [
27− bench "V1" $ nfIO U.nextUUID,
28− bench "V4-stock" $ nfIO (U.nextRandom :: IO U.UUID),
29− bench "V4-mersenne" $ nfIO (randomUUID :: IO U.UUID),
30− bench "V3" $ nf (U3.generateNamed U3.namespaceURL) n1,
31− bench "V5" $ nf (U5.generateNamed U5.namespaceURL) n1
32− ]
33− ]
uuid-bench/src-uuiddeleted−1
@@ -1 +0,0 @@
1−../uuid/src
uuid-bench/src-uuid-typesdeleted−1
@@ -1 +0,0 @@
1−../uuid-types/src
uuid-bench/uuid-bench.cabaldeleted−126
@@ -1,126 +0,0 @@
1−cabal-version: 1.12
2−name: uuid-bench
3−version: 0
4−copyright:
5− (c) 2017-2018 Herbert Valerio Riedel
6− (c) 2008-2014 Antoine Latter
7−
8−author: Antoine Latter
9−maintainer: Oleg Grenrus <oleg.grenrus@iki.fi>
10−license: BSD3
11−license-file: LICENSE
12−category: Data
13−build-type: Simple
14−
15−-- Benchmarking with older GHCs is not meaningful
16−tested-with:
17− GHC ==8.6.5
18− || ==8.8.4
19− || ==8.10.7
20− || ==9.0.2
21− || ==9.2.8
22− || ==9.4.8
23− || ==9.6.6
24− || ==9.8.2
25− || ==9.10.1
26−
27−synopsis: UUID benchmarks
28−description:
29− UUID benchmarks.
30− This package is combined uuid and uuid-types, renamed so we do not
31− cause benchmark tools to be build against local package.
32−
33−homepage: https://github.com/haskell-hvr/uuid
34−bug-reports: https://github.com/haskell-hvr/uuid/issues
35−
36−source-repository head
37− type: git
38− location: https://github.com/haskell-hvr/uuid.git
39− subdir: uuid-bench
40−
41−library
42− build-depends:
43− base >=4.12.0.0 && <5
44− , binary >=0.8.6.0 && <0.9
45− , bytestring >=0.10.8.2 && <0.13
46− , cryptohash-md5 >=0.11.100 && <0.12
47− , cryptohash-sha1 >=0.11.100 && <0.12
48− , deepseq >=1.4.4.0 && <1.6
49− , entropy >=0.3.7 && <0.5
50− , hashable >=1.4.4.0 && <1.6
51− , network-info >=0.2 && <0.3
52− , random >=1.2.1.2 && <1.3
53− , template-haskell >=2.14.0.0 && <2.23
54− , text >=1.2.3.0 && <1.3 || >=2.0 && <2.2
55− , time >=1.4 && <1.13
56−
57− -- uuid modules
58− exposed-modules:
59− Data.UUID
60− Data.UUID.Util
61− Data.UUID.V3
62− Data.UUID.V4
63− Data.UUID.V5
64−
65− other-modules:
66− Data.UUID.Named
67− Data.Word.Util
68−
69− -- uuid-types modules
70− exposed-modules: Data.UUID.Types
71−
72− -- Exposed for companion projects; *NOT* part of the official API:
73− exposed-modules:
74− Data.UUID.Types.Internal
75− Data.UUID.Types.Internal.Builder
76−
77− default-language: Haskell2010
78− other-extensions:
79− DeriveDataTypeable
80− TypeFamilies
81−
82− ghc-options: -Wall
83− hs-source-dirs: src-uuid-types src-uuid
84−
85−benchmark uuid-types-benchmark
86− type: exitcode-stdio-1.0
87− main-is: uuid-types-benchmark.hs
88− hs-source-dirs: bench
89− default-language: Haskell2010
90− other-extensions: CPP
91− ghc-options: -Wall
92−
93− -- inherited constraints
94− build-depends:
95− base
96− , bytestring
97− , random
98− , uuid-bench
99−
100− -- deps w/o inherited constraints
101− build-depends:
102− containers >=0.5 && <0.8
103− , criterion >=1.5 && <1.7
104− , unordered-containers >=0.2.7 && <0.3
105−
106−benchmark uuid-benchmark
107− type: exitcode-stdio-1.0
108− main-is: uuid-benchmark.hs
109− hs-source-dirs: bench
110− default-language: Haskell2010
111− default-extensions:
112− CPP
113− DeriveDataTypeable
114−
115− ghc-options: -Wall -fno-warn-orphans
116−
117− -- inherited constraints
118− build-depends:
119− base
120− , random
121− , uuid-bench
122−
123− -- deps w/o inherited constraints
124− build-depends:
125− criterion >=1.5 && <1.7
126− , mersenne-random-pure64 >=0.2 && <0.3
uuid-types/ChangeLog.mddeleted−31
@@ -1,31 +0,0 @@
1−## 1.0.6 (2023-04-16)
2−
3−- Support GHC-8.6.5..GHC-9.10.1
4−
5−## 1.0.5 (2021-05-03)
6−
7−- Add (Template Haskell) `Lift UUID` instance
8−
9−## 1.0.4.0
10−
11−- Declare `Data.UUID.Types` module "`Trustworthy`" with respect to SafeHaskell.
12−- Use more compact heap object representation which saves 16 bytes on 64bit platforms.
13−- Add `toWords64`/`fromWords64` functions
14−- Drop support for GHC < 7.
15−- Add support for `random-1.2`, i.e. idiomatic `Random` and added `Uniform` instances.
16−
17−## 1.0.3
18−
19−- Bump package dependencies.
20−
21−## 1.0.2
22−
23−- Add `toText`/`fromText` functions.
24−
25−## 1.0.1
26−
27−- Update dependencies in tests and benchmarks.
28−
29−## 1.0.0
30−
31−- Initial split from "`uuid-1.3.8`" package.
uuid-types/LICENSEdeleted−28
@@ -1,28 +0,0 @@
1−Copyright (c) 2008, Antoine Latter
2−
3−All rights reserved.
4−
5−Redistribution and use in source and binary forms, with or without
6−modification, are permitted provided that the following conditions are
7−met:
8−
9− * Redistributions of source code must retain the above copyright
10−notice, this list of conditions and the following disclaimer.
11− * Redistributions in binary form must reproduce the above copyright
12−notice, this list of conditions and the following disclaimer in the
13−documentation and/or other materials provided with the distribution.
14− * The names of the authors may not be used to endorse or promote
15−products derived from this software without specific prior written
16−permission.
17−
18−THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
19−"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
20−LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
21−A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
22−OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
23−SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
24−TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
25−PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
26−LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
27−NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
28−SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
uuid-types/cabal.projectdeleted−1
@@ -1 +0,0 @@
1−packages: .
uuid-types/src/Data/UUID/Types.hsdeleted−47
@@ -1,47 +0,0 @@
1−{-# LANGUAGE Trustworthy #-}
2−
3−{- |
4−Module : Data.UUID.Types
5−Copyright : (c) 2017-2018 Herbert Valerio Riedel
6− (c) 2008,2012 Antoine Latter
7−
8−License : BSD-style
9−
10−Maintainer : hvr@gnu.org
11−Portability : portable
12−
13−This library is useful for comparing, parsing and
14−printing <http://en.wikipedia.org/wiki/UUID Universally Unique Identifiers (UUID)>.
15−See <http://tools.ietf.org/html/rfc4122 RFC 4122> for the specification.
16−
17−-}
18−module Data.UUID.Types
19− ( -- * The 'UUID' Type
20− UUID
21− -- * Nil UUID
22− , nil
23− , null
24− -- * Textual Representation
25− , toString
26− , fromString
27− , toText
28− , fromText
29− , toASCIIBytes
30− , fromASCIIBytes
31− , toLazyASCIIBytes
32− , fromLazyASCIIBytes
33− -- * Binary Representation
34− , toByteString
35− , fromByteString
36− -- * Integer Representation
37− , toWords
38− , fromWords
39− , toWords64
40− , fromWords64
41− ) where
42−
43−import Data.UUID.Types.Internal
44−import Prelude ()
45−
46−-- Everything is really implemented in Data.UUID.Types.Internal, but I
47−-- don't want to export the constructors out of the package.
uuid-types/uuid-types.cabaldeleted−99
@@ -1,99 +0,0 @@
1−cabal-version: 1.12
2−name: uuid-types
3−version: 1.0.6
4−x-revision: 2
5−copyright:
6− (c) 2017-2018 Herbert Valerio Riedel
7− (c) 2008-2014 Antoine Latter
8−
9−author: Antoine Latter
10−maintainer: Oleg Grenrus <oleg.grenrus@iki.fi>
11−license: BSD3
12−license-file: LICENSE
13−category: Data
14−build-type: Simple
15−tested-with:
16− GHC ==8.6.5
17− || ==8.8.4
18− || ==8.10.7
19− || ==9.0.2
20− || ==9.2.8
21− || ==9.4.8
22− || ==9.6.6
23− || ==9.8.4
24− || ==9.10.1
25− || ==9.12.1
26−
27−synopsis: Type definitions for Universally Unique Identifiers
28−description:
29− This library contains type definitions for
30− <https://en.wikipedia.org/wiki/UUID Universally Unique Identifiers (UUID)>
31− (as specified in
32− <http://tools.ietf.org/html/rfc4122 RFC 4122>)
33− and basic conversion functions.
34− .
35− See also the <https://hackage.haskell.org/package/uuid 'uuid' package>
36− providing a high-level API for managing the different UUID versions.
37−
38−homepage: https://github.com/haskell-hvr/uuid
39−bug-reports: https://github.com/haskell-hvr/uuid/issues
40−extra-source-files: ChangeLog.md
41−
42−source-repository head
43− type: git
44− location: https://github.com/haskell-hvr/uuid.git
45− subdir: uuid-types
46−
47−library
48− build-depends:
49− base >=4.12.0.0 && <5
50− , binary >=0.8.6.0 && <0.9
51− , bytestring >=0.10.8.2 && <0.13
52− , deepseq >=1.4.4.0 && <1.6
53− , hashable >=1.4.4.0 && <1.6
54− , random >=1.2.1.2 && <1.3
55− , template-haskell >=2.14.0.0 && <2.24
56− , text >=1.2.3.0 && <1.3 || >=2.0 && <2.2
57−
58− exposed-modules: Data.UUID.Types
59−
60− -- Exposed for companion projects; *NOT* part of the official API:
61− exposed-modules:
62− Data.UUID.Types.Internal
63− Data.UUID.Types.Internal.Builder
64−
65− default-language: Haskell2010
66− other-extensions:
67− DeriveDataTypeable
68− TypeFamilies
69−
70− ghc-options: -Wall
71− hs-source-dirs: src
72−
73−test-suite testuuid
74− type: exitcode-stdio-1.0
75− main-is: TestUUID.hs
76− hs-source-dirs: tests
77− default-language: Haskell2010
78− other-extensions: ViewPatterns
79− ghc-options: -Wall
80− if impl(ghc >= 8.10)
81− ghc-options: -Wunused-packages
82−
83− -- inherited constraints
84− build-depends:
85− base
86− , binary
87− , bytestring
88− , template-haskell
89− , uuid-types
90−
91− -- deps w/o inherited constraints
92− build-depends:
93− QuickCheck >=2.14.2 && <2.16
94− , tasty >=1.4.0.1 && <1.6
95− , tasty-hunit >=0.10 && <0.11
96− , tasty-quickcheck >=0.10 && <0.12
97−
98− if !impl(ghc >=8.4)
99− build-depends: ghc-byteorder >=4.11 && <4.12
uuid.cabalnew file+102
@@ -0,0 +1,102 @@
1+Name: uuid
2+Version: 1.3.0
3+Copyright: (c) 2008-2013 Antoine Latter
4+Author: Antoine Latter
5+Maintainer: aslatter@gmail.com
6+License: BSD3
7+License-file: LICENSE
8+
9+Category: Data
10+Build-Type: Simple
11+Cabal-Version: >= 1.8
12+
13+Description:
14+ This library is useful for creating, comparing, parsing and
15+ printing Universally Unique Identifiers.
16+ See <http://en.wikipedia.org/wiki/UUID> for the general idea.
17+
18+Synopsis: For creating, comparing, parsing and printing Universally Unique Identifiers
19+
20+Homepage: http://projects.haskell.org/uuid/
21+Bug-Reports: mailto:aslatter@gmail.com
22+
23+Extra-Source-Files:
24+ CHANGES
25+ CONTRIBUTORS
26+
27+
28+Library
29+ Build-Depends: base >=3 && < 5,
30+ binary >= 0.4 && < 0.8,
31+ bytestring >= 0.9 && < 1.1,
32+ cryptohash >= 0.7 && < 0.11,
33+ deepseq == 1.3.*,
34+ hashable == 1.2.*,
35+ network-info == 0.2.*,
36+ random >= 1.0.1 && < 1.1,
37+ time >= 1.1 && < 1.5
38+
39+ Exposed-Modules:
40+ Data.UUID
41+ Data.UUID.Util
42+ Data.UUID.V1
43+ Data.UUID.V3
44+ Data.UUID.V4
45+ Data.UUID.V5
46+
47+ Other-Modules:
48+ Data.UUID.Builder
49+ Data.UUID.Internal
50+ Data.UUID.Named
51+ Data.Word.Util
52+
53+ Extensions: DeriveDataTypeable
54+ Ghc-Options: -Wall
55+
56+source-repository head
57+ type: darcs
58+ location: http://code.haskell.org/uuid
59+
60+Test-Suite testuuid
61+ Type: exitcode-stdio-1.0
62+ Main-is: TestUUID.hs
63+ Hs-source-dirs: tests
64+ Extensions: DeriveDataTypeable
65+ Ghc-Options: -Wall -fno-warn-orphans
66+ Build-Depends: base >= 3 && < 5,
67+ uuid,
68+ bytestring >= 0.9 && < 1.1,
69+ HUnit >=1.2 && < 1.3,
70+ QuickCheck >=2.4 && < 2.7,
71+ random >= 1.0.1 && < 1.1,
72+ test-framework == 0.8.*,
73+ test-framework-hunit == 0.3.*,
74+ test-framework-quickcheck2 == 0.3.*
75+
76+benchmark benchmark
77+ Type: exitcode-stdio-1.0
78+ Main-is: BenchUUID.hs
79+ Hs-source-dirs: tests
80+ Extensions: DeriveDataTypeable, CPP
81+ Ghc-Options: -Wall -fno-warn-orphans
82+ Build-depends: base == 4.*,
83+ uuid,
84+ bytestring >= 0.9 && < 1.1,
85+ containers >= 0.4 && < 0.6,
86+ criterion >= 0.4 && < 0.9,
87+ deepseq >= 1.1 && < 1.4,
88+ mersenne-random-pure64,
89+ random >= 1.0.1 && < 1.1
90+
91+benchmark benchbytestring
92+ Type: exitcode-stdio-1.0
93+ Hs-Source-Dirs: tests
94+ Main-Is: BenchByteString.hs
95+ Ghc-Options: -threaded -rtsopts -Wall -O2 -fno-warn-orphans
96+ Build-Depends: base >= 4 && < 5
97+ , uuid
98+ , bytestring >= 0.10
99+ , criterion >= 0.8
100+ , random >= 1.0
101+ , QuickCheck >= 2
102+
uuid/CHANGES.mddeleted−186
@@ -1,186 +0,0 @@
1−1.3.16
2−
3−- Support GHC-8.6.5...9.10.1
4−
5−1.3.15
6−
7−- Add (Template Haskell) `Lift UUID` instance
8−
9−1.3.14
10−
11−- Use more compact heap object representation which saves 16 bytes on 64bit platforms.
12−- Add `toWords64`/`fromWords64` functions
13−
14−1.3.13
15−
16−- Optimize `V4.nextRandom` (~3x speed increase)
17−- Optimize UUID V3 & V5 generation (~2x speed increase)
18−- Use `cryptohash-md5`/`cryptohash-sha1`/`entropy` instead
19− of `memory`/`cryptonite` for better performance and stability,
20− but GHCJS is now no longer supported.
21−- Update cabal-spec to version 1.10
22−
23−1.3.12
24−
25−- Update package dependencies
26−- Use `cryptonite` for crypto
27−- The function `V4.nextRandom` is now implemented with functions from
28− `Crypto.Random` in package `cryptonite`. This does slow-down random
29− UUID generation but provides for far greater randomness. The
30− `Random` instance for `UUID` can be used to re-gain the old
31− behavior.
32−
33−1.3.11
34−
35−- Add `toText`/`fromText`
36−
37−1.3.10
38−
39−- Update dependencies in tests and benchmarks.
40−
41−1.3.9
42−
43−- Split definition of UUID data type into separate Cabal package to
44− enable 3rd party libraries to avoid some of the larger dependencies.
45−
46−1.3.8
47−
48−- Allow building against newer `deepseq`.
49−
50−1.3.7
51−
52−- Allow building against newer `time`.
53−
54−1.3.6
55−
56−- Move to GitHub.
57−
58−1.3.5
59−
60−- Allow building against newer `random`.
61−
62−1.3.4
63−
64−- Allow building against newer `QuickCheck`.
65−
66−1.3.3
67−
68−- More complex version constraints on `hashable`, to avoid building against
69− versions less than 1.1.1.0 or equal to 1.2.0.*.
70−
71−1.3.2
72−
73−- Fix for building against `bytestring` 0.9.*
74−
75−1.3.1
76−
77−- Allow building against `hashable` 1.1.* in addition to 1.2.*
78−
79−1.3.0
80−
81−- New functions for parsing and printing UUIDs to and from ASCII BytesStrings
82−- New module `Data.UUID.Util`. This module includes the type `UnpackedUUID`,
83− whose fields correspond to the UUID fields described in RFC 4122.
84−- The `Storable` instance now stores a UUID in host byte-order instead of
85− big endian.
86−- There is now an instance for `Hashable UUID`.
87−
88−1.2.13
89−
90−Benchmark only changes:
91−
92−- Allow `criterion` 0.8.*
93−
94−1.2.12
95−
96−Test only changes:
97−
98−- Allow `QuickCheck` 2.6.*
99−
100−1.2.11
101−
102−- Allow `binary` 0.7.*
103−
104−1.2.10
105−
106−- Allow `cryptohash` version 0.9.*
107−- Cleanup tests
108−
109−1.2.9
110−
111−- Bumped dependency on `cryptohash`.
112−
113−1.2.8
114−
115−- Bumped various dependencies and cleaned up dependencies in general.
116−
117−1.2.7
118−
119−- Added stricter constraints on `random` package.
120−
121−1.2.6
122−
123−- Add module `V4` to direct attention to our Random instance
124−
125−- In module `V1` seed the generator with a random number
126− if the hardware MAC address could not be discovered.
127−
128−- Fix and cleanup various haddocks.
129−
130−- In module docs, warn about MD5 use in Data.UUID.V3 and
131− encourage the reader to use Data.UUID.V5 instead.
132−
133−1.2.5
134−
135−- Use `cryptohash` package for MD5 and SHA1 instead of `Crypto`
136−
137−1.2.4
138−
139−- Unpack Word32 values into UUID constructor.
140−
141−- Update test suite to QuickCheck 2
142−
143−- Bump other dependencies in tests/benchmarks
144−
145−1.2.3
146−
147−- The Read instance now drops leading spaces in the string to be parsed.
148−Thanks to Marc Ziegert for reporting this bug.
149−
150−- The tests have moved over to the new Cabal test running framework.
151−
152−1.2.2
153−
154−- Add functions fromWords/toWords
155−
156−The goal was to have a total function that can be used to construct
157−a UUID, primarily for use by uuid-th.
158−
159−1.2.1
160−
161−- Fix concurrency bug in Data.UUID.V1 (thanks to Neil Mitchell for reporting
162−and a test case)
163−
164−1.2.0
165− (Contributors: Antoine Latter & Mark Lentczner)
166−
167−- added functions toByteString and fromByteString
168−- added `nil` UUID
169−- added unit tests and benchmarks, built when configured -ftest
170−- major speed up of to/from functions (as well as in general)
171−- added version-3 generation (deterministic based on MD5)
172−- major changes to internal representation
173− - now uses four strict Word32 values
174− - internal ByteSource classes for easy construction (see Builder.hs)
175−- Storable instance now stores in memory as system libraries in C do:
176− 16 bytes derived from the network order of the fields, no matter what
177− the host native endianess is.
178−- fixed bugs in V1 time and clock stepping, and V1 generated values
179−- builds cleanly under GHC's -Wall
180−- added CHANGES file
181−
182−1.1.1
183−
184−- no longer exporting `null` from the prelude
185−- add `null` predicate on UUIDs
186−- documentation fix (thanks Mark Lentczner)
uuid/LICENSEdeleted−28
@@ -1,28 +0,0 @@
1−Copyright (c) 2008, Antoine Latter
2−
3−All rights reserved.
4−
5−Redistribution and use in source and binary forms, with or without
6−modification, are permitted provided that the following conditions are
7−met:
8−
9− * Redistributions of source code must retain the above copyright
10−notice, this list of conditions and the following disclaimer.
11− * Redistributions in binary form must reproduce the above copyright
12−notice, this list of conditions and the following disclaimer in the
13−documentation and/or other materials provided with the distribution.
14− * The names of the authors may not be used to endorse or promote
15−products derived from this software without specific prior written
16−permission.
17−
18−THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
19−"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
20−LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
21−A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
22−OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
23−SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
24−TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
25−PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
26−LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
27−NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
28−SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
uuid/Setup.hsdeleted−4
@@ -1,4 +0,0 @@
1−import Distribution.Simple
2−main :: IO ()
3−main = defaultMain
4−
uuid/src/Data/UUID/Util.hsdeleted−42
@@ -1,42 +0,0 @@
1−{-# LANGUAGE TypeFamilies #-}
2−module Data.UUID.Util (
3− UnpackedUUID(..)
4− , unpack, pack
5− , version
6− , extractTime
7− , setTime
8− ) where
9−
10−import Prelude hiding (null)
11−import Data.Word
12−import Data.Word.Util
13−import Data.Bits
14−import Data.UUID.Types.Internal
15−import Data.Int (Int64)
16−
17−version :: UUID -> Int
18−version uuid =
19− fromEnum ((time_hi_and_version unpacked `shiftR` 12) .&. 0xF)
20− where
21− unpacked = unpack uuid
22−
23−-- Note UUID time is in 10^-7 seconds.
24−setTime :: (Integral a, Bits a) => UUID -> a -> Maybe UUID
25−setTime uuid t =
26− if version uuid == 1
27− then Just $ pack $ (unpack uuid){time_low = new_low_bits, time_mid = new_mid_bits, time_hi_and_version = new_hi_and_version_bits}
28− else Nothing
29− where new_low_bits = fromIntegral $ t .&. 0xFFFFFFFF
30− new_mid_bits = fromIntegral $ (t `shiftR` 32) .&. 0xFFFF
31− new_hi_and_version_bits = fromIntegral $ 0x1000 .|. ((t `shiftR` 48) .&. 0x0FFF)
32−
33−extractTime :: UUID -> Maybe Int64
34−extractTime uuid =
35− if version uuid == 1
36− then Just $ fromIntegral $ w32to64 (w16to32 (timeAndVersionToTime $ time_hi_and_version unpacked) $ time_mid unpacked) (time_low unpacked)
37− else Nothing
38− where
39− unpacked = unpack uuid
40−
41−timeAndVersionToTime :: Word16 -> Word16
42−timeAndVersionToTime tv = tv .&. 0x0FFF
uuid/src/Data/UUID/V4.hsdeleted−33
@@ -1,33 +0,0 @@
1−{- |
2− Module : Data.UUID.V4
3− Copyright : (c) 2012-2016 Antoine Latter
4−
5− License : BSD-style
6−
7− Maintainer : aslatter@gmail.com
8− Stability : experimental
9− Portability : portable
10−
11− This module implements Version 4 UUIDs as specified
12− in RFC 4122.
13−
14− These UUIDs are generated from a pseudo-random generator.
15− We use the 'getEntropy' method from the <https://hackage.haskell.org/package/entropy entropy> package,
16− which should provide cryptographically secure random data.
17−-}
18−module Data.UUID.V4 (nextRandom) where
19−
20−import Data.UUID
21−import Data.UUID.Types.Internal ( buildFromBytes )
22−
23−import System.Entropy ( getEntropy )
24−import Data.ByteString ( unpack )
25−
26−-- | Generate a crytographically secure, random UUID.
27−--
28−-- @since 1.2.6
29−nextRandom :: IO UUID
30−nextRandom = do
31− [b0, b1, b2, b3, b4, b5, b6, b7, b8, b9, ba, bb, bc, bd, be, bf]
32− <- unpack `fmap` getEntropy 16
33− return $ buildFromBytes 4 b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf
uuid/src/Data/Word/Util.hsdeleted−20
@@ -1,20 +0,0 @@
1−
2−-- | Internal utilites
3−module Data.Word.Util where
4−
5−import Data.Bits
6−import Data.Word
7−
8−w16to32 :: Word16 -> Word16 -> Word32
9−w16to32 w0s w1s =
10− (w0 `shiftL` 16) .|. w1
11− where
12− w0 = fromIntegral w0s
13− w1 = fromIntegral w1s
14−
15−w32to64 :: Word32 -> Word32 -> Word64
16−w32to64 w0s w1s =
17− (w0 `shiftL` 32) .|. w1
18− where
19− w0 = fromIntegral w0s
20− w1 = fromIntegral w1s
uuid/tests/TestUUID.hsdeleted−96
@@ -1,96 +0,0 @@
1−{-# LANGUAGE ViewPatterns #-}
2−
3−import Data.Bits
4−import qualified Data.ByteString.Lazy as BL
5−import Data.Char (ord)
6−import Data.Maybe
7−import Data.Word
8−import qualified Data.UUID as U
9−import qualified Data.UUID.V3 as U3
10−import qualified Data.UUID.V5 as U5
11−
12−import Test.QuickCheck ( Arbitrary(arbitrary) )
13−import Test.Tasty ( TestTree, testGroup, defaultMain )
14−import Test.Tasty.HUnit
15− ( assertBool, (@?=), testCase )
16−import Test.Tasty.QuickCheck ( testProperty )
17−
18−type Test = TestTree
19−
20−isValidVersion :: Int -> U.UUID -> Bool
21−isValidVersion v u = lenOK && variantOK && versionOK
22− where bs = U.toByteString u
23− lenOK = BL.length bs == 16
24− variantOK = BL.index bs 8 .&. 0xc0 == 0x80
25− versionOK = BL.index bs 6 .&. 0xf0 == fromIntegral (v `shiftL` 4)
26−
27−
28−instance Arbitrary U.UUID where
29− -- the UUID random instance ignores bounds
30− arbitrary = pure U.nil
31−
32−
33−test_null :: Test
34−test_null =
35− testCase "namespaceDNS is not null" $
36− assertBool "" (not $ U.null U3.namespaceDNS)
37−
38−test_v3 :: Test
39−test_v3 =
40− testCase "V3 computation" $
41− U3.generateNamed U3.namespaceDNS name @?= uV3
42−
43− where name = map (fromIntegral . ord) "www.widgets.com" :: [Word8]
44− uV3 = fromJust $ U.fromString "3d813cbb-47fb-32ba-91df-831e1593ac29"
45−
46−test_v5 :: Test
47−test_v5 =
48− testCase "V5 computation" $
49− U5.generateNamed U5.namespaceDNS name @?= uV5
50−
51− where name = map (fromIntegral . ord) "www.widgets.com" :: [Word8]
52− uV5 = fromJust $ U.fromString "21f7f8de-8051-5b89-8680-0195ef798b6a"
53−
54−
55−prop_randomsValid :: Test
56−prop_randomsValid = testProperty "Random valid" randomsValid
57− where randomsValid :: U.UUID -> Bool
58− randomsValid = isValidVersion 4
59−
60−prop_v3NotNull :: Test
61−prop_v3NotNull = testProperty "V3 not null" v3NotNull
62− where v3NotNull :: [Word8] -> Bool
63− v3NotNull = not . U.null . U3.generateNamed U3.namespaceDNS
64−
65−prop_v3Valid :: Test
66−prop_v3Valid = testProperty "V3 valid" v3Valid
67− where v3Valid :: [Word8] -> Bool
68− v3Valid = isValidVersion 3 . U3.generateNamed U3.namespaceDNS
69−
70−prop_v5NotNull :: Test
71−prop_v5NotNull = testProperty "V5 not null" v5NotNull
72− where v5NotNull :: [Word8] -> Bool
73− v5NotNull = not . U.null . U5.generateNamed U5.namespaceDNS
74−
75−prop_v5Valid :: Test
76−prop_v5Valid = testProperty "V5 valid" v5Valid
77− where v5Valid :: [Word8] -> Bool
78− v5Valid = isValidVersion 5 . U5.generateNamed U5.namespaceDNS
79−
80−main :: IO ()
81−main = do
82− defaultMain $
83− testGroup "tests" $
84− concat $
85− [ [
86− test_null,
87− test_v3,
88− test_v5
89− ]
90− , [ prop_randomsValid,
91− prop_v3NotNull,
92− prop_v3Valid,
93− prop_v5NotNull,
94− prop_v5Valid
95− ]
96− ]
uuid/uuid.cabaldeleted−95
@@ -1,95 +0,0 @@
1−cabal-version: 1.12
2−name: uuid
3−version: 1.3.16
4−x-revision: 2
5−copyright: (c) 2008-2014 Antoine Latter
6−author: Antoine Latter
7−maintainer: Oleg Grenrus <oleg.grenrus@iki.fi>
8−license: BSD3
9−license-file: LICENSE
10−category: Data
11−build-type: Simple
12−tested-with:
13− GHC ==8.6.5
14− || ==8.8.4
15− || ==8.10.7
16− || ==9.0.2
17− || ==9.2.8
18− || ==9.4.8
19− || ==9.6.6
20− || ==9.8.4
21− || ==9.10.1
22− || ==9.12.1
23−
24−synopsis:
25− For creating, comparing, parsing and printing Universally Unique Identifiers
26−
27−description:
28− This library is useful for creating, comparing, parsing and
29− printing Universally Unique Identifiers.
30− .
31− See <http://en.wikipedia.org/wiki/UUID> for the general idea.
32−
33−homepage: https://github.com/haskell-hvr/uuid
34−bug-reports: https://github.com/haskell-hvr/uuid/issues
35−extra-source-files: CHANGES.md
36−
37−source-repository head
38− type: git
39− location: https://github.com/haskell-hvr/uuid.git
40− subdir: uuid
41−
42−library
43− build-depends:
44− base >=4.12 && <5
45− , binary >=0.8.6.0 && <0.9
46− , bytestring >=0.10.8.2 && <0.13
47− , cryptohash-md5 >=0.11.100 && <0.12
48− , cryptohash-sha1 >=0.11.100 && <0.12
49− , entropy >=0.3.7 && <0.5
50−
51− -- strict dependency on uuid-types,
52− -- as we re-rexport datatype, thus leak instances etc.
53− build-depends: uuid-types >=1.0.6 && <1.0.7
54− exposed-modules:
55− Data.UUID
56− Data.UUID.Util
57− Data.UUID.V3
58− Data.UUID.V4
59− Data.UUID.V5
60−
61− other-modules:
62− Data.UUID.Named
63− Data.Word.Util
64−
65− default-language: Haskell2010
66− default-extensions: DeriveDataTypeable
67− other-extensions: TypeFamilies
68− ghc-options: -Wall
69− if impl(ghc >= 8.10)
70− ghc-options: -Wunused-packages
71− hs-source-dirs: src
72−
73−test-suite testuuid
74− type: exitcode-stdio-1.0
75− main-is: TestUUID.hs
76− hs-source-dirs: tests
77− default-language: Haskell2010
78− default-extensions: DeriveDataTypeable
79− other-extensions: ViewPatterns
80− ghc-options: -Wall -fno-warn-orphans
81− if impl(ghc >= 8.10)
82− ghc-options: -Wunused-packages
83−
84− -- inherited constraints
85− build-depends:
86− base
87− , bytestring
88− , uuid
89−
90− -- deps w/o inherited constraints
91− build-depends:
92− QuickCheck >=2.14.2 && <2.16
93− , tasty >=1.4.0.1 && <1.6
94− , tasty-hunit >=0.10 && <0.11
95− , tasty-quickcheck >=0.10 && <0.12