├── .devcontainer └── devcontainer.json ├── .git-blame-ignore-revs ├── .gitattributes ├── .github ├── ISSUE_TEMPLATE │ ├── config.yml │ ├── feature_idea_base.yml │ └── release-packages.md ├── PULL_REQUEST_TEMPLATE.md └── workflows │ ├── cabal.project.local.ci.Darwin │ ├── cabal.project.local.ci.Linux │ ├── cabal.project.local.ci.MINGW64_NT-10.0-20348 │ ├── gh-pages.yml │ ├── haskell.yml │ └── rate-limit-check.yml ├── .gitignore ├── CHANGELOG.md ├── CODE-OF-CONDUCT.md ├── CODEOWNERS ├── CONTRIBUTING.md ├── LICENSE ├── NOTICE ├── README.md ├── RELEASING.md ├── SECURITY.md ├── base-deriving-via ├── CHANGELOG.md ├── LICENSE ├── NOTICE ├── base-deriving-via.cabal └── src │ └── Data │ ├── DerivingVia.hs │ └── DerivingVia │ └── GHC │ └── Generics │ ├── Monoid.hs │ └── Semigroup.hs ├── cabal.project ├── cardano-binary ├── CHANGELOG.md ├── LICENSE ├── NOTICE ├── README.md ├── Setup.hs ├── cardano-binary.cabal ├── src │ └── Cardano │ │ ├── Binary.hs │ │ └── Binary │ │ ├── Deserialize.hs │ │ ├── FromCBOR.hs │ │ ├── Serialize.hs │ │ └── ToCBOR.hs ├── test │ ├── CHANGELOG.md │ ├── LICENSE │ ├── Test │ │ └── Cardano │ │ │ └── Binary │ │ │ ├── Failure.hs │ │ │ ├── Helpers.hs │ │ │ ├── Helpers │ │ │ └── GoldenRoundTrip.hs │ │ │ ├── RoundTrip.hs │ │ │ ├── Serialization.hs │ │ │ └── SizeBounds.hs │ ├── cardano-binary-test.cabal │ ├── golden │ │ ├── TestSimpleIndexed1 │ │ ├── TestSimpleIndexed2 │ │ ├── TestSimpleIndexed3 │ │ ├── TestSimpleIndexed4 │ │ └── TestSimpleIndexed5 │ └── test.hs └── testlib │ └── Test │ └── Cardano │ └── Binary │ └── TreeDiff.hs ├── cardano-crypto-class ├── CHANGELOG.md ├── LICENSE ├── NOTICE ├── README.md ├── Setup.hs ├── cardano-crypto-class.cabal ├── cbits │ └── blst_util.c ├── memory-example │ └── Main.hs └── src │ └── Cardano │ ├── Crypto │ ├── DSIGN.hs │ ├── DSIGN │ │ ├── Class.hs │ │ ├── EcdsaSecp256k1.hs │ │ ├── Ed25519.hs │ │ ├── Ed25519ML.hs │ │ ├── Ed448.hs │ │ ├── Mock.hs │ │ ├── NeverUsed.hs │ │ └── SchnorrSecp256k1.hs │ ├── DirectSerialise.hs │ ├── EllipticCurve │ │ ├── BLS12_381.hs │ │ └── BLS12_381 │ │ │ └── Internal.hs │ ├── Hash.hs │ ├── Hash │ │ ├── Blake2b.hs │ │ ├── Class.hs │ │ ├── Keccak256.hs │ │ ├── NeverUsed.hs │ │ ├── RIPEMD160.hs │ │ ├── SHA256.hs │ │ ├── SHA3_256.hs │ │ ├── SHA3_512.hs │ │ ├── SHA512.hs │ │ └── Short.hs │ ├── Init.hs │ ├── KES.hs │ ├── KES │ │ ├── Class.hs │ │ ├── CompactSingle.hs │ │ ├── CompactSum.hs │ │ ├── Mock.hs │ │ ├── NeverUsed.hs │ │ ├── Simple.hs │ │ ├── Single.hs │ │ └── Sum.hs │ ├── Libsodium.hs │ ├── Libsodium │ │ ├── C.hs │ │ ├── Constants.hsc │ │ ├── Hash.hs │ │ ├── Hash │ │ │ └── Class.hs │ │ ├── Init.hs │ │ ├── MLockedBytes.hs │ │ ├── MLockedBytes │ │ │ └── Internal.hs │ │ ├── MLockedSeed.hs │ │ ├── Memory.hs │ │ ├── Memory │ │ │ └── Internal.hs │ │ └── UnsafeC.hs │ ├── PackedBytes.hs │ ├── PinnedSizedBytes.hs │ ├── SECP256K1 │ │ ├── C.hs │ │ └── Constants.hsc │ ├── Seed.hs │ ├── Util.hs │ ├── VRF.hs │ └── VRF │ │ ├── Class.hs │ │ ├── Mock.hs │ │ ├── NeverUsed.hs │ │ └── Simple.hs │ └── Foreign.hs ├── cardano-crypto-praos ├── CHANGELOG.md ├── LICENSE ├── NOTICE ├── README.md ├── Setup.hs ├── cardano-crypto-praos.cabal ├── cbits │ ├── README │ ├── crypto_vrf.c │ ├── crypto_vrf.h │ ├── private │ │ ├── common.h │ │ ├── core_h2c.c │ │ ├── core_h2c.h │ │ ├── ed25519_ref10.c │ │ ├── ed25519_ref10.h │ │ ├── ed25519_ref10_fe_25_5.h │ │ ├── ed25519_ref10_fe_51.h │ │ ├── fe_25_5 │ │ │ ├── base.h │ │ │ ├── base2.h │ │ │ ├── constants.h │ │ │ └── fe.h │ │ └── fe_51 │ │ │ ├── base.h │ │ │ ├── base2.h │ │ │ ├── constants.h │ │ │ └── fe.h │ ├── vrf03 │ │ ├── crypto_vrf_ietfdraft03.h │ │ ├── prove.c │ │ ├── verify.c │ │ └── vrf.c │ └── vrf13_batchcompat │ │ ├── crypto_vrf_ietfdraft13.h │ │ ├── prove.c │ │ ├── verify.c │ │ └── vrf.c └── src │ └── Cardano │ └── Crypto │ ├── RandomBytes.hs │ └── VRF │ ├── Praos.hs │ └── PraosBatchCompat.hs ├── cardano-crypto-tests ├── CHANGELOG.md ├── LICENSE ├── NOTICE ├── README.md ├── Setup.hs ├── bench │ └── Main.hs ├── bls12-381-test-vectors │ ├── Cargo.toml │ ├── README.md │ ├── src │ │ └── main.rs │ └── test_vectors │ │ ├── bls_sig_aug_test_vectors │ │ ├── ec_operations_test_vectors │ │ ├── h2c_large_dst │ │ ├── pairing_test_vectors │ │ └── serde_test_vectors ├── cardano-crypto-tests.cabal ├── src │ ├── Bench │ │ └── Crypto │ │ │ ├── BenchData.hs │ │ │ ├── DSIGN.hs │ │ │ ├── HASH.hs │ │ │ ├── KES.hs │ │ │ └── VRF.hs │ └── Test │ │ └── Crypto │ │ ├── AllocLog.hs │ │ ├── DSIGN.hs │ │ ├── EllipticCurve.hs │ │ ├── EqST.hs │ │ ├── Hash.hs │ │ ├── Instances.hs │ │ ├── KES.hs │ │ ├── Regressions.hs │ │ ├── RunIO.hs │ │ ├── Util.hs │ │ ├── VRF.hs │ │ └── Vector │ │ ├── Secp256k1DSIGN.hs │ │ ├── SerializationUtils.hs │ │ ├── StringConstants.hs │ │ └── Vectors.hs ├── test │ └── Main.hs └── test_vectors │ ├── vrf_ver03_generated_1 │ ├── vrf_ver03_generated_2 │ ├── vrf_ver03_generated_3 │ ├── vrf_ver03_generated_4 │ ├── vrf_ver03_standard_10 │ ├── vrf_ver03_standard_11 │ ├── vrf_ver03_standard_12 │ ├── vrf_ver13_generated_1 │ ├── vrf_ver13_generated_2 │ ├── vrf_ver13_generated_3 │ ├── vrf_ver13_generated_4 │ ├── vrf_ver13_standard_10 │ ├── vrf_ver13_standard_11 │ └── vrf_ver13_standard_12 ├── cardano-git-rev ├── LICENSE ├── NOTICE ├── README.md ├── Setup.hs ├── cardano-git-rev.cabal ├── cbits │ └── rev.c └── src │ └── Cardano │ └── Git │ └── Rev.hs ├── cardano-slotting ├── CHANGELOG.md ├── LICENSE ├── NOTICE ├── Setup.hs ├── cardano-slotting.cabal ├── src │ └── Cardano │ │ └── Slotting │ │ ├── Block.hs │ │ ├── EpochInfo.hs │ │ ├── EpochInfo │ │ ├── API.hs │ │ ├── Extend.hs │ │ └── Impl.hs │ │ ├── Slot.hs │ │ └── Time.hs ├── test │ ├── Main.hs │ └── Test │ │ └── Cardano │ │ └── Slotting │ │ └── EpochInfo.hs └── testlib │ └── Test │ └── Cardano │ └── Slotting │ ├── Arbitrary.hs │ ├── Numeric.hs │ └── TreeDiff.hs ├── cardano-strict-containers ├── CHANGELOG.md ├── LICENSE ├── NOTICE ├── Setup.hs ├── cardano-strict-containers.cabal └── src │ └── Data │ ├── FingerTree │ └── Strict.hs │ ├── Maybe │ └── Strict.hs │ ├── Sequence │ └── Strict.hs │ └── Unit │ └── Strict.hs ├── default.nix ├── flake.lock ├── flake.nix ├── fourmolu.yaml ├── heapwords ├── CHANGELOG.md ├── LICENSE ├── NOTICE ├── heapwords.cabal └── src │ └── Cardano │ └── HeapWords.hs ├── hie-cabal.yaml ├── measures ├── CHANGELOG.md ├── LICENSE ├── NOTICE ├── measures.cabal ├── src │ └── Data │ │ ├── Measure.hs │ │ └── Measure │ │ └── Class.hs └── test │ ├── Main.hs │ └── Test │ └── Data │ └── Measure.hs ├── orphans-deriving-via ├── CHANGELOG.md ├── LICENSE ├── NOTICE ├── orphans-deriving-via.cabal └── src │ └── Data │ └── DerivingVia │ ├── DeepSeq.hs │ └── NoThunks.hs ├── scripts ├── cabal-format.sh ├── fourmolize.sh ├── haddocks.sh └── mkprolog.sh └── shell.nix /.devcontainer/devcontainer.json: -------------------------------------------------------------------------------- 1 | { 2 | "image":"ghcr.io/input-output-hk/devx-devcontainer:x86_64-linux.ghc96-iog", 3 | "onCreateCommand": "on-create-command", 4 | "customizations":{ 5 | "vscode":{ 6 | "extensions":[ 7 | "haskell.haskell" 8 | ] 9 | } 10 | // Do not set custom `settings` as they would override devx-container defaults... 11 | } 12 | } -------------------------------------------------------------------------------- /.git-blame-ignore-revs: -------------------------------------------------------------------------------- 1 | ### NOTE 2 | # Run `git config blame.ignoreRevsFile .git-blame-ignore-revs` 3 | # from the repository's root to tell `git blame` to ignore 4 | # the commits below. 5 | 6 | # `fourmolize` 7 | # CommitDate: Wed Nov 20 18:01:24 2024 +0100 8 | db87b19be6ff702d3bf37cef259de456c48b7ffe 9 | -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | # GitHub Linguist annotations. 2 | # Hide nix/.stack.nix/*.nix 3 | # That is stuff that is generated by nix-tools stack-to-nix 4 | 5 | nix/.stack.nix/*.nix linguist-generated=true 6 | nix/sources.nix linguist-generated=true 7 | -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE/config.yml: -------------------------------------------------------------------------------- 1 | blank_issues_enabled: true 2 | contact_links: 3 | - name: Contributing guidelines 4 | url: https://github.com/IntersectMBO/cardano-base/blob/master/CONTRIBUTING.md 5 | about: Some rules & processes we honor. 6 | 7 | - name: All issues 8 | url: https://github.com/IntersectMBO/cardano-base/issues 9 | about: Check whether your issue is not already covered here. 10 | -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE/feature_idea_base.yml: -------------------------------------------------------------------------------- 1 | name: Cardano Base Repository Issue 2 | description: Issue, Feature Enhancement, or Fix for the cardano-base repository 3 | ### Description 4 | A clear and concise description of the problem or feature request. Include relevant context, details and the package name(s) that is affected 5 | 6 | ### Steps to Reproduce (for bugs) 7 | 1. Step 1 8 | 2. Step 2 9 | 3. Step 3 10 | (Include screenshots if applicable) 11 | 12 | ### Expected Behavior 13 | A clear description of what you expected to happen. 14 | 15 | ### Actual Behavior 16 | What actually happens when following the steps. Include any error messages. 17 | 18 | ### Environment (if applicable) 19 | - Package Name and Version: 20 | - Operating System: 21 | - Nix/Cabal Version: 22 | 23 | ### Additional Context 24 | Add any other context about the problem or request here. Include possible solutions, discussions, or relevant documentation links. 25 | 26 | ### Labels 27 | (For maintainers: add relevant labels such as `bug`, `enhancement`, `technical-debt`, etc.) -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE/release-packages.md: -------------------------------------------------------------------------------- 1 | --- 2 | name: Release some packages 3 | about: Use this template for tracking package releases. 4 | title: "Release some packages" 5 | --- 6 | 7 | ### Release checklist 8 | 9 | Once all the pending issues/pull-requests are integrated: 10 | 11 | - [ ] Run the following script from [CHaP](https://github.com/IntersectMBO/cardano-haskell-packages) to open a pull-request for releases. 12 | ```shellsession 13 | ./scripts/add-from-github.sh "https://github.com/intersectmbo/cardano-base" \ 14 | base-deriving-via \ 15 | cardano-binary \ 16 | cardano-crypto-class \ 17 | cardano-crypto-praos \ 18 | cardano-crypto-tests \ 19 | cardano-git-rev \ 20 | cardano-slotting \ 21 | cardano-strict-containers \ 22 | heapwords \ 23 | measures \ 24 | orphans-deriving-via 25 | ``` 26 | - [ ] List the pull-request made to [CHaP](https://github.com/IntersectMBO/cardano-haskell-packages) below. 27 | - [ ] [Create Git tags](https://github.com/IntersectMBO/cardano-base/blob/master/RELEASING.md#release-to-chap) for the versions of packages released on the respective commit. 28 | - [ ] Open a pull-request to [update the change-logs](https://github.com/IntersectMBO/cardano-ledger/blob/master/RELEASING.md#release-to-chap) with new sections as the "post-release process". 29 | - [ ] If these releases are for a specific version release of `cardano-node`, mention this in the title. 30 | 31 | ----- 32 | 33 | ### CHaP PRs 34 | 35 | To know the exact versions and packages released, check these pull-requests on [CHaP](https://github.com/IntersectMBO/cardano-haskell-packages). 36 | 37 | - [Link](#) 38 | -------------------------------------------------------------------------------- /.github/PULL_REQUEST_TEMPLATE.md: -------------------------------------------------------------------------------- 1 | # Description 2 | 3 | 6 | 7 | # Checklist 8 | 9 | - [ ] Commit sequence broadly makes sense and commits have useful messages 10 | - [ ] New tests are added if needed and existing tests are updated 11 | - [ ] All visible changes are prepended to the latest section of a `CHANGELOG.md` for the affected packages. 12 | **_New section is never added with the code changes._** (See [RELEASING.md](https://github.com/intersectmbo/cardano-base/blob/master/RELEASING.md#changelogmd)) 13 | - [ ] When applicable, versions are updated in `.cabal` and `CHANGELOG.md` files according to the 14 | [versioning process](https://github.com/intersectmbo/cardano-base/blob/master/RELEASING.md#versioning-process). 15 | - [ ] The version bounds in `.cabal` files for all affected packages are updated. 16 | **_If you change the bounds in a cabal file, that package itself must have a version increase._** (See [RELEASING.md](https://github.com/intersectmbo/cardano-base/blob/master/RELEASING.md#versioning-process)) 17 | - [ ] Self-reviewed the diff 18 | -------------------------------------------------------------------------------- /.github/workflows/cabal.project.local.ci.Darwin: -------------------------------------------------------------------------------- 1 | package cardano-crypto-praos 2 | flags: -external-libsodium-vrf 3 | 4 | package HsOpenSSL 5 | flags: +use-pkg-config 6 | -------------------------------------------------------------------------------- /.github/workflows/cabal.project.local.ci.Linux: -------------------------------------------------------------------------------- 1 | package cardano-crypto-praos 2 | flags: -external-libsodium-vrf 3 | 4 | package HsOpenSSL 5 | flags: +use-pkg-config 6 | -------------------------------------------------------------------------------- /.github/workflows/cabal.project.local.ci.MINGW64_NT-10.0-20348: -------------------------------------------------------------------------------- 1 | package cardano-crypto-praos 2 | flags: -external-libsodium-vrf 3 | 4 | package HsOpenSSL 5 | flags: +use-pkg-config 6 | 7 | package text 8 | flags: -simdutf 9 | -------------------------------------------------------------------------------- /.github/workflows/gh-pages.yml: -------------------------------------------------------------------------------- 1 | name: Haddocks to GitHub Pages 2 | 3 | on: 4 | push: 5 | branches: [ "master" ] 6 | workflow_dispatch: 7 | 8 | jobs: 9 | gh-pages: 10 | runs-on: ubuntu-latest 11 | permissions: 12 | contents: write 13 | 14 | steps: 15 | - uses: actions/checkout@v4 16 | 17 | - name: Install Haskell 18 | uses: input-output-hk/setup-haskell@v1 19 | id: setup-haskell 20 | with: 21 | ghc-version: "9.2.8" 22 | cabal-version: "3.12" 23 | 24 | - name: Install system dependencies 25 | uses: input-output-hk/actions/base@latest 26 | with: 27 | use-sodium-vrf: false # default is true 28 | 29 | - name: Configure to use libsodium 30 | run: | 31 | cat >> cabal.project <CNAME 72 | touch .nojekyll 73 | git add CNAME .nojekyll 74 | git commit -qm "Add CNAME and .nojekyll" 75 | 76 | # Preserve benchmark results, if any 77 | git ls-remote origin --heads gh-pages | 78 | while read -r _SHA REFNAME; do 79 | git fetch origin "$REFNAME" 80 | if git diff --name-only FETCH_HEAD -- dev | grep -q .; then 81 | git checkout FETCH_HEAD dev 82 | git commit -qC "$(git log -1 --format=%H FETCH_HEAD dev)" 83 | fi 84 | done 85 | 86 | # Add Haddocks 87 | git add -A --force ./haddocks 88 | git mv ./haddocks/* . 89 | git commit -qm "Updated from ${GITHUB_SHA} via ${GITHUB_EVENT_NAME}" 90 | 91 | - name: Push to gh-pages 92 | if: github.event_name == 'push' && github.ref_name == 'master' 93 | uses: ad-m/github-push-action@v0.8.0 94 | with: 95 | github_token: ${{ secrets.GITHUB_TOKEN }} 96 | branch: gh-pages 97 | force: true 98 | directory: . 99 | -------------------------------------------------------------------------------- /.github/workflows/rate-limit-check.yml: -------------------------------------------------------------------------------- 1 | name: Rate Limit Check 2 | 3 | on: 4 | push: 5 | create: 6 | 7 | jobs: 8 | build: 9 | runs-on: ubuntu-latest 10 | 11 | steps: 12 | - name: "WIN: Install System Dependencies via pacman (msys2)" 13 | run: | 14 | curl -H "Accept: application/vnd.github.v3+json" https://api.github.com/rate_limit 15 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Cabal & Stack 2 | .stack-work*/ 3 | **/dist 4 | dist-newstyle/ 5 | .ghc.environment.x86_64-linux-8.6.5 6 | stack.yaml.lock 7 | cabal.project.local 8 | .nix-shell-cabal.project 9 | 10 | # Editors 11 | TAGS 12 | 13 | # Vim swap files 14 | *.sw[a-p] 15 | 16 | # Emacs auto-generated Emacs-lisp code 17 | auto/ 18 | 19 | # Nix artifacts 20 | result 21 | .stack-to-nix.cache 22 | 23 | # Profiler and profiteur artifacts 24 | *.aux 25 | *.folded 26 | *.prof 27 | *.hp 28 | *.ps 29 | *.html 30 | 31 | # Local development 32 | stack-local.yaml 33 | .nvimrc 34 | 35 | # Visual Studio Code 36 | /.vscode 37 | 38 | # Test artefacts 39 | /result-* 40 | cardano-crypto-class/output 41 | cardano-crypto-praos/output 42 | 43 | # ghcid 44 | **/.ghcid 45 | **/ghcid.txt 46 | tags 47 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | ## Changelog 2 | 3 | Changelogs for components can be found as follows: 4 | 5 | - [base-deriving-via](https://github.com/IntersectMBO/cardano-base/blob/master/base-deriving-via/CHANGELOG.md) 6 | - [cardano-binary](https://github.com/IntersectMBO/cardano-base/blob/master/cardano-binary/CHANGELOG.md) 7 | - [cardano-crypto-class](https://github.com/IntersectMBO/cardano-base/blob/master/cardano-crypto-class/CHANGELOG.md) 8 | - [cardano-crypto-praos](https://github.com/IntersectMBO/cardano-base/blob/master/cardano-crypto-praos/CHANGELOG.md) 9 | - [cardano-crypto-tests](https://github.com/IntersectMBO/cardano-base/blob/master/cardano-crypto-tests/CHANGELOG.md) 10 | - [cardano-mempool](https://github.com/IntersectMBO/cardano-base/blob/master/cardano-mempool/CHANGELOG.md) 11 | - [cardano-slotting](https://github.com/IntersectMBO/cardano-base/blob/master/cardano-slotting/CHANGELOG.md) 12 | - [cardano-strict-containers](https://github.com/IntersectMBO/cardano-base/blob/master/cardano-strict-containers/CHANGELOG.md) 13 | - [heapwords](https://github.com/IntersectMBO/cardano-base/blob/master/heapwords/CHANGELOG.md) 14 | - [measures](https://github.com/IntersectMBO/cardano-base/blob/master/measures/CHANGELOG.md) 15 | - [orphans-deriving-via](https://github.com/IntersectMBO/cardano-base/blob/master/orphans-deriving-via/CHANGELOG.md) -------------------------------------------------------------------------------- /CODE-OF-CONDUCT.md: -------------------------------------------------------------------------------- 1 | See the code of conduct in the [https://github.com/input-output-hk/cardano-engineering-handbook/blob/main/CODE-OF-CONDUCT.md](Cardano engineering handbook). 2 | -------------------------------------------------------------------------------- /CODEOWNERS: -------------------------------------------------------------------------------- 1 | # code owners are automatically assigned to review PRs 2 | 3 | # DevX 4 | *.nix @IntersectMBO/core-tech-devx @lehins 5 | nix @IntersectMBO/core-tech-devx @lehins 6 | flake.lock @IntersectMBO/core-tech-devx @lehins 7 | .github @IntersectMBO/core-tech-devx @lehins 8 | 9 | # Packages 10 | cardano-binary @lehins @IntersectMBO/cardano-ledger-maintainers 11 | cardano-crypto-class @lehins 12 | cardano-crypto-praos @lehins 13 | cardano-crypto-tests @lehins 14 | cardano-mempool @lehins 15 | cardano-slotting @lehins @IntersectMBO/cardano-ledger-maintainers 16 | cardano-strict-containers @lehins @IntersectMBO/cardano-ledger-maintainers 17 | heapwords @lehins @IntersectMBO/cardano-ledger-maintainers 18 | 19 | base-deriving-via @nfrisby @lehins 20 | orphans-deriving-via @nfrisby @lehins 21 | measures @nfrisby @lehins 22 | 23 | cardano-git-rev @erikd @lehins 24 | -------------------------------------------------------------------------------- /NOTICE: -------------------------------------------------------------------------------- 1 | Copyright 2019-2021 Input Output (Hong Kong) Ltd. 2 | 3 | Licensed under the Apache License, Version 2.0 (the "License"); 4 | you may not use this file except in compliance with the License. 5 | You may obtain a copy of the License at 6 | 7 | http://www.apache.org/licenses/LICENSE-2.0 8 | 9 | Unless required by applicable law or agreed to in writing, software 10 | distributed under the License is distributed on an "AS IS" BASIS, 11 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | See the License for the specific language governing permissions and 13 | limitations under the License. 14 | 15 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # cardano-base 2 | 3 | A collection of miscellaneous packages used by Cardano that cover: 4 | 5 | * cryptography 6 | * serialization 7 | * slotting 8 | 9 | Each sub-project has its own README. 10 | 11 | Haddock for all packages from master branch can be found here: 12 | [https://cardano-base.cardano.intersectmbo.org](https://cardano-base.cardano.intersectmbo.org/) 13 | 14 | All releases for packages found in this repository are recorded in [Cardano Haskell 15 | package repository](https://github.com/intersectmbo/cardano-haskell-packages) 16 | 17 | ## Building 18 | 19 | ### With `nix` 20 | 21 | With nix it is as easy as: 22 | 23 | ``` 24 | $ nix develop 25 | ... 26 | $ cabal build all 27 | ``` 28 | 29 | ### Without `nix` 30 | 31 | Crypotgraphic depencencies needed for building Haskell packages: 32 | 33 | * [`libsodium`](https://github.com/jedisct1/libsodium) 34 | * [`libsecp256k1`](https://github.com/bitcoin-core/secp256k1) 35 | * [`libblst`](https://github.com/supranational/blst) 36 | 37 | We provide packaged versions for common Operating Systems for all of the above 38 | dependencies: [Download](https://github.com/input-output-hk/iohk-nix/releases/latest) 39 | 40 | 41 | ## GHC 42 | 43 | Default version of GHC used in `nix` is `9.2.7`, but we do support other GHC versions 44 | `8.10.7` and `9.6.1`. 45 | 46 | 47 | ### Testing 48 | 49 | This is a command to run test suites for all packages: 50 | 51 | ``` 52 | $ cabal build all 53 | ``` 54 | 55 | The test suites use [Tasty](https://github.com/feuerbach/tasty), 56 | which allows for running specific tests. 57 | This is done by passing the `-p` flag to the test program, followed by an `awk` pattern. 58 | You can alternatively use the `TASTY_PATTERN` environment variable with a pattern. 59 | For example, the `cardano-crypto-tests` can be run with: 60 | 61 | ```shell 62 | $ cabal test cardano-crypto-tests --test-options '-p blake2b_256' 63 | ``` 64 | 65 | or 66 | 67 | ```shell 68 | $ TASTY_PATTERN="blake2b_256" cabal test cardano-crypto-tests 69 | ``` 70 | 71 | -------------------------------------------------------------------------------- /SECURITY.md: -------------------------------------------------------------------------------- 1 | # Security Policy 2 | 3 | ## Reporting a Vulnerability 4 | 5 | Please report (suspected) security vulnerabilities to security@intersectmbo.org. You will receive a 6 | response from us within 48 hours. If the issue is confirmed, we will release a patch as soon 7 | as possible. 8 | 9 | Please provide a clear and concise description of the vulnerability, including: 10 | 11 | * the affected version(s) of cardano-base, 12 | * steps that can be followed to exercise the vulnerability, 13 | * any workarounds or mitigations 14 | 15 | If you have developed any code or utilities that can help demonstrate the suspected 16 | vulnerability, please mention them in your email but ***DO NOT*** attempt to include them as 17 | attachments as this may cause your Email to be blocked by spam filters. 18 | See the security file in the [Cardano engineering handbook](https://github.com/input-output-hk/cardano-engineering-handbook/blob/main/SECURITY.md). 19 | -------------------------------------------------------------------------------- /base-deriving-via/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Changelog for `base-deriving-via` 2 | 3 | ## 0.1.0.2 4 | 5 | * 6 | 7 | ## 0.1.0.1 8 | 9 | * Remove `development` flag: #372 10 | 11 | ## 0.1.0.1 12 | 13 | * Initial release 14 | 15 | -------------------------------------------------------------------------------- /base-deriving-via/NOTICE: -------------------------------------------------------------------------------- 1 | Copyright 2021 Input Output (Hong Kong) Ltd. 2 | 3 | Licensed under the Apache License, Version 2.0 (the "License"); 4 | you may not use this file except in compliance with the License. 5 | You may obtain a copy of the License at 6 | 7 | http://www.apache.org/licenses/LICENSE-2.0 8 | 9 | Unless required by applicable law or agreed to in writing, software 10 | distributed under the License is distributed on an "AS IS" BASIS, 11 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | See the License for the specific language governing permissions and 13 | limitations under the License. 14 | -------------------------------------------------------------------------------- /base-deriving-via/base-deriving-via.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: >=1.10 2 | name: base-deriving-via 3 | version: 0.1.0.2 4 | synopsis: A general hook newtype for use with deriving via 5 | license: Apache-2.0 6 | license-files: 7 | LICENSE 8 | NOTICE 9 | 10 | author: IOHK 11 | maintainer: operations@iohk.io 12 | copyright: IOHK 13 | build-type: Simple 14 | extra-source-files: CHANGELOG.md 15 | 16 | library 17 | default-language: Haskell2010 18 | hs-source-dirs: src 19 | ghc-options: 20 | -Wall 21 | -Wcompat 22 | -Wincomplete-uni-patterns 23 | -Wincomplete-record-updates 24 | -Wpartial-fields 25 | -Widentities 26 | -Wredundant-constraints 27 | -Wmissing-export-lists 28 | 29 | exposed-modules: 30 | Data.DerivingVia 31 | Data.DerivingVia.GHC.Generics.Monoid 32 | Data.DerivingVia.GHC.Generics.Semigroup 33 | 34 | build-depends: base 35 | -------------------------------------------------------------------------------- /base-deriving-via/src/Data/DerivingVia.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ConstraintKinds #-} 2 | {-# LANGUAGE DerivingStrategies #-} 3 | {-# LANGUAGE FlexibleContexts #-} 4 | {-# LANGUAGE FlexibleInstances #-} 5 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 6 | {-# LANGUAGE KindSignatures #-} 7 | {-# LANGUAGE UndecidableInstances #-} 8 | 9 | -- | Newtype wrappers for us in @deriving via@ clauses that " should " have 10 | -- been defined in @base@ and other packages we depend on but do not control 11 | -- 12 | -- We expected variations of these to eventually be defined upstream, but we'd 13 | -- like to use these concepts before that happens. 14 | module Data.DerivingVia ( 15 | InstantiatedAt (..), 16 | ) 17 | where 18 | 19 | import Data.Kind (Constraint, Type) 20 | import GHC.Generics 21 | 22 | import Data.DerivingVia.GHC.Generics.Monoid 23 | import Data.DerivingVia.GHC.Generics.Semigroup 24 | 25 | infix 0 `InstantiatedAt` 26 | 27 | -- | A hook that represents a @deriving via@ scheme via some class constraint 28 | -- 29 | -- The most notable example is 'GHC.Generics.Generic'. 30 | -- 31 | -- > data T = ... 32 | -- > deriving (Monoid, Semigroup) 33 | -- > via InstantiatedAt Generic T 34 | -- 35 | -- This type's parameterization is useful because many such schemes are 36 | -- similarly identified by a single type class, such as 'Ord'. 37 | newtype InstantiatedAt (c :: Type -> Constraint) a = InstantiatedAt a 38 | deriving newtype (Eq, Ord, Show) 39 | 40 | instance 41 | (Generic a, GSemigroup (Rep a)) => 42 | Semigroup (InstantiatedAt Generic a) 43 | where 44 | InstantiatedAt l <> InstantiatedAt r = 45 | InstantiatedAt $ to $ gsappend (from l) (from r) 46 | 47 | instance 48 | (Generic a, GSemigroup (Rep a), GMonoid (Rep a)) => 49 | Monoid (InstantiatedAt Generic a) 50 | where 51 | mempty = InstantiatedAt $ to gmempty 52 | -------------------------------------------------------------------------------- /base-deriving-via/src/Data/DerivingVia/GHC/Generics/Monoid.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE FlexibleInstances #-} 4 | {-# LANGUAGE TypeOperators #-} 5 | {-# LANGUAGE UndecidableInstances #-} 6 | 7 | {-# OPTIONS -Wno-unticked-promoted-constructors #-} 8 | 9 | -- | "GHC.Generics" definition of 'mempty' 10 | module Data.DerivingVia.GHC.Generics.Monoid ( 11 | GMonoid (..), 12 | ) 13 | where 14 | 15 | import GHC.Generics 16 | import GHC.TypeLits 17 | 18 | class GMonoid rep where 19 | gmempty :: rep x 20 | 21 | instance Monoid c => GMonoid (K1 i c) where 22 | gmempty = K1 mempty 23 | 24 | instance GMonoid f => GMonoid (M1 i c f) where 25 | gmempty = M1 gmempty 26 | 27 | instance GMonoid V1 where 28 | gmempty = error "GMonoid V1" 29 | 30 | instance GMonoid U1 where 31 | gmempty = U1 32 | 33 | instance (GMonoid l, GMonoid r) => GMonoid (l :*: r) where 34 | gmempty = gmempty :*: gmempty 35 | 36 | instance 37 | TypeError 38 | ( Text "No Generics definition of " 39 | :<>: ShowType Monoid 40 | :<>: Text " for types with multiple constructors " 41 | :<>: ShowType (l :+: r) 42 | ) => 43 | GMonoid (l :+: r) 44 | where 45 | gmempty = error "GMonoid :+:" 46 | -------------------------------------------------------------------------------- /base-deriving-via/src/Data/DerivingVia/GHC/Generics/Semigroup.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE EmptyCase #-} 3 | {-# LANGUAGE FlexibleContexts #-} 4 | {-# LANGUAGE FlexibleInstances #-} 5 | {-# LANGUAGE LambdaCase #-} 6 | {-# LANGUAGE TypeOperators #-} 7 | {-# LANGUAGE UndecidableInstances #-} 8 | 9 | {-# OPTIONS -Wno-unticked-promoted-constructors #-} 10 | 11 | -- | "GHC.Generics" definition of '<>' 12 | module Data.DerivingVia.GHC.Generics.Semigroup ( 13 | GSemigroup (..), 14 | ) 15 | where 16 | 17 | import GHC.Generics 18 | import GHC.TypeLits 19 | 20 | class GSemigroup rep where 21 | gsappend :: rep x -> rep x -> rep x 22 | 23 | instance Monoid c => GSemigroup (K1 i c) where 24 | gsappend (K1 l) (K1 r) = K1 (l <> r) 25 | 26 | instance GSemigroup f => GSemigroup (M1 i c f) where 27 | gsappend (M1 l) (M1 r) = M1 (gsappend l r) 28 | 29 | instance GSemigroup V1 where 30 | gsappend = \case {} 31 | 32 | instance GSemigroup U1 where 33 | gsappend U1 U1 = U1 34 | 35 | instance (GSemigroup l, GSemigroup r) => GSemigroup (l :*: r) where 36 | gsappend (l1 :*: r1) (l2 :*: r2) = gsappend l1 l2 :*: gsappend r1 r2 37 | 38 | instance 39 | TypeError 40 | ( Text "No Generics definition of " 41 | :<>: ShowType Semigroup 42 | :<>: Text " for types with multiple constructors " 43 | :<>: ShowType (l :+: r) 44 | ) => 45 | GSemigroup (l :+: r) 46 | where 47 | gsappend = error "GSemigroup :+:" 48 | -------------------------------------------------------------------------------- /cabal.project: -------------------------------------------------------------------------------- 1 | repository cardano-haskell-packages 2 | url: https://chap.intersectmbo.org/ 3 | secure: True 4 | root-keys: 5 | 3e0cce471cf09815f930210f7827266fd09045445d65923e6d0238a6cd15126f 6 | 443abb7fb497a134c343faf52f0b659bd7999bc06b7f63fa76dc99d631f9bea1 7 | a86a1f6ce86c449c46666bda44268677abf29b5b2d2eb5ec7af903ec2f117a82 8 | bcec67e8e99cabfa7764d75ad9b158d72bfacf70ca1d0ec8bc6b4406d1bf8413 9 | c00aae8461a256275598500ea0e187588c35a5d5d7454fb57eac18d9edb86a56 10 | d4a35cd3121aa00d18544bb0ac01c3e1691d618f462c46129271bccf39f7e8ee 11 | 12 | -- The hackage index-state 13 | index-state: 2025-05-14T16:20:57Z 14 | index-state: cardano-haskell-packages 2025-05-14T07:44:24Z 15 | packages: 16 | base-deriving-via 17 | cardano-binary 18 | cardano-binary/test 19 | cardano-crypto-class 20 | cardano-crypto-praos 21 | cardano-crypto-tests 22 | cardano-git-rev 23 | cardano-slotting 24 | cardano-strict-containers 25 | heapwords 26 | measures 27 | orphans-deriving-via 28 | 29 | -- Ensures colourized output from test runners 30 | test-show-details: direct 31 | tests: true 32 | benchmarks: true 33 | 34 | program-options 35 | ghc-options: -Werror 36 | 37 | -- Windows cross with bitvec/simd is broken. 38 | package bitvec 39 | -- Workaround for windows cross-compilation 40 | flags: -simd 41 | 42 | if impl(ghc >=9.12) 43 | allow-newer: 44 | -- treediff: Difficult maintainer https://github.com/haskellari/tree-diff/issues/97 45 | , tree-diff:base 46 | , tree-diff:time 47 | -------------------------------------------------------------------------------- /cardano-binary/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Changelog for `cardano-binary` 2 | 3 | ## 1.7.1.0 4 | 5 | * New `Test.Cardano.Binary.TreeDiff` module extracted from 6 | `cardano-ledger-binary`. It lives in a new public sublibrary `testlib`. 7 | * Add `FromCBOR` instance for `TermToken` 8 | 9 | ## 1.7.0.1 10 | 11 | * GHC-9.6 compatibility 12 | 13 | ## 1.7.0.0 14 | 15 | * Remove `development` flag: #372 16 | * Remove `To/FromCBOR` instances for `NominalDiffTime`, since they did rounding. Newly 17 | added functions `encodeNominalDiffTimeMicro`/`decodedNominalDiffTimeMicro` can be used 18 | to recover previous behavior. Correct instances that do not perform any rounding will 19 | be added in some future version, for now `decodeNominalDiffTime` and 20 | `encodeNominalDiffTime` can be used. 21 | * Add `decodeNominalDiffTime` and `encodeNominalDiffTime` 22 | * Add `To/FromCBOR` for all `Fixed a`, not just `Nano` and `Pico` 23 | 24 | ## 1.6.0.0 25 | 26 | * Removed `Cardano.Binary.Annotated` and `Cardano.Binary.Drop` modules. They have been 27 | replaced by equivalent in 28 | [`cardano-ledger-binary`](https://github.com/input-output-hk/cardano-ledger/blob/master/libs/cardano-ledger-binary) 29 | * Removed `Cardano.Binary.Raw`. It has moved into: 30 | [`cardano-crypto-wrapper:Cardano.Crypto.Raw`](https://github.com/input-output-hk/cardano-ledger/blob/master/eras/byron/crypto/src/Cardano/Crypto/Raw.hs) 31 | * Generalized `cborError` and `toCborError` to `MonadFail` 32 | * Add `ToCBOR` instance for `Tokens -> Tokens` 33 | * Add `To/FromCBOR` instances for `Term` and `ToCBOR` for `Encoding` 34 | * Add `To/FromCBOR` instances for 6-tuples and 8-tuples 35 | * Remove `FromCBOR` instance for `Ratio` in favor of `Rational`. 36 | * Add `To/FromCBOR` instances for `Double`. 37 | * Rename `toCBORMaybe` -> `encodeMaybe` with deprecation. 38 | * Rename `decCBORMaybe` -> `decodeMaybe` with deprecation. 39 | * Add `encodeNullMaybe` and `decodeNullMaybe`. 40 | * Add `To/FromCBOR` instances for `Seq` 41 | * Deprecate `serializeEncoding` and `serializeEncoding'` in favor of `serialize` and 42 | `serialize'` respectively, since `Encoding` now has the `ToCBOR` instance. 43 | * Add `decodeFullDecoder'` that accepts strict `ByteString`. 44 | -------------------------------------------------------------------------------- /cardano-binary/NOTICE: -------------------------------------------------------------------------------- 1 | Copyright 2019-2021 Input Output (Hong Kong) Ltd. 2 | 3 | Licensed under the Apache License, Version 2.0 (the "License"); 4 | you may not use this file except in compliance with the License. 5 | You may obtain a copy of the License at 6 | 7 | http://www.apache.org/licenses/LICENSE-2.0 8 | 9 | Unless required by applicable law or agreed to in writing, software 10 | distributed under the License is distributed on an "AS IS" BASIS, 11 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | See the License for the specific language governing permissions and 13 | limitations under the License. 14 | 15 | -------------------------------------------------------------------------------- /cardano-binary/README.md: -------------------------------------------------------------------------------- 1 | # cardano-base 2 | 3 | This package includes: 4 | 5 | - Binary serialisation and deserialisation for Cardano, built on top of the [cborg] package 6 | 7 | [cborg]: https://hackage.haskell.org/package/cborg 8 | -------------------------------------------------------------------------------- /cardano-binary/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /cardano-binary/cardano-binary.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 3.0 2 | name: cardano-binary 3 | version: 1.7.1.0 4 | synopsis: Binary serialization for Cardano 5 | description: This package includes the binary serialization format for Cardano 6 | license: Apache-2.0 7 | license-files: 8 | LICENSE 9 | NOTICE 10 | 11 | author: IOHK 12 | maintainer: operations@iohk.io 13 | copyright: 2019-2021 IOHK 14 | category: Currency 15 | build-type: Simple 16 | extra-source-files: 17 | CHANGELOG.md 18 | README.md 19 | 20 | common base 21 | build-depends: base >=4.14 && <5 22 | 23 | common project-config 24 | default-language: Haskell2010 25 | ghc-options: 26 | -Wall 27 | -Wcompat 28 | -Wincomplete-record-updates 29 | -Wincomplete-uni-patterns 30 | -Wpartial-fields 31 | -Wredundant-constraints 32 | -Wunused-packages 33 | 34 | library 35 | import: base, project-config 36 | hs-source-dirs: src 37 | exposed-modules: Cardano.Binary 38 | other-modules: 39 | Cardano.Binary.Deserialize 40 | Cardano.Binary.FromCBOR 41 | Cardano.Binary.Serialize 42 | Cardano.Binary.ToCBOR 43 | 44 | build-depends: 45 | base, 46 | bytestring, 47 | cborg >=0.2.9 && <0.3, 48 | containers, 49 | data-fix, 50 | formatting, 51 | primitive, 52 | recursion-schemes >=5.1 && <5.3, 53 | safe-exceptions, 54 | tagged, 55 | text, 56 | time, 57 | vector, 58 | 59 | library testlib 60 | import: base, project-config 61 | visibility: public 62 | hs-source-dirs: testlib 63 | exposed-modules: Test.Cardano.Binary.TreeDiff 64 | build-depends: 65 | base, 66 | base16-bytestring, 67 | bytestring, 68 | cardano-binary, 69 | cborg, 70 | formatting, 71 | tree-diff, 72 | 73 | test-suite test 74 | import: base, project-config 75 | hs-source-dirs: test 76 | main-is: test.hs 77 | type: exitcode-stdio-1.0 78 | other-modules: 79 | Test.Cardano.Binary.Failure 80 | Test.Cardano.Binary.Helpers 81 | Test.Cardano.Binary.Helpers.GoldenRoundTrip 82 | Test.Cardano.Binary.RoundTrip 83 | Test.Cardano.Binary.Serialization 84 | Test.Cardano.Binary.SizeBounds 85 | 86 | build-depends: 87 | QuickCheck, 88 | base, 89 | bytestring, 90 | cardano-binary, 91 | cardano-prelude-test, 92 | cborg, 93 | containers, 94 | formatting, 95 | hedgehog, 96 | hspec, 97 | pretty-show, 98 | quickcheck-instances, 99 | tagged, 100 | text, 101 | time, 102 | vector, 103 | 104 | ghc-options: 105 | -threaded 106 | -rtsopts 107 | -------------------------------------------------------------------------------- /cardano-binary/src/Cardano/Binary.hs: -------------------------------------------------------------------------------- 1 | module Cardano.Binary ( 2 | module X, 3 | ) 4 | where 5 | 6 | import Cardano.Binary.Deserialize as X 7 | import Cardano.Binary.FromCBOR as X 8 | import Cardano.Binary.Serialize as X 9 | import Cardano.Binary.ToCBOR as X 10 | -------------------------------------------------------------------------------- /cardano-binary/test/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Changelog for `cardano-binary-test` 2 | 3 | ## 1.4.0.3 4 | 5 | * 6 | 7 | ## 1.4.0.2 8 | 9 | * GHC-9.6 compatibility 10 | 11 | ## 1.4.0.1 12 | 13 | * Remove `development` flag: #372 14 | 15 | ## 1.4.0.0 16 | 17 | * Remove `Test.Cardano.Binary.Drop` module 18 | 19 | ## 1.3.0.1 20 | 21 | * Initial release 22 | 23 | -------------------------------------------------------------------------------- /cardano-binary/test/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2019-2021 IOHK 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining a copy of 4 | this software and associated documentation files (the "Software"), to deal in 5 | the Software without restriction, including without limitation the rights to 6 | use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies 7 | of the Software, and to permit persons to whom the Software is furnished to 8 | do so, subject to the following conditions: 9 | 10 | The above copyright notice and this permission notice shall be included in 11 | all copies or substantial portions of the Software. 12 | 13 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 14 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 15 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 16 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 17 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 18 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 19 | THE SOFTWARE. 20 | -------------------------------------------------------------------------------- /cardano-binary/test/Test/Cardano/Binary/Failure.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BangPatterns #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE TemplateHaskell #-} 4 | 5 | module Test.Cardano.Binary.Failure (tests) 6 | where 7 | 8 | import qualified Codec.CBOR.Read as CR 9 | 10 | import Data.List.NonEmpty (NonEmpty) 11 | import Data.Set (Set) 12 | import GHC.Stack (HasCallStack, withFrozenCallStack) 13 | import Numeric.Natural (Natural) 14 | 15 | import Cardano.Binary hiding (Range) 16 | 17 | import Hedgehog 18 | import qualified Hedgehog.Gen as Gen 19 | import Hedgehog.Internal.Property (failWith) 20 | import qualified Hedgehog.Range as Range 21 | 22 | {- HLINT ignore "Use record patterns" -} 23 | 24 | tests :: IO Bool 25 | tests = checkParallel $$(discover) 26 | 27 | ---------------------------------------------------------------------- 28 | ------------------------- Generators ----------------------------- 29 | 30 | genInvalidNonEmptyCBOR :: Gen Encoding -- NonEmpty Bool 31 | genInvalidNonEmptyCBOR = pure (toCBOR ([] :: [Bool])) 32 | 33 | genInvalidEitherCBOR :: Gen Encoding -- Either Bool Bool 34 | genInvalidEitherCBOR = do 35 | b <- Gen.bool 36 | pure (encodeListLen 2 <> encodeWord 3 <> toCBOR b) 37 | 38 | genNegativeInteger :: Gen Integer 39 | genNegativeInteger = 40 | negate . toInteger <$> Gen.word64 (Range.exponential 1 maxBound) 41 | 42 | ---------------------------------------------------------------------- 43 | ------------------------- Properties ----------------------------- 44 | 45 | prop_shouldFailNonEmpty :: Property 46 | prop_shouldFailNonEmpty = property $ do 47 | ne <- forAll genInvalidNonEmptyCBOR 48 | assertIsLeft (decode ne :: Either DecoderError (NonEmpty Bool)) 49 | 50 | prop_shouldFailEither :: Property 51 | prop_shouldFailEither = property $ do 52 | e <- forAll genInvalidEitherCBOR 53 | assertIsLeft (decode e :: Either DecoderError (Either Bool Bool)) 54 | 55 | prop_shouldFailMaybe :: Property 56 | prop_shouldFailMaybe = property $ do 57 | e <- forAll genInvalidEitherCBOR 58 | assertIsLeft (decode e :: Either DecoderError (Maybe Bool)) 59 | 60 | prop_shouldFailSetTag :: Property 61 | prop_shouldFailSetTag = property $ do 62 | set <- forAll genInvalidEitherCBOR 63 | let wrongTag = encodeTag 266 64 | assertIsLeft (decode (wrongTag <> set) :: Either DecoderError (Set Int)) 65 | 66 | prop_shouldFailSet :: Property 67 | prop_shouldFailSet = property $ do 68 | ls <- forAll $ Gen.list (Range.constant 0 20) (Gen.int Range.constantBounded) 69 | let set = 70 | encodeTag 258 71 | <> encodeListLen (fromIntegral (length ls + 2)) 72 | <> mconcat (toCBOR <$> (4 : 3 : ls)) 73 | assertIsLeft (decode set :: Either DecoderError (Set Int)) 74 | 75 | prop_shouldFailNegativeNatural :: Property 76 | prop_shouldFailNegativeNatural = property $ do 77 | n <- forAll genNegativeInteger 78 | assertIsLeft (decode (toCBOR n) :: Either DecoderError Natural) 79 | 80 | --------------------------------------------------------------------- 81 | ------------------------------- helpers ----------------------------- 82 | 83 | assertIsLeft :: (HasCallStack, MonadTest m) => Either DecoderError b -> m () 84 | assertIsLeft (Right _) = withFrozenCallStack $ failWith Nothing "This should have Left : failed" 85 | assertIsLeft (Left !x) = case x of 86 | DecoderErrorDeserialiseFailure _ (CR.DeserialiseFailure _ str) | not (null str) -> success 87 | DecoderErrorCanonicityViolation _ -> success 88 | DecoderErrorCustom _ _ -> success 89 | DecoderErrorEmptyList _ -> success 90 | DecoderErrorLeftover _ _ -> success 91 | DecoderErrorSizeMismatch _ _ _ -> success 92 | DecoderErrorUnknownTag _ i | i > 0 -> success 93 | _ -> success 94 | 95 | decode :: FromCBOR a => Encoding -> Either DecoderError a 96 | decode enc = 97 | let encoded = serialize enc 98 | in decodeFull encoded 99 | -------------------------------------------------------------------------------- /cardano-binary/test/Test/Cardano/Binary/RoundTrip.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE NumDecimals #-} 2 | {-# LANGUAGE TemplateHaskell #-} 3 | {-# LANGUAGE TypeApplications #-} 4 | 5 | module Test.Cardano.Binary.RoundTrip ( 6 | tests, 7 | ) 8 | where 9 | 10 | import Test.Cardano.Prelude (discoverRoundTrip, eachOf) 11 | 12 | import Data.Fixed (E9, Fixed (..)) 13 | import Data.Ratio ((%)) 14 | import Hedgehog (Property, Range, checkParallel) 15 | import qualified Hedgehog.Gen as Gen 16 | import qualified Hedgehog.Range as Range 17 | 18 | import Test.Cardano.Binary.Helpers.GoldenRoundTrip ( 19 | roundTripsCBORBuildable, 20 | roundTripsCBORShow, 21 | ) 22 | 23 | tests :: IO Bool 24 | tests = checkParallel $$discoverRoundTrip 25 | 26 | roundTripUnitBi :: Property 27 | roundTripUnitBi = eachOf 1 (pure ()) roundTripsCBORBuildable 28 | 29 | roundTripBoolBi :: Property 30 | roundTripBoolBi = eachOf 10 Gen.bool roundTripsCBORBuildable 31 | 32 | -- | Tests up to 'Integer's with multiple machine words using large upper bound 33 | roundTripIntegerBi :: Property 34 | roundTripIntegerBi = 35 | eachOf 36 | 1000 37 | (Gen.integral (Range.linearFrom 0 (-1e40) 1e40 :: Range Integer)) 38 | roundTripsCBORBuildable 39 | 40 | roundTripWordBi :: Property 41 | roundTripWordBi = 42 | eachOf 1000 (Gen.word Range.constantBounded) roundTripsCBORBuildable 43 | 44 | roundTripWord8Bi :: Property 45 | roundTripWord8Bi = 46 | eachOf 1000 (Gen.word8 Range.constantBounded) roundTripsCBORBuildable 47 | 48 | roundTripWord16Bi :: Property 49 | roundTripWord16Bi = 50 | eachOf 1000 (Gen.word16 Range.constantBounded) roundTripsCBORBuildable 51 | 52 | roundTripWord32Bi :: Property 53 | roundTripWord32Bi = 54 | eachOf 1000 (Gen.word32 Range.constantBounded) roundTripsCBORBuildable 55 | 56 | roundTripWord64Bi :: Property 57 | roundTripWord64Bi = 58 | eachOf 1000 (Gen.word64 Range.constantBounded) roundTripsCBORBuildable 59 | 60 | roundTripIntBi :: Property 61 | roundTripIntBi = 62 | eachOf 1000 (Gen.int Range.constantBounded) roundTripsCBORBuildable 63 | 64 | roundTripFloatBi :: Property 65 | roundTripFloatBi = 66 | eachOf 1000 (Gen.float (Range.constant (-1e12) 1e12)) roundTripsCBORBuildable 67 | 68 | roundTripDoubleBi :: Property 69 | roundTripDoubleBi = 70 | eachOf 1000 (Gen.double (Range.constant (-1e308) 1e308)) roundTripsCBORBuildable 71 | 72 | roundTripInt32Bi :: Property 73 | roundTripInt32Bi = 74 | eachOf 1000 (Gen.int32 Range.constantBounded) roundTripsCBORBuildable 75 | 76 | roundTripInt64Bi :: Property 77 | roundTripInt64Bi = 78 | eachOf 1000 (Gen.int64 Range.constantBounded) roundTripsCBORBuildable 79 | 80 | roundTripRatioBi :: Property 81 | roundTripRatioBi = 82 | eachOf 83 | 1000 84 | ( ((%) :: Integer -> Integer -> Rational) 85 | <$> Gen.integral (Range.constant (-2 ^ (128 :: Int)) (2 ^ (128 :: Int))) 86 | <*> Gen.integral (Range.constant (-2 ^ (128 :: Int)) (2 ^ (128 :: Int))) 87 | ) 88 | roundTripsCBORBuildable 89 | 90 | roundTripNanoBi :: Property 91 | roundTripNanoBi = 92 | eachOf 93 | 1000 94 | ((MkFixed :: Integer -> Fixed E9) <$> Gen.integral (Range.constantFrom 0 (-1e12) 1e12)) 95 | roundTripsCBORShow 96 | 97 | roundTripMapBi :: Property 98 | roundTripMapBi = 99 | eachOf 100 | 100 101 | ( Gen.map 102 | (Range.constant 0 50) 103 | ((,) <$> Gen.int Range.constantBounded <*> Gen.int Range.constantBounded) 104 | ) 105 | roundTripsCBORShow 106 | 107 | roundTripSetBi :: Property 108 | roundTripSetBi = 109 | eachOf 110 | 100 111 | (Gen.set (Range.constant 0 50) (Gen.int Range.constantBounded)) 112 | roundTripsCBORShow 113 | 114 | roundTripByteStringBi :: Property 115 | roundTripByteStringBi = 116 | eachOf 100 (Gen.bytes $ Range.constant 0 100) roundTripsCBORShow 117 | 118 | roundTripTextBi :: Property 119 | roundTripTextBi = 120 | eachOf 121 | 100 122 | (Gen.text (Range.constant 0 100) Gen.unicode) 123 | roundTripsCBORBuildable 124 | -------------------------------------------------------------------------------- /cardano-binary/test/cardano-binary-test.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.2 2 | name: cardano-binary-test 3 | version: 1.4.0.2 4 | synopsis: Test helpers from cardano-binary exposed to other packages 5 | description: Test helpers from cardano-binary exposed to other packages 6 | license: MIT 7 | license-file: LICENSE 8 | author: IOHK 9 | maintainer: operations@iohk.io 10 | copyright: 2019-2021 IOHK 11 | category: Currency 12 | build-type: Simple 13 | extra-source-files: CHANGELOG.md 14 | 15 | common base 16 | build-depends: base >=4.14 && <5 17 | 18 | common project-config 19 | default-language: Haskell2010 20 | ghc-options: 21 | -Wall 22 | -Wcompat 23 | -Wincomplete-record-updates 24 | -Wincomplete-uni-patterns 25 | -Wpartial-fields 26 | -Wredundant-constraints 27 | -Wunused-packages 28 | 29 | library 30 | import: base, project-config 31 | exposed-modules: 32 | Test.Cardano.Binary.Failure 33 | Test.Cardano.Binary.Helpers 34 | Test.Cardano.Binary.Helpers.GoldenRoundTrip 35 | Test.Cardano.Binary.Serialization 36 | 37 | build-depends: 38 | QuickCheck, 39 | base, 40 | bytestring, 41 | cardano-binary >=1.6, 42 | cardano-prelude-test, 43 | cborg, 44 | containers, 45 | formatting, 46 | hedgehog, 47 | hspec, 48 | pretty-show, 49 | quickcheck-instances, 50 | text, 51 | time, 52 | vector, 53 | -------------------------------------------------------------------------------- /cardano-binary/test/golden/TestSimpleIndexed1: -------------------------------------------------------------------------------- 1 | 00: 83068306830264f0a5b2b264f181a48b 2 | 10: 8204811b2b2a532ff2876ba1830264f2 3 | 20: 97bc8c64f2aa83ba 4 | -------------------------------------------------------------------------------- /cardano-binary/test/golden/TestSimpleIndexed2: -------------------------------------------------------------------------------- 1 | 00: 83068306830264f387a09064f489bba0 2 | 10: 8306830264f0b88fb164f4848f888201 3 | 20: 9f1b07311d2d7939272f1b2b0c8c405c 4 | 30: 0e8e3c1b2a07099ad0952d273b18df61 5 | 40: bcb490a7dc3b38236a76175bb823ff83 6 | 50: 0564f099a59a64f1a891b0 7 | -------------------------------------------------------------------------------- /cardano-binary/test/golden/TestSimpleIndexed3: -------------------------------------------------------------------------------- 1 | 00: 83068203c34a6d1914fff090beabc44b 2 | 10: 82001b000f0ede417a505f 3 | -------------------------------------------------------------------------------- /cardano-binary/test/golden/TestSimpleIndexed4: -------------------------------------------------------------------------------- 1 | 00: 8306830264f09cbcb464f486baa98306 2 | 10: 8204811b1d436b0eb5e90fb583068203 3 | 20: c34a9be0913b92f5a2edd8a283068200 4 | 30: 1b53245398189d8af982003b69041e5e 5 | 40: d4785f55 6 | -------------------------------------------------------------------------------- /cardano-binary/test/golden/TestSimpleIndexed5: -------------------------------------------------------------------------------- 1 | 00: 830683068204811b1d436b0eb5e90fb5 2 | 10: 83068203c34a9be0913b92f5a2edd8a2 3 | 20: 830682001b53245398189d8af982003b 4 | 30: 69041e5ed4785f558306830561716161 5 | 40: 830682019f0102030405060708090a0b 6 | 50: 0c0d0e0f101112131415161718181819 7 | 60: 181a181b181c181d181e181f18201821 8 | 70: 18221823182418251826182718281829 9 | 80: 182a182b182c182d182e182f18301831 10 | 90: 18321833183418351836183718381839 11 | a0: 183a183b183c183d183e183f18401841 12 | b0: 18421843184418451846184718481849 13 | c0: 184a184b184c184d184e184f18501851 14 | d0: 18521853185418551856185718581859 15 | e0: 185a185b185c185d185e185f18601861 16 | f0: 186218631864ff83026166617a 17 | -------------------------------------------------------------------------------- /cardano-binary/test/test.hs: -------------------------------------------------------------------------------- 1 | import Test.Cardano.Prelude (runTests) 2 | import Prelude 3 | 4 | import qualified Test.Cardano.Binary.Failure 5 | import qualified Test.Cardano.Binary.RoundTrip 6 | import qualified Test.Cardano.Binary.Serialization 7 | import qualified Test.Cardano.Binary.SizeBounds 8 | 9 | -- | Main testing action 10 | main :: IO () 11 | main = do 12 | runTests 13 | [ Test.Cardano.Binary.RoundTrip.tests 14 | , Test.Cardano.Binary.SizeBounds.tests 15 | , Test.Cardano.Binary.Serialization.tests 16 | , Test.Cardano.Binary.Failure.tests 17 | ] 18 | -------------------------------------------------------------------------------- /cardano-crypto-class/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Changelog for `cardano-crypto-class` 2 | 3 | ## 2.2.2.1 4 | 5 | * 6 | 7 | ## 2.2.2.0 8 | 9 | * Add `SHA512` and `SHA3_512` algorithms. 10 | 11 | ## 2.2.1.0 12 | 13 | * Add `NoThunks` constraint on `UnsoundPureSignKeyKES` that was missed during KES changes 14 | 15 | ## 2.2.0.0 16 | 17 | * Add required `HashAlgorithm` constraint to `Hash` serialization. 18 | * Add `MemPack` instance for `Hash` and `PackedBytes` 19 | * Introduce memory locking and secure forgetting functionality: 20 | [#255](https://github.com/input-output-hk/cardano-base/pull/255) 21 | [#404](https://github.com/input-output-hk/cardano-base/pull/404) 22 | * KES started using the new memlocking functionality: 23 | [#255](https://github.com/input-output-hk/cardano-base/pull/255) 24 | [#404](https://github.com/input-output-hk/cardano-base/pull/404) 25 | * Introduction of `DSIGNM` that uses the new memlocking functionality: 26 | [#404](https://github.com/input-output-hk/cardano-base/pull/404) 27 | * Included bindings to `blst` library to enable operations over curve BLS12-381 28 | [#266](https://github.com/input-output-hk/cardano-base/pull/266) 29 | * Introduction of `DirectSerialise` / `DirectDeserialise` APIs, providing 30 | direct access to mlocked keys in RAM: 31 | [#404](https://github.com/input-output-hk/cardano-base/pull/404) 32 | * Restructuring of libsodium bindings and related APIs: 33 | [#404](https://github.com/input-output-hk/cardano-base/pull/404) 34 | * Re-introduction of non-mlocked KES implementations to support a smoother 35 | migration path: 36 | [#504](https://github.com/IntersectMBO/cardano-base/pull/504) 37 | * Exposing constructors of the BLS12-381 internals: [#509](https://github.com/IntersectMBO/cardano-base/pull/509) 38 | 39 | ## 2.1.0.2 40 | 41 | * Deserialization performance improvements 42 | * GHC-9.6 compatibility 43 | 44 | ## 2.1.0.1 45 | 46 | * Remove `development` flag: #372 47 | 48 | ## 2.1.0.0 49 | 50 | * Fixed the name `encodedSignKeyDESIGNSizeExpr` -> `encodedSignKeyDSIGNSizeExpr` 51 | * Add `IsString` instance for `Code Q (Hash h a)`, so `$$"deadbeaf"` would work with GHC-9.2 52 | 53 | ## 2.0.0.1 54 | 55 | * Initial release 56 | 57 | -------------------------------------------------------------------------------- /cardano-crypto-class/NOTICE: -------------------------------------------------------------------------------- 1 | Copyright 2019-2021 Input Output (Hong Kong) Ltd. 2 | 3 | Licensed under the Apache License, Version 2.0 (the "License"); 4 | you may not use this file except in compliance with the License. 5 | You may obtain a copy of the License at 6 | 7 | http://www.apache.org/licenses/LICENSE-2.0 8 | 9 | Unless required by applicable law or agreed to in writing, software 10 | distributed under the License is distributed on an "AS IS" BASIS, 11 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | See the License for the specific language governing permissions and 13 | limitations under the License. 14 | 15 | -------------------------------------------------------------------------------- /cardano-crypto-class/README.md: -------------------------------------------------------------------------------- 1 | # cardano-crypto-class 2 | 3 | This package defines type classes and mock instances for the following cryptographic primitives: 4 | 5 | - A digital signature scheme 6 | 7 | - A cryptographic hashing function 8 | 9 | - A key-evolving signature scheme 10 | 11 | - A verifiable random function 12 | -------------------------------------------------------------------------------- /cardano-crypto-class/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | 3 | main = defaultMain 4 | -------------------------------------------------------------------------------- /cardano-crypto-class/cbits/blst_util.c: -------------------------------------------------------------------------------- 1 | #include "blst.h" 2 | #include 3 | 4 | const size_t size_blst_p1 () { return sizeof(blst_p1); } 5 | const size_t size_blst_p2 () { return sizeof(blst_p2); } 6 | const size_t size_blst_scalar () { return sizeof(blst_scalar); } 7 | const size_t size_blst_fr () { return sizeof(blst_fr); } 8 | const size_t size_blst_fp12 () { return sizeof(blst_fp12); } 9 | const size_t size_blst_affine1 () { return sizeof(blst_p1_affine); } 10 | const size_t size_blst_affine2 () { return sizeof(blst_p2_affine); } 11 | 12 | const int blst_success () { return BLST_SUCCESS; } 13 | const int blst_error_bad_encoding () { return BLST_BAD_ENCODING; } 14 | const int blst_error_point_not_on_curve () { return BLST_POINT_NOT_ON_CURVE; } 15 | const int blst_error_point_not_in_group () { return BLST_POINT_NOT_IN_GROUP; } 16 | const int blst_error_aggr_type_mismatch () { return BLST_AGGR_TYPE_MISMATCH; } 17 | const int blst_error_verify_fail () { return BLST_VERIFY_FAIL; } 18 | const int blst_error_pk_is_infinity () { return BLST_PK_IS_INFINITY; } 19 | const int blst_error_bad_scalar () { return BLST_BAD_SCALAR; } 20 | -------------------------------------------------------------------------------- /cardano-crypto-class/memory-example/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE RankNTypes #-} 4 | {-# LANGUAGE TypeApplications #-} 5 | -- traceMLockedForeignPtr is deprecated 6 | {-# OPTIONS_GHC -Wno-deprecations #-} 7 | 8 | {- FOURMOLU_DISABLE -} 9 | module Main (main) where 10 | 11 | import Data.Proxy (Proxy (..)) 12 | import Foreign.Storable (Storable (poke)) 13 | import Control.Monad (void, when) 14 | import GHC.Fingerprint (Fingerprint (..)) 15 | import System.Environment (getArgs) 16 | 17 | #ifdef MIN_VERSION_unix 18 | import System.Posix.Process (getProcessID) 19 | #endif 20 | 21 | import qualified Data.ByteString as SB 22 | 23 | import Cardano.Crypto.Libsodium 24 | import Cardano.Crypto.Libsodium.MLockedBytes (traceMLSB) 25 | import Cardano.Crypto.Hash (SHA256, Blake2b_256, digest) 26 | 27 | main :: IO () 28 | main = do 29 | #ifdef MIN_VERSION_unix 30 | pid <- getProcessID 31 | 32 | putStrLn $ "If you run this test with 'pause' argument" 33 | putStrLn $ "you may look at /proc/" ++ show pid ++ "/maps" 34 | putStrLn $ " /proc/" ++ show pid ++ "/smaps" 35 | #endif 36 | 37 | sodiumInit 38 | 39 | args <- getArgs 40 | 41 | sodiumInit 42 | example args mlockedAllocForeignPtr 43 | 44 | -- example SHA256 hash 45 | do 46 | let input = SB.pack [0..255] 47 | hash <- digestMLockedBS (Proxy @SHA256) input 48 | traceMLSB hash 49 | print (digest (Proxy @SHA256) input) 50 | 51 | -- example Blake2b_256 hash 52 | do 53 | let input = SB.pack [0..255] 54 | hash <- digestMLockedBS (Proxy @Blake2b_256) input 55 | traceMLSB hash 56 | print (digest (Proxy @Blake2b_256) input) 57 | 58 | example 59 | :: [String] 60 | -> IO (MLockedForeignPtr Fingerprint) 61 | -> IO () 62 | example args alloc = do 63 | -- create foreign ptr to mlocked memory 64 | fptr <- alloc 65 | withMLockedForeignPtr fptr $ \ptr -> poke ptr (Fingerprint 0xdead 0xc0de) 66 | 67 | when ("pause" `elem` args) $ do 68 | putStrLn "Allocated..." 69 | void getLine 70 | 71 | -- we shouldn't do this, but rather do computation inside 72 | -- withForeignPtr on provided Ptr a 73 | traceMLockedForeignPtr fptr 74 | 75 | -- smoke test that hashing works 76 | hash <- withMLockedForeignPtr fptr $ \ptr -> 77 | digestMLockedStorable (Proxy @SHA256) ptr 78 | traceMLSB hash 79 | 80 | -- force finalizers 81 | finalizeMLockedForeignPtr fptr 82 | 83 | when ("pause" `elem` args) $ do 84 | putStrLn "Finalized..." 85 | void getLine 86 | 87 | when ("use-after-free" `elem` args) $ do 88 | -- in this demo we can try to print it again. 89 | -- this should deterministically cause segmentation fault 90 | traceMLockedForeignPtr fptr 91 | -------------------------------------------------------------------------------- /cardano-crypto-class/src/Cardano/Crypto/DSIGN.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | 3 | -- | Digital signatures. 4 | module Cardano.Crypto.DSIGN ( 5 | module X, 6 | ) 7 | where 8 | 9 | import Cardano.Crypto.DSIGN.Class as X 10 | import Cardano.Crypto.DSIGN.Ed25519 as X 11 | import Cardano.Crypto.DSIGN.Ed448 as X 12 | import Cardano.Crypto.DSIGN.Mock as X 13 | import Cardano.Crypto.DSIGN.NeverUsed as X 14 | #ifdef SECP256K1_ENABLED 15 | import Cardano.Crypto.DSIGN.EcdsaSecp256k1 as X 16 | import Cardano.Crypto.DSIGN.SchnorrSecp256k1 as X 17 | #endif 18 | -------------------------------------------------------------------------------- /cardano-crypto-class/src/Cardano/Crypto/DSIGN/NeverUsed.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE DeriveAnyClass #-} 3 | {-# LANGUAGE DeriveGeneric #-} 4 | {-# LANGUAGE FlexibleInstances #-} 5 | {-# LANGUAGE TypeFamilies #-} 6 | 7 | module Cardano.Crypto.DSIGN.NeverUsed ( 8 | NeverDSIGN, 9 | VerKeyDSIGN (..), 10 | SignKeyDSIGN (..), 11 | SigDSIGN (..), 12 | ) 13 | where 14 | 15 | import GHC.Generics (Generic) 16 | 17 | import NoThunks.Class (NoThunks) 18 | 19 | import Cardano.Crypto.DSIGN.Class 20 | 21 | -- | DSIGN never used 22 | -- 23 | -- The type of keys and signatures is isomorphic to unit, but when actually 24 | -- trying to sign or verify something a runtime exception will be thrown. 25 | data NeverDSIGN 26 | 27 | instance DSIGNAlgorithm NeverDSIGN where 28 | type SeedSizeDSIGN NeverDSIGN = 0 29 | type SizeVerKeyDSIGN NeverDSIGN = 0 30 | type SizeSignKeyDSIGN NeverDSIGN = 0 31 | type SizeSigDSIGN NeverDSIGN = 0 32 | 33 | data VerKeyDSIGN NeverDSIGN = NeverUsedVerKeyDSIGN 34 | deriving (Show, Eq, Generic, NoThunks) 35 | 36 | data SignKeyDSIGN NeverDSIGN = NeverUsedSignKeyDSIGN 37 | deriving (Show, Eq, Generic, NoThunks) 38 | 39 | data SigDSIGN NeverDSIGN = NeverUsedSigDSIGN 40 | deriving (Show, Eq, Generic, NoThunks) 41 | 42 | algorithmNameDSIGN _ = "never" 43 | 44 | deriveVerKeyDSIGN _ = NeverUsedVerKeyDSIGN 45 | 46 | signDSIGN = error "DSIGN not available" 47 | verifyDSIGN = error "DSIGN not available" 48 | 49 | genKeyDSIGN _ = NeverUsedSignKeyDSIGN 50 | 51 | rawSerialiseVerKeyDSIGN _ = mempty 52 | rawSerialiseSignKeyDSIGN _ = mempty 53 | rawSerialiseSigDSIGN _ = mempty 54 | 55 | rawDeserialiseVerKeyDSIGN _ = Just NeverUsedVerKeyDSIGN 56 | rawDeserialiseSignKeyDSIGN _ = Just NeverUsedSignKeyDSIGN 57 | rawDeserialiseSigDSIGN _ = Just NeverUsedSigDSIGN 58 | -------------------------------------------------------------------------------- /cardano-crypto-class/src/Cardano/Crypto/EllipticCurve/BLS12_381.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | {-# LANGUAGE ScopedTypeVariables #-} 3 | 4 | module Cardano.Crypto.EllipticCurve.BLS12_381 ( 5 | -- * Types 6 | Point, 7 | Point1, 8 | Point2, 9 | PT, 10 | Curve1, 11 | Curve2, 12 | BLSTError (..), 13 | 14 | -- * BLS Class 15 | BLS, 16 | 17 | -- * Point / Group operations 18 | 19 | -- | These work on both curves, and take phantom parameters of type 'Curve1' 20 | -- or 'Curve2' to select one of the two provided elliptic curves. 21 | blsInGroup, 22 | blsAddOrDouble, 23 | blsMult, 24 | blsCneg, 25 | blsNeg, 26 | blsCompress, 27 | blsSerialize, 28 | blsUncompress, 29 | blsDeserialize, 30 | blsHash, 31 | blsGenerator, 32 | blsIsInf, 33 | 34 | -- * PT operations 35 | ptMult, 36 | ptFinalVerify, 37 | 38 | -- * Pairings 39 | millerLoop, 40 | 41 | -- * The period (modulo) of scalars 42 | scalarPeriod, 43 | ) 44 | where 45 | 46 | import Cardano.Crypto.EllipticCurve.BLS12_381.Internal 47 | -------------------------------------------------------------------------------- /cardano-crypto-class/src/Cardano/Crypto/Hash.hs: -------------------------------------------------------------------------------- 1 | -- | Hashing functionality. 2 | module Cardano.Crypto.Hash ( 3 | module X, 4 | ) 5 | where 6 | 7 | import Cardano.Crypto.Hash.Blake2b as X 8 | import Cardano.Crypto.Hash.Class as X 9 | import Cardano.Crypto.Hash.Keccak256 as X 10 | import Cardano.Crypto.Hash.NeverUsed as X 11 | import Cardano.Crypto.Hash.SHA256 as X 12 | import Cardano.Crypto.Hash.SHA3_256 as X 13 | import Cardano.Crypto.Hash.SHA3_512 as X 14 | import Cardano.Crypto.Hash.SHA512 as X 15 | import Cardano.Crypto.Hash.Short as X 16 | -------------------------------------------------------------------------------- /cardano-crypto-class/src/Cardano/Crypto/Hash/Blake2b.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE TypeFamilies #-} 3 | 4 | -- | Implementation of the Blake2b hashing algorithm, with various sizes. 5 | module Cardano.Crypto.Hash.Blake2b ( 6 | Blake2b_224, 7 | Blake2b_256, 8 | blake2b_libsodium, -- Used for Hash.Short 9 | ) 10 | where 11 | 12 | import Cardano.Crypto.Libsodium.C (c_crypto_generichash_blake2b) 13 | import Control.Monad (unless) 14 | 15 | import Cardano.Crypto.Hash.Class (HashAlgorithm (..), SizeHash, digest, hashAlgorithmName) 16 | import Foreign.C.Error (errnoToIOError, getErrno) 17 | import Foreign.Ptr (castPtr, nullPtr) 18 | import GHC.IO.Exception (ioException) 19 | 20 | import qualified Data.ByteString as B 21 | import qualified Data.ByteString.Internal as BI 22 | 23 | data Blake2b_224 24 | data Blake2b_256 25 | 26 | instance HashAlgorithm Blake2b_224 where 27 | type SizeHash Blake2b_224 = 28 28 | hashAlgorithmName _ = "blake2b_224" 29 | digest _ = blake2b_libsodium 28 30 | 31 | instance HashAlgorithm Blake2b_256 where 32 | type SizeHash Blake2b_256 = 32 33 | hashAlgorithmName _ = "blake2b_256" 34 | digest _ = blake2b_libsodium 32 35 | 36 | blake2b_libsodium :: Int -> B.ByteString -> B.ByteString 37 | blake2b_libsodium size input = 38 | BI.unsafeCreate size $ \outptr -> 39 | B.useAsCStringLen input $ \(inptr, inputlen) -> do 40 | res <- 41 | c_crypto_generichash_blake2b 42 | (castPtr outptr) 43 | (fromIntegral size) 44 | (castPtr inptr) 45 | (fromIntegral inputlen) 46 | nullPtr 47 | 0 -- we used unkeyed hash 48 | unless (res == 0) $ do 49 | errno <- getErrno 50 | ioException $ errnoToIOError "digest @Blake2b: crypto_generichash_blake2b" errno Nothing Nothing 51 | -------------------------------------------------------------------------------- /cardano-crypto-class/src/Cardano/Crypto/Hash/Keccak256.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE PackageImports #-} 3 | {-# LANGUAGE TypeFamilies #-} 4 | 5 | -- | Implementation of the Keccak256 hashing algorithm. 6 | module Cardano.Crypto.Hash.Keccak256 ( 7 | Keccak256, 8 | ) 9 | where 10 | 11 | import Cardano.Crypto.Hash.Class 12 | import qualified Data.ByteArray as BA 13 | import qualified "crypton" Crypto.Hash as H 14 | 15 | data Keccak256 16 | 17 | instance HashAlgorithm Keccak256 where 18 | type SizeHash Keccak256 = 32 19 | hashAlgorithmName _ = "keccak256" 20 | digest _ = convert . H.hash 21 | 22 | convert :: H.Digest H.Keccak_256 -> ByteString 23 | convert = BA.convert 24 | -------------------------------------------------------------------------------- /cardano-crypto-class/src/Cardano/Crypto/Hash/NeverUsed.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE TypeFamilies #-} 3 | 4 | module Cardano.Crypto.Hash.NeverUsed (NeverHash) where 5 | 6 | import Cardano.Crypto.Hash.Class 7 | 8 | -- | HASH never used 9 | -- 10 | -- Will throw a runtime exception when trying to hash something. 11 | data NeverHash 12 | 13 | instance HashAlgorithm NeverHash where 14 | type SizeHash NeverHash = 0 15 | hashAlgorithmName _ = "never" 16 | digest = error "HASH not available" 17 | -------------------------------------------------------------------------------- /cardano-crypto-class/src/Cardano/Crypto/Hash/RIPEMD160.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE PackageImports #-} 3 | {-# LANGUAGE TypeFamilies #-} 4 | 5 | -- | Implementation of the RIPEMD-160 hashing algorithm. 6 | module Cardano.Crypto.Hash.RIPEMD160 ( 7 | RIPEMD160, 8 | ) 9 | where 10 | 11 | import Cardano.Crypto.Hash.Class 12 | import qualified Data.ByteArray as BA 13 | import qualified "crypton" Crypto.Hash as H 14 | 15 | data RIPEMD160 16 | 17 | instance HashAlgorithm RIPEMD160 where 18 | type SizeHash RIPEMD160 = 20 19 | hashAlgorithmName _ = "RIPEMD160" 20 | digest _ = convert . H.hash 21 | 22 | convert :: H.Digest H.RIPEMD160 -> ByteString 23 | convert = BA.convert 24 | -------------------------------------------------------------------------------- /cardano-crypto-class/src/Cardano/Crypto/Hash/SHA256.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE TypeFamilies #-} 3 | 4 | -- | Implementation of the SHA256 hashing algorithm. 5 | module Cardano.Crypto.Hash.SHA256 ( 6 | SHA256, 7 | ) 8 | where 9 | 10 | import Cardano.Crypto.Hash.Class (HashAlgorithm, SizeHash, digest, hashAlgorithmName) 11 | import Cardano.Crypto.Libsodium.C (c_crypto_hash_sha256) 12 | import Cardano.Foreign (SizedPtr (SizedPtr)) 13 | import Control.Monad (unless) 14 | 15 | import Data.Proxy (Proxy (..)) 16 | import Foreign.C.Error (errnoToIOError, getErrno) 17 | import Foreign.Ptr (castPtr) 18 | import GHC.IO.Exception (ioException) 19 | import GHC.TypeLits (natVal) 20 | 21 | import qualified Data.ByteString as B 22 | import qualified Data.ByteString.Internal as BI 23 | 24 | data SHA256 25 | 26 | instance HashAlgorithm SHA256 where 27 | type SizeHash SHA256 = 32 28 | hashAlgorithmName _ = "sha256" 29 | digest _ = sha256_libsodium 30 | 31 | sha256_libsodium :: B.ByteString -> B.ByteString 32 | sha256_libsodium input = 33 | BI.unsafeCreate expected_size $ \outptr -> 34 | B.useAsCStringLen input $ \(inptr, inputlen) -> do 35 | res <- c_crypto_hash_sha256 (SizedPtr (castPtr outptr)) (castPtr inptr) (fromIntegral inputlen) 36 | unless (res == 0) $ do 37 | errno <- getErrno 38 | ioException $ errnoToIOError "digest @SHA256: c_crypto_hash_sha256" errno Nothing Nothing 39 | where 40 | expected_size = fromIntegral (natVal (Proxy :: Proxy (SizeHash SHA256))) 41 | -------------------------------------------------------------------------------- /cardano-crypto-class/src/Cardano/Crypto/Hash/SHA3_256.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE PackageImports #-} 3 | {-# LANGUAGE TypeFamilies #-} 4 | 5 | -- | Implementation of the SHA3_256 hashing algorithm. 6 | module Cardano.Crypto.Hash.SHA3_256 ( 7 | SHA3_256, 8 | ) 9 | where 10 | 11 | import Cardano.Crypto.Hash.Class 12 | import qualified Data.ByteArray as BA 13 | import qualified "crypton" Crypto.Hash as H 14 | 15 | data SHA3_256 16 | 17 | instance HashAlgorithm SHA3_256 where 18 | type SizeHash SHA3_256 = 32 19 | hashAlgorithmName _ = "sha3-256" 20 | digest _ = convert . H.hash 21 | 22 | convert :: H.Digest H.SHA3_256 -> ByteString 23 | convert = BA.convert 24 | -------------------------------------------------------------------------------- /cardano-crypto-class/src/Cardano/Crypto/Hash/SHA3_512.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE PackageImports #-} 3 | {-# LANGUAGE TypeFamilies #-} 4 | 5 | -- | Implementation of the SHA3_512 hashing algorithm. 6 | module Cardano.Crypto.Hash.SHA3_512 ( 7 | SHA3_512, 8 | ) 9 | where 10 | 11 | import Cardano.Crypto.Hash.Class 12 | import qualified Data.ByteArray as BA 13 | import qualified "crypton" Crypto.Hash as H 14 | 15 | data SHA3_512 16 | 17 | instance HashAlgorithm SHA3_512 where 18 | type SizeHash SHA3_512 = 64 19 | hashAlgorithmName _ = "sha3-512" 20 | digest _ = convert . H.hash 21 | 22 | convert :: H.Digest H.SHA3_512 -> ByteString 23 | convert = BA.convert 24 | -------------------------------------------------------------------------------- /cardano-crypto-class/src/Cardano/Crypto/Hash/SHA512.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE PackageImports #-} 3 | {-# LANGUAGE TypeFamilies #-} 4 | 5 | -- | Implementation of the SHA512 hashing algorithm. 6 | module Cardano.Crypto.Hash.SHA512 ( 7 | SHA512, 8 | ) 9 | where 10 | 11 | import Cardano.Crypto.Hash.Class 12 | import qualified Data.ByteArray as BA 13 | import qualified "crypton" Crypto.Hash as H 14 | 15 | data SHA512 16 | 17 | instance HashAlgorithm SHA512 where 18 | type SizeHash SHA512 = 64 19 | hashAlgorithmName _ = "sha512" 20 | digest _ = convert . H.hash 21 | 22 | convert :: H.Digest H.SHA512 -> ByteString 23 | convert = BA.convert 24 | -------------------------------------------------------------------------------- /cardano-crypto-class/src/Cardano/Crypto/Hash/Short.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE ScopedTypeVariables #-} 4 | {-# LANGUAGE TypeFamilies #-} 5 | {-# LANGUAGE TypeOperators #-} 6 | 7 | -- | Implementation of short hashing algorithm, suitable for testing. 8 | module Cardano.Crypto.Hash.Short ( 9 | ShortHash, 10 | Blake2bPrefix, 11 | ) 12 | where 13 | 14 | import Cardano.Crypto.Hash.Blake2b (blake2b_libsodium) 15 | import Cardano.Crypto.Hash.Class 16 | 17 | import Data.Proxy (Proxy (..)) 18 | import GHC.TypeLits (CmpNat, KnownNat, Nat, natVal) 19 | 20 | type ShortHash = Blake2bPrefix 8 21 | 22 | data Blake2bPrefix (n :: Nat) 23 | 24 | instance (KnownNat n, CmpNat n 33 ~ 'LT) => HashAlgorithm (Blake2bPrefix n) where 25 | type SizeHash (Blake2bPrefix n) = n 26 | hashAlgorithmName _ = "blake2b_prefix_" <> show (natVal (Proxy :: Proxy n)) 27 | digest _ = blake2b_libsodium (fromIntegral (natVal (Proxy :: Proxy n))) 28 | -------------------------------------------------------------------------------- /cardano-crypto-class/src/Cardano/Crypto/Init.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | 3 | -- | Initialization for the library's functionality 4 | module Cardano.Crypto.Init ( 5 | cryptoInit, 6 | ) where 7 | 8 | import Cardano.Crypto.Libsodium.Init (sodiumInit) 9 | #if defined(SECP256K1_ENABLED) 10 | import Control.Monad (void) 11 | import Cardano.Crypto.SECP256K1.C (secpCtxPtr) 12 | import Control.Exception (evaluate) 13 | #endif 14 | 15 | -- | Initialize all the functionality provided by this library. This should be 16 | -- called at least once /before/ you use anything this library provides, in 17 | -- @main@. 18 | -- 19 | -- It is safe to call this multiple times, but isn't necessary. 20 | -- 21 | -- = Note 22 | -- 23 | -- This includes a call to 'sodiumInit'. 24 | cryptoInit :: IO () 25 | cryptoInit = do 26 | sodiumInit 27 | #if defined(SECP256K1_ENABLED) 28 | void . evaluate $ secpCtxPtr 29 | #endif 30 | -------------------------------------------------------------------------------- /cardano-crypto-class/src/Cardano/Crypto/KES.hs: -------------------------------------------------------------------------------- 1 | -- | Key evolving signatures. 2 | module Cardano.Crypto.KES ( 3 | module X, 4 | ) 5 | where 6 | 7 | import Cardano.Crypto.KES.Class as X 8 | import Cardano.Crypto.KES.CompactSingle as X 9 | import Cardano.Crypto.KES.CompactSum as X 10 | import Cardano.Crypto.KES.Mock as X 11 | import Cardano.Crypto.KES.NeverUsed as X 12 | import Cardano.Crypto.KES.Simple as X 13 | import Cardano.Crypto.KES.Single as X 14 | import Cardano.Crypto.KES.Sum as X 15 | -------------------------------------------------------------------------------- /cardano-crypto-class/src/Cardano/Crypto/KES/NeverUsed.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE DeriveAnyClass #-} 3 | {-# LANGUAGE DeriveGeneric #-} 4 | {-# LANGUAGE FlexibleInstances #-} 5 | {-# LANGUAGE MultiParamTypeClasses #-} 6 | {-# LANGUAGE TypeFamilies #-} 7 | 8 | module Cardano.Crypto.KES.NeverUsed ( 9 | NeverKES, 10 | VerKeyKES (..), 11 | SignKeyKES (..), 12 | SigKES (..), 13 | ) 14 | where 15 | 16 | import GHC.Generics (Generic) 17 | import NoThunks.Class (NoThunks) 18 | 19 | import Cardano.Crypto.KES.Class 20 | 21 | -- | KES never used 22 | -- 23 | -- The type of keys and signatures is isomorphic to unit, but when actually 24 | -- trying to sign or verify something a runtime exception will be thrown. 25 | data NeverKES 26 | 27 | instance KESAlgorithm NeverKES where 28 | type SeedSizeKES NeverKES = 0 29 | 30 | data VerKeyKES NeverKES = NeverUsedVerKeyKES 31 | deriving (Show, Eq, Generic, NoThunks) 32 | 33 | data SigKES NeverKES = NeverUsedSigKES 34 | deriving (Show, Eq, Generic, NoThunks) 35 | 36 | data SignKeyKES NeverKES = NeverUsedSignKeyKES 37 | deriving (Show, Eq, Generic, NoThunks) 38 | 39 | algorithmNameKES _ = "never" 40 | 41 | verifyKES = error "KES not available" 42 | 43 | totalPeriodsKES _ = 0 44 | 45 | type SizeVerKeyKES NeverKES = 0 46 | type SizeSignKeyKES NeverKES = 0 47 | type SizeSigKES NeverKES = 0 48 | 49 | rawSerialiseVerKeyKES _ = mempty 50 | rawSerialiseSigKES _ = mempty 51 | 52 | rawDeserialiseVerKeyKES _ = Just NeverUsedVerKeyKES 53 | rawDeserialiseSigKES _ = Just NeverUsedSigKES 54 | 55 | deriveVerKeyKES _ = return NeverUsedVerKeyKES 56 | 57 | signKES = error "KES not available" 58 | updateKESWith _ = error "KES not available" 59 | 60 | genKeyKESWith _ _ = return NeverUsedSignKeyKES 61 | 62 | forgetSignKeyKESWith _ = const $ return () 63 | 64 | instance UnsoundKESAlgorithm NeverKES where 65 | rawSerialiseSignKeyKES _ = return mempty 66 | rawDeserialiseSignKeyKESWith _ _ = return $ Just NeverUsedSignKeyKES 67 | 68 | instance UnsoundPureKESAlgorithm NeverKES where 69 | data UnsoundPureSignKeyKES NeverKES = NeverUsedUnsoundPureSignKeyKES 70 | deriving (Show, Eq, Generic, NoThunks) 71 | 72 | unsoundPureSignKES = error "KES not available" 73 | unsoundPureGenKeyKES _ = NeverUsedUnsoundPureSignKeyKES 74 | unsoundPureDeriveVerKeyKES _ = NeverUsedVerKeyKES 75 | unsoundPureUpdateKES _ = error "KES not available" 76 | unsoundPureSignKeyKESToSoundSignKeyKES _ = return NeverUsedSignKeyKES 77 | rawSerialiseUnsoundPureSignKeyKES _ = mempty 78 | rawDeserialiseUnsoundPureSignKeyKES _ = Just NeverUsedUnsoundPureSignKeyKES 79 | -------------------------------------------------------------------------------- /cardano-crypto-class/src/Cardano/Crypto/Libsodium.hs: -------------------------------------------------------------------------------- 1 | module Cardano.Crypto.Libsodium ( 2 | -- * Initialization 3 | sodiumInit, 4 | 5 | -- * MLocked memory management 6 | MLockedForeignPtr, 7 | MLockedAllocator, 8 | finalizeMLockedForeignPtr, 9 | mlockedAllocForeignPtr, 10 | mlockedMalloc, 11 | traceMLockedForeignPtr, 12 | withMLockedForeignPtr, 13 | 14 | -- * MLocked bytes ('MLockedSizedBytes') 15 | MLockedSizedBytes, 16 | mlsbAsByteString, 17 | mlsbCompare, 18 | mlsbCopy, 19 | mlsbCopyWith, 20 | mlsbEq, 21 | mlsbFinalize, 22 | mlsbFromByteString, 23 | mlsbFromByteStringCheck, 24 | mlsbFromByteStringCheckWith, 25 | mlsbFromByteStringWith, 26 | mlsbNew, 27 | mlsbNewWith, 28 | mlsbNewZero, 29 | mlsbNewZeroWith, 30 | mlsbToByteString, 31 | mlsbUseAsCPtr, 32 | mlsbUseAsSizedPtr, 33 | mlsbZero, 34 | 35 | -- * Hashing 36 | digestMLockedBS, 37 | digestMLockedStorable, 38 | expandHash, 39 | expandHashWith, 40 | SodiumHashAlgorithm (..), 41 | ) where 42 | 43 | import Cardano.Crypto.Libsodium.Hash 44 | import Cardano.Crypto.Libsodium.Init 45 | import Cardano.Crypto.Libsodium.MLockedBytes 46 | import Cardano.Crypto.Libsodium.Memory 47 | -------------------------------------------------------------------------------- /cardano-crypto-class/src/Cardano/Crypto/Libsodium/Constants.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | module Cardano.Crypto.Libsodium.Constants ( 3 | CRYPTO_SHA256_BYTES, 4 | CRYPTO_SHA512_BYTES, 5 | CRYPTO_BLAKE2B_256_BYTES, 6 | CRYPTO_SHA256_STATE_SIZE, 7 | CRYPTO_SHA512_STATE_SIZE, 8 | CRYPTO_BLAKE2B_256_STATE_SIZE, 9 | CRYPTO_SIGN_ED25519_BYTES, 10 | CRYPTO_SIGN_ED25519_SEEDBYTES, 11 | CRYPTO_SIGN_ED25519_PUBLICKEYBYTES, 12 | CRYPTO_SIGN_ED25519_SECRETKEYBYTES, 13 | ) where 14 | 15 | #include 16 | 17 | -- From https://libsodium.gitbook.io/doc/advanced/sha-2_hash_function 18 | -- and https://libsodium.gitbook.io/doc/hashing/generic_hashing 19 | 20 | type CRYPTO_SHA256_BYTES = #{const crypto_hash_sha256_BYTES} 21 | type CRYPTO_SHA512_BYTES = #{const crypto_hash_sha512_BYTES} 22 | type CRYPTO_BLAKE2B_256_BYTES = #{const crypto_generichash_blake2b_BYTES} 23 | 24 | type CRYPTO_SHA256_STATE_SIZE = #{size crypto_hash_sha256_state} 25 | type CRYPTO_SHA512_STATE_SIZE = #{size crypto_hash_sha512_state} 26 | type CRYPTO_BLAKE2B_256_STATE_SIZE = #{size crypto_generichash_blake2b_state} 27 | 28 | type CRYPTO_SIGN_ED25519_BYTES = #{const crypto_sign_ed25519_BYTES} 29 | type CRYPTO_SIGN_ED25519_SEEDBYTES = #{const crypto_sign_ed25519_SEEDBYTES} 30 | type CRYPTO_SIGN_ED25519_PUBLICKEYBYTES = #{const crypto_sign_ed25519_PUBLICKEYBYTES} 31 | type CRYPTO_SIGN_ED25519_SECRETKEYBYTES = #{const crypto_sign_ed25519_SECRETKEYBYTES} 32 | -------------------------------------------------------------------------------- /cardano-crypto-class/src/Cardano/Crypto/Libsodium/Hash.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE RoleAnnotations #-} 4 | {-# LANGUAGE ScopedTypeVariables #-} 5 | {-# LANGUAGE TypeApplications #-} 6 | {-# LANGUAGE TypeFamilies #-} 7 | 8 | module Cardano.Crypto.Libsodium.Hash ( 9 | SodiumHashAlgorithm (..), 10 | digestMLockedStorable, 11 | digestMLockedBS, 12 | expandHash, 13 | expandHashWith, 14 | ) where 15 | 16 | import Data.Proxy (Proxy (..)) 17 | import Data.Word (Word8) 18 | import Foreign.C.Types (CSize) 19 | import Foreign.Ptr (castPtr, plusPtr) 20 | import Foreign.Storable (Storable (poke)) 21 | import GHC.TypeLits 22 | 23 | import Cardano.Crypto.Hash (HashAlgorithm (SizeHash)) 24 | import Cardano.Crypto.Libsodium.Hash.Class 25 | import Cardano.Crypto.Libsodium.MLockedBytes.Internal 26 | import Cardano.Crypto.Libsodium.Memory 27 | import Control.Monad.Class.MonadST (MonadST (..)) 28 | import Control.Monad.Class.MonadThrow (MonadThrow) 29 | import Control.Monad.ST.Unsafe (unsafeIOToST) 30 | 31 | ------------------------------------------------------------------------------- 32 | -- Hash expansion 33 | ------------------------------------------------------------------------------- 34 | 35 | expandHash :: 36 | forall h m proxy. 37 | (SodiumHashAlgorithm h, MonadST m, MonadThrow m) => 38 | proxy h -> 39 | MLockedSizedBytes (SizeHash h) -> 40 | m (MLockedSizedBytes (SizeHash h), MLockedSizedBytes (SizeHash h)) 41 | expandHash = expandHashWith mlockedMalloc 42 | 43 | expandHashWith :: 44 | forall h m proxy. 45 | (SodiumHashAlgorithm h, MonadST m, MonadThrow m) => 46 | MLockedAllocator m -> 47 | proxy h -> 48 | MLockedSizedBytes (SizeHash h) -> 49 | m (MLockedSizedBytes (SizeHash h), MLockedSizedBytes (SizeHash h)) 50 | expandHashWith allocator h (MLSB sfptr) = do 51 | withMLockedForeignPtr sfptr $ \ptr -> do 52 | l <- mlockedAllocaWith allocator size1 $ \ptr' -> do 53 | stToIO . unsafeIOToST $ do 54 | poke ptr' (1 :: Word8) 55 | copyMem (castPtr (plusPtr ptr' 1)) ptr size 56 | naclDigestPtr h ptr' (fromIntegral size1) 57 | 58 | r <- mlockedAllocaWith allocator size1 $ \ptr' -> do 59 | stToIO . unsafeIOToST $ do 60 | poke ptr' (2 :: Word8) 61 | copyMem (castPtr (plusPtr ptr' 1)) ptr size 62 | naclDigestPtr h ptr' (fromIntegral size1) 63 | 64 | return (l, r) 65 | where 66 | size1 :: CSize 67 | size1 = size + 1 68 | 69 | size :: CSize 70 | size = fromInteger $ natVal (Proxy @(SizeHash h)) 71 | -------------------------------------------------------------------------------- /cardano-crypto-class/src/Cardano/Crypto/Libsodium/Init.hs: -------------------------------------------------------------------------------- 1 | module Cardano.Crypto.Libsodium.Init ( 2 | sodiumInit, 3 | ) where 4 | 5 | import Control.Monad (unless) 6 | 7 | import Cardano.Crypto.Libsodium.C 8 | 9 | -- @sodiumInit@ initializes the library and should be called before any other 10 | -- function provided by Sodium. It is safe to call this function more than once 11 | -- and from different threads -- subsequent calls won't have any effects. 12 | -- 13 | -- 14 | sodiumInit :: IO () 15 | sodiumInit = do 16 | res <- c_sodium_init 17 | -- sodium_init() returns 0 on success, -1 on failure, and 1 if the library 18 | -- had already been initialized. 19 | unless (res == 0 || res == 1) $ fail "sodium_init failed" 20 | -------------------------------------------------------------------------------- /cardano-crypto-class/src/Cardano/Crypto/Libsodium/MLockedBytes.hs: -------------------------------------------------------------------------------- 1 | module Cardano.Crypto.Libsodium.MLockedBytes ( 2 | MLockedSizedBytes, 3 | SizedVoid, 4 | withMLSB, 5 | withMLSBChunk, 6 | mlsbNew, 7 | mlsbNewZero, 8 | mlsbZero, 9 | mlsbFromByteString, 10 | mlsbFromByteStringCheck, 11 | mlsbAsByteString, 12 | mlsbToByteString, 13 | mlsbUseAsCPtr, 14 | mlsbUseAsSizedPtr, 15 | mlsbFinalize, 16 | mlsbCopy, 17 | traceMLSB, 18 | mlsbCompare, 19 | mlsbEq, 20 | mlsbNewWith, 21 | mlsbNewZeroWith, 22 | mlsbCopyWith, 23 | mlsbFromByteStringWith, 24 | mlsbFromByteStringCheckWith, 25 | ) where 26 | 27 | import Cardano.Crypto.Libsodium.MLockedBytes.Internal 28 | -------------------------------------------------------------------------------- /cardano-crypto-class/src/Cardano/Crypto/Libsodium/Memory.hs: -------------------------------------------------------------------------------- 1 | module Cardano.Crypto.Libsodium.Memory ( 2 | -- * High-level memory management 3 | MLockedForeignPtr, 4 | withMLockedForeignPtr, 5 | finalizeMLockedForeignPtr, 6 | traceMLockedForeignPtr, 7 | 8 | -- * MLocked allocations 9 | mlockedMalloc, 10 | MLockedAllocator (..), 11 | mlockedAlloca, 12 | mlockedAllocaSized, 13 | mlockedAllocForeignPtr, 14 | mlockedAllocForeignPtrBytes, 15 | 16 | -- * Allocations using an explicit allocator 17 | mlockedAllocaWith, 18 | mlockedAllocaSizedWith, 19 | mlockedAllocForeignPtrWith, 20 | mlockedAllocForeignPtrBytesWith, 21 | 22 | -- * Unmanaged memory, generalized to 'MonadST' 23 | zeroMem, 24 | copyMem, 25 | allocaBytes, 26 | 27 | -- * 'ForeignPtr' operations, generalized to 'MonadST' 28 | ForeignPtr (..), 29 | mallocForeignPtrBytes, 30 | withForeignPtr, 31 | 32 | -- * ByteString memory access, generalized to 'MonadST' 33 | unpackByteStringCStringLen, 34 | packByteStringCStringLen, 35 | ) where 36 | 37 | import Cardano.Crypto.Libsodium.Memory.Internal 38 | -------------------------------------------------------------------------------- /cardano-crypto-class/src/Cardano/Crypto/Libsodium/UnsafeC.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CApiFFI #-} 2 | 3 | module Cardano.Crypto.Libsodium.UnsafeC ( 4 | c_sodium_compare_unsafe, 5 | ) where 6 | 7 | import Foreign.C.Types (CSize (..)) 8 | import Foreign.Ptr (Ptr) 9 | 10 | -- | Unsafe variant of 'c_sodium_compare'. 11 | foreign import capi unsafe "sodium.h sodium_compare" 12 | c_sodium_compare_unsafe :: Ptr a -> Ptr a -> CSize -> IO Int 13 | -------------------------------------------------------------------------------- /cardano-crypto-class/src/Cardano/Crypto/SECP256K1/Constants.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | module Cardano.Crypto.SECP256K1.Constants ( 3 | SECP256K1_ECDSA_PRIVKEY_BYTES, 4 | SECP256K1_ECDSA_SIGNATURE_BYTES, 5 | SECP256K1_ECDSA_SIGNATURE_BYTES_INTERNAL, 6 | SECP256K1_ECDSA_PUBKEY_BYTES, 7 | SECP256K1_ECDSA_PUBKEY_BYTES_INTERNAL, 8 | SECP256K1_ECDSA_MESSAGE_BYTES, 9 | SECP256K1_SCHNORR_PUBKEY_BYTES, 10 | SECP256K1_SCHNORR_PRIVKEY_BYTES, 11 | SECP256K1_SCHNORR_PUBKEY_BYTES_INTERNAL, 12 | SECP256K1_SCHNORR_KEYPAIR_BYTES, 13 | SECP256K1_SCHNORR_SIGNATURE_BYTES 14 | ) where 15 | 16 | #include 17 | #include 18 | 19 | -- ECDSA-related constants 20 | 21 | type SECP256K1_ECDSA_PRIVKEY_BYTES = 32 22 | -- As we do not want to serialize the internal state used by ECDSA directly, we 23 | -- define _two_ values: one for the 'external' representation size, and one for 24 | -- the 'internal' representation size. 25 | type SECP256K1_ECDSA_PUBKEY_BYTES = 33 26 | type SECP256K1_ECDSA_PUBKEY_BYTES_INTERNAL = 64 27 | -- Same as here. They happen to be the same, but by using different tags, we can 28 | -- ensure we don't mix them up on accident. 29 | type SECP256K1_ECDSA_SIGNATURE_BYTES = 64 30 | type SECP256K1_ECDSA_SIGNATURE_BYTES_INTERNAL = 64 31 | -- Since the ECDSA scheme signs hashes, not whole messages, we define this for 32 | -- clarity. 33 | type SECP256K1_ECDSA_MESSAGE_BYTES = 32 34 | 35 | -- Schnorr-related constants 36 | 37 | -- Not defined as a struct, but derived from inspecting the source 38 | type SECP256K1_SCHNORR_PRIVKEY_BYTES = 32 39 | -- As we do not want to serialize the internal state used by Schnorr directly, 40 | -- we define _two_ values: one for the 'external' representation size, and one 41 | -- for the 'internal' representation size. 42 | type SECP256K1_SCHNORR_PUBKEY_BYTES = 32 43 | type SECP256K1_SCHNORR_PUBKEY_BYTES_INTERNAL = #{size secp256k1_xonly_pubkey} 44 | type SECP256K1_SCHNORR_KEYPAIR_BYTES = #{size secp256k1_keypair} 45 | -- Not defined as a struct, but derived from inspecting the source 46 | type SECP256K1_SCHNORR_SIGNATURE_BYTES = 64 47 | -------------------------------------------------------------------------------- /cardano-crypto-class/src/Cardano/Crypto/VRF.hs: -------------------------------------------------------------------------------- 1 | -- | Verifiable random functions. 2 | module Cardano.Crypto.VRF ( 3 | module X, 4 | ) 5 | where 6 | 7 | import Cardano.Crypto.VRF.Class as X 8 | import Cardano.Crypto.VRF.Mock as X 9 | import Cardano.Crypto.VRF.NeverUsed as X 10 | import Cardano.Crypto.VRF.Simple as X 11 | -------------------------------------------------------------------------------- /cardano-crypto-class/src/Cardano/Crypto/VRF/Mock.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 4 | {-# LANGUAGE TypeApplications #-} 5 | {-# LANGUAGE TypeFamilies #-} 6 | 7 | -- | Mock implementations of verifiable random functions. 8 | module Cardano.Crypto.VRF.Mock ( 9 | MockVRF, 10 | VerKeyVRF (..), 11 | SignKeyVRF (..), 12 | ) 13 | where 14 | 15 | import Data.Proxy (Proxy (..)) 16 | import Data.Word (Word64) 17 | import GHC.Generics (Generic) 18 | import NoThunks.Class (NoThunks) 19 | 20 | import Cardano.Binary (FromCBOR (..), ToCBOR (..)) 21 | 22 | import Cardano.Crypto.Hash 23 | import Cardano.Crypto.Seed 24 | import Cardano.Crypto.Util 25 | import Cardano.Crypto.VRF.Class 26 | 27 | data MockVRF 28 | 29 | instance VRFAlgorithm MockVRF where 30 | -- 31 | -- Key and signature types 32 | -- 33 | 34 | newtype VerKeyVRF MockVRF = VerKeyMockVRF Word64 35 | deriving (Show, Eq, Ord, Generic, NoThunks) 36 | 37 | newtype SignKeyVRF MockVRF = SignKeyMockVRF Word64 38 | deriving (Show, Eq, Ord, Generic, NoThunks) 39 | 40 | newtype CertVRF MockVRF = CertMockVRF Word64 41 | deriving (Show, Eq, Ord, Generic, NoThunks) 42 | 43 | -- 44 | -- Metadata and basic key operations 45 | -- 46 | 47 | algorithmNameVRF _ = "mock" 48 | 49 | deriveVerKeyVRF (SignKeyMockVRF n) = VerKeyMockVRF n 50 | 51 | -- 52 | -- Core algorithm operations 53 | -- 54 | 55 | type Signable MockVRF = SignableRepresentation 56 | 57 | evalVRF () a sk = evalVRF' a sk 58 | 59 | verifyVRF () (VerKeyMockVRF n) a c 60 | | c == c' = Just o 61 | | otherwise = Nothing 62 | where 63 | (o, c') = evalVRF' a (SignKeyMockVRF n) 64 | 65 | sizeOutputVRF _ = sizeHash (Proxy :: Proxy ShortHash) 66 | 67 | -- 68 | -- Key generation 69 | -- 70 | 71 | seedSizeVRF _ = 8 72 | genKeyVRF seed = SignKeyMockVRF sk 73 | where 74 | sk = runMonadRandomWithSeed seed getRandomWord64 75 | 76 | -- 77 | -- raw serialise/deserialise 78 | -- 79 | 80 | sizeVerKeyVRF _ = 8 81 | sizeSignKeyVRF _ = 8 82 | sizeCertVRF _ = 8 83 | 84 | rawSerialiseVerKeyVRF (VerKeyMockVRF k) = writeBinaryWord64 k 85 | rawSerialiseSignKeyVRF (SignKeyMockVRF k) = writeBinaryWord64 k 86 | rawSerialiseCertVRF (CertMockVRF k) = writeBinaryWord64 k 87 | 88 | rawDeserialiseVerKeyVRF bs 89 | | [kb] <- splitsAt [8] bs 90 | , let k = readBinaryWord64 kb = 91 | Just $! VerKeyMockVRF k 92 | | otherwise = 93 | Nothing 94 | 95 | rawDeserialiseSignKeyVRF bs 96 | | [kb] <- splitsAt [8] bs 97 | , let k = readBinaryWord64 kb = 98 | Just $! SignKeyMockVRF k 99 | | otherwise = 100 | Nothing 101 | 102 | rawDeserialiseCertVRF bs 103 | | [kb] <- splitsAt [8] bs 104 | , let k = readBinaryWord64 kb = 105 | Just $! CertMockVRF k 106 | | otherwise = 107 | Nothing 108 | 109 | instance ToCBOR (VerKeyVRF MockVRF) where 110 | toCBOR = encodeVerKeyVRF 111 | encodedSizeExpr _size = encodedVerKeyVRFSizeExpr 112 | 113 | instance FromCBOR (VerKeyVRF MockVRF) where 114 | fromCBOR = decodeVerKeyVRF 115 | 116 | instance ToCBOR (SignKeyVRF MockVRF) where 117 | toCBOR = encodeSignKeyVRF 118 | encodedSizeExpr _size = encodedSignKeyVRFSizeExpr 119 | 120 | instance FromCBOR (SignKeyVRF MockVRF) where 121 | fromCBOR = decodeSignKeyVRF 122 | 123 | instance ToCBOR (CertVRF MockVRF) where 124 | toCBOR = encodeCertVRF 125 | encodedSizeExpr _size = encodedCertVRFSizeExpr 126 | 127 | instance FromCBOR (CertVRF MockVRF) where 128 | fromCBOR = decodeCertVRF 129 | 130 | evalVRF' :: 131 | SignableRepresentation a => 132 | a -> 133 | SignKeyVRF MockVRF -> 134 | (OutputVRF MockVRF, CertVRF MockVRF) 135 | evalVRF' a sk@(SignKeyMockVRF n) = 136 | let y = 137 | hashToBytes $ 138 | hashWithSerialiser @ShortHash id $ 139 | toCBOR (getSignableRepresentation a) <> toCBOR sk 140 | in (OutputVRF y, CertMockVRF n) 141 | -------------------------------------------------------------------------------- /cardano-crypto-class/src/Cardano/Crypto/VRF/NeverUsed.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | {-# LANGUAGE FlexibleInstances #-} 4 | {-# LANGUAGE TypeFamilies #-} 5 | 6 | module Cardano.Crypto.VRF.NeverUsed ( 7 | NeverVRF, 8 | VerKeyVRF (..), 9 | SignKeyVRF (..), 10 | CertVRF (..), 11 | ) 12 | where 13 | 14 | import GHC.Generics (Generic) 15 | import NoThunks.Class (NoThunks) 16 | 17 | import Cardano.Crypto.VRF.Class 18 | 19 | -- | VRF not available 20 | -- 21 | -- The type of keys and certificates is isomorphic to unit, but when actually 22 | -- trying to sign or verify something a runtime exception will be thrown. 23 | data NeverVRF 24 | 25 | instance VRFAlgorithm NeverVRF where 26 | data VerKeyVRF NeverVRF = NeverUsedVerKeyVRF 27 | deriving (Show, Eq, Generic, NoThunks) 28 | 29 | data SignKeyVRF NeverVRF = NeverUsedSignKeyVRF 30 | deriving (Show, Eq, Generic, NoThunks) 31 | 32 | data CertVRF NeverVRF = NeverUsedCertVRF 33 | deriving (Show, Eq, Ord, Generic, NoThunks) 34 | 35 | algorithmNameVRF _ = "never" 36 | 37 | deriveVerKeyVRF _ = NeverUsedVerKeyVRF 38 | 39 | evalVRF = error "VRF unavailable" 40 | 41 | verifyVRF = error "VRF unavailable" 42 | 43 | sizeOutputVRF _ = 0 44 | 45 | genKeyVRF _ = NeverUsedSignKeyVRF 46 | seedSizeVRF _ = 0 47 | 48 | sizeVerKeyVRF _ = 0 49 | sizeSignKeyVRF _ = 0 50 | sizeCertVRF _ = 0 51 | 52 | rawSerialiseVerKeyVRF _ = mempty 53 | rawSerialiseSignKeyVRF _ = mempty 54 | rawSerialiseCertVRF _ = mempty 55 | 56 | rawDeserialiseVerKeyVRF _ = Just NeverUsedVerKeyVRF 57 | rawDeserialiseSignKeyVRF _ = Just NeverUsedSignKeyVRF 58 | rawDeserialiseCertVRF _ = Just NeverUsedCertVRF 59 | -------------------------------------------------------------------------------- /cardano-crypto-class/src/Cardano/Foreign.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE KindSignatures #-} 3 | {-# LANGUAGE ScopedTypeVariables #-} 4 | {-# LANGUAGE TypeApplications #-} 5 | 6 | -- | Utilities for FFI 7 | module Cardano.Foreign ( 8 | -- * Sized pointer 9 | SizedPtr (..), 10 | allocaSized, 11 | memcpySized, 12 | memsetSized, 13 | 14 | -- * Low-level C functions 15 | c_memcpy, 16 | c_memset, 17 | ) where 18 | 19 | import Control.Monad (void) 20 | import Data.Proxy (Proxy (..)) 21 | import Data.Void (Void) 22 | import Data.Word (Word8) 23 | import Foreign.C.Types (CSize (..)) 24 | import Foreign.Marshal.Alloc (allocaBytes) 25 | import Foreign.Ptr (Ptr) 26 | import GHC.TypeLits 27 | 28 | ------------------------------------------------------------------------------- 29 | -- Sized pointer 30 | ------------------------------------------------------------------------------- 31 | 32 | -- A pointer which knows the size of underlying memory block 33 | newtype SizedPtr (n :: Nat) = SizedPtr (Ptr Void) 34 | 35 | -- | Like 'allocaBytes'. 36 | allocaSized :: forall n b. KnownNat n => (SizedPtr n -> IO b) -> IO b 37 | allocaSized k = allocaBytes size (k . SizedPtr) 38 | where 39 | size :: Int 40 | size = fromInteger (natVal (Proxy @n)) 41 | 42 | memcpySized :: forall n. KnownNat n => SizedPtr n -> SizedPtr n -> IO () 43 | memcpySized (SizedPtr dest) (SizedPtr src) = void (c_memcpy dest src size) 44 | where 45 | size :: CSize 46 | size = fromInteger (natVal (Proxy @n)) 47 | 48 | memsetSized :: forall n. KnownNat n => SizedPtr n -> Word8 -> IO () 49 | memsetSized (SizedPtr s) c = void (c_memset s (fromIntegral c) size) 50 | where 51 | size :: CSize 52 | size = fromInteger (natVal (Proxy @n)) 53 | 54 | ------------------------------------------------------------------------------- 55 | -- Some C functions 56 | ------------------------------------------------------------------------------- 57 | 58 | -- | @void *memcpy(void *dest, const void *src, size_t n);@ 59 | -- 60 | -- Note: this is safe foreign import 61 | foreign import ccall "memcpy" 62 | c_memcpy :: Ptr a -> Ptr a -> CSize -> IO (Ptr ()) 63 | 64 | -- | @void *memset(void *s, int c, size_t n);@ 65 | -- 66 | -- Note: for sure zeroing memory use @c_sodium_memzero@. 67 | foreign import ccall "memset" 68 | c_memset :: Ptr a -> Int -> CSize -> IO (Ptr ()) 69 | -------------------------------------------------------------------------------- /cardano-crypto-praos/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Changelog for `cardano-crypto-praos` 2 | 3 | ## 2.2.1.1 4 | 5 | * 6 | 7 | ## 2.2.1.0 8 | 9 | * Add `outputFromBytes` to `Cardano.Crypto.VRF.Praos` module 10 | * Expose `outputFromProof` from `Cardano.Crypto.VRF.Praos` module 11 | * Add `outputFromBytes` to `Cardano.Crypto.VRF.PraosBatchCompat` module 12 | * Expose `Proof`, `Output`, `proofFromBytes`, `skFromBytes`, `vkFromBytes` and `outputFromProof` from `Cardano.Crypto.VRF.PraosBatchCompat` module 13 | 14 | ## 2.2.0.0 15 | 16 | * Prefixed private bundled c functions with `cardano_` to ensure they are not 17 | silently overwritten. 18 | 19 | ## 2.1.2.0 20 | 21 | * 22 | 23 | ## 2.1.1.1 24 | 25 | * GHC-9.6 compatibility 26 | 27 | ## 2.1.1.0 28 | 29 | * Addition of `Cardano.Crypto.VRF.PraosBatchCompat`. 30 | * Addition of conversion functions: `vkToBatchCompat`, `skToBatchCompat`, `outputToBatchCompat`. 31 | 32 | ## 2.1.0.0 33 | 34 | * Remove redundant and unused `unsafeRawSeed`, `io_crypto_vrf_publickeybytes` and 35 | `io_crypto_vrf_secretkeybytes`. 36 | * Stop exporting internal `crypto_vrf_publickeybytes`, `crypto_vrf_secretkeybytes`, 37 | `crypto_vrf_proofbytes`, `crypto_vrf_outputbytes` and `crypto_vrf_seedbytes` in favor of 38 | `sizeVerKeyVRF`, `sizeSignKeyVRF`, `sizeCertVRF`, `sizeOutputVRF` and `seedSizeVRF` 39 | respectfully. 40 | * Export `proofFromBytes`, `skFromBytes` and `vkFromBytes` 41 | * Expose internal types without constructors: `Proof`, `SignKey`, `VerKey` and `Output` 42 | 43 | ## 2.0.0.1 44 | 45 | * Initial version released on [CHaP](https://github.com/input-output-hk/cardano-haskell-packages) 46 | -------------------------------------------------------------------------------- /cardano-crypto-praos/NOTICE: -------------------------------------------------------------------------------- 1 | Copyright 2019-2021 Input Output (Hong Kong) Ltd. 2 | 3 | Licensed under the Apache License, Version 2.0 (the "License"); 4 | you may not use this file except in compliance with the License. 5 | You may obtain a copy of the License at 6 | 7 | http://www.apache.org/licenses/LICENSE-2.0 8 | 9 | Unless required by applicable law or agreed to in writing, software 10 | distributed under the License is distributed on an "AS IS" BASIS, 11 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | See the License for the specific language governing permissions and 13 | limitations under the License. 14 | 15 | -------------------------------------------------------------------------------- /cardano-crypto-praos/README.md: -------------------------------------------------------------------------------- 1 | # cardano-crypto-praos 2 | 3 | This package implements Haskell FFI wrappers around the VRF (verifiable random 4 | function) implemented in libsodium. 5 | 6 | ## Libsodium Dependency 7 | 8 | This package depends on a custom fork of the `libsodium` C library, found at 9 | 10 | https://github.com/input-output-hk/libsodium/tree/iquerejeta/vrf_batchverify 11 | 12 | ### Usage with `cabal` 13 | 14 | #### Using external libsodium 15 | 16 | - Clone out the above-mentioned libsodium fork 17 | - Build and install this `libsodium` version (make sure `pkgconfig` can find 18 | it) 19 | - Cabal should now pick up this version 20 | 21 | #### Using internal C code 22 | 23 | The `cbits` directory contains the C code that's needed to implement 24 | the custom VRF code, disable the `external-libsodium-vrf` flag to let 25 | GHC build those directly. This still requires a working libsodium 26 | installation. 27 | 28 | ``` 29 | cabal build -f-external-libsodium-vrf 30 | ``` 31 | 32 | ### Usage with Nix 33 | 34 | To build fully with nix: 35 | > nix-build default.nix -A haskellPackages.cardano-crypto-praos 36 | To use nix+cabal: 37 | > nix-shell --run "cabal build cardano-crypto-praos" 38 | -------------------------------------------------------------------------------- /cardano-crypto-praos/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | 3 | main = defaultMain 4 | -------------------------------------------------------------------------------- /cardano-crypto-praos/cardano-crypto-praos.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.2 2 | name: cardano-crypto-praos 3 | version: 2.2.1.0 4 | synopsis: Crypto primitives from libsodium 5 | description: VRF (and KES, tba) primitives from libsodium. 6 | license: Apache-2.0 7 | license-files: 8 | LICENSE 9 | NOTICE 10 | 11 | author: IOHK 12 | maintainer: operations@iohk.io 13 | copyright: 2019-2021 IOHK 14 | category: Currency 15 | build-type: Simple 16 | extra-source-files: 17 | CHANGELOG.md 18 | README.md 19 | 20 | extra-source-files: 21 | cbits/crypto_vrf.h 22 | cbits/private/common.h 23 | cbits/private/core_h2c.h 24 | cbits/private/ed25519_ref10.h 25 | cbits/private/ed25519_ref10_fe_25_5.h 26 | cbits/private/ed25519_ref10_fe_51.h 27 | cbits/private/fe_25_5/base.h 28 | cbits/private/fe_25_5/base2.h 29 | cbits/private/fe_25_5/constants.h 30 | cbits/private/fe_25_5/fe.h 31 | cbits/private/fe_51/base.h 32 | cbits/private/fe_51/base2.h 33 | cbits/private/fe_51/constants.h 34 | cbits/private/fe_51/fe.h 35 | cbits/vrf03/crypto_vrf_ietfdraft03.h 36 | cbits/vrf13_batchcompat/crypto_vrf_ietfdraft13.h 37 | 38 | flag external-libsodium-vrf 39 | description: 40 | Rely on a special libsodium fork containing the VRF code. 41 | Otherwise expect a normal unaltered system libsodium, and 42 | bundle the VRF code. 43 | 44 | default: True 45 | manual: True 46 | 47 | common base 48 | build-depends: base >=4.14 && <5 49 | 50 | common project-config 51 | default-language: Haskell2010 52 | ghc-options: 53 | -Wall 54 | -Wcompat 55 | -Wincomplete-record-updates 56 | -Wincomplete-uni-patterns 57 | -Wpartial-fields 58 | -Wredundant-constraints 59 | -Wunused-packages 60 | 61 | library 62 | import: base, project-config 63 | hs-source-dirs: src 64 | exposed-modules: 65 | Cardano.Crypto.RandomBytes 66 | Cardano.Crypto.VRF.Praos 67 | Cardano.Crypto.VRF.PraosBatchCompat 68 | 69 | build-depends: 70 | base, 71 | bytestring, 72 | cardano-binary, 73 | cardano-crypto-class >=2.1.1, 74 | deepseq, 75 | nothunks, 76 | 77 | pkgconfig-depends: libsodium 78 | 79 | if !flag(external-libsodium-vrf) 80 | c-sources: 81 | cbits/crypto_vrf.c 82 | cbits/private/core_h2c.c 83 | cbits/private/ed25519_ref10.c 84 | cbits/vrf03/prove.c 85 | cbits/vrf03/verify.c 86 | cbits/vrf03/vrf.c 87 | cbits/vrf13_batchcompat/prove.c 88 | cbits/vrf13_batchcompat/verify.c 89 | cbits/vrf13_batchcompat/vrf.c 90 | -------------------------------------------------------------------------------- /cardano-crypto-praos/cbits/README: -------------------------------------------------------------------------------- 1 | This is an implementation of an elliptic curve-based verifiable random function construction designed by Goldberg et al. and specified in an IETF internet draft, draft-irtf-cfrg-vrf-03 (https://www.ietf.org/id/draft-irtf-cfrg-vrf-03.txt). The specification is still a draft and may change before it becomes standardized. In particular, this implements the ECVRF-ED25519-SHA512-Elligator2 suite. 2 | The code is structured to closely follow the pseudocode given in the spec, with a few notable exceptions described below, and we point to the relevant section of the draft spec in comments before each function. 3 | 4 | For readability, the code is separated into a few files: keygen.c (key generation), prove.c (constructing vrf proofs), verify.c (verifying VRF proofs and turning them into output hashes), convert.c (helper functions used in prove and verify), and vrf.c (boilerplate). vrf_ietfdraft03.h is used internally so that prove.c and verify.c can use the helper functions defined in convert.c. 5 | 6 | keygen.c contains key generation functions. In this VRF scheme, key generation is identical to standard ed25519 key generation from RFC8032, so these functions are essentially copied directly from libsodium/crypto_sign/ed25519/ref10/keypair.c. 7 | In libsodium's ed25519 signature implementation, the "secret key" returned by keygen is not the 32-byte string RFC8032 calls the secret key -- libsodium calls that 32-byte string the "seed" -- but is instead the seed with the public key appended. This precomputation saves a scalar multiplication during signing. We do this same optimization in the VRF implementation, saving a scalar multiplication during proving, and we use the same terminology (32-byte seed / 64-byte secret key). keygen.c defines functions for converting back and forth between 32-byte seeds and 64-byte secret keys. Our terminology here differs from the VRF draft spec, where "secret key" refers to the 32-byte seed. 8 | 9 | convert.c has some internal utility functions: point_to_string, string_to_point, hash_to_curve_elligator2_25519, hash_points, and decode_proof. These correspond to the similarly-named subroutines in the VRF draft spec. 10 | 11 | verify.c contains verification-related code: verify, proof_to_hash, validate_key, and helper functions. Verification runtime depends only on the message length (assuming verification succeeds). 12 | 13 | prove.c contains the prove function. As mentioned above, to save a scalar multiplication, prove() takes in a 64-byte secret key where the first half is the secret seed and the second half is the public key. If the second half doesn't encode a valid curve point, prove() will fail early; otherwise prove's runtime depends only on the length of the message. (If the second half of the secret key encodes a valid curve point that but not the correct public key, the proof returned may fail to verify.) 14 | prove.c also contains the helper function vrf_nonce_generation (specificed in section 5.4.2.2. of the draft spec). In the draft spec, the nonce generation function takes in the seed and computes a truncated hash of it; we instead compute this same truncated hash earlier in a helper function (vrf_expand_sk, which already hashes the seed to derive x) and pass that to vrf_nonce_generation directly, giving the same result. 15 | -------------------------------------------------------------------------------- /cardano-crypto-praos/cbits/crypto_vrf.c: -------------------------------------------------------------------------------- 1 | #include "sodium/crypto_hash_sha512.h" 2 | #include "private/ed25519_ref10.h" 3 | #include "sodium/randombytes.h" 4 | #include "crypto_vrf.h" 5 | 6 | size_t 7 | cardano_crypto_vrf_publickeybytes(void) 8 | { 9 | return cardano_crypto_vrf_PUBLICKEYBYTES; 10 | } 11 | 12 | size_t 13 | cardano_crypto_vrf_secretkeybytes(void) 14 | { 15 | return cardano_crypto_vrf_SECRETKEYBYTES; 16 | } 17 | 18 | size_t 19 | cardano_crypto_vrf_seedbytes(void) 20 | { 21 | return cardano_crypto_vrf_SEEDBYTES; 22 | } 23 | 24 | size_t 25 | cardano_crypto_vrf_proofbytes(void) 26 | { 27 | return crypto_vrf_PROOFBYTES; 28 | } 29 | 30 | size_t 31 | cardano_crypto_vrf_outputbytes(void) 32 | { 33 | return cardano_crypto_vrf_OUTPUTBYTES; 34 | } 35 | 36 | const char * 37 | cardano_crypto_vrf_primitive(void) 38 | { 39 | return cardano_crypto_vrf_PRIMITIVE; 40 | } 41 | 42 | int 43 | crypto_vrf_seed_keypair(unsigned char *pk, unsigned char *skpk, 44 | const unsigned char *seed) 45 | { 46 | ge25519_p3 A; 47 | 48 | crypto_hash_sha512(skpk, seed, 32); 49 | skpk[0] &= 248; 50 | skpk[31] &= 127; 51 | skpk[31] |= 64; 52 | 53 | cardano_ge25519_scalarmult_base(&A, skpk); 54 | cardano_ge25519_p3_tobytes(pk, &A); 55 | 56 | memmove(skpk, seed, 32); 57 | memmove(skpk + 32, pk, 32); 58 | 59 | return 0; 60 | } 61 | 62 | int 63 | cardano_crypto_vrf_keypair(unsigned char *pk, unsigned char *skpk) 64 | { 65 | unsigned char seed[32]; 66 | int ret; 67 | 68 | randombytes_buf(seed, sizeof seed); 69 | ret = crypto_vrf_seed_keypair(pk, skpk, seed); 70 | sodium_memzero(seed, sizeof seed); 71 | 72 | return ret; 73 | } 74 | 75 | int 76 | cardano_crypto_vrf_prove(unsigned char *proof, const unsigned char *skpk, 77 | const unsigned char *m, const unsigned long long mlen) 78 | { 79 | return crypto_vrf_ietfdraft13_prove(proof, skpk, m, mlen); 80 | } 81 | 82 | int 83 | cardano_crypto_vrf_verify(unsigned char *output, const unsigned char *pk, 84 | const unsigned char *proof, const unsigned char *m, 85 | const unsigned long long mlen) 86 | { 87 | return crypto_vrf_ietfdraft13_verify(output, pk, proof, m, mlen); 88 | } 89 | 90 | int 91 | cardano_crypto_vrf_proof_to_hash(unsigned char *hash, const unsigned char *proof) 92 | { 93 | return crypto_vrf_ietfdraft13_proof_to_hash(hash, proof); 94 | } 95 | 96 | void 97 | crypto_vrf_sk_to_pk(unsigned char *pk, const unsigned char *skpk) 98 | { 99 | memmove(pk, skpk+32, 32); 100 | } 101 | 102 | void 103 | crypto_vrf_sk_to_seed(unsigned char *seed, const unsigned char *skpk) 104 | { 105 | memmove(seed, skpk, 32); 106 | } 107 | -------------------------------------------------------------------------------- /cardano-crypto-praos/cbits/crypto_vrf.h: -------------------------------------------------------------------------------- 1 | #ifndef crypto_vrf_H 2 | #define crypto_vrf_H 3 | 4 | /* 5 | * THREAD SAFETY: cardano_crypto_vrf_keypair() is thread-safe provided that 6 | * sodium_init() was called before. 7 | * 8 | * Other functions, including cardano_crypto_vrf_keypair_from_seed(), are always 9 | * thread-safe. 10 | */ 11 | 12 | #include 13 | 14 | #include "vrf13_batchcompat/crypto_vrf_ietfdraft13.h" 15 | #include "sodium/export.h" 16 | 17 | #ifdef __cplusplus 18 | # ifdef __GNUC__ 19 | # pragma GCC diagnostic ignored "-Wlong-long" 20 | # endif 21 | extern "C" { 22 | #endif 23 | 24 | static const unsigned char SUITE = 0x04; /* ECVRF-ED25519-SHA512-ELL2 */ 25 | 26 | static const unsigned char ZERO = 0x00; 27 | static const unsigned char ONE = 0x01; 28 | static const unsigned char TWO = 0x02; 29 | static const unsigned char THREE = 0x03; 30 | 31 | #define cardano_crypto_vrf_PUBLICKEYBYTES crypto_vrf_ietfdraft13_PUBLICKEYBYTES 32 | SODIUM_EXPORT 33 | size_t cardano_crypto_vrf_publickeybytes(void); 34 | 35 | #define cardano_crypto_vrf_SECRETKEYBYTES crypto_vrf_ietfdraft13_SECRETKEYBYTES 36 | SODIUM_EXPORT 37 | size_t cardano_crypto_vrf_secretkeybytes(void); 38 | 39 | #define cardano_crypto_vrf_SEEDBYTES crypto_vrf_ietfdraft13_SEEDBYTES 40 | SODIUM_EXPORT 41 | size_t cardano_crypto_vrf_seedbytes(void); 42 | 43 | #define crypto_vrf_PROOFBYTES crypto_vrf_ietfdraft13_BYTES 44 | SODIUM_EXPORT 45 | size_t cardano_crypto_vrf_proofbytes(void); 46 | 47 | #define cardano_crypto_vrf_OUTPUTBYTES crypto_vrf_ietfdraft13_OUTPUTBYTES 48 | SODIUM_EXPORT 49 | size_t cardano_crypto_vrf_outputbytes(void); 50 | 51 | #define cardano_crypto_vrf_PRIMITIVE "ietfdraft13" 52 | SODIUM_EXPORT 53 | const char *cardano_crypto_vrf_primitive(void); 54 | 55 | SODIUM_EXPORT 56 | int cardano_crypto_vrf_keypair(unsigned char *pk, unsigned char *skpk) 57 | __attribute__ ((nonnull)); 58 | 59 | SODIUM_EXPORT 60 | int crypto_vrf_seed_keypair(unsigned char *pk, unsigned char *skpk, 61 | const unsigned char *seed) 62 | __attribute__ ((nonnull)); 63 | 64 | SODIUM_EXPORT 65 | int cardano_crypto_vrf_prove(unsigned char *proof, const unsigned char *skpk, 66 | const unsigned char *m, unsigned long long mlen) 67 | __attribute__ ((nonnull)); 68 | 69 | SODIUM_EXPORT 70 | int cardano_crypto_vrf_verify(unsigned char *output, 71 | const unsigned char *pk, 72 | const unsigned char *proof, 73 | const unsigned char *m, unsigned long long mlen) 74 | __attribute__ ((warn_unused_result)) 75 | __attribute__ ((warn_unused_result)) __attribute__ ((nonnull)); 76 | 77 | SODIUM_EXPORT 78 | int cardano_crypto_vrf_proof_to_hash(unsigned char *hash, const unsigned char *proof); 79 | 80 | SODIUM_EXPORT 81 | void crypto_vrf_sk_to_pk(unsigned char *pk, const unsigned char *skpk); 82 | 83 | SODIUM_EXPORT 84 | void crypto_vrf_sk_to_seed(unsigned char *seed, const unsigned char *skpk); 85 | 86 | #ifdef __cplusplus 87 | } 88 | #endif 89 | 90 | #endif 91 | -------------------------------------------------------------------------------- /cardano-crypto-praos/cbits/private/core_h2c.h: -------------------------------------------------------------------------------- 1 | #ifndef core_h2c_H 2 | #define core_h2c_H 3 | 4 | #define CORE_H2C_SHA256 1 5 | #define CORE_H2C_SHA512 2 6 | 7 | int cardano_core_h2c_string_to_hash(unsigned char *h, const size_t h_len, const char *ctx, 8 | const unsigned char *msg, size_t msg_len, 9 | int hash_alg); 10 | #endif 11 | -------------------------------------------------------------------------------- /cardano-crypto-praos/cbits/private/fe_25_5/base2.h: -------------------------------------------------------------------------------- 1 | { 2 | { 25967493, -14356035, 29566456, 3660896, -12694345, 4014787, 27544626, -11754271, -6079156, 2047605 }, 3 | { -12545711, 934262, -2722910, 3049990, -727428, 9406986, 12720692, 5043384, 19500929, -15469378 }, 4 | { -8738181, 4489570, 9688441, -14785194, 10184609, -12363380, 29287919, 11864899, -24514362, -4438546 } 5 | }, 6 | { 7 | { 15636291, -9688557, 24204773, -7912398, 616977, -16685262, 27787600, -14772189, 28944400, -1550024 }, 8 | { 16568933, 4717097, -11556148, -1102322, 15682896, -11807043, 16354577, -11775962, 7689662, 11199574 }, 9 | { 30464156, -5976125, -11779434, -15670865, 23220365, 15915852, 7512774, 10017326, -17749093, -9920357 } 10 | }, 11 | { 12 | { 10861363, 11473154, 27284546, 1981175, -30064349, 12577861, 32867885, 14515107, -15438304, 10819380 }, 13 | { 4708026, 6336745, 20377586, 9066809, -11272109, 6594696, -25653668, 12483688, -12668491, 5581306 }, 14 | { 19563160, 16186464, -29386857, 4097519, 10237984, -4348115, 28542350, 13850243, -23678021, -15815942 } 15 | }, 16 | { 17 | { 5153746, 9909285, 1723747, -2777874, 30523605, 5516873, 19480852, 5230134, -23952439, -15175766 }, 18 | { -30269007, -3463509, 7665486, 10083793, 28475525, 1649722, 20654025, 16520125, 30598449, 7715701 }, 19 | { 28881845, 14381568, 9657904, 3680757, -20181635, 7843316, -31400660, 1370708, 29794553, -1409300 } 20 | }, 21 | { 22 | { -22518993, -6692182, 14201702, -8745502, -23510406, 8844726, 18474211, -1361450, -13062696, 13821877 }, 23 | { -6455177, -7839871, 3374702, -4740862, -27098617, -10571707, 31655028, -7212327, 18853322, -14220951 }, 24 | { 4566830, -12963868, -28974889, -12240689, -7602672, -2830569, -8514358, -10431137, 2207753, -3209784 } 25 | }, 26 | { 27 | { -25154831, -4185821, 29681144, 7868801, -6854661, -9423865, -12437364, -663000, -31111463, -16132436 }, 28 | { 25576264, -2703214, 7349804, -11814844, 16472782, 9300885, 3844789, 15725684, 171356, 6466918 }, 29 | { 23103977, 13316479, 9739013, -16149481, 817875, -15038942, 8965339, -14088058, -30714912, 16193877 } 30 | }, 31 | { 32 | { -33521811, 3180713, -2394130, 14003687, -16903474, -16270840, 17238398, 4729455, -18074513, 9256800 }, 33 | { -25182317, -4174131, 32336398, 5036987, -21236817, 11360617, 22616405, 9761698, -19827198, 630305 }, 34 | { -13720693, 2639453, -24237460, -7406481, 9494427, -5774029, -6554551, -15960994, -2449256, -14291300 } 35 | }, 36 | { 37 | { -3151181, -5046075, 9282714, 6866145, -31907062, -863023, -18940575, 15033784, 25105118, -7894876 }, 38 | { -24326370, 15950226, -31801215, -14592823, -11662737, -5090925, 1573892, -2625887, 2198790, -15804619 }, 39 | { -3099351, 10324967, -2241613, 7453183, -5446979, -2735503, -13812022, -16236442, -32461234, -12290683 } 40 | } 41 | -------------------------------------------------------------------------------- /cardano-crypto-praos/cbits/private/fe_25_5/constants.h: -------------------------------------------------------------------------------- 1 | /* 37095705934669439343138083508754565189542113879843219016388785533085940283555 */ 2 | static const fe25519 cardano_d = { 3 | -10913610, 13857413, -15372611, 6949391, 114729, -8787816, -6275908, -3247719, -18696448, -12055116 4 | }; 5 | 6 | /* 2 * d = 7 | * 16295367250680780974490674513165176452449235426866156013048779062215315747161 8 | */ 9 | static const fe25519 cardano_d2 = { 10 | -21827239, -5839606, -30745221, 13898782, 229458, 15978800, -12551817, -6495438, 29715968, 9444199 }; 11 | 12 | /* sqrt(-1) */ 13 | static const fe25519 cardano_sqrtm1 = { 14 | -32595792, -7943725, 9377950, 3500415, 12389472, -272473, -25146209, -2005654, 326686, 11406482 15 | }; 16 | 17 | /* sqrt(-486664) */ 18 | static const fe25519 cardano_ed25519_sqrtam2 = { 19 | -12222970, -8312128, -11511410, 9067497, -15300785, -241793, 25456130, 14121551, -12187136, 3972024 20 | }; 21 | 22 | #define ed25519_A_32 486662 23 | /* A = 486662 */ 24 | static const fe25519 cardano_curve25519_A = { 25 | ed25519_A_32, 0, 0, 0, 0, 0, 0, 0, 0, 0 26 | }; 27 | 28 | /* sqrt(ad - 1) with a = -1 (mod p) */ 29 | static const fe25519 cardano_sqrtadm1 = { 30 | 24849947, -153582, -23613485, 6347715, -21072328, -667138, -25271143, -15367704, -870347, 14525639 31 | }; 32 | 33 | /* 1 / sqrt(a - d) */ 34 | static const fe25519 cardano_invsqrtamd = { 35 | 6111485, 4156064, -27798727, 12243468, -25904040, 120897, 20826367, -7060776, 6093568, -1986012 36 | }; 37 | 38 | /* 1 - d ^ 2 */ 39 | static const fe25519 cardano_onemsqd = { 40 | 6275446, -16617371, -22938544, -3773710, 11667077, 7397348, -27922721, 1766195, -24433858, 672203 41 | }; 42 | 43 | /* (d - 1) ^ 2 */ 44 | static const fe25519 cardano_sqdmone = { 45 | 15551795, -11097455, -13425098, -10125071, -11896535, 10178284, -26634327, 4729244, -5282110, -10116402 46 | }; 47 | -------------------------------------------------------------------------------- /cardano-crypto-praos/cbits/private/fe_51/base2.h: -------------------------------------------------------------------------------- 1 | { 2 | { 1288382639258501, 245678601348599, 269427782077623, 1462984067271730, 137412439391563 }, 3 | { 62697248952638, 204681361388450, 631292143396476, 338455783676468, 1213667448819585 }, 4 | { 301289933810280, 1259582250014073, 1422107436869536, 796239922652654, 1953934009299142 } 5 | }, 6 | { 7 | { 1601611775252272, 1720807796594148, 1132070835939856, 1260455018889551, 2147779492816911 }, 8 | { 316559037616741, 2177824224946892, 1459442586438991, 1461528397712656, 751590696113597 }, 9 | { 1850748884277385, 1200145853858453, 1068094770532492, 672251375690438, 1586055907191707 } 10 | }, 11 | { 12 | { 769950342298419, 132954430919746, 844085933195555, 974092374476333, 726076285546016 }, 13 | { 425251763115706, 608463272472562, 442562545713235, 837766094556764, 374555092627893 }, 14 | { 1086255230780037, 274979815921559, 1960002765731872, 929474102396301, 1190409889297339 } 15 | }, 16 | { 17 | { 665000864555967, 2065379846933859, 370231110385876, 350988370788628, 1233371373142985 }, 18 | { 2019367628972465, 676711900706637, 110710997811333, 1108646842542025, 517791959672113 }, 19 | { 965130719900578, 247011430587952, 526356006571389, 91986625355052, 2157223321444601 } 20 | }, 21 | { 22 | { 1802695059465007, 1664899123557221, 593559490740857, 2160434469266659, 927570450755031 }, 23 | { 1725674970513508, 1933645953859181, 1542344539275782, 1767788773573747, 1297447965928905 }, 24 | { 1381809363726107, 1430341051343062, 2061843536018959, 1551778050872521, 2036394857967624 } 25 | }, 26 | { 27 | { 1970894096313054, 528066325833207, 1619374932191227, 2207306624415883, 1169170329061080 }, 28 | { 2070390218572616, 1458919061857835, 624171843017421, 1055332792707765, 433987520732508 }, 29 | { 893653801273833, 1168026499324677, 1242553501121234, 1306366254304474, 1086752658510815 } 30 | }, 31 | { 32 | { 213454002618221, 939771523987438, 1159882208056014, 317388369627517, 621213314200687 }, 33 | { 1971678598905747, 338026507889165, 762398079972271, 655096486107477, 42299032696322 }, 34 | { 177130678690680, 1754759263300204, 1864311296286618, 1180675631479880, 1292726903152791 } 35 | }, 36 | { 37 | { 1913163449625248, 460779200291993, 2193883288642314, 1008900146920800, 1721983679009502 }, 38 | { 1070401523076875, 1272492007800961, 1910153608563310, 2075579521696771, 1191169788841221 }, 39 | { 692896803108118, 500174642072499, 2068223309439677, 1162190621851337, 1426986007309901 } 40 | } 41 | -------------------------------------------------------------------------------- /cardano-crypto-praos/cbits/private/fe_51/constants.h: -------------------------------------------------------------------------------- 1 | /* 37095705934669439343138083508754565189542113879843219016388785533085940283555 */ 2 | static const fe25519 cardano_d = { 3 | 929955233495203, 466365720129213, 1662059464998953, 2033849074728123, 1442794654840575 4 | }; 5 | 6 | /* 2 * d = 7 | * 16295367250680780974490674513165176452449235426866156013048779062215315747161 8 | */ 9 | static const fe25519 cardano_d2 = { 10 | 1859910466990425, 932731440258426, 1072319116312658, 1815898335770999, 633789495995903 11 | }; 12 | 13 | /* sqrt(-1) */ 14 | static const fe25519 cardano_sqrtm1 = { 15 | 1718705420411056, 234908883556509, 2233514472574048, 2117202627021982, 765476049583133 16 | }; 17 | 18 | /* 19 | * sqrt(-486664) 20 | * This uses the notation of latest master branch, mainly prefixing it with `ed25519`. 21 | * */ 22 | static const fe25519 cardano_ed25519_sqrtam2 = { 23 | 1693982333959686, 608509411481997, 2235573344831311, 947681270984193, 266558006233600 24 | }; 25 | 26 | /* A = 486662 */ 27 | #define ed25519_A_32 486662 28 | static const fe25519 cardano_curve25519_A = { 29 | ed25519_A_32, 0, 0, 0, 0 30 | }; 31 | 32 | /* sqrt(ad - 1) with a = -1 (mod p) */ 33 | static const fe25519 cardano_sqrtadm1 = { 34 | 2241493124984347, 425987919032274, 2207028919301688, 1220490630685848, 974799131293748 35 | }; 36 | 37 | /* 1 / sqrt(a - d) */ 38 | static const fe25519 cardano_invsqrtamd = { 39 | 278908739862762, 821645201101625, 8113234426968, 1777959178193151, 2118520810568447 40 | }; 41 | 42 | /* 1 - d ^ 2 */ 43 | static const fe25519 cardano_onemsqd = { 44 | 1136626929484150, 1998550399581263, 496427632559748, 118527312129759, 45110755273534 45 | }; 46 | 47 | /* (d - 1) ^ 2 */ 48 | static const fe25519 cardano_sqdmone = { 49 | 1507062230895904, 1572317787530805, 683053064812840, 317374165784489, 1572899562415810 50 | }; 51 | -------------------------------------------------------------------------------- /cardano-crypto-praos/cbits/private/fe_51/fe.h: -------------------------------------------------------------------------------- 1 | /* 2 | Ignores top bit of h. 3 | */ 4 | 5 | void 6 | cardano_fe25519_frombytes(fe25519 h, const unsigned char *s) 7 | { 8 | const uint64_t mask = 0x7ffffffffffffULL; 9 | uint64_t h0, h1, h2, h3, h4; 10 | 11 | h0 = (LOAD64_LE(s ) ) & mask; 12 | h1 = (LOAD64_LE(s + 6) >> 3) & mask; 13 | h2 = (LOAD64_LE(s + 12) >> 6) & mask; 14 | h3 = (LOAD64_LE(s + 19) >> 1) & mask; 15 | h4 = (LOAD64_LE(s + 24) >> 12) & mask; 16 | 17 | h[0] = h0; 18 | h[1] = h1; 19 | h[2] = h2; 20 | h[3] = h3; 21 | h[4] = h4; 22 | } 23 | 24 | static void 25 | cardano_fe25519_reduce(fe25519 h, const fe25519 f) 26 | { 27 | const uint64_t mask = 0x7ffffffffffffULL; 28 | uint128_t t[5]; 29 | 30 | t[0] = f[0]; 31 | t[1] = f[1]; 32 | t[2] = f[2]; 33 | t[3] = f[3]; 34 | t[4] = f[4]; 35 | 36 | t[1] += t[0] >> 51; 37 | t[0] &= mask; 38 | t[2] += t[1] >> 51; 39 | t[1] &= mask; 40 | t[3] += t[2] >> 51; 41 | t[2] &= mask; 42 | t[4] += t[3] >> 51; 43 | t[3] &= mask; 44 | t[0] += 19 * (t[4] >> 51); 45 | t[4] &= mask; 46 | 47 | t[1] += t[0] >> 51; 48 | t[0] &= mask; 49 | t[2] += t[1] >> 51; 50 | t[1] &= mask; 51 | t[3] += t[2] >> 51; 52 | t[2] &= mask; 53 | t[4] += t[3] >> 51; 54 | t[3] &= mask; 55 | t[0] += 19 * (t[4] >> 51); 56 | t[4] &= mask; 57 | 58 | /* now t is between 0 and 2^255-1, properly carried. */ 59 | /* case 1: between 0 and 2^255-20. case 2: between 2^255-19 and 2^255-1. */ 60 | 61 | t[0] += 19ULL; 62 | 63 | t[1] += t[0] >> 51; 64 | t[0] &= mask; 65 | t[2] += t[1] >> 51; 66 | t[1] &= mask; 67 | t[3] += t[2] >> 51; 68 | t[2] &= mask; 69 | t[4] += t[3] >> 51; 70 | t[3] &= mask; 71 | t[0] += 19ULL * (t[4] >> 51); 72 | t[4] &= mask; 73 | 74 | /* now between 19 and 2^255-1 in both cases, and offset by 19. */ 75 | 76 | t[0] += 0x8000000000000 - 19ULL; 77 | t[1] += 0x8000000000000 - 1ULL; 78 | t[2] += 0x8000000000000 - 1ULL; 79 | t[3] += 0x8000000000000 - 1ULL; 80 | t[4] += 0x8000000000000 - 1ULL; 81 | 82 | /* now between 2^255 and 2^256-20, and offset by 2^255. */ 83 | 84 | t[1] += t[0] >> 51; 85 | t[0] &= mask; 86 | t[2] += t[1] >> 51; 87 | t[1] &= mask; 88 | t[3] += t[2] >> 51; 89 | t[2] &= mask; 90 | t[4] += t[3] >> 51; 91 | t[3] &= mask; 92 | t[4] &= mask; 93 | 94 | h[0] = t[0]; 95 | h[1] = t[1]; 96 | h[2] = t[2]; 97 | h[3] = t[3]; 98 | h[4] = t[4]; 99 | } 100 | 101 | void 102 | cardano_fe25519_tobytes(unsigned char *s, const fe25519 h) 103 | { 104 | fe25519 t; 105 | uint64_t t0, t1, t2, t3; 106 | 107 | cardano_fe25519_reduce(t, h); 108 | t0 = t[0] | (t[1] << 51); 109 | t1 = (t[1] >> 13) | (t[2] << 38); 110 | t2 = (t[2] >> 26) | (t[3] << 25); 111 | t3 = (t[3] >> 39) | (t[4] << 12); 112 | STORE64_LE(s + 0, t0); 113 | STORE64_LE(s + 8, t1); 114 | STORE64_LE(s + 16, t2); 115 | STORE64_LE(s + 24, t3); 116 | } 117 | -------------------------------------------------------------------------------- /cardano-crypto-praos/cbits/vrf03/crypto_vrf_ietfdraft03.h: -------------------------------------------------------------------------------- 1 | 2 | #ifndef crypto_vrf_ietfdraft03_H 3 | #define crypto_vrf_ietfdraft03_H 4 | 5 | #include 6 | 7 | #include "sodium/export.h" 8 | 9 | #ifdef __cplusplus 10 | # ifdef __GNUC__ 11 | # pragma GCC diagnostic ignored "-Wlong-long" 12 | # endif 13 | extern "C" { 14 | #endif 15 | 16 | #define crypto_vrf_ietfdraft03_PUBLICKEYBYTES 32U 17 | SODIUM_EXPORT 18 | size_t crypto_vrf_ietfdraft03_publickeybytes(void); 19 | 20 | #define crypto_vrf_ietfdraft03_SECRETKEYBYTES 64U 21 | SODIUM_EXPORT 22 | size_t crypto_vrf_ietfdraft03_secretkeybytes(void); 23 | 24 | #define crypto_vrf_ietfdraft03_SEEDBYTES 32U 25 | SODIUM_EXPORT 26 | size_t crypto_vrf_ietfdraft03_seedbytes(void); 27 | 28 | #define crypto_vrf_ietfdraft03_BYTES 80U 29 | SODIUM_EXPORT 30 | size_t crypto_vrf_ietfdraft03_bytes(void); 31 | 32 | #define crypto_vrf_ietfdraft03_OUTPUTBYTES 64U 33 | SODIUM_EXPORT 34 | size_t crypto_vrf_ietfdraft03_outputbytes(void); 35 | 36 | SODIUM_EXPORT 37 | int crypto_vrf_ietfdraft03_prove(unsigned char *proof, const unsigned char *skpk, 38 | const unsigned char *m, 39 | unsigned long long mlen); 40 | 41 | SODIUM_EXPORT 42 | int crypto_vrf_ietfdraft03_verify(unsigned char *output, 43 | const unsigned char *pk, 44 | const unsigned char *proof, 45 | const unsigned char *m, 46 | unsigned long long mlen) 47 | __attribute__ ((warn_unused_result)) __attribute__ ((nonnull)); 48 | 49 | SODIUM_EXPORT 50 | int crypto_vrf_ietfdraft03_proof_to_hash(unsigned char *hash, 51 | const unsigned char *proof) 52 | __attribute__ ((nonnull)); 53 | 54 | #ifdef __cplusplus 55 | } 56 | #endif 57 | 58 | #endif 59 | -------------------------------------------------------------------------------- /cardano-crypto-praos/cbits/vrf03/prove.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | 4 | #include "sodium/crypto_hash_sha512.h" 5 | #include "crypto_vrf_ietfdraft03.h" 6 | #include "sodium/crypto_core_ed25519.h" 7 | #include "../private/ed25519_ref10.h" 8 | #include "sodium/utils.h" 9 | #include "../crypto_vrf.h" 10 | 11 | 12 | int 13 | crypto_vrf_ietfdraft03_prove(unsigned char *proof, const unsigned char *skpk, 14 | const unsigned char *m, unsigned long long mlen) 15 | { 16 | 17 | crypto_hash_sha512_state hs; 18 | unsigned char az[64], r_string[64]; 19 | unsigned char H_string[32]; 20 | unsigned char kB_string[32], kH_string[32]; 21 | unsigned char hram[64], nonce[64]; 22 | ge25519_p3 H, Gamma, kB, kH; 23 | 24 | crypto_hash_sha512(az, skpk, 32); 25 | az[0] &= 248; 26 | az[31] &= 127; 27 | az[31] |= 64; 28 | 29 | crypto_hash_sha512_init(&hs); 30 | crypto_hash_sha512_update(&hs, &SUITE, 1); 31 | crypto_hash_sha512_update(&hs, &ONE, 1); 32 | crypto_hash_sha512_update(&hs, skpk + 32, 32); 33 | crypto_hash_sha512_update(&hs, m, mlen); 34 | crypto_hash_sha512_final(&hs, r_string); 35 | 36 | r_string[31] &= 0x7f; /* clear sign bit */ 37 | cardano_ge25519_from_uniform(H_string, r_string); /* elligator2 */ 38 | 39 | cardano_ge25519_frombytes(&H, H_string); 40 | cardano_ge25519_scalarmult(&Gamma, az, &H); 41 | 42 | crypto_hash_sha512_init(&hs); 43 | crypto_hash_sha512_update(&hs, az + 32, 32); 44 | crypto_hash_sha512_update(&hs, H_string, 32); 45 | crypto_hash_sha512_final(&hs, nonce); 46 | 47 | cardano_sc25519_reduce(nonce); 48 | cardano_ge25519_scalarmult_base(&kB, nonce); 49 | cardano_ge25519_scalarmult(&kH, nonce, &H); 50 | 51 | cardano_ge25519_p3_tobytes(proof, &Gamma); 52 | cardano_ge25519_p3_tobytes(kB_string, &kB); 53 | cardano_ge25519_p3_tobytes(kH_string, &kH); 54 | 55 | crypto_hash_sha512_init(&hs); 56 | crypto_hash_sha512_update(&hs, &SUITE, 1); 57 | crypto_hash_sha512_update(&hs, &TWO, 1); 58 | crypto_hash_sha512_update(&hs, H_string, 32); 59 | crypto_hash_sha512_update(&hs, proof, 32); 60 | crypto_hash_sha512_update(&hs, kB_string, 32); 61 | crypto_hash_sha512_update(&hs, kH_string, 32); 62 | crypto_hash_sha512_final(&hs, hram); 63 | 64 | memmove(proof + 32, hram, 16); 65 | memset(hram + 16, 0, 48); /* we zero out the last 48 bytes of the challenge */ 66 | cardano_sc25519_muladd(proof + 48, hram, az, nonce); 67 | 68 | sodium_memzero(az, sizeof az); 69 | sodium_memzero(nonce, sizeof nonce); 70 | 71 | return 0; 72 | } 73 | -------------------------------------------------------------------------------- /cardano-crypto-praos/cbits/vrf03/vrf.c: -------------------------------------------------------------------------------- 1 | #include "crypto_vrf_ietfdraft03.h" 2 | #include "../crypto_vrf.h" 3 | 4 | size_t 5 | crypto_vrf_ietfdraft03_bytes(void) 6 | { 7 | return crypto_vrf_ietfdraft03_BYTES; 8 | } 9 | 10 | size_t 11 | crypto_vrf_ietfdraft03_outputbytes(void) 12 | { 13 | return crypto_vrf_ietfdraft03_OUTPUTBYTES; 14 | } 15 | 16 | size_t 17 | crypto_vrf_ietfdraft03_seedbytes(void) 18 | { 19 | return crypto_vrf_ietfdraft03_SEEDBYTES; 20 | } 21 | 22 | size_t 23 | crypto_vrf_ietfdraft03_publickeybytes(void) 24 | { 25 | return crypto_vrf_ietfdraft03_PUBLICKEYBYTES; 26 | } 27 | 28 | size_t 29 | crypto_vrf_ietfdraft03_secretkeybytes(void) 30 | { 31 | return crypto_vrf_ietfdraft03_SECRETKEYBYTES; 32 | } 33 | 34 | /* 35 | * We keep the functions below to be backwards compatible with older 36 | * versions of the cardano node, but these are identical as those 37 | * without the versioning in crypto_vrf.h 38 | */ 39 | int crypto_vrf_ietfdraft03_keypair_from_seed(unsigned char *pk, unsigned char *skpk, 40 | const unsigned char *seed) 41 | { 42 | return crypto_vrf_seed_keypair(pk, skpk, seed); 43 | } 44 | 45 | void crypto_vrf_ietfdraft03_sk_to_pk(unsigned char *pk, 46 | const unsigned char *skpk) 47 | { 48 | crypto_vrf_sk_to_pk(pk, skpk); 49 | } 50 | 51 | void crypto_vrf_ietfdraft03_sk_to_seed(unsigned char *seed, 52 | const unsigned char *skpk) 53 | { 54 | crypto_vrf_sk_to_seed(seed, skpk); 55 | } 56 | -------------------------------------------------------------------------------- /cardano-crypto-praos/cbits/vrf13_batchcompat/crypto_vrf_ietfdraft13.h: -------------------------------------------------------------------------------- 1 | #ifndef crypto_vrf_ietfdraft13_H 2 | #define crypto_vrf_ietfdraft13_H 3 | 4 | #include 5 | 6 | #include "sodium/export.h" 7 | 8 | #ifdef __cplusplus 9 | # ifdef __GNUC__ 10 | # pragma GCC diagnostic ignored "-Wlong-long" 11 | # endif 12 | extern "C" { 13 | #endif 14 | 15 | #define crypto_vrf_ietfdraft13_BYTES 80U 16 | SODIUM_EXPORT 17 | size_t crypto_vrf_ietfdraft13_bytes(void); 18 | 19 | #define crypto_vrf_ietfdraft13_BYTES_BATCHCOMPAT 128U 20 | SODIUM_EXPORT 21 | size_t crypto_vrf_ietfdraft13_bytes_batchcompat(void); 22 | 23 | #define crypto_vrf_ietfdraft13_OUTPUTBYTES 64U 24 | SODIUM_EXPORT 25 | size_t crypto_vrf_ietfdraft13_outputbytes(void); 26 | 27 | #define crypto_vrf_ietfdraft13_SEEDBYTES 32U 28 | SODIUM_EXPORT 29 | size_t crypto_vrf_ietfdraft13_seedbytes(void); 30 | 31 | #define crypto_vrf_ietfdraft13_PUBLICKEYBYTES 32U 32 | SODIUM_EXPORT 33 | size_t crypto_vrf_ietfdraft13_publickeybytes(void); 34 | 35 | #define crypto_vrf_ietfdraft13_SECRETKEYBYTES 64U 36 | SODIUM_EXPORT 37 | size_t crypto_vrf_ietfdraft13_secretkeybytes(void); 38 | 39 | SODIUM_EXPORT 40 | int crypto_vrf_ietfdraft13_prove(unsigned char *proof, 41 | const unsigned char *skpk, 42 | const unsigned char *m, 43 | unsigned long long mlen); 44 | 45 | SODIUM_EXPORT 46 | int crypto_vrf_ietfdraft13_prove_batchcompat(unsigned char *proof, 47 | const unsigned char *skpk, 48 | const unsigned char *m, 49 | unsigned long long mlen); 50 | 51 | SODIUM_EXPORT 52 | int crypto_vrf_ietfdraft13_verify(unsigned char *output, 53 | const unsigned char *pk, 54 | const unsigned char *proof, 55 | const unsigned char *m, 56 | unsigned long long mlen) 57 | __attribute__ ((warn_unused_result)) __attribute__ ((nonnull)); 58 | 59 | SODIUM_EXPORT 60 | int crypto_vrf_ietfdraft13_verify_batchcompat(unsigned char *output, 61 | const unsigned char *pk, 62 | const unsigned char *proof, 63 | const unsigned char *m, 64 | unsigned long long mlen) 65 | __attribute__ ((warn_unused_result)) __attribute__ ((nonnull)); 66 | 67 | SODIUM_EXPORT 68 | int crypto_vrf_ietfdraft13_batch_verify(unsigned char *output[64], 69 | const unsigned char *pk[32], 70 | const unsigned char *proof[128], 71 | const unsigned char **msg, 72 | const unsigned long long *msglen, 73 | size_t num) 74 | __attribute__ ((warn_unused_result)) __attribute__ ((nonnull)); 75 | 76 | SODIUM_EXPORT 77 | int crypto_vrf_ietfdraft13_proof_to_hash(unsigned char *hash, 78 | const unsigned char *proof) 79 | __attribute__ ((nonnull)); 80 | 81 | SODIUM_EXPORT 82 | int crypto_vrf_ietfdraft13_proof_to_hash_batchcompat(unsigned char *hash, 83 | const unsigned char *proof) 84 | __attribute__ ((nonnull)); 85 | 86 | #ifdef __cplusplus 87 | } 88 | #endif 89 | 90 | #endif 91 | -------------------------------------------------------------------------------- /cardano-crypto-praos/cbits/vrf13_batchcompat/vrf.c: -------------------------------------------------------------------------------- 1 | #include "crypto_vrf_ietfdraft13.h" 2 | 3 | size_t 4 | crypto_vrf_ietfdraft13_bytes(void) 5 | { 6 | return crypto_vrf_ietfdraft13_BYTES; 7 | } 8 | 9 | size_t 10 | crypto_vrf_ietfdraft13_bytes_batchcompat(void) 11 | { 12 | return crypto_vrf_ietfdraft13_BYTES_BATCHCOMPAT; 13 | } 14 | 15 | size_t 16 | crypto_vrf_ietfdraft13_outputbytes(void) 17 | { 18 | return crypto_vrf_ietfdraft13_OUTPUTBYTES; 19 | } 20 | 21 | size_t 22 | crypto_vrf_ietfdraft13_seedbytes(void) 23 | { 24 | return crypto_vrf_ietfdraft13_SEEDBYTES; 25 | } 26 | 27 | size_t 28 | crypto_vrf_ietfdraft13_publickeybytes(void) 29 | { 30 | return crypto_vrf_ietfdraft13_PUBLICKEYBYTES; 31 | } 32 | 33 | size_t 34 | crypto_vrf_ietfdraft13_secretkeybytes(void) 35 | { 36 | return crypto_vrf_ietfdraft13_SECRETKEYBYTES; 37 | } 38 | -------------------------------------------------------------------------------- /cardano-crypto-praos/src/Cardano/Crypto/RandomBytes.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface #-} 2 | 3 | module Cardano.Crypto.RandomBytes 4 | where 5 | 6 | import Foreign.C.Types 7 | import Foreign.Ptr 8 | 9 | foreign import ccall "randombytes_buf" randombytes_buf :: Ptr a -> CSize -> IO () 10 | -------------------------------------------------------------------------------- /cardano-crypto-tests/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Changelog for `cardano-crypto-tests` 2 | 3 | ## 2.2.1.1 4 | 5 | * 6 | 7 | ## 2.2.1.0 8 | 9 | * Add test for `SHA512` and `SHA3_512` algorithms. 10 | * Add tests using standard test vectors and generated ones for Praos and PraosBatchCompat 11 | 12 | ## 2.2.0.0 13 | 14 | * Memlocking functionality 15 | 16 | ## 2.1.2.0 17 | 18 | * Add tests for BLST 19 | 20 | ## 2.1.1.0 21 | 22 | * Add benchmark for `HASH` 23 | 24 | ## 2.1.0.2 25 | 26 | * GHC-9.6 compatibility 27 | 28 | ## 2.1.0.1 29 | 30 | * Remove `development` flag: #372 31 | 32 | ## 2.1.0.0 33 | 34 | * Addition of `DSIGN` benchmarks. New modules: 35 | * `Bench.Crypto.DSIGN` 36 | * `Bench.Crypto.BenchData` 37 | * Addition of `DSIGN` vector tests. New modules: 38 | * `Test.Crypto.Vector.Secp256k1DSIGN` 39 | * `Test.Crypto.Vector.Vectors` 40 | * `Test.Crypto.Vector.StringConstants` 41 | * `Test.Crypto.Vector.SerializationUtils` 42 | 43 | ## 2.0.0.1 44 | 45 | * Initial release 46 | -------------------------------------------------------------------------------- /cardano-crypto-tests/NOTICE: -------------------------------------------------------------------------------- 1 | Copyright 2019-2021 Input Output (Hong Kong) Ltd. 2 | 3 | Licensed under the Apache License, Version 2.0 (the "License"); 4 | you may not use this file except in compliance with the License. 5 | You may obtain a copy of the License at 6 | 7 | http://www.apache.org/licenses/LICENSE-2.0 8 | 9 | Unless required by applicable law or agreed to in writing, software 10 | distributed under the License is distributed on an "AS IS" BASIS, 11 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | See the License for the specific language governing permissions and 13 | limitations under the License. 14 | 15 | -------------------------------------------------------------------------------- /cardano-crypto-tests/README.md: -------------------------------------------------------------------------------- 1 | # cardano-crypto-test 2 | 3 | This package defines tests the implementations of the following cryptographic primitives: 4 | 5 | - A digital signature scheme 6 | 7 | - A cryptographic hashing function 8 | 9 | - A key-evolving signature scheme 10 | 11 | - A verifiable random function 12 | 13 | Those implementations can be found in these packages: 14 | 15 | - cardano-crypto-class 16 | - cardano-crypto-praos 17 | -------------------------------------------------------------------------------- /cardano-crypto-tests/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | 3 | main = defaultMain 4 | -------------------------------------------------------------------------------- /cardano-crypto-tests/bench/Main.hs: -------------------------------------------------------------------------------- 1 | module Main (main) where 2 | 3 | import Cardano.Crypto.Libsodium.Init 4 | import Criterion.Main 5 | 6 | import qualified Bench.Crypto.DSIGN (benchmarks) 7 | import qualified Bench.Crypto.HASH (benchmarks) 8 | import qualified Bench.Crypto.KES (benchmarks) 9 | import qualified Bench.Crypto.VRF (benchmarks) 10 | 11 | main :: IO () 12 | main = do 13 | sodiumInit 14 | defaultMain benchmarks 15 | 16 | benchmarks :: [Benchmark] 17 | benchmarks = 18 | [ Bench.Crypto.DSIGN.benchmarks 19 | , Bench.Crypto.HASH.benchmarks 20 | , Bench.Crypto.KES.benchmarks 21 | , Bench.Crypto.VRF.benchmarks 22 | ] 23 | -------------------------------------------------------------------------------- /cardano-crypto-tests/bls12-381-test-vectors/Cargo.toml: -------------------------------------------------------------------------------- 1 | [package] 2 | name = "bls12-381-test-vectors" 3 | version = "0.1.0" 4 | edition = "2021" 5 | 6 | [dependencies] 7 | bls12_381 = { version = "0.8.0", features = ["default", "experimental"] } 8 | rand_chacha = "0.3.1" 9 | ff = "0.13.0" 10 | group = "0.13.0" 11 | hex = "0.4.3" 12 | blst = "0.3.10" 13 | sha2 = "0.9" 14 | -------------------------------------------------------------------------------- /cardano-crypto-tests/bls12-381-test-vectors/test_vectors/bls_sig_aug_test_vectors: -------------------------------------------------------------------------------- 1 | 83422fd1d8f134fbbc7ad2949a0b7c38dc1f85bfd398bc58ae824ad34ace68eaa49f438872ee22e90778513a91f9685e 2 | b756d6223a92609cccf660b6f37e6e34fbb23972fc3955710f9bb202cc84cffacd337792700ebcb4324a99c7e7c9ed6d0e1cfdce8cd879a35300957c69c524c5365f6f0a85130735f27510618bbea605a1d024bb2d3bee2a5d68a827406f11c7 3 | -------------------------------------------------------------------------------- /cardano-crypto-tests/bls12-381-test-vectors/test_vectors/ec_operations_test_vectors: -------------------------------------------------------------------------------- 1 | b93105d0cff4c3f6a42ab790900a26bb1843f4b07fc83d527a66e4a2ddf6c49ea86fe37b1106dbd20dc280ec5996dadf 2 | a077246742bfbffdefc1193aba17434d337f231478bf63173065c1e09c34429e76877983ae5f3add1438e5d237f63724 3 | 9863eb0a7f8b092fca1a4333866ae3579ad2a4edef84bfcdf736333b3adf0100820c7603b002bf911b564cf032392f07 4 | b7fbd72bc365d8b7ea3954d0203bb4c6539cdec8feef30e6f44a3c67b2480e922a70b382bd5642737095c433938529bf 5 | a07796202c3fcad405a5da58d99f0194c8ee21999dd03291f0bfe97e68eb4e69077cf8052b9f5d9cbc4a1394baa0e0d8 6 | 993105d0cff4c3f6a42ab790900a26bb1843f4b07fc83d527a66e4a2ddf6c49ea86fe37b1106dbd20dc280ec5996dadf 7 | b5ed6482bf5486831a9eb445b8b9a77aa6330005b8b432523c69fee7085d3032856de9f857c55ac9745eabcf14894205149cc67393687289e6c2728be69ad1f8ea1a6c0a5a65bf93eca984f3dac5da1abc6f7156ccbc5a33c655f7b17724eb19 8 | a6cc0f01663fd65a95d1359758ebe3a412ce05f4242b0c1f5964351b38e188362a8ceb6c2f86d3f7e5f73b60cd04288005d2a50f8ddf1751d7a915515054276fbae7569c3f18c614c9954177d8e745e98404654cf759d4747b0c806bbd336b7d 9 | b3db03681aaf0d218be32f7cc94bd6a975c6870b4a1d4e461b77b60eee2461ca367154b0c4583b2d5f81124aa21fdf3e09ff6b54ce7c57572283a175fba381a32ac6f46abaf11cdbaeb206dcd7d4269caa4d0ebbb3adc1b8fce42ccfa855ea83 10 | b0e55ab637ca0ed203af268bda8d681c04bd0696cf8cdba4e61c3ba2f3e4fa4ac5a2a7cb93a4a3feaea162506d73222d13caa80d0471afc79e8e5c97b1fccf27e024897545827c654a089d654c1987053b1baaaff3af25c5610d65c3345ae361 11 | 89b8e839c317ab3c735c6a65122fff4654f469c30c480701f6e4d9f311f3c5f3411c7cd2876c539bf56f983d14e550b5172765f62bba1235394a33413c21667a57214e9a6f2516f8d7bf57321c20bf8cd8ecd290691ad6bd5ab9e391304240a4 12 | 95ed6482bf5486831a9eb445b8b9a77aa6330005b8b432523c69fee7085d3032856de9f857c55ac9745eabcf14894205149cc67393687289e6c2728be69ad1f8ea1a6c0a5a65bf93eca984f3dac5da1abc6f7156ccbc5a33c655f7b17724eb19 13 | -------------------------------------------------------------------------------- /cardano-crypto-tests/bls12-381-test-vectors/test_vectors/h2c_large_dst: -------------------------------------------------------------------------------- 1 | 54657374696e67206c61726765206473742e 2 | 62f5804020e6a8e242c736d1c97bcd8262f91b88e1d70b00d10d5e315c8c6501ead0a7e367e5d394b9fcff9c15aa0f6a05e5085fdc56bcdee3865016f1c49b20e1e609a606eccabc9b9199a42345c25e06ae70028397f8fb95576f264239da3eb49629d5efeb1f1d74a3b1ac58608d893f98058f5ab870833489f5dfec52db5f92e70db05c9704cd9d644b1ae16aaafcc173d48db17e207d91308d3045b042b7241f87b8d42ac5df97d94fdf3f29d20ca2ae22c22e9c5b84b48d6daf1f7959c7c71d0169f370ebf2838479b3731885ff0d278deb632fcb83aef0ab593dddd4f5d21dac56abe08b8cb4aaf4235b1a292b91d6e8b90e39dc953c75fc460e7dd6d2bc8a372ac4efce161f5f18f861e67e5717c86805a05cc53ff493e91de2b85d3166b353f5bbc64bae0d2a4787 3 | a16b5778b5b88519b6caf05921d0d9b8b94a33d1daaa0c7fbfa66d52e801a5e798fae840bb9608aa31712e0b1b3a054a 4 | -------------------------------------------------------------------------------- /cardano-crypto-tests/bls12-381-test-vectors/test_vectors/pairing_test_vectors: -------------------------------------------------------------------------------- 1 | 840463aa2f2cda89985b1f3f5eb43b9c29809765d2747d60734b19d6f90610effdfc500af7d458a3e78cee0945ddc669 2 | 8baa4f3fcd895033f93494b040ccd7dfb77cb759cd2e150bfff4264873174509cd22230423b70896b17c8fc3660f6b21 3 | a4a925cb9c0580c14cbc8ec54447eb20070336a61c349c6a64b0d87e4db89d77734021cd88e2da369bdd85c0518c66c4 4 | aecf54083187026a6b689e70af54375ab7cc6d0d311acb6203730a2904654d6e92f82e62006c0d5e21094155eb93cc98 5 | b2bb2433441c452b78f5be911aa136dd2c886a9ac329cb6c805e50d5255891fcc389b1190432f16a109c6f431f0f8023 6 | b67029fbf3ab8e62ab6b499f541537fc07d9466e668392df2bc19762d7dc48b64be09a448cd46dbfe21819a91cd0ab3205f1316ad1cc32853f3f1a1d06497f5cfbc2d753dfc01bff177adeb93f24d452045435dc6eb29f5610b66cd0dd3fb352 7 | a80f311db6f2fdc45404870f4c55b65a9a59a35efcfa2a7c595f3955226076bbaa33e403c0d4749495d9423b806f9dbe08cca770e08fa535daefb6dba2edb62f8b9aff6bae83bf48819bcdf98f07e79de8635e8521ddecae19b01a6777bc4684 8 | 9906a15ff959b496f478dd17348b32c033236db5a7437768a30c5ce87d9b6adfa7bf2223a0721c93a92f33abac9b2faf00d25e48b0f3cc52595264ef9ad0aa7b81e20b3c8634d577883ff5fc2373a021a1e57826f420a74f3ce0fbd2dcf79415 9 | a63be4a1a776cadc7fc2e2d823bcc905f8f9cb0ebe662360d28d9964b022a99ce34a48b2e93cfceebc9bc1d79a3338da03a41393717239e66d4db06a87510b99fe04b0840c87c4051030b25e56ba34248d9ed30c82e8e501a616097299eefd62 10 | 82606f4c771ca685bfc1bb9c51c886d0daa0f63fbb0f6a24b512a1b9b92d401e556cbffdc204c0a85192c865ed73f8090da58ecd1690d5a3b236cc5d40a98988f9602a6d114edb59954ef4e21692f2d48219aeacb964604849336059ceece69f 11 | -------------------------------------------------------------------------------- /cardano-crypto-tests/bls12-381-test-vectors/test_vectors/serde_test_vectors: -------------------------------------------------------------------------------- 1 | 16b8f1d20fe2c13c6248d3d73d4d66d9c8587ac68a7976a3bbb8b5808320607400dbdb1918e3d3b90cfc38c4ddfade990a213d208fbf7898334f4deed7e5830fd266751315435ae19bb94f4d3dc92652f243dd1f96f3595ab473d2356d8fa8f6 2 | 864cc4f64b12ca99ecdd1962572e6add609d9c619aab678b3fc298bc2f0f81feb4f0d3ebad7e850a8bcb52ca467e649d 3 | 9483141c933166b61990a706aca07f467d22bc34c6552f5bba91cb1fc21db51d03dfff6523a5e1b4285d54c47660eda1 4 | 04092fbc9b385639343cf26c9faf845e7a98cb1f2c9306e8200185d95de059f83ad17c4b97f8c62cf6c347dc6eb5f2b10c07b24a20cbcbd5121ba97f906bee018c34a71c6075ec91556ef67edda7e5ca42e3a785a183f630d7e330d7384a9ccd 5 | 14f2c0c96d9f70e48a42cdcdae542bae833eb4a976d4f98410b4a3d77857762d1527ec6714a040baaec3bec41bf9cff00e1cf81ce61e95d97792d7c0db7a88545f10d9b0a5940457018817725da257766906ffbc6172b9c4d2d32a14d00c0d1d01e15280074a4a9fd2d21393f078ef55b16cfea5327993263bffe8e99e56837b2763abd221ed85d83f9187af8b9e928f00deff423fffdadb786e6678a59af305cdc02546d0f8ab4681acc1f00069b0c47bbc9f13d12fd9411f8df532096d53e4 6 | 87861839e602fc5dfa0d0b72232dd81d2b0e4b660a7eba353da27e66ceaf2d6c7734925247281866a12d67752a1edaad01ea59e4e86e2e85a81a573cd68f6dfb526558d81a8f488f261f355ddac23f6caf07d27fda71d8f3968d4ceeda89a09d 7 | 8bd83699f607412448d202d948bb111badd456d68086ff9a5906ea3b2cda4111d3638391f7a7b153eea77ab47215d6fe13b350f59f884c6e31ac087239d9145b816424cba2c8bcb7b3ed7e19638089d91e5c9136d2aefc8da165284b42229a70 8 | 1120dda4e2d4bcc2fb6984277af23a282ceabebfcd847b8e6130b31c1f2febc638de2fb90d366743bcd4147a974235210462011fd256214f85e5591a3574a3003ec2eeff92634fd9fdd3a64dde1ecd92f0beb5f9eeb4697348a60921b6d3feb303a20332decaaa7fab892e34a43c5e6a2e90455a754b92a2cde128c3eeb46e8c9e22f1920d338f5107e86baa934c5c5f11589c6d345e5adefc0cd27d079e22f4d21f6f4a3f764c3d47062299c2f56bf49f5ff7e6cd2966aa3f2c1d125b76049c 9 | -------------------------------------------------------------------------------- /cardano-crypto-tests/src/Bench/Crypto/BenchData.hs: -------------------------------------------------------------------------------- 1 | module Bench.Crypto.BenchData where 2 | 3 | import Data.ByteString (ByteString) 4 | import qualified Data.ByteString as BS 5 | 6 | import Cardano.Crypto.Seed 7 | 8 | testSeed :: Seed 9 | testSeed = mkSeedFromBytes testBytes 10 | 11 | {- FOURMOLU_DISABLE -} 12 | testBytes :: ByteString 13 | testBytes = BS.pack 14 | -- Totally random, determined by fair dice rolls 15 | [ 0xa8, 0x53, 0x16, 0x1f, 0xef, 0x50, 0xc0, 0x6d, 0x7a, 0x21, 0xc1, 0xfa, 0x78, 0x33, 0x96, 0xf1, 16 | 0x7b, 0x2d, 0xa8, 0x4b, 0x5a, 0x7f, 0xe4, 0x49, 0x94, 0x5f, 0xe8, 0x9d, 0xd1, 0x41, 0xc6, 0x05, 17 | 0x03, 0xd9, 0x70, 0x9b, 0xa6, 0xe6, 0x5a, 0xce, 0xde, 0xe5, 0x78, 0x12, 0x87, 0x0f, 0x1d, 0x0d, 18 | 0x8c, 0x64, 0xbb, 0x82, 0xdc, 0xee, 0x31, 0x6c, 0xf0, 0xba, 0xc1, 0xfe, 0x44, 0xb7, 0x5e, 0x36, 19 | 0x86, 0x05, 0x4f, 0xad, 0x13, 0xc4, 0x03, 0x22, 0xd7, 0x07, 0x54, 0xf5, 0x0d, 0xdd, 0x73, 0x2a, 20 | 0x78, 0x75, 0x95, 0xb1, 0x3c, 0xa9, 0x7e, 0x75, 0xc5, 0x3f, 0x45, 0x35, 0x1a, 0xa0, 0x79, 0x44, 21 | 0xf3, 0xc4, 0x4c, 0x58, 0x2f, 0xfc, 0x5f, 0x8b, 0xad, 0x05, 0x2b, 0xbd, 0xcb, 0xfe, 0x2c, 0x83, 22 | 0x90, 0x7a, 0x8f, 0xbb, 0xd4, 0xde, 0xa6, 0x89, 0xc9, 0xb1, 0x70, 0xbe, 0xbc, 0x71, 0x6f, 0x63, 23 | 0xe5, 0xce, 0x21, 0xa6, 0xfd, 0xbf, 0xd6, 0x95, 0x76, 0xf9, 0x4c, 0x48, 0xa2, 0x15, 0xca, 0x2a, 24 | 0x2f, 0x82, 0xb4, 0xcb, 0x12, 0x24, 0x9a, 0x80, 0x66, 0xfc, 0x4e, 0xee, 0xc0, 0x87, 0x84, 0x0e, 25 | 0x37, 0xf2, 0x44, 0x56, 0x2c, 0xec, 0x16, 0xe6, 0x45, 0x3a, 0x2f, 0x5c, 0xa7, 0x71, 0xfb, 0xfc, 26 | 0x68, 0x5b, 0x30, 0x10, 0xac, 0x5f, 0x31, 0x06, 0xa9, 0xc4, 0x5a, 0x6e, 0xf2, 0x86, 0x68, 0xfb, 27 | 0x89, 0xf7, 0x32, 0x37, 0xe1, 0x71, 0xcd, 0x0c, 0xba, 0xfc, 0x03, 0xb9, 0x79, 0x25, 0x35, 0xcb, 28 | 0x3d, 0x77, 0x0a, 0x74, 0x02, 0x49, 0x5f, 0xdf, 0xfa, 0xac, 0xb9, 0x8c, 0xe0, 0xcb, 0x76, 0xfe, 29 | 0xc2, 0x7a, 0x6a, 0xc8, 0xa9, 0xd6, 0x1a, 0xe7, 0x5d, 0xba, 0xc6, 0xee, 0x93, 0x52, 0x60, 0xf2, 30 | 0xd7, 0x51, 0x22, 0xa8, 0x84, 0x29, 0x23, 0x5e, 0x1a, 0x55, 0xb0, 0xe8, 0xf9, 0x82, 0xb8, 0xf4 31 | ] 32 | 33 | typicalMsg :: ByteString 34 | typicalMsg = BS.pack 35 | [ 0x00, 0x1b, 0xbc, 0x93, 0x95, 0x38, 0x05, 0x8e 36 | , 0xaa, 0x88, 0xa2, 0x62, 0xd9, 0x69, 0xfb, 0x36 37 | , 0x39, 0xde, 0x6c, 0xc3, 0x29, 0x6a, 0xf2, 0xd5 38 | , 0xff, 0x0e, 0xbc, 0xf6, 0xac, 0x81, 0xc2, 0x02 39 | ] 40 | {- FOURMOLU_ENABLE -} 41 | -------------------------------------------------------------------------------- /cardano-crypto-tests/src/Bench/Crypto/DSIGN.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE FunctionalDependencies #-} 4 | {-# LANGUAGE MultiParamTypeClasses #-} 5 | {-# LANGUAGE ScopedTypeVariables #-} 6 | {-# LANGUAGE TypeApplications #-} 7 | {-# LANGUAGE TypeFamilies #-} 8 | {-# LANGUAGE TypeOperators #-} 9 | 10 | {- FOURMOLU_DISABLE -} 11 | 12 | module Bench.Crypto.DSIGN 13 | ( benchmarks 14 | ) where 15 | 16 | import Data.Proxy 17 | import Data.ByteString (ByteString) 18 | 19 | import Control.DeepSeq 20 | 21 | import Cardano.Crypto.DSIGN.Class 22 | import Cardano.Crypto.DSIGN.Ed25519 23 | #ifdef SECP256K1_ENABLED 24 | import Cardano.Crypto.DSIGN.EcdsaSecp256k1 25 | import Cardano.Crypto.DSIGN.SchnorrSecp256k1 26 | import Cardano.Crypto.Hash.Blake2b 27 | #endif 28 | 29 | import Criterion 30 | 31 | import Bench.Crypto.BenchData 32 | 33 | 34 | benchmarks :: Benchmark 35 | benchmarks = bgroup "DSIGN" 36 | [ benchDSIGN (Proxy :: Proxy Ed25519DSIGN) "Ed25519" 37 | #ifdef SECP256K1_ENABLED 38 | , benchDSIGN (Proxy :: Proxy EcdsaSecp256k1DSIGN) "EcdsaSecp256k1" 39 | , benchDSIGN (Proxy :: Proxy SchnorrSecp256k1DSIGN) "SchnorrSecp256k1" 40 | #endif 41 | ] 42 | 43 | benchDSIGN :: forall v a 44 | . ( DSIGNAlgorithm v 45 | , ContextDSIGN v ~ () 46 | , Signable v a 47 | , ExampleSignable v a 48 | , NFData (SignKeyDSIGN v) 49 | , NFData (VerKeyDSIGN v) 50 | , NFData (SigDSIGN v) 51 | ) 52 | => Proxy v 53 | -> String 54 | -> Benchmark 55 | benchDSIGN _ lbl = 56 | bgroup lbl 57 | [ bench "genKeyDSIGN" $ 58 | nf (genKeyDSIGN @v) testSeed 59 | 60 | , env (return (genKeyDSIGN @v testSeed)) $ \signKey -> 61 | bench "signDSIGN" $ 62 | nf (signDSIGN @v () (exampleSignable (Proxy @v))) signKey 63 | 64 | , env (let signKey = genKeyDSIGN @v testSeed 65 | verKey = deriveVerKeyDSIGN signKey 66 | sig = signDSIGN @v () (exampleSignable (Proxy @v)) signKey 67 | in return (verKey, sig) 68 | ) $ \ ~(verKey, sig) -> 69 | bench "verifyDSIGN" $ 70 | nf (verifyDSIGN @v () verKey (exampleSignable (Proxy @v))) sig 71 | ] 72 | 73 | -- | A helper class to gloss over the differences in the 'Signable' constraint 74 | -- for different 'DSIGNAlgorithm' instances. Some use 'ByteString', some use 75 | -- 'MessageHash'. 76 | class ExampleSignable v a | v -> a where 77 | exampleSignable :: Signable v a => Proxy v -> a 78 | 79 | instance ExampleSignable Ed25519DSIGN ByteString where 80 | exampleSignable _ = typicalMsg 81 | 82 | #ifdef SECP256K1_ENABLED 83 | instance ExampleSignable EcdsaSecp256k1DSIGN MessageHash where 84 | exampleSignable _ = hashAndPack (Proxy @Blake2b_256) typicalMsg 85 | 86 | instance ExampleSignable SchnorrSecp256k1DSIGN ByteString where 87 | exampleSignable _ = typicalMsg 88 | #endif 89 | -------------------------------------------------------------------------------- /cardano-crypto-tests/src/Bench/Crypto/HASH.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | {-# LANGUAGE ScopedTypeVariables #-} 3 | {-# LANGUAGE TypeApplications #-} 4 | 5 | module Bench.Crypto.HASH ( 6 | benchmarks, 7 | ) where 8 | 9 | import Cardano.Binary 10 | import Data.Proxy 11 | 12 | import Cardano.Crypto.Hash.Blake2b 13 | import Cardano.Crypto.Hash.Class 14 | 15 | import Criterion 16 | 17 | import Bench.Crypto.BenchData 18 | 19 | benchmarks :: Benchmark 20 | benchmarks = 21 | bgroup 22 | "HASH" 23 | [ benchHASH (Proxy @Blake2b_224) "Blake2b_224" 24 | , benchHASH (Proxy @Blake2b_256) "Blake2b_256" 25 | ] 26 | 27 | benchHASH :: 28 | forall proxy h. 29 | HashAlgorithm h => 30 | proxy h -> 31 | [Char] -> 32 | Benchmark 33 | benchHASH _ lbl = 34 | bgroup 35 | lbl 36 | [ bench "hashWith" $ 37 | nf (hashWith @h id) testBytes 38 | , env (return (serialize' (hashWith @h id testBytes))) $ 39 | bench "decodeHash" 40 | . nf (either (error . show) (id @(Hash h ByteString)) . decodeFull') 41 | ] 42 | -------------------------------------------------------------------------------- /cardano-crypto-tests/src/Bench/Crypto/KES.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE PolyKinds #-} 4 | {-# LANGUAGE RankNTypes #-} 5 | {-# LANGUAGE ScopedTypeVariables #-} 6 | {-# LANGUAGE TypeApplications #-} 7 | {-# LANGUAGE TypeFamilies #-} 8 | {-# LANGUAGE TypeOperators #-} 9 | 10 | module Bench.Crypto.KES ( 11 | benchmarks, 12 | ) where 13 | 14 | import Data.Maybe (fromJust) 15 | import Data.Proxy 16 | 17 | import Control.DeepSeq 18 | 19 | import Cardano.Crypto.DSIGN.Ed25519 20 | import Cardano.Crypto.Hash.Blake2b 21 | import Cardano.Crypto.KES.Class 22 | import Cardano.Crypto.KES.CompactSum 23 | import Cardano.Crypto.KES.Sum 24 | 25 | import Cardano.Crypto.Libsodium as NaCl 26 | import Cardano.Crypto.Libsodium.MLockedSeed 27 | import Criterion 28 | import qualified Data.ByteString as BS (ByteString) 29 | import Data.Either (fromRight) 30 | import Data.Kind (Type) 31 | import GHC.TypeLits (KnownNat) 32 | import System.IO.Unsafe (unsafePerformIO) 33 | 34 | import Bench.Crypto.BenchData 35 | 36 | {- HLINT ignore "Use camelCase" -} 37 | 38 | {-# NOINLINE testSeedML #-} 39 | testSeedML :: forall n. KnownNat n => MLockedSeed n 40 | testSeedML = MLockedSeed . unsafePerformIO $ NaCl.mlsbFromByteString testBytes 41 | 42 | benchmarks :: Benchmark 43 | benchmarks = 44 | bgroup 45 | "KES" 46 | [ benchKES @Proxy @(Sum6KES Ed25519DSIGN Blake2b_256) Proxy "Sum6KES" 47 | , benchKES @Proxy @(Sum7KES Ed25519DSIGN Blake2b_256) Proxy "Sum7KES" 48 | , benchKES @Proxy @(CompactSum6KES Ed25519DSIGN Blake2b_256) Proxy "CompactSum6KES" 49 | , benchKES @Proxy @(CompactSum7KES Ed25519DSIGN Blake2b_256) Proxy "CompactSum7KES" 50 | ] 51 | 52 | {-# NOINLINE benchKES #-} 53 | benchKES :: 54 | forall (proxy :: forall k. k -> Type) v. 55 | ( KESAlgorithm v 56 | , ContextKES v ~ () 57 | , Signable v BS.ByteString 58 | , NFData (SignKeyKES v) 59 | , NFData (SigKES v) 60 | ) => 61 | proxy v -> 62 | [Char] -> 63 | Benchmark 64 | benchKES _ lbl = 65 | bgroup 66 | lbl 67 | [ bench "genKey" $ 68 | nfIO $ 69 | genKeyKES @v testSeedML >>= forgetSignKeyKES @v 70 | , bench "signKES" $ 71 | nfIO $ 72 | (\sk -> do sig <- signKES @v () 0 typicalMsg sk; forgetSignKeyKES sk; return sig) 73 | =<< genKeyKES @v testSeedML 74 | , bench "verifyKES" $ 75 | nfIO $ do 76 | signKey <- genKeyKES @v testSeedML 77 | sig <- signKES @v () 0 typicalMsg signKey 78 | verKey <- deriveVerKeyKES signKey 79 | forgetSignKeyKES signKey 80 | return . fromRight $ verifyKES @v () verKey 0 typicalMsg sig 81 | , bench "updateKES" $ 82 | nfIO $ do 83 | signKey <- genKeyKES @v testSeedML 84 | sk' <- fromJust <$> updateKES () signKey 0 85 | forgetSignKeyKES signKey 86 | return sk' 87 | ] 88 | -------------------------------------------------------------------------------- /cardano-crypto-tests/src/Bench/Crypto/VRF.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | {-# LANGUAGE ScopedTypeVariables #-} 3 | {-# LANGUAGE TypeApplications #-} 4 | {-# LANGUAGE TypeFamilies #-} 5 | {-# LANGUAGE TypeOperators #-} 6 | 7 | module Bench.Crypto.VRF ( 8 | benchmarks, 9 | ) where 10 | 11 | import Data.ByteString (ByteString) 12 | import Data.Proxy 13 | 14 | import Control.DeepSeq 15 | 16 | import Cardano.Crypto.VRF.Class 17 | import Cardano.Crypto.VRF.Praos hiding (Seed) 18 | import Cardano.Crypto.VRF.Simple 19 | 20 | import Criterion 21 | 22 | import Bench.Crypto.BenchData 23 | 24 | benchmarks :: Benchmark 25 | benchmarks = 26 | bgroup 27 | "VRF" 28 | [ benchVRF (Proxy @SimpleVRF) "SimpleVRF" 29 | , benchVRF (Proxy @PraosVRF) "PraosVRF" 30 | ] 31 | 32 | benchVRF :: 33 | forall proxy v. 34 | ( VRFAlgorithm v 35 | , ContextVRF v ~ () 36 | , Signable v ByteString 37 | , NFData (CertVRF v) 38 | , NFData (SignKeyVRF v) 39 | , NFData (VerKeyVRF v) 40 | ) => 41 | proxy v -> 42 | [Char] -> 43 | Benchmark 44 | benchVRF _ lbl = 45 | bgroup 46 | lbl 47 | [ bench "genKey" $ 48 | nf (genKeyVRF @v) testSeed 49 | , env (return (genKeyVRF @v testSeed)) $ \signKey -> 50 | bench "eval" $ 51 | nf (evalVRF @v () typicalMsg) signKey 52 | , env 53 | ( let (sk, vk) = genKeyPairVRF @v testSeed 54 | (_output, cert) = evalVRF @v () typicalMsg sk 55 | in return (vk, cert) 56 | ) 57 | $ \ ~(vk, cert) -> 58 | bench "verify" $ 59 | nf (verifyVRF () vk typicalMsg) cert 60 | ] 61 | -------------------------------------------------------------------------------- /cardano-crypto-tests/src/Test/Crypto/AllocLog.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | {-# LANGUAGE GADTs #-} 3 | {-# LANGUAGE MultiParamTypeClasses #-} 4 | {-# LANGUAGE ScopedTypeVariables #-} 5 | 6 | module Test.Crypto.AllocLog where 7 | 8 | import Control.Tracer 9 | import Foreign.Concurrent 10 | import Foreign.Ptr 11 | 12 | import Cardano.Crypto.Libsodium (withMLockedForeignPtr) 13 | import Cardano.Crypto.Libsodium.Memory (MLockedAllocator (..)) 14 | import Cardano.Crypto.Libsodium.Memory.Internal (MLockedForeignPtr (..)) 15 | 16 | -- | Allocation log event. These are emitted automatically whenever mlocked 17 | -- memory is allocated through the 'mlockedAllocForeignPtr' primitive, or 18 | -- released through an associated finalizer (either explicitly or due to GC). 19 | -- Additional events that are not actual allocations/deallocations, but may 20 | -- provide useful debugging context, can be inserted as 'MarkerEv'. 21 | data AllocEvent 22 | = AllocEv !WordPtr 23 | | FreeEv !WordPtr 24 | | MarkerEv !String 25 | deriving (Eq, Show) 26 | 27 | mkLoggingAllocator :: 28 | Tracer IO AllocEvent -> MLockedAllocator IO -> MLockedAllocator IO 29 | mkLoggingAllocator tracer ioAllocator = 30 | MLockedAllocator 31 | { mlAllocate = 32 | \size -> do 33 | sfptr@(SFP fptr) <- mlAllocate ioAllocator size 34 | addr <- withMLockedForeignPtr sfptr (return . ptrToWordPtr) 35 | traceWith tracer (AllocEv addr) 36 | addForeignPtrFinalizer fptr (traceWith tracer (FreeEv addr)) 37 | return sfptr 38 | } 39 | -------------------------------------------------------------------------------- /cardano-crypto-tests/src/Test/Crypto/EqST.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DerivingVia #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE FlexibleInstances #-} 4 | {-# LANGUAGE MultiParamTypeClasses #-} 5 | {-# LANGUAGE StandaloneDeriving #-} 6 | 7 | module Test.Crypto.EqST where 8 | 9 | import Control.Monad.Class.MonadST (MonadST) 10 | import qualified Data.Vector as Vec 11 | import GHC.TypeLits (KnownNat) 12 | 13 | import Cardano.Crypto.DSIGN.Class 14 | import Cardano.Crypto.DSIGN.Ed25519 15 | import Cardano.Crypto.KES.Simple 16 | import Cardano.Crypto.Libsodium.MLockedBytes.Internal 17 | import Cardano.Crypto.Libsodium.MLockedSeed 18 | 19 | -- | Monadic flavor of 'Eq', for things that can only be compared in a monadic 20 | -- context that satisfies 'MonadST'. 21 | -- This is needed because we cannot have a sound 'Eq' instance on mlocked 22 | -- memory types, but we do need to compare them for equality in tests. 23 | class EqST a where 24 | equalsM :: MonadST m => a -> a -> m Bool 25 | 26 | nequalsM :: (MonadST m, EqST a) => a -> a -> m Bool 27 | nequalsM a b = not <$> equalsM a b 28 | 29 | -- | Infix version of 'equalsM' 30 | (==!) :: (MonadST m, EqST a) => a -> a -> m Bool 31 | (==!) = equalsM 32 | 33 | infix 4 ==! 34 | 35 | -- | Infix version of 'nequalsM' 36 | (!=!) :: (MonadST m, EqST a) => a -> a -> m Bool 37 | (!=!) = nequalsM 38 | 39 | infix 4 !=! 40 | 41 | instance EqST a => EqST (Maybe a) where 42 | equalsM Nothing Nothing = pure True 43 | equalsM (Just a) (Just b) = equalsM a b 44 | equalsM _ _ = pure False 45 | 46 | instance (EqST a, EqST b) => EqST (Either a b) where 47 | equalsM (Left x) (Left y) = equalsM x y 48 | equalsM (Right x) (Right y) = equalsM x y 49 | equalsM _ _ = pure False 50 | 51 | instance (EqST a, EqST b) => EqST (a, b) where 52 | equalsM (a, b) (a', b') = (&&) <$> equalsM a a' <*> equalsM b b' 53 | 54 | instance (EqST a, EqST b, EqST c) => EqST (a, b, c) where 55 | equalsM (a, b, c) (a', b', c') = equalsM ((a, b), c) ((a', b'), c') 56 | 57 | instance (EqST a, EqST b, EqST c, EqST d) => EqST (a, b, c, d) where 58 | equalsM (a, b, c, d) (a', b', c', d') = equalsM ((a, b, c), d) ((a', b', c'), d') 59 | 60 | -- TODO: If anyone needs larger tuples, add more instances here... 61 | 62 | -- | Helper newtype, useful for defining 'EqST' in terms of 'Eq' for types that 63 | -- have sound 'Eq' instances, using @DerivingVia@. An 'Applicative' context 64 | -- must be provided for such instances to work, so this will generally require 65 | -- @StandaloneDeriving@ as well. 66 | -- 67 | -- Ex.: @deriving via PureEq Int instance Applicative m => EqST m Int@ 68 | newtype PureEqST a = PureEqST a 69 | 70 | instance Eq a => EqST (PureEqST a) where 71 | equalsM (PureEqST a) (PureEqST b) = pure (a == b) 72 | 73 | instance KnownNat n => EqST (MLockedSizedBytes n) where 74 | equalsM = mlsbEq 75 | 76 | deriving via 77 | MLockedSizedBytes n 78 | instance 79 | KnownNat n => EqST (MLockedSeed n) 80 | 81 | deriving via 82 | (MLockedSizedBytes (SizeSignKeyDSIGN Ed25519DSIGN)) 83 | instance 84 | EqST (SignKeyDSIGNM Ed25519DSIGN) 85 | 86 | instance EqST (SignKeyDSIGNM d) => EqST (SignKeyKES (SimpleKES d t)) where 87 | equalsM (ThunkySignKeySimpleKES a) (ThunkySignKeySimpleKES b) = 88 | -- No need to check that lengths agree, the types already guarantee this. 89 | Vec.and <$> Vec.zipWithM equalsM a b 90 | -------------------------------------------------------------------------------- /cardano-crypto-tests/src/Test/Crypto/Instances.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ScopedTypeVariables #-} 2 | {-# LANGUAGE TypeApplications #-} 3 | {-# OPTIONS_GHC -Wno-orphans #-} 4 | 5 | module Test.Crypto.Instances ( 6 | withMLSBFromPSB, 7 | withMLockedSeedFromPSB, 8 | ) where 9 | 10 | import Cardano.Crypto.Libsodium 11 | import Cardano.Crypto.Libsodium.MLockedSeed 12 | import Cardano.Crypto.PinnedSizedBytes 13 | import Control.Monad.Class.MonadST 14 | import Control.Monad.Class.MonadThrow 15 | import Data.Maybe (mapMaybe) 16 | import Data.Proxy (Proxy (Proxy)) 17 | import GHC.Exts (fromList, fromListN, toList) 18 | import GHC.TypeLits (KnownNat, natVal) 19 | import Test.QuickCheck (Arbitrary (..)) 20 | import qualified Test.QuickCheck.Gen as Gen 21 | 22 | -- We cannot allow this instance, because it doesn't guarantee timely 23 | -- forgetting of the MLocked memory, and in a QuickCheck context, where 24 | -- tens of thousands of these values may be generated, waiting for GC to clean 25 | -- up after us could have us run over our mlock quota. 26 | -- 27 | -- Instead, use 'arbitrary' to generate a suitably sized PinnedSizedBytes 28 | -- value, and then mlsbFromPSB or withMLSBFromPSB to convert it to an 29 | -- MLockedSizedBytes value. 30 | -- 31 | -- instance KnownNat n => Arbitrary (MLockedSizedBytes n) where 32 | -- arbitrary = unsafePerformIO . mlsbFromByteString . BS.pack <$> vectorOf size arbitrary 33 | -- where 34 | -- size :: Int 35 | -- size = fromInteger (natVal (Proxy :: Proxy n)) 36 | 37 | mlsbFromPSB :: (MonadST m, KnownNat n) => PinnedSizedBytes n -> m (MLockedSizedBytes n) 38 | mlsbFromPSB = mlsbFromByteString . psbToByteString 39 | 40 | withMLSBFromPSB :: 41 | (MonadST m, MonadThrow m, KnownNat n) => PinnedSizedBytes n -> (MLockedSizedBytes n -> m a) -> m a 42 | withMLSBFromPSB psb = 43 | bracket 44 | (mlsbFromPSB psb) 45 | mlsbFinalize 46 | 47 | mlockedSeedFromPSB :: (MonadST m, KnownNat n) => PinnedSizedBytes n -> m (MLockedSeed n) 48 | mlockedSeedFromPSB = fmap MLockedSeed . mlsbFromPSB 49 | 50 | withMLockedSeedFromPSB :: 51 | (MonadST m, MonadThrow m, KnownNat n) => PinnedSizedBytes n -> (MLockedSeed n -> m a) -> m a 52 | withMLockedSeedFromPSB psb = 53 | bracket 54 | (mlockedSeedFromPSB psb) 55 | mlockedSeedFinalize 56 | 57 | instance KnownNat n => Arbitrary (PinnedSizedBytes n) where 58 | arbitrary = do 59 | let size :: Int = fromIntegral . natVal $ Proxy @n 60 | Gen.suchThatMap 61 | (fromListN size <$> Gen.vectorOf size arbitrary) 62 | psbFromByteStringCheck 63 | shrink psb = case toList . psbToByteString $ psb of 64 | bytes -> mapMaybe (psbFromByteStringCheck . fromList) . shrink $ bytes 65 | -------------------------------------------------------------------------------- /cardano-crypto-tests/src/Test/Crypto/Regressions.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE TypeApplications #-} 4 | 5 | {- FOURMOLU_DISABLE -} 6 | module Test.Crypto.Regressions ( 7 | tests 8 | ) where 9 | 10 | import Test.Tasty.HUnit (testCase, assertEqual) 11 | import Test.Tasty (TestTree, testGroup) 12 | import Cardano.Crypto.DSIGN (rawDeserialiseVerKeyDSIGN) 13 | import Cardano.Crypto.DSIGN.Ed25519 (Ed25519DSIGN) 14 | import qualified Data.ByteString as BS 15 | #ifdef SECP256K1_ENABLED 16 | import Cardano.Crypto.DSIGN.SchnorrSecp256k1 (SchnorrSecp256k1DSIGN) 17 | #endif 18 | 19 | tests :: TestTree 20 | tests = testGroup "Regressions" [ 21 | testGroup "DSIGN" [ 22 | #ifdef SECP256K1_ENABLED 23 | testGroup "Schnorr serialization" [ 24 | testCase "Schnorr verkey deserialization fails on \"m\" literal" $ do 25 | let actual = rawDeserialiseVerKeyDSIGN @SchnorrSecp256k1DSIGN "m" 26 | assertEqual "" Nothing actual 27 | ], 28 | #endif 29 | testGroup "Ed25519 serialization" [ 30 | testCase "Ed25519 sign key deserialization fails on 33 NUL bytes" $ do 31 | let actual = rawDeserialiseVerKeyDSIGN @Ed25519DSIGN . BS.replicate 33 $ 0 32 | assertEqual "" Nothing actual 33 | ] 34 | ] 35 | ] 36 | -------------------------------------------------------------------------------- /cardano-crypto-tests/src/Test/Crypto/RunIO.hs: -------------------------------------------------------------------------------- 1 | module Test.Crypto.RunIO 2 | where 3 | 4 | import Control.Monad.Identity 5 | 6 | class RunIO m where 7 | io :: m a -> IO a 8 | 9 | instance RunIO IO where 10 | io = id 11 | 12 | instance RunIO Identity where 13 | io = return . runIdentity 14 | -------------------------------------------------------------------------------- /cardano-crypto-tests/src/Test/Crypto/Vector/SerializationUtils.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | {-# LANGUAGE RankNTypes #-} 3 | 4 | module Test.Crypto.Vector.SerializationUtils ( 5 | unHex, 6 | unsafeUnHex, 7 | SignatureResult, 8 | HexStringInCBOR (..), 9 | sKeyParser, 10 | vKeyParser, 11 | sigParser, 12 | dropBytes, 13 | hexByteStringLength, 14 | ) 15 | where 16 | 17 | import Cardano.Binary (FromCBOR, serialize', unsafeDeserialize') 18 | import Cardano.Crypto.DSIGN ( 19 | DSIGNAlgorithm (SigDSIGN, SignKeyDSIGN, VerKeyDSIGN), 20 | ) 21 | import Data.ByteString (ByteString) 22 | import qualified Data.ByteString as BS 23 | import qualified Data.ByteString.Base16 as BS16 24 | import qualified Data.ByteString.Char8 as BS8 25 | import Data.String (IsString (fromString)) 26 | import Prelude hiding (drop) 27 | 28 | -- Wrapper for serialized CBOR ByteString parsed from hex string 29 | newtype HexStringInCBOR = HexCBOR ByteString 30 | 31 | instance IsString HexStringInCBOR where 32 | fromString s = 33 | let bs = unsafeUnHex $ BS8.pack s 34 | cborBs = serialize' bs 35 | in HexCBOR cborBs 36 | 37 | instance Show HexStringInCBOR where 38 | show (HexCBOR bs) = BS8.unpack $ BS16.encode bs 39 | 40 | -- Drop from actual bytestring without cbor then recalculate 41 | dropBytes :: Int -> HexStringInCBOR -> HexStringInCBOR 42 | dropBytes n (HexCBOR bs) = HexCBOR $ serialize' $ BS.drop n (unsafeDeserialize' bs) 43 | 44 | hexByteStringLength :: HexStringInCBOR -> Integer 45 | hexByteStringLength (HexCBOR bs) = toInteger $ BS.length $ unsafeDeserialize' bs 46 | 47 | unHex :: ByteString -> Either String ByteString 48 | unHex = BS16.decode 49 | 50 | unsafeUnHex :: ByteString -> ByteString 51 | unsafeUnHex hexBs = case unHex hexBs of 52 | Left err -> error $ "Couldn't unHex the Hex string. Incorrect format: " ++ err 53 | Right bytes' -> bytes' 54 | 55 | type SignatureResult = (Either String ()) 56 | 57 | sKeyParser :: forall d. FromCBOR (SignKeyDSIGN d) => HexStringInCBOR -> SignKeyDSIGN d 58 | sKeyParser (HexCBOR bs) = unsafeDeserialize' bs 59 | 60 | vKeyParser :: forall d. FromCBOR (VerKeyDSIGN d) => HexStringInCBOR -> VerKeyDSIGN d 61 | vKeyParser (HexCBOR bs) = unsafeDeserialize' bs 62 | 63 | sigParser :: forall d. FromCBOR (SigDSIGN d) => HexStringInCBOR -> SigDSIGN d 64 | sigParser (HexCBOR bs) = unsafeDeserialize' bs 65 | -------------------------------------------------------------------------------- /cardano-crypto-tests/src/Test/Crypto/Vector/StringConstants.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TypeApplications #-} 2 | 3 | module Test.Crypto.Vector.StringConstants ( 4 | invalidEcdsaSigLengthError, 5 | invalidSchnorrVerKeyLengthError, 6 | invalidEcdsaVerKeyLengthError, 7 | invalidSchnorrSigLengthError, 8 | cannotDecodeVerificationKeyError, 9 | unexpectedDecodingError, 10 | ) 11 | where 12 | 13 | import Cardano.Crypto.SECP256K1.Constants ( 14 | SECP256K1_ECDSA_PUBKEY_BYTES, 15 | SECP256K1_ECDSA_SIGNATURE_BYTES, 16 | SECP256K1_SCHNORR_PUBKEY_BYTES, 17 | SECP256K1_SCHNORR_SIGNATURE_BYTES, 18 | ) 19 | import Data.Data (Proxy (Proxy)) 20 | import GHC.TypeLits (natVal) 21 | 22 | invalidEcdsaVerKeyLengthError :: Integer -> String 23 | invalidEcdsaVerKeyLengthError = invalidVerKeyLengthError $ natVal $ Proxy @SECP256K1_ECDSA_PUBKEY_BYTES 24 | 25 | invalidSchnorrVerKeyLengthError :: Integer -> String 26 | invalidSchnorrVerKeyLengthError = invalidVerKeyLengthError $ natVal $ Proxy @SECP256K1_SCHNORR_PUBKEY_BYTES 27 | 28 | invalidVerKeyLengthError :: Integer -> Integer -> String 29 | invalidVerKeyLengthError expectedLength actualLength = 30 | "decodeVerKeyDSIGN: wrong length, expected " 31 | ++ show expectedLength 32 | ++ " bytes but got " 33 | ++ show actualLength 34 | 35 | invalidEcdsaSigLengthError :: Integer -> String 36 | invalidEcdsaSigLengthError = invalidSigLengthError $ natVal $ Proxy @SECP256K1_ECDSA_SIGNATURE_BYTES 37 | 38 | invalidSchnorrSigLengthError :: Integer -> String 39 | invalidSchnorrSigLengthError = invalidSigLengthError $ natVal $ Proxy @SECP256K1_SCHNORR_SIGNATURE_BYTES 40 | 41 | invalidSigLengthError :: Integer -> Integer -> String 42 | invalidSigLengthError expectedLength actualLength = 43 | "decodeSigDSIGN: wrong length, expected " 44 | ++ show expectedLength 45 | ++ " bytes but got " 46 | ++ show actualLength 47 | 48 | cannotDecodeVerificationKeyError :: String 49 | cannotDecodeVerificationKeyError = "decodeVerKeyDSIGN: cannot decode key" 50 | 51 | unexpectedDecodingError :: String 52 | unexpectedDecodingError = "Test failed. Unexpected decoding error encountered." 53 | -------------------------------------------------------------------------------- /cardano-crypto-tests/test/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | 3 | {- FOURMOLU_DISABLE -} 4 | module Main (main) where 5 | 6 | import qualified Test.Crypto.DSIGN 7 | import qualified Test.Crypto.Hash 8 | import qualified Test.Crypto.KES 9 | import qualified Test.Crypto.VRF 10 | import qualified Test.Crypto.Regressions 11 | #ifdef SECP256K1_ENABLED 12 | import qualified Test.Crypto.Vector.Secp256k1DSIGN 13 | #endif 14 | import qualified Test.Crypto.EllipticCurve 15 | import Test.Tasty (TestTree, adjustOption, testGroup, defaultMain) 16 | import Test.Tasty.QuickCheck (QuickCheckTests (QuickCheckTests)) 17 | import Cardano.Crypto.Libsodium (sodiumInit) 18 | import Test.Crypto.Util (Lock, mkLock) 19 | 20 | main :: IO () 21 | main = do 22 | sodiumInit 23 | 24 | -- This lock is used to prevent tests that use mlocking from running 25 | -- concurrently. Concurrent execution of these tests can cause the testsuite 26 | -- to exhaust mlock quota; but each individual test on its own should be 27 | -- fine. 28 | mlockLock <- mkLock 29 | 30 | defaultMain (tests mlockLock) 31 | 32 | tests :: Lock -> TestTree 33 | tests mlockLock = 34 | -- The default QuickCheck test count is 100. This is too few to catch 35 | -- anything, so we set a minimum of 1000. 36 | adjustOption (\(QuickCheckTests i) -> QuickCheckTests $ max i 1000) . 37 | testGroup "cardano-crypto-class" $ 38 | [ Test.Crypto.DSIGN.tests mlockLock 39 | , Test.Crypto.Hash.tests mlockLock 40 | , Test.Crypto.KES.tests mlockLock 41 | , Test.Crypto.VRF.tests 42 | , Test.Crypto.Regressions.tests 43 | #ifdef SECP256K1_ENABLED 44 | , Test.Crypto.Vector.Secp256k1DSIGN.tests 45 | #endif 46 | , Test.Crypto.EllipticCurve.tests 47 | ] 48 | -------------------------------------------------------------------------------- /cardano-crypto-tests/test_vectors/vrf_ver03_generated_1: -------------------------------------------------------------------------------- 1 | vrf: PraosVRF 2 | ver: ietfdraft03 3 | ciphersuite: ECVRF-ED25519-SHA512-Elligator2 4 | sk: 0000000000000000000000000000000000000000000000000000000000000000 5 | pk: 3b6a27bcceb6a42d62a3a8d02a6f0d73653215771de243a63ac048a18b59da29 6 | alpha: 00 7 | pi: 000f006e64c91f84212919fe0899970cd341206fc081fe599339c8492e2cea3299ae9de4b6ce21cda0a975f65f45b70f82b3952ba6d0dbe11a06716e67aca233c0d78f115a655aa1952ada9f3d692a0a 8 | beta: 9930b5dddc0938f01cf6f9746eded569ee676bd6ff3b4f19233d74b903ec53a45c5728116088b7c622b6d6c354f7125c7d09870b56ec6f1e4bf4970f607e04b2 9 | -------------------------------------------------------------------------------- /cardano-crypto-tests/test_vectors/vrf_ver03_generated_2: -------------------------------------------------------------------------------- 1 | vrf: PraosVRF 2 | ver: ietfdraft03 3 | ciphersuite: ECVRF-ED25519-SHA512-Elligator2 4 | sk: 0000000000000000000000000000000000000000000000000000000000000000 5 | pk: 3b6a27bcceb6a42d62a3a8d02a6f0d73653215771de243a63ac048a18b59da29 6 | alpha: 00010203040506070809 7 | pi: 0031f929352875995e3d55c4abdac7bfb92e706beb182999dd7d78f61e1bdc3f83b746a9ae6caee317a7c47597ece1801799c06ca2180cdb5392677cd8815353c1d0d5691956b3be52b322be049fc20c 8 | beta: ca4171883d173a3f03bdb87c45ce349f0bb168ca8171d64f9b9aeaf20d0869bab9f74e819ccdc6754656468ccc2aa85e5f903a31375a39be84464fa515b51512 9 | -------------------------------------------------------------------------------- /cardano-crypto-tests/test_vectors/vrf_ver03_generated_3: -------------------------------------------------------------------------------- 1 | vrf: PraosVRF 2 | ver: ietfdraft03 3 | ciphersuite: ECVRF-ED25519-SHA512-Elligator2 4 | sk: a70b8f607568df8ae26cf438b1057d8d0a94b7f3ac44cd984577fc43c2da55b7 5 | pk: f1eb347d5c59e24f9f5f33c80cfd866e79fd72e0c370da3c011b1c9f045e23f1 6 | alpha: 00 7 | pi: aa349327d919c8c96de316855de6fe5fa841ef25af913cfb9b33d6b663c425bd024456ca193f10da319a2205c67222e8a62da87101904f453de0beb79568902cedeea891f3db8202690f51c8e7d3210b 8 | beta: d4b4deef941fc3ece4e86f837c784951b4a0cbc4accd79cdcbc882123befeb17c63b329730c59bbe9253294496f730428d588b9221832cb336bfd9d67754030f 9 | -------------------------------------------------------------------------------- /cardano-crypto-tests/test_vectors/vrf_ver03_generated_4: -------------------------------------------------------------------------------- 1 | vrf: PraosVRF 2 | ver: ietfdraft03 3 | ciphersuite: ECVRF-ED25519-SHA512-Elligator2 4 | sk: a70b8f607568df8ae26cf438b1057d8d0a94b7f3ac44cd984577fc43c2da55b7 5 | pk: f1eb347d5c59e24f9f5f33c80cfd866e79fd72e0c370da3c011b1c9f045e23f1 6 | alpha: 00010203040506070809 7 | pi: 989c0c477b4a0c07e0dabd7b73cdb42beb4b4e09471377e6d0b75e8ffd5d091704394c5ea4e2be5d5244b02c03cf85984adfa12c61280bc8c6e46f02035ee57d6cd18b96695ea04ff5ec541869ea890a 8 | beta: 933f886e8648796a968dccc71a3ce09a8026b28fdf5ffcc50be4b97431f3e3904375870b0bd196509dc33606846bb14820acdf36170e1667dbe9d3a940717bbd 9 | -------------------------------------------------------------------------------- /cardano-crypto-tests/test_vectors/vrf_ver03_standard_10: -------------------------------------------------------------------------------- 1 | vrf: PraosVRF 2 | ver: ietfdraft03 3 | ciphersuite: ECVRF-ED25519-SHA512-Elligator2 4 | sk: 9d61b19deffd5a60ba844af492ec2cc44449c5697b326919703bac031cae7f60 5 | pk: d75a980182b10ab7d54bfed3c964073a0ee172f3daa62325af021a68f707511a 6 | alpha: empty 7 | pi: b6b4699f87d56126c9117a7da55bd0085246f4c56dbc95d20172612e9d38e8d7ca65e573a126ed88d4e30a46f80a666854d675cf3ba81de0de043c3774f061560f55edc256a787afe701677c0f602900 8 | beta: 5b49b554d05c0cd5a5325376b3387de59d924fd1e13ded44648ab33c21349a603f25b84ec5ed887995b33da5e3bfcb87cd2f64521c4c62cf825cffabbe5d31cc 9 | -------------------------------------------------------------------------------- /cardano-crypto-tests/test_vectors/vrf_ver03_standard_11: -------------------------------------------------------------------------------- 1 | vrf: PraosVRF 2 | ver: ietfdraft03 3 | ciphersuite: ECVRF-ED25519-SHA512-Elligator2 4 | sk: 4ccd089b28ff96da9db6c346ec114e0f5b8a319f35aba624da8cf6ed4fb8a6fb 5 | pk: 3d4017c3e843895a92b70aa74d1b7ebc9c982ccf2ec4968cc0cd55f12af4660c 6 | alpha: 72 7 | pi: ae5b66bdf04b4c010bfe32b2fc126ead2107b697634f6f7337b9bff8785ee111200095ece87dde4dbe87343f6df3b107d91798c8a7eb1245d3bb9c5aafb093358c13e6ae1111a55717e895fd15f99f07 8 | beta: 94f4487e1b2fec954309ef1289ecb2e15043a2461ecc7b2ae7d4470607ef82eb1cfa97d84991fe4a7bfdfd715606bc27e2967a6c557cfb5875879b671740b7d8 9 | -------------------------------------------------------------------------------- /cardano-crypto-tests/test_vectors/vrf_ver03_standard_12: -------------------------------------------------------------------------------- 1 | vrf: PraosVRF 2 | ver: ietfdraft03 3 | ciphersuite: ECVRF-ED25519-SHA512-Elligator2 4 | sk: c5aa8df43f9f837bedb7442f31dcb7b166d38535076f094b85ce3a2e0b4458f7 5 | pk: fc51cd8e6218a1a38da47ed00230f0580816ed13ba3303ac5deb911548908025 6 | alpha: af82 7 | pi: dfa2cba34b611cc8c833a6ea83b8eb1bb5e2ef2dd1b0c481bc42ff36ae7847f6ab52b976cfd5def172fa412defde270c8b8bdfbaae1c7ece17d9833b1bcf31064fff78ef493f820055b561ece45e1009 8 | beta: 2031837f582cd17a9af9e0c7ef5a6540e3453ed894b62c293686ca3c1e319dde9d0aa489a4b59a9594fc2328bc3deff3c8a0929a369a72b1180a596e016b5ded 9 | -------------------------------------------------------------------------------- /cardano-crypto-tests/test_vectors/vrf_ver13_generated_1: -------------------------------------------------------------------------------- 1 | vrf: PraosBatchCompatVRF 2 | ver: ietfdraft13 3 | ciphersuite: ECVRF-ED25519-SHA512-Elligator2 4 | sk: 0000000000000000000000000000000000000000000000000000000000000000 5 | pk: 3b6a27bcceb6a42d62a3a8d02a6f0d73653215771de243a63ac048a18b59da29 6 | alpha: 00 7 | pi: 93d70c5ed59ccb21ca9991be561756939ff9753bf85764d2a7b937d6fbf9183443cd118bee8a0f61e8bdc5403c03d6c94ead31956e98bfd6a5e02d3be5900d17a540852d586f0891caed3e3b0e0871d6a741fb0edcdb586f7f10252f79c35176474ece4936e0190b5167832c10712884ad12acdfff2e434aacb165e1f789660f 8 | beta: 9a4d34f87003412e413ca42feba3b6158bdf11db41c2bbde98961c5865400cfdee07149b928b376db365c5d68459378b0981f1cb0510f1e0c194c4a17603d44d 9 | -------------------------------------------------------------------------------- /cardano-crypto-tests/test_vectors/vrf_ver13_generated_2: -------------------------------------------------------------------------------- 1 | vrf: PraosBatchCompatVRF 2 | ver: ietfdraft13 3 | ciphersuite: ECVRF-ED25519-SHA512-Elligator2 4 | sk: 0000000000000000000000000000000000000000000000000000000000000000 5 | pk: 3b6a27bcceb6a42d62a3a8d02a6f0d73653215771de243a63ac048a18b59da29 6 | alpha: 00010203040506070809 7 | pi: 235d7f05374c05e2ca22017575c572d708b0fbd22c90d1ca5a94d0596b28a6cbd2e5de31550e43281ebe23b7b1393e166b796a1193ff3cb41900082688a191a8ee8431e51c0a007a5860f8e72a9a1ed4aa1535d3161b462bf8a0bc54dae8df5920598aeb7752acfdfe56a158e754d9ee48e345aa65128348d0dc7953add5ad0a 8 | beta: a8ad413d234680303a14203ca624cabe5f061798a7c248f687883993b1ac7cf808868efcc47f5cf565bca51cb95cb7d8d18f2eb4c7ad3e648c369b477a7d45cd 9 | -------------------------------------------------------------------------------- /cardano-crypto-tests/test_vectors/vrf_ver13_generated_3: -------------------------------------------------------------------------------- 1 | vrf: PraosBatchCompatVRF 2 | ver: ietfdraft13 3 | ciphersuite: ECVRF-ED25519-SHA512-Elligator2 4 | sk: a70b8f607568df8ae26cf438b1057d8d0a94b7f3ac44cd984577fc43c2da55b7 5 | pk: f1eb347d5c59e24f9f5f33c80cfd866e79fd72e0c370da3c011b1c9f045e23f1 6 | alpha: 00 7 | pi: fe7fe305611dbd8402bf580ceaa4775b573a3be110bc30901880cfd81903852b306d432fc2d197b79a690ba8af62d166134ad57ec546b4675554207465e5d92d5570ba7336636f78afdf4ed2362c220572c2735752b975773ec3289c803689cbfa9b8d841d2e603e3d9376c9c884a156c70cfd0a4293cc4edcd8902da8972f04 8 | beta: 05cff584ea083ae01537fc43a2456f70cbd0d1abc60b8f62170b83b647a0022840c27f747134e16641428d6cc6f66675b13fff7f975a5c6891172360417ac62d 9 | -------------------------------------------------------------------------------- /cardano-crypto-tests/test_vectors/vrf_ver13_generated_4: -------------------------------------------------------------------------------- 1 | vrf: PraosBatchCompatVRF 2 | ver: ietfdraft13 3 | ciphersuite: ECVRF-ED25519-SHA512-Elligator2 4 | sk: a70b8f607568df8ae26cf438b1057d8d0a94b7f3ac44cd984577fc43c2da55b7 5 | pk: f1eb347d5c59e24f9f5f33c80cfd866e79fd72e0c370da3c011b1c9f045e23f1 6 | alpha: 00010203040506070809 7 | pi: 2ad402fec38563095e0a355fe580084812d7728f613da256ddd01140c29d5ec9f76dcef18ef955bf74db970736e12b50968444fd7e69ebd15b83cbd27bb6cc27d49a39e8eb6c1242d9ccc9c0bab9eebbdd81eed1571316e2f9644fda6519e6740556a8d28c38ccddb23978d2e1c180afacea6e7fff589772ff10a1ea5cfc8700 8 | beta: 52f6d5f46c02df6231503b8ef6dbf870726235e41063e8698d69a72c17c05040e0cfe86215f4497747dff787a03470d285d05f5a7c88d545e2e28baf2ceeaa2a 9 | -------------------------------------------------------------------------------- /cardano-crypto-tests/test_vectors/vrf_ver13_standard_10: -------------------------------------------------------------------------------- 1 | vrf: PraosBatchCompatVRF 2 | ver: ietfdraft13 3 | ciphersuite: ECVRF-ED25519-SHA512-Elligator2 4 | sk: 9d61b19deffd5a60ba844af492ec2cc44449c5697b326919703bac031cae7f60 5 | pk: d75a980182b10ab7d54bfed3c964073a0ee172f3daa62325af021a68f707511a 6 | alpha: empty 7 | pi: 7d9c633ffeee27349264cf5c667579fc583b4bda63ab71d001f89c10003ab46f762f5c178b68f0cddcc1157918edf45ec334ac8e8286601a3256c3bbf858edd94652eba1c4612e6fce762977a59420b451e12964adbe4fbecd58a7aeff5860afcafa73589b023d14311c331a9ad15ff2fb37831e00f0acaa6d73bc9997b06501 8 | beta: 9d574bf9b8302ec0fc1e21c3ec5368269527b87b462ce36dab2d14ccf80c53cccf6758f058c5b1c856b116388152bbe509ee3b9ecfe63d93c3b4346c1fbc6c54 9 | -------------------------------------------------------------------------------- /cardano-crypto-tests/test_vectors/vrf_ver13_standard_11: -------------------------------------------------------------------------------- 1 | vrf: PraosBatchCompatVRF 2 | ver: ietfdraft13 3 | ciphersuite: ECVRF-ED25519-SHA512-Elligator2 4 | sk: 4ccd089b28ff96da9db6c346ec114e0f5b8a319f35aba624da8cf6ed4fb8a6fb 5 | pk: 3d4017c3e843895a92b70aa74d1b7ebc9c982ccf2ec4968cc0cd55f12af4660c 6 | alpha: 72 7 | pi: 47b327393ff2dd81336f8a2ef10339112401253b3c714eeda879f12c509072ef8ec26e77b8cb3114dd2265fe1564a4efb40d109aa3312536d93dfe3d8d80a061fe799eb5770b4e3a5a27d22518bb631db183c8316bb552155f442c62a47d1c8bd60e93908f93df1623ad78a86a028d6bc064dbfc75a6a57379ef855dc6733801 8 | beta: 38561d6b77b71d30eb97a062168ae12b667ce5c28caccdf76bc88e093e4635987cd96814ce55b4689b3dd2947f80e59aac7b7675f8083865b46c89b2ce9cc735 9 | -------------------------------------------------------------------------------- /cardano-crypto-tests/test_vectors/vrf_ver13_standard_12: -------------------------------------------------------------------------------- 1 | vrf: PraosBatchCompatVRF 2 | ver: ietfdraft13 3 | ciphersuite: ECVRF-ED25519-SHA512-Elligator2 4 | sk: c5aa8df43f9f837bedb7442f31dcb7b166d38535076f094b85ce3a2e0b4458f7 5 | pk: fc51cd8e6218a1a38da47ed00230f0580816ed13ba3303ac5deb911548908025 6 | alpha: af82 7 | pi: 926e895d308f5e328e7aa159c06eddbe56d06846abf5d98c2512235eaa57fdcea012f35433df219a88ab0f9481f4e0065d00422c3285f3d34a8b0202f20bac60fb613986d171b3e98319c7ca4dc44c5dd8314a6e5616c1a4f16ce72bd7a0c25a374e7ef73027e14760d42e77341fe05467bb286cc2c9d7fde29120a0b2320d04 8 | beta: 121b7f9b9aaaa29099fc04a94ba52784d44eac976dd1a3cca458733be5cd090a7b5fbd148444f17f8daf1fb55cb04b1ae85a626e30a54b4b0f8abf4a43314a58 9 | -------------------------------------------------------------------------------- /cardano-git-rev/NOTICE: -------------------------------------------------------------------------------- 1 | Copyright 2022-2023 Input Output Global Inc (IOG). 2 | 3 | Licensed under the Apache License, Version 2.0 (the "License"); 4 | you may not use this file except in compliance with the License. 5 | You may obtain a copy of the License at 6 | 7 | http://www.apache.org/licenses/LICENSE-2.0 8 | 9 | Unless required by applicable law or agreed to in writing, software 10 | distributed under the License is distributed on an "AS IS" BASIS, 11 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | See the License for the specific language governing permissions and 13 | limitations under the License. 14 | 15 | -------------------------------------------------------------------------------- /cardano-git-rev/README.md: -------------------------------------------------------------------------------- 1 | # Cardano Git Rev 2 | 3 | This package exposes functions to provide git information for `cardano-node`. 4 | 5 | `cardano-node` support building via `nix` and `cabal` 6 | 7 | When building with `nix` the git executable and git metadata isn't available so the 8 | git revision is embedded as a series of 40 zeros during the build. After the nix build 9 | is finished the executable is patched with the correct git sha. See [set-git-rev.hs][set-git-rev.hs] 10 | 11 | [set-git-rev.hs]: https://github.com/input-output-hk/iohk-nix/blob/master/overlays/haskell-nix-extra/utils/set-git-rev.hs 12 | -------------------------------------------------------------------------------- /cardano-git-rev/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /cardano-git-rev/cardano-git-rev.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 3.0 2 | name: cardano-git-rev 3 | version: 0.2.2.0 4 | synopsis: Git revisioning 5 | description: Embeds git revision into Haskell packages. 6 | category: 7 | Cardano, 8 | Versioning, 9 | 10 | copyright: 2022-2023 Input Output Global Inc (IOG). 11 | author: IOHK 12 | maintainer: operations@iohk.io 13 | license: Apache-2.0 14 | license-files: 15 | LICENSE 16 | NOTICE 17 | 18 | build-type: Simple 19 | extra-source-files: README.md 20 | 21 | common project-config 22 | default-language: Haskell2010 23 | build-depends: base >=4.14 && <5 24 | ghc-options: 25 | -Wall 26 | -Wcompat 27 | -Wincomplete-record-updates 28 | -Wincomplete-uni-patterns 29 | -Wpartial-fields 30 | -Wredundant-constraints 31 | -Wunused-packages 32 | 33 | library 34 | import: project-config 35 | hs-source-dirs: src 36 | c-sources: cbits/rev.c 37 | exposed-modules: Cardano.Git.Rev 38 | build-depends: 39 | process, 40 | template-haskell, 41 | text, 42 | -------------------------------------------------------------------------------- /cardano-git-rev/cbits/rev.c: -------------------------------------------------------------------------------- 1 | // 2 | char _cardano_git_rev[68] 3 | = "fe" 4 | "gitrev" 5 | "0000000000" 6 | "0000000040" 7 | "0000000000" 8 | "0000000000" 9 | "0000000000" 10 | "0000000000" 11 | ; -------------------------------------------------------------------------------- /cardano-git-rev/src/Cardano/Git/Rev.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE ForeignFunctionInterface #-} 3 | {-# LANGUAGE MultiWayIf #-} 4 | {-# LANGUAGE OverloadedStrings #-} 5 | 6 | {- FOURMOLU_DISABLE -} 7 | 8 | #if __GLASGOW_HASKELL__ >= 900 9 | {-# LANGUAGE TemplateHaskellQuotes #-} 10 | #else 11 | -- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/2288 12 | {-# LANGUAGE TemplateHaskell #-} 13 | #endif 14 | 15 | module Cardano.Git.Rev 16 | ( gitRev 17 | ) where 18 | 19 | import Data.Text (Text) 20 | import qualified Data.Text as Text 21 | 22 | import Foreign.C.String (CString) 23 | import GHC.Foreign (peekCStringLen) 24 | import Language.Haskell.TH (Exp, Q) 25 | import qualified Language.Haskell.TH as TH 26 | import qualified Language.Haskell.TH.Syntax as TH 27 | import System.IO (utf8) 28 | import System.IO.Unsafe (unsafeDupablePerformIO) 29 | 30 | #if !defined(arm_HOST_ARCH) 31 | import Control.Exception (catch) 32 | import System.Exit (ExitCode (..)) 33 | import qualified System.IO as IO 34 | import System.IO.Error (isDoesNotExistError) 35 | import System.Process (readProcessWithExitCode) 36 | #endif 37 | 38 | foreign import ccall "&_cardano_git_rev" c_gitrev :: CString 39 | 40 | -- This must be a TH splice to ensure the git commit is captured at build time. 41 | -- ie called as `$(gitRev)`. 42 | gitRev :: Q Exp 43 | gitRev = 44 | [| if 45 | | gitRevEmbed /= zeroRev -> gitRevEmbed 46 | | otherwise -> $(textE =<< TH.runIO runGitRevParse) 47 | |] 48 | 49 | -- Git revision embedded after compilation using 50 | -- Data.FileEmbed.injectWith. If nothing has been injected, 51 | -- this will be filled with 0 characters. 52 | gitRevEmbed :: Text 53 | gitRevEmbed = Text.pack $ drop 28 $ unsafeDupablePerformIO (peekCStringLen utf8 (c_gitrev, 68)) 54 | 55 | runGitRevParse :: IO Text 56 | #if defined(arm_HOST_ARCH) 57 | -- cross compiling to arm fails; due to a linker bug 58 | runGitRevParse = pure zeroRev 59 | #else 60 | runGitRevParse = do 61 | (exitCode, output, errorMessage) <- readProcessWithExitCode_ "git" ["rev-parse", "--verify", "HEAD"] "" 62 | case exitCode of 63 | ExitSuccess -> pure $ Text.strip (Text.pack output) 64 | ExitFailure _ -> do 65 | IO.hPutStrLn IO.stderr $ "WARNING: " ++ errorMessage 66 | pure zeroRev 67 | where 68 | readProcessWithExitCode_ :: FilePath -> [String] -> String -> IO (ExitCode, String, String) 69 | readProcessWithExitCode_ cmd args input = 70 | catch (readProcessWithExitCode cmd args input) $ \e -> 71 | if isDoesNotExistError e 72 | then pure (ExitFailure 127, "", show e) 73 | else pure (ExitFailure 999, "", show e) 74 | #endif 75 | 76 | textE :: Text -> Q Exp 77 | textE = TH.lift 78 | 79 | zeroRev :: Text 80 | zeroRev = "0000000000000000000000000000000000000000" 81 | -------------------------------------------------------------------------------- /cardano-slotting/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Changelog for `cardano-slotting` 2 | 3 | ## 0.2.0.1 4 | 5 | * 6 | 7 | ## 0.2.0.0 8 | 9 | * Add `EpochInterval` and `addEpochInterval` from `cardano-ledger`. 10 | * Add `binOpEpochNo` helper function to facilitate binary operations on 11 | `EpochNo`. 12 | * Remove numeric instances (`Num`, `Integral`, `Real`) of `EpochNo` and 13 | `EpochSize` for safety. 14 | They are still available for testing from the `testlib` as orphans. 15 | * New `Test.Cardano.Slotting.TreeDiff` module extracted from 16 | `cardano-ledger-binary`. It lives in a new public sublibrary `testlib`. 17 | 18 | ### `testlib` 19 | 20 | * Add numeric instances (`Num`, `Integral`, `Real`) of `EpochNo` and 21 | `EpochSize` as orphans. 22 | 23 | ## 0.1.1.1 24 | 25 | * GHC-9.6 compatibility 26 | 27 | ## 0.1.1.0 28 | 29 | * Remove `development` flag: #372 30 | * Addition of `ToJSON`/`FromJSON` instances for: 31 | * `WithOrigin` 32 | * `BlockNo` 33 | * `SystemStart` 34 | * `RelativeTime` and `SlotLength` 35 | 36 | ## 0.1.0.1 37 | 38 | * Initial release 39 | -------------------------------------------------------------------------------- /cardano-slotting/NOTICE: -------------------------------------------------------------------------------- 1 | Copyright 2019-2021 Input Output (Hong Kong) Ltd. 2 | 3 | Licensed under the Apache License, Version 2.0 (the "License"); 4 | you may not use this file except in compliance with the License. 5 | You may obtain a copy of the License at 6 | 7 | http://www.apache.org/licenses/LICENSE-2.0 8 | 9 | Unless required by applicable law or agreed to in writing, software 10 | distributed under the License is distributed on an "AS IS" BASIS, 11 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | See the License for the specific language governing permissions and 13 | limitations under the License. 14 | -------------------------------------------------------------------------------- /cardano-slotting/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /cardano-slotting/cardano-slotting.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 3.0 2 | name: cardano-slotting 3 | version: 0.2.0.0 4 | synopsis: Key slotting types for cardano libraries 5 | license: Apache-2.0 6 | license-files: 7 | LICENSE 8 | NOTICE 9 | 10 | author: IOHK Formal Methods Team 11 | maintainer: formal.methods@iohk.io 12 | copyright: IOHK 13 | build-type: Simple 14 | extra-source-files: CHANGELOG.md 15 | 16 | common base 17 | build-depends: base >=4.14 && <5 18 | 19 | common project-config 20 | default-language: Haskell2010 21 | ghc-options: 22 | -Wall 23 | -Wcompat 24 | -Wincomplete-record-updates 25 | -Wincomplete-uni-patterns 26 | -Wredundant-constraints 27 | -Wunused-packages 28 | 29 | library 30 | import: base, project-config 31 | hs-source-dirs: src 32 | exposed-modules: 33 | Cardano.Slotting.Block 34 | Cardano.Slotting.EpochInfo 35 | Cardano.Slotting.EpochInfo.API 36 | Cardano.Slotting.EpochInfo.Extend 37 | Cardano.Slotting.EpochInfo.Impl 38 | Cardano.Slotting.Slot 39 | Cardano.Slotting.Time 40 | 41 | build-depends: 42 | aeson, 43 | base, 44 | cardano-binary, 45 | deepseq, 46 | mmorph, 47 | nothunks, 48 | quiet, 49 | serialise, 50 | time, 51 | 52 | library testlib 53 | import: base, project-config 54 | visibility: public 55 | hs-source-dirs: testlib 56 | exposed-modules: 57 | Test.Cardano.Slotting.Arbitrary 58 | Test.Cardano.Slotting.Numeric 59 | Test.Cardano.Slotting.TreeDiff 60 | 61 | build-depends: 62 | QuickCheck, 63 | base, 64 | cardano-slotting, 65 | tree-diff, 66 | 67 | test-suite tests 68 | import: base, project-config 69 | type: exitcode-stdio-1.0 70 | hs-source-dirs: test 71 | main-is: Main.hs 72 | other-modules: Test.Cardano.Slotting.EpochInfo 73 | build-depends: 74 | base, 75 | cardano-slotting, 76 | tasty, 77 | tasty-quickcheck, 78 | 79 | ghc-options: 80 | -threaded 81 | -rtsopts 82 | -with-rtsopts=-N 83 | -------------------------------------------------------------------------------- /cardano-slotting/src/Cardano/Slotting/Block.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | {-# LANGUAGE DerivingVia #-} 3 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 4 | 5 | module Cardano.Slotting.Block ( 6 | BlockNo (..), 7 | ) 8 | where 9 | 10 | import Cardano.Binary (FromCBOR (..), ToCBOR (..)) 11 | import Codec.Serialise (Serialise (..)) 12 | import Control.DeepSeq (NFData) 13 | import Data.Aeson (FromJSON, ToJSON) 14 | import Data.Word (Word64) 15 | import GHC.Generics (Generic) 16 | import NoThunks.Class (NoThunks) 17 | import Quiet (Quiet (..)) 18 | 19 | -- | The 0-based index of the block in the blockchain. 20 | -- BlockNo is <= SlotNo and is only equal at slot N if there is a block 21 | -- for every slot where N <= SlotNo. 22 | newtype BlockNo = BlockNo {unBlockNo :: Word64} 23 | deriving stock (Eq, Ord, Generic) 24 | deriving (Show) via Quiet BlockNo 25 | deriving newtype (Enum, Bounded, Num, Serialise, NoThunks, NFData, ToJSON, FromJSON) 26 | 27 | instance ToCBOR BlockNo where 28 | toCBOR = encode 29 | encodedSizeExpr size = encodedSizeExpr size . fmap unBlockNo 30 | 31 | instance FromCBOR BlockNo where 32 | fromCBOR = decode 33 | -------------------------------------------------------------------------------- /cardano-slotting/src/Cardano/Slotting/EpochInfo.hs: -------------------------------------------------------------------------------- 1 | module Cardano.Slotting.EpochInfo ( 2 | module Cardano.Slotting.EpochInfo.API, 3 | module Cardano.Slotting.EpochInfo.Impl, 4 | ) 5 | where 6 | 7 | import Cardano.Slotting.EpochInfo.API 8 | import Cardano.Slotting.EpochInfo.Impl 9 | -------------------------------------------------------------------------------- /cardano-slotting/src/Cardano/Slotting/EpochInfo/Extend.hs: -------------------------------------------------------------------------------- 1 | module Cardano.Slotting.EpochInfo.Extend where 2 | 3 | import Cardano.Slotting.EpochInfo.API (EpochInfo (..)) 4 | import Cardano.Slotting.Slot ( 5 | EpochNo (EpochNo), 6 | EpochSize (EpochSize), 7 | SlotNo (SlotNo), 8 | binOpEpochNo, 9 | ) 10 | import Cardano.Slotting.Time ( 11 | SlotLength (getSlotLength), 12 | addRelativeTime, 13 | multNominalDiffTime, 14 | ) 15 | 16 | -- | Given a basis point, use it and its slot length to impute a linear 17 | -- relationship between slots and time in order to extend an 'EpochInfo' to 18 | -- infinity. 19 | -- 20 | -- The returned `EpochInfo` may still fail (according to the semantics of the 21 | -- specified monad) if any of the underlying operations fail. For example, if we 22 | -- cannot translate the basis point. 23 | unsafeLinearExtendEpochInfo :: 24 | Monad m => 25 | SlotNo -> 26 | EpochInfo m -> 27 | EpochInfo m 28 | unsafeLinearExtendEpochInfo basisSlot underlyingEI = 29 | let lastKnownEpochM = epochInfoEpoch_ underlyingEI basisSlot 30 | 31 | goSize = \en -> do 32 | lke <- lastKnownEpochM 33 | if en <= lke 34 | then epochInfoSize_ underlyingEI en 35 | else epochInfoSize_ underlyingEI lke 36 | goFirst = \en -> do 37 | lke <- lastKnownEpochM 38 | if en <= lke 39 | then epochInfoFirst_ underlyingEI en 40 | else do 41 | SlotNo lkeStart <- epochInfoFirst_ underlyingEI lke 42 | EpochSize sz <- epochInfoSize_ underlyingEI en 43 | let EpochNo numEpochs = binOpEpochNo (-) en lke 44 | pure . SlotNo $ lkeStart + (numEpochs * sz) 45 | goEpoch = \sn -> 46 | if sn <= basisSlot 47 | then epochInfoEpoch_ underlyingEI sn 48 | else do 49 | lke <- lastKnownEpochM 50 | lkeStart <- epochInfoFirst_ underlyingEI lke 51 | EpochSize sz <- epochInfoSize_ underlyingEI lke 52 | let SlotNo slotsForward = sn - lkeStart 53 | pure . binOpEpochNo (+) lke . EpochNo $ slotsForward `div` sz 54 | goTime = \sn -> 55 | if sn <= basisSlot 56 | then epochInfoSlotToRelativeTime_ underlyingEI sn 57 | else do 58 | let SlotNo slotDiff = sn - basisSlot 59 | 60 | a1 <- epochInfoSlotToRelativeTime_ underlyingEI basisSlot 61 | lgth <- epochInfoSlotLength_ underlyingEI basisSlot 62 | 63 | pure $ 64 | addRelativeTime 65 | (multNominalDiffTime (getSlotLength lgth) slotDiff) 66 | a1 67 | goLength = \sn -> 68 | if sn <= basisSlot 69 | then epochInfoSlotLength_ underlyingEI sn 70 | else epochInfoSlotLength_ underlyingEI basisSlot 71 | in EpochInfo 72 | { epochInfoSize_ = goSize 73 | , epochInfoFirst_ = goFirst 74 | , epochInfoEpoch_ = goEpoch 75 | , epochInfoSlotToRelativeTime_ = goTime 76 | , epochInfoSlotLength_ = goLength 77 | } 78 | -------------------------------------------------------------------------------- /cardano-slotting/src/Cardano/Slotting/EpochInfo/Impl.hs: -------------------------------------------------------------------------------- 1 | -- | For use in trivial cases, such as in mocks, tests, etc. 2 | module Cardano.Slotting.EpochInfo.Impl ( 3 | fixedEpochInfo, 4 | 5 | -- * Shortcuts 6 | fixedEpochInfoEpoch, 7 | fixedEpochInfoFirst, 8 | ) 9 | where 10 | 11 | import Cardano.Slotting.EpochInfo.API 12 | import Cardano.Slotting.Slot (EpochNo (..), EpochSize (..), SlotNo (..)) 13 | import Cardano.Slotting.Time (RelativeTime (..), SlotLength, getSlotLength) 14 | 15 | -- | The 'EpochInfo' induced by assuming the epoch size and slot length are 16 | -- fixed for the entire system lifetime 17 | fixedEpochInfo :: Monad m => EpochSize -> SlotLength -> EpochInfo m 18 | fixedEpochInfo (EpochSize size) slotLength = 19 | EpochInfo 20 | { epochInfoSize_ = \_ -> 21 | return $ EpochSize size 22 | , epochInfoFirst_ = \e -> return $ fixedEpochInfoFirst (EpochSize size) e 23 | , epochInfoEpoch_ = \sl -> return $ fixedEpochInfoEpoch (EpochSize size) sl 24 | , epochInfoSlotToRelativeTime_ = \(SlotNo slot) -> 25 | return $ RelativeTime (fromIntegral slot * getSlotLength slotLength) 26 | , epochInfoSlotLength_ = const $ pure slotLength 27 | } 28 | 29 | -- | The pure computation underlying 'epochInfoFirst' applied to 30 | -- 'fixedEpochInfo' 31 | -- 32 | -- You don't need a 'SlotLength' for this. 33 | fixedEpochInfoFirst :: EpochSize -> EpochNo -> SlotNo 34 | fixedEpochInfoFirst (EpochSize size) (EpochNo epochNo) = 35 | SlotNo (epochNo * size) 36 | 37 | -- | The pure computation underlying 'epochInfoEpoch' applied to 38 | -- 'fixedEpochInfo' 39 | -- 40 | -- You don't need a 'SlotLength' for this. 41 | fixedEpochInfoEpoch :: EpochSize -> SlotNo -> EpochNo 42 | fixedEpochInfoEpoch (EpochSize size) (SlotNo slot) = 43 | EpochNo (slot `div` size) 44 | -------------------------------------------------------------------------------- /cardano-slotting/test/Main.hs: -------------------------------------------------------------------------------- 1 | import Test.Cardano.Slotting.EpochInfo (epochInfoTests) 2 | import Test.Tasty 3 | 4 | main :: IO () 5 | main = defaultMain tests 6 | 7 | tests :: TestTree 8 | tests = testGroup "EpochInfo" [epochInfoTests] 9 | -------------------------------------------------------------------------------- /cardano-slotting/test/Test/Cardano/Slotting/EpochInfo.hs: -------------------------------------------------------------------------------- 1 | module Test.Cardano.Slotting.EpochInfo where 2 | 3 | import Cardano.Slotting.EpochInfo.API (EpochInfo (..)) 4 | import Cardano.Slotting.EpochInfo.Extend (unsafeLinearExtendEpochInfo) 5 | import Cardano.Slotting.EpochInfo.Impl (fixedEpochInfo) 6 | import Cardano.Slotting.Slot (EpochNo (EpochNo), EpochSize (EpochSize), SlotNo (SlotNo)) 7 | import Cardano.Slotting.Time (slotLengthFromSec) 8 | import Data.Functor.Identity (Identity) 9 | import Test.Tasty (TestTree, testGroup) 10 | import Test.Tasty.QuickCheck as QC ( 11 | Arbitrary (arbitrary), 12 | choose, 13 | testProperty, 14 | (===), 15 | ) 16 | 17 | baseEpochInfo :: EpochInfo Identity 18 | baseEpochInfo = fixedEpochInfo (EpochSize 10) (slotLengthFromSec 10) 19 | 20 | -- An extended epoch info from a fixedEpochInfo should act as identity. 21 | extendedEpochInfo :: SlotNo -> EpochInfo Identity 22 | extendedEpochInfo sn = unsafeLinearExtendEpochInfo sn baseEpochInfo 23 | 24 | newtype TestSlotNo = TestSlotNo SlotNo 25 | deriving (Eq, Show) 26 | 27 | instance Arbitrary TestSlotNo where 28 | arbitrary = TestSlotNo . SlotNo <$> choose (1, 200) 29 | 30 | newtype TestEpochNo = TestEpochNo EpochNo 31 | deriving (Eq, Show) 32 | 33 | instance Arbitrary TestEpochNo where 34 | arbitrary = TestEpochNo . EpochNo <$> choose (0, 20) 35 | 36 | epochInfoTests :: TestTree 37 | epochInfoTests = 38 | testGroup 39 | "linearExtend" 40 | [ QC.testProperty "epochSize matches" $ \(TestSlotNo basisSlot, TestEpochNo sn) -> 41 | epochInfoSize_ baseEpochInfo sn === epochInfoSize_ (extendedEpochInfo basisSlot) sn 42 | , QC.testProperty "epochFirst matches" $ \(TestSlotNo basisSlot, TestEpochNo sn) -> 43 | epochInfoFirst_ baseEpochInfo sn === epochInfoFirst_ (extendedEpochInfo basisSlot) sn 44 | , QC.testProperty "epochEpoch matches" $ \(TestSlotNo basisSlot, TestSlotNo sn) -> 45 | epochInfoEpoch_ baseEpochInfo sn === epochInfoEpoch_ (extendedEpochInfo basisSlot) sn 46 | , QC.testProperty "epochTime matches" $ \(TestSlotNo basisSlot, TestSlotNo sn) -> 47 | epochInfoSlotToRelativeTime_ baseEpochInfo sn 48 | === epochInfoSlotToRelativeTime_ (extendedEpochInfo basisSlot) sn 49 | ] 50 | -------------------------------------------------------------------------------- /cardano-slotting/testlib/Test/Cardano/Slotting/Arbitrary.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DerivingStrategies #-} 2 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 3 | {-# LANGUAGE StandaloneDeriving #-} 4 | {-# OPTIONS_GHC -Wno-orphans #-} 5 | 6 | module Test.Cardano.Slotting.Arbitrary () where 7 | 8 | import Cardano.Slotting.Slot 9 | import Test.QuickCheck 10 | 11 | instance Arbitrary SlotNo where 12 | arbitrary = 13 | SlotNo 14 | <$> ( (getPositive <$> arbitrary) 15 | `suchThat` (\n -> n < maxBound - 2 ^ (32 :: Int)) 16 | ) 17 | 18 | -- need some room, we're assuming we'll never wrap around 64bits 19 | 20 | shrink (SlotNo n) = [SlotNo n' | n' <- shrink n, n' > 0] 21 | 22 | deriving newtype instance Arbitrary EpochNo 23 | -------------------------------------------------------------------------------- /cardano-slotting/testlib/Test/Cardano/Slotting/Numeric.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DerivingStrategies #-} 2 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 3 | {-# LANGUAGE StandaloneDeriving #-} 4 | {-# OPTIONS_GHC -Wno-orphans #-} 5 | 6 | module Test.Cardano.Slotting.Numeric () where 7 | 8 | import Cardano.Slotting.Slot ( 9 | EpochNo (EpochNo), 10 | EpochSize (EpochSize), 11 | ) 12 | 13 | deriving newtype instance Num EpochNo 14 | 15 | deriving newtype instance Num EpochSize 16 | 17 | deriving newtype instance Real EpochSize 18 | 19 | deriving newtype instance Integral EpochSize 20 | -------------------------------------------------------------------------------- /cardano-slotting/testlib/Test/Cardano/Slotting/TreeDiff.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -Wno-orphans #-} 2 | 3 | module Test.Cardano.Slotting.TreeDiff where 4 | 5 | import Cardano.Slotting.Block 6 | import Cardano.Slotting.Slot 7 | import Data.TreeDiff 8 | 9 | instance ToExpr x => ToExpr (WithOrigin x) 10 | 11 | instance ToExpr SlotNo 12 | 13 | instance ToExpr BlockNo 14 | 15 | instance ToExpr EpochNo 16 | 17 | instance ToExpr EpochSize 18 | -------------------------------------------------------------------------------- /cardano-strict-containers/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Changelog for `cardano-strict-containers` 2 | 3 | # 0.1.4.1 4 | 5 | * 6 | 7 | # 0.1.4.0 8 | 9 | * GHC-8.10 compatibility 10 | * Added `takeWhileR` and `takeWhileL` to `Data.Sequence.Strict` 11 | 12 | # 0.1.3.0 13 | 14 | * Added `IsList` instance for `StrictSeq` 15 | 16 | # 0.1.2.1 17 | 18 | * Remove `development` flag: #372 19 | 20 | # 0.1.2.0 21 | 22 | * Added `ToCBOR` and `FromCBOR` instances for `StrictSeq`: [#361](https://github.com/input-output-hk/cardano-base/pull/361) 23 | 24 | # 0.1.1.0 25 | 26 | * Added instances of `Monoid` and `Semigroup` for `StrictMaybe`: [#314](https://github.com/input-output-hk/cardano-base/pull/314) 27 | 28 | # 0.1.0.1 29 | 30 | * Intiial release 31 | -------------------------------------------------------------------------------- /cardano-strict-containers/NOTICE: -------------------------------------------------------------------------------- 1 | Copyright 2021 Input Output (Hong Kong) Ltd. 2 | 3 | Licensed under the Apache License, Version 2.0 (the "License"); 4 | you may not use this file except in compliance with the License. 5 | You may obtain a copy of the License at 6 | 7 | http://www.apache.org/licenses/LICENSE-2.0 8 | 9 | Unless required by applicable law or agreed to in writing, software 10 | distributed under the License is distributed on an "AS IS" BASIS, 11 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | See the License for the specific language governing permissions and 13 | limitations under the License. 14 | -------------------------------------------------------------------------------- /cardano-strict-containers/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /cardano-strict-containers/cardano-strict-containers.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: >=1.10 2 | name: cardano-strict-containers 3 | version: 0.1.4.0 4 | synopsis: Various strict container types 5 | license: Apache-2.0 6 | license-files: 7 | LICENSE 8 | NOTICE 9 | 10 | extra-source-files: CHANGELOG.md 11 | author: IOHK 12 | maintainer: operations@iohk.io 13 | copyright: IOHK 14 | build-type: Simple 15 | 16 | library 17 | default-language: Haskell2010 18 | hs-source-dirs: src 19 | ghc-options: 20 | -Wall 21 | -Wcompat 22 | -Wincomplete-record-updates 23 | -Wincomplete-uni-patterns 24 | -Wredundant-constraints 25 | 26 | exposed-modules: 27 | Data.FingerTree.Strict 28 | Data.Maybe.Strict 29 | Data.Sequence.Strict 30 | Data.Unit.Strict 31 | 32 | build-depends: 33 | aeson, 34 | base, 35 | cardano-binary >=1.6, 36 | cborg, 37 | containers, 38 | data-default-class, 39 | deepseq, 40 | fingertree, 41 | nothunks, 42 | serialise 43 | -------------------------------------------------------------------------------- /cardano-strict-containers/src/Data/Unit/Strict.hs: -------------------------------------------------------------------------------- 1 | -- | Helper functions for enforcing strictness. 2 | module Data.Unit.Strict ( 3 | StrictUnit (), 4 | forceElemsToWHNF, 5 | ) 6 | where 7 | 8 | -- | Force all of the elements of a 'Foldable' to weak head normal form. 9 | -- 10 | -- In order to ensure that all of the elements of a 'Foldable' are strict, we 11 | -- can simply 'foldMap' over it and 'seq' each value with '()'. However, 12 | -- '()''s 'mappend' implementation is actually completely lazy: @_ <> _ = ()@ 13 | -- So, in order to work around this, we instead utilize this newly defined 14 | -- 'StrictUnit' whose 'mappend' implementation is specifically strict. 15 | forceElemsToWHNF :: Foldable t => t a -> t a 16 | forceElemsToWHNF x = foldMap (`seq` StrictUnit) x `seq` x 17 | 18 | -- | The equivalent of '()', but with a strict 'mappend' implementation. 19 | -- 20 | -- For more information, see the documentation for 'forceElemsToWHNF'. 21 | data StrictUnit = StrictUnit 22 | 23 | instance Semigroup StrictUnit where 24 | StrictUnit <> StrictUnit = StrictUnit 25 | 26 | instance Monoid StrictUnit where 27 | mempty = StrictUnit 28 | -------------------------------------------------------------------------------- /default.nix: -------------------------------------------------------------------------------- 1 | # a non-flake nix compat wrapper using https://github.com/edolstra/flake-compat 2 | # DO NOT EDIT THIS FILE 3 | __trace 4 | ''************************************************************************************ 5 | Hi there! This project has been moved to nix flakes. You are using the default.nix 6 | compatibility layer. Please consider using flake commands like `nix build .#...`, 7 | `nix repl` with `:lf .` and similar instead. 8 | ************************************************************************************ 9 | '' 10 | (import 11 | ( 12 | let lock = builtins.fromJSON (builtins.readFile ./flake.lock); in 13 | fetchTarball { 14 | url = "https://github.com/edolstra/flake-compat/archive/${lock.nodes.flake-compat.locked.rev}.tar.gz"; 15 | sha256 = lock.nodes.flake-compat.locked.narHash; 16 | } 17 | ) 18 | { src = ./.; } 19 | ).defaultNix 20 | -------------------------------------------------------------------------------- /fourmolu.yaml: -------------------------------------------------------------------------------- 1 | indentation: 2 2 | function-arrows: trailing 3 | comma-style: leading 4 | import-export-style: diff-friendly 5 | indent-wheres: true 6 | record-brace-space: true 7 | newlines-between-decls: 1 8 | haddock-style: single-line 9 | haddock-style-module: 10 | let-style: auto 11 | in-style: right-align 12 | unicode: never 13 | respectful: true 14 | fixities: [] 15 | single-constraint-parens: never 16 | column-limit: 100 17 | -------------------------------------------------------------------------------- /heapwords/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Changelog for `heapwords` 2 | 3 | ## 0.1.0.3 4 | 5 | * 6 | 7 | ## 0.1.0.2 8 | 9 | * Remove `development` flag: #372 10 | 11 | ## 0.1.0.1 12 | 13 | * Initial release 14 | 15 | -------------------------------------------------------------------------------- /heapwords/NOTICE: -------------------------------------------------------------------------------- 1 | Copyright 2021 Input Output (Hong Kong) Ltd. 2 | 3 | Licensed under the Apache License, Version 2.0 (the "License"); 4 | you may not use this file except in compliance with the License. 5 | You may obtain a copy of the License at 6 | 7 | http://www.apache.org/licenses/LICENSE-2.0 8 | 9 | Unless required by applicable law or agreed to in writing, software 10 | distributed under the License is distributed on an "AS IS" BASIS, 11 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | See the License for the specific language governing permissions and 13 | limitations under the License. 14 | -------------------------------------------------------------------------------- /heapwords/heapwords.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: >=1.10 2 | name: heapwords 3 | version: 0.1.0.2 4 | synopsis: Heapwords 5 | license: Apache-2.0 6 | license-files: 7 | LICENSE 8 | NOTICE 9 | 10 | author: IOHK 11 | maintainer: operations@iohk.io 12 | copyright: IOHK 13 | build-type: Simple 14 | extra-source-files: CHANGELOG.md 15 | 16 | library 17 | default-language: Haskell2010 18 | hs-source-dirs: src 19 | ghc-options: 20 | -Wall 21 | -Wcompat 22 | -Wincomplete-record-updates 23 | -Wincomplete-uni-patterns 24 | -Wredundant-constraints 25 | -Wunused-packages 26 | 27 | exposed-modules: Cardano.HeapWords 28 | build-depends: 29 | array, 30 | base, 31 | bytestring, 32 | containers, 33 | ghc-prim, 34 | text, 35 | time, 36 | vector 37 | 38 | if impl(ghc <9.0.0) 39 | build-depends: 40 | integer-gmp 41 | -------------------------------------------------------------------------------- /hie-cabal.yaml: -------------------------------------------------------------------------------- 1 | cradle: 2 | cabal: 3 | - path: "base-deriving-via/src" 4 | component: "lib:base-deriving-via" 5 | 6 | - path: "binary/src" 7 | component: "lib:cardano-binary" 8 | 9 | - path: "binary/test" 10 | component: "cardano-binary:test:test" 11 | 12 | - path: "cardano-crypto-class/src" 13 | component: "lib:cardano-crypto-class" 14 | 15 | - path: "cardano-crypto-class/memory-example" 16 | component: "cardano-crypto-class:test:test-memory-example" 17 | 18 | - path: "cardano-crypto-praos/src" 19 | component: "lib:cardano-crypto-praos" 20 | 21 | - path: "cardano-crypto-tests/src" 22 | component: "lib:cardano-crypto-tests" 23 | 24 | - path: "cardano-crypto-tests/test" 25 | component: "cardano-crypto-tests:test:test-crypto" 26 | 27 | - path: "heapwords" 28 | component: "lib:heapwords" 29 | 30 | - path: "measures/src" 31 | component: "lib:measures" 32 | 33 | - path: "measures/test" 34 | component: "measures:test:test" 35 | 36 | - path: "orphans-deriving-via/src" 37 | component: "lib:orphans-deriving-via" 38 | 39 | - path: "slotting/src" 40 | component: "lib:cardano-slotting" 41 | 42 | - path: "cardano-strict-containers" 43 | component: "lib:cardano-strict-containers" 44 | -------------------------------------------------------------------------------- /measures/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Changelog for `measures` 2 | 3 | ## 0.1.0.3 4 | 5 | * 6 | 7 | ## 0.1.0.2 8 | 9 | * Remove `development` flag: #372 10 | 11 | ## 0.1.0.1 12 | 13 | * Initial release 14 | 15 | -------------------------------------------------------------------------------- /measures/NOTICE: -------------------------------------------------------------------------------- 1 | Copyright 2021 Input Output (Hong Kong) Ltd. 2 | 3 | Licensed under the Apache License, Version 2.0 (the "License"); 4 | you may not use this file except in compliance with the License. 5 | You may obtain a copy of the License at 6 | 7 | http://www.apache.org/licenses/LICENSE-2.0 8 | 9 | Unless required by applicable law or agreed to in writing, software 10 | distributed under the License is distributed on an "AS IS" BASIS, 11 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | See the License for the specific language governing permissions and 13 | limitations under the License. 14 | -------------------------------------------------------------------------------- /measures/measures.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: >=1.10 2 | name: measures 3 | version: 0.1.0.2 4 | synopsis: An abstraction for (tuples of) measured quantities 5 | license: Apache-2.0 6 | license-files: 7 | LICENSE 8 | NOTICE 9 | 10 | author: IOHK 11 | maintainer: operations@iohk.io 12 | copyright: IOHK 13 | build-type: Simple 14 | extra-source-files: CHANGELOG.md 15 | 16 | library 17 | default-language: Haskell2010 18 | hs-source-dirs: src 19 | ghc-options: 20 | -Wall 21 | -Wcompat 22 | -Wincomplete-uni-patterns 23 | -Wincomplete-record-updates 24 | -Wpartial-fields 25 | -Widentities 26 | -Wredundant-constraints 27 | -Wmissing-export-lists 28 | 29 | exposed-modules: 30 | Data.Measure 31 | Data.Measure.Class 32 | 33 | build-depends: 34 | base, 35 | base-deriving-via 36 | 37 | test-suite test 38 | hs-source-dirs: test 39 | main-is: Main.hs 40 | type: exitcode-stdio-1.0 41 | other-modules: 42 | Test.Data.Measure 43 | 44 | build-depends: 45 | QuickCheck, 46 | base, 47 | measures, 48 | tasty, 49 | tasty-quickcheck 50 | -------------------------------------------------------------------------------- /measures/src/Data/Measure.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BangPatterns #-} 2 | {-# LANGUAGE LambdaCase #-} 3 | {-# LANGUAGE NoImplicitPrelude #-} 4 | 5 | -- | Combinators for a possibly-multidimensional measurement 6 | -- 7 | -- The type @(Age, Height)@ is archetypal example of 'Measure'. It's typically 8 | -- a fixed-length vector of non-negative " measurements ". 9 | -- 10 | -- The anticipated use-cases involve some notion of a capacity that is limited 11 | -- on a per-dimension basis. Thus the measure of each included candidate 12 | -- quantifies how much of that capacity the candidate would occupy. See eg 13 | -- 'splitAt'. 14 | -- 15 | -- See the 'Measure' class for more. 16 | module Data.Measure ( 17 | module Data.Measure.Class, 18 | (<=), 19 | (>=), 20 | drop, 21 | splitAt, 22 | take, 23 | ) 24 | where 25 | 26 | import Data.Measure.Class 27 | import qualified Prelude 28 | 29 | infix 4 <=, >= 30 | 31 | -- | The partial order induced by 'min' 32 | -- 33 | -- It's only true if every component on the left is @<=@ the corresponding 34 | -- component on the right. 35 | (<=) :: Measure a => a -> a -> Prelude.Bool 36 | x <= y = x Prelude.== min x y 37 | 38 | -- | The partial order induced by 'max' 39 | -- 40 | -- It's only true if every component on the left is @>=@ the corresponding 41 | -- component on the right. 42 | (>=) :: Measure a => a -> a -> Prelude.Bool 43 | x >= y = x Prelude.== max x y 44 | 45 | -- | Split a list once a prefix fills up the given capacity 46 | -- 47 | -- Note that this just splits the given list; it does not attempt anything 48 | -- clever like bin-packing etc. 49 | splitAt :: Measure a => (e -> a) -> a -> [e] -> ([e], [e]) 50 | splitAt measure limit = 51 | go zero [] 52 | where 53 | go !tot acc = \case 54 | [] -> (Prelude.reverse acc, []) 55 | e : es -> 56 | if tot' <= limit 57 | then go tot' (e : acc) es 58 | else (Prelude.reverse acc, e : es) 59 | where 60 | tot' = plus tot (measure e) 61 | 62 | -- | @fst . 'splitAt' measure limit@, but non-strict 63 | take :: Measure a => (e -> a) -> a -> [e] -> [e] 64 | take measure limit = 65 | go zero 66 | where 67 | go !tot = \case 68 | [] -> [] 69 | e : es -> 70 | if tot' <= limit 71 | then e : go tot' es 72 | else [] 73 | where 74 | tot' = plus tot (measure e) 75 | 76 | -- | @snd . 'splitAt' measure limit@, with a bit less allocation 77 | drop :: Measure a => (e -> a) -> a -> [e] -> [e] 78 | drop measure limit = 79 | go zero 80 | where 81 | go !tot = \case 82 | [] -> [] 83 | e : es -> 84 | if tot' <= limit 85 | then go tot' es 86 | else e : es 87 | where 88 | tot' = plus tot (measure e) 89 | -------------------------------------------------------------------------------- /measures/test/Main.hs: -------------------------------------------------------------------------------- 1 | module Main ( 2 | main, 3 | tests, 4 | ) 5 | where 6 | 7 | import Test.Tasty 8 | 9 | import qualified Test.Data.Measure (tests) 10 | 11 | main :: IO () 12 | main = defaultMain tests 13 | 14 | tests :: TestTree 15 | tests = 16 | testGroup 17 | "measures package" 18 | [ Test.Data.Measure.tests 19 | ] 20 | -------------------------------------------------------------------------------- /measures/test/Test/Data/Measure.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 2 | 3 | module Test.Data.Measure ( 4 | tests, 5 | ) 6 | where 7 | 8 | import GHC.Natural 9 | import Test.Tasty 10 | import Test.Tasty.QuickCheck 11 | 12 | import qualified Data.Measure as M 13 | 14 | tests :: TestTree 15 | tests = 16 | testGroup 17 | "Data.Measure" 18 | [ testProperty "uncurry (++) undoes splitAt" prop_idAppendSplitAt 19 | , testProperty "take and drop agrees with splitAt" prop_eqTakeDropSplitAt 20 | ] 21 | 22 | -------------------------------------------------------------------------------- 23 | -- A nice measure to run tests with 24 | -------------------------------------------------------------------------------- 25 | 26 | newtype Item = Item Natural 27 | deriving (Eq, M.Measure, Show) 28 | 29 | integerToItem :: Integer -> Item 30 | integerToItem = Item . naturalFromInteger . abs 31 | 32 | itemToInteger :: Item -> Integer 33 | itemToInteger (Item n) = naturalToInteger n 34 | 35 | instance Arbitrary Item where 36 | arbitrary = fmap (integerToItem . getSmall) arbitrary 37 | shrink = 38 | fmap (integerToItem . getSmall) 39 | . filter (>= 0) 40 | . shrink 41 | . Small 42 | . itemToInteger 43 | 44 | -------------------------------------------------------------------------------- 45 | -- Required properties 46 | -------------------------------------------------------------------------------- 47 | 48 | -- | @uncurry (++)@ undoes 'M.splitAt' 49 | prop_idAppendSplitAt :: Item -> [Item] -> Property 50 | prop_idAppendSplitAt limit es = 51 | l ++ r === es 52 | where 53 | (l, r) = M.splitAt id limit es 54 | 55 | -- | 'M.take' and 'M.drop' are the components of 'M.splitAt' 56 | prop_eqTakeDropSplitAt :: Item -> [Item] -> Property 57 | prop_eqTakeDropSplitAt limit es = 58 | (M.take id limit es, M.drop id limit es) 59 | === M.splitAt id limit es 60 | -------------------------------------------------------------------------------- /orphans-deriving-via/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Changelog for `orphans-deriving-via` 2 | 3 | ## 0.1.0.3 4 | 5 | * 6 | 7 | ## 0.1.0.2 8 | 9 | * Remove `development` flag: #372 10 | 11 | ## 0.1.0.1 12 | 13 | * Initial release 14 | 15 | -------------------------------------------------------------------------------- /orphans-deriving-via/NOTICE: -------------------------------------------------------------------------------- 1 | Copyright 2021 Input Output (Hong Kong) Ltd. 2 | 3 | Licensed under the Apache License, Version 2.0 (the "License"); 4 | you may not use this file except in compliance with the License. 5 | You may obtain a copy of the License at 6 | 7 | http://www.apache.org/licenses/LICENSE-2.0 8 | 9 | Unless required by applicable law or agreed to in writing, software 10 | distributed under the License is distributed on an "AS IS" BASIS, 11 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | See the License for the specific language governing permissions and 13 | limitations under the License. 14 | -------------------------------------------------------------------------------- /orphans-deriving-via/orphans-deriving-via.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: >=1.10 2 | name: orphans-deriving-via 3 | version: 0.1.0.2 4 | synopsis: Orphan instances for the base-deriving-via hooks 5 | license: Apache-2.0 6 | license-files: 7 | LICENSE 8 | NOTICE 9 | 10 | author: IOHK 11 | maintainer: operations@iohk.io 12 | copyright: IOHK 13 | build-type: Simple 14 | extra-source-files: CHANGELOG.md 15 | 16 | library 17 | default-language: Haskell2010 18 | hs-source-dirs: src 19 | ghc-options: 20 | -Wall 21 | -Wcompat 22 | -Wincomplete-uni-patterns 23 | -Wincomplete-record-updates 24 | -Wpartial-fields 25 | -Widentities 26 | -Wredundant-constraints 27 | -Wmissing-export-lists 28 | 29 | exposed-modules: 30 | Data.DerivingVia.DeepSeq 31 | Data.DerivingVia.NoThunks 32 | 33 | build-depends: 34 | base, 35 | base-deriving-via, 36 | deepseq, 37 | nothunks 38 | -------------------------------------------------------------------------------- /orphans-deriving-via/src/Data/DerivingVia/DeepSeq.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE EmptyCase #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE FlexibleInstances #-} 4 | {-# LANGUAGE LambdaCase #-} 5 | {-# LANGUAGE TypeOperators #-} 6 | {-# LANGUAGE UndecidableInstances #-} 7 | {-# OPTIONS_GHC -Wno-orphans #-} 8 | 9 | -- | "GHC.Generics" definition of 'rnf' 10 | module Data.DerivingVia.DeepSeq ( 11 | 12 | ) 13 | where 14 | 15 | import Control.DeepSeq 16 | import Data.DerivingVia 17 | import GHC.Generics 18 | 19 | instance 20 | (Generic a, GNFData (Rep a)) => 21 | NFData (InstantiatedAt Generic a) 22 | where 23 | rnf (InstantiatedAt x) = grnf (from x) 24 | 25 | class GNFData rep where 26 | grnf :: rep x -> () 27 | 28 | instance NFData c => GNFData (K1 i c) where 29 | grnf (K1 a) = rnf a 30 | 31 | instance GNFData f => GNFData (M1 i c f) where 32 | grnf (M1 a) = grnf a 33 | 34 | instance GNFData V1 where 35 | grnf = \case {} 36 | 37 | instance GNFData U1 where 38 | grnf U1 = () 39 | 40 | instance (GNFData l, GNFData r) => GNFData (l :*: r) where 41 | grnf (l :*: r) = grnf l `seq` grnf r 42 | 43 | instance (GNFData l, GNFData r) => GNFData (l :+: r) where 44 | grnf = \case 45 | L1 l -> grnf l 46 | R1 r -> grnf r 47 | -------------------------------------------------------------------------------- /orphans-deriving-via/src/Data/DerivingVia/NoThunks.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BangPatterns #-} 2 | {-# LANGUAGE DataKinds #-} 3 | {-# LANGUAGE FlexibleContexts #-} 4 | {-# LANGUAGE FlexibleInstances #-} 5 | {-# LANGUAGE ScopedTypeVariables #-} 6 | {-# LANGUAGE TypeApplications #-} 7 | {-# LANGUAGE UndecidableInstances #-} 8 | {-# OPTIONS_GHC -Wno-orphans #-} 9 | 10 | -- | "GHC.Generics" definition of 'NoThunks' 11 | module Data.DerivingVia.NoThunks ( 12 | 13 | ) 14 | where 15 | 16 | import Data.DerivingVia 17 | import Data.Proxy 18 | import GHC.Generics 19 | import NoThunks.Class 20 | 21 | -- | Copied from the "NoThunks.Class" default method definitions 22 | instance 23 | (Generic a, GShowTypeOf (Rep a), GWNoThunks '[] (Rep a)) => 24 | NoThunks (InstantiatedAt Generic a) 25 | where 26 | wNoThunks ctxt (InstantiatedAt x) = 27 | gwNoThunks (Proxy @'[]) ctxt fp 28 | where 29 | !fp = from x 30 | 31 | showTypeOf _ = gShowTypeOf (from (undefined :: a)) 32 | 33 | -- Copied from the "NoThunks.Class" 34 | class GShowTypeOf f where gShowTypeOf :: f x -> String 35 | instance Datatype c => GShowTypeOf (D1 c f) where gShowTypeOf = datatypeName 36 | -------------------------------------------------------------------------------- /scripts/cabal-format.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | set -euo pipefail 4 | 5 | mode="${1:-format}" 6 | 7 | if [[ "$mode" != "format" && "$mode" != "check" ]]; then 8 | echo "Error: Invalid mode: ${mode}. Allowed values are 'format' or 'check'." >&2 9 | exit 1 10 | fi 11 | 12 | git ls-files -- '*.cabal' 'cabal.project' | while IFS= read -r f; do 13 | cmd=(cabal-gild -i "$f" -m "$mode") 14 | 15 | if [[ "$mode" == "format" ]]; then 16 | cmd+=(-o "$f") 17 | fi 18 | 19 | "${cmd[@]}" 20 | done 21 | 22 | if [[ "$mode" == "format" ]]; then 23 | git diff --exit-code 24 | fi 25 | -------------------------------------------------------------------------------- /scripts/fourmolize.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | set -euo pipefail 4 | 5 | if [[ $# -gt 0 ]]; then 6 | case "$1" in 7 | --changes) 8 | files=$(git diff --diff-filter=MA --name-only origin/master HEAD -- '*.hs') 9 | if [[ -n "$files" ]]; then 10 | # Run fourmolu on changes compared to `master`. 11 | fourmolu -m inplace $(echo "$files" | grep -v Setup.hs) 12 | fi 13 | ;; 14 | *) 15 | echo "Invalid option: $1" >&2 16 | exit 1 17 | ;; 18 | esac 19 | else 20 | fourmolu -m inplace $(git ls-files -- '*.hs' | grep -v Setup.hs) 21 | fi 22 | 23 | git diff --exit-code 24 | -------------------------------------------------------------------------------- /scripts/mkprolog.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | set -euo pipefail 4 | 5 | HADDOCKS_DIR=${1:-"./haddocks"} 6 | PROLOG_FILE=${2:-"./scripts/prolog"} 7 | 8 | > ${PROLOG_FILE} 9 | 10 | cat > ${PROLOG_FILE} << EOF 11 | = Cardano Ledger Repository Hackage Documentation 12 | 13 | [skip to module list](#module-list) 14 | 15 | This site contains Haskell documentation of: 16 | 17 | EOF 18 | 19 | for dir in $(ls ${HADDOCKS_DIR}); do 20 | if [[ -d ${HADDOCKS_DIR}/${dir} ]]; then 21 | link=$(echo "${dir}" | sed "s/:/%3A/g") 22 | echo "* __[${dir}](${link}/index.html)__" >> ${PROLOG_FILE} 23 | fi 24 | done 25 | -------------------------------------------------------------------------------- /shell.nix: -------------------------------------------------------------------------------- 1 | # a non-flake nix compat wrapper using https://github.com/edolstra/flake-compat 2 | # DO NOT EDIT THIS FILE 3 | __trace 4 | ''************************************************************************************ 5 | Hi there! This project has been moved to nix flakes. You are using the `nix-shell` 6 | compatibility layer. Please consider using `nix develop` instead. 7 | ************************************************************************************ 8 | '' 9 | (import 10 | ( 11 | let lock = builtins.fromJSON (builtins.readFile ./flake.lock); in 12 | fetchTarball { 13 | url = "https://github.com/edolstra/flake-compat/archive/${lock.nodes.flake-compat.locked.rev}.tar.gz"; 14 | sha256 = lock.nodes.flake-compat.locked.narHash; 15 | } 16 | ) 17 | { src = ./.; } 18 | ).shellNix 19 | --------------------------------------------------------------------------------