From fea7014d23f7b192866dd995c63aad27528d0461 Mon Sep 17 00:00:00 2001 From: Lars Kuhtz Date: Mon, 16 Oct 2023 16:01:50 -0700 Subject: [PATCH 01/11] support building with GHC-9.8.1 and aeson-2.2 --- cabal.project | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) diff --git a/cabal.project b/cabal.project index a6435cf99..f88bbca11 100644 --- a/cabal.project +++ b/cabal.project @@ -8,9 +8,9 @@ constraints: hspec-golden <0.2, source-repository-package type: git - tag: e43073d0b8d89d9b300980913b842f4be339846d location: https://github.com/kadena-io/pact-json - --sha256: sha256-ZWbAId0JBaxDsYhwcYUyw04sjYstXyosSCenzOvUxsQ= + tag: 2d75e5d9ee4ae6484f1f16218dd5e767ef97f593 + --sha256: 0fzq4mzaszj5clvixx9mn1x6r4dcrnwvbl2znd0p5mmy5h2jr0hh -- These packages are tightly bundled with GHC. The rules ensure that -- our builds use the version that ships with the GHC version that is @@ -19,13 +19,19 @@ source-repository-package allow-newer: *:template-haskell allow-newer: *:base allow-newer: *:ghc-prim +allow-newer: *:deepseq +allow-newer: *:pretty +allow-newer: *:text +allow-newer: *:bytestring -- Patch merged into master (upcoming verison 10.0). We are currently using 9.2 +-- Also contains a patch for 9.8.1 related to -Wx-partial +-- source-repository-package type: git - tag: 3946a0e94470d7403a855dd60f8e54687ecc2b1d location: https://github.com/larskuhtz/sbv - --sha256: 1msbz6525nmsywpm910jh23siil4qgn3rpsm52m8j6877r7v5zw3 + tag: e42acfb5058cde37e0213a95af9f6732fac78f3d + --sha256: 0ajr196qp1vqdlscp65myjjs95pimmdsq07w0z83d89xild1bl85 -- Servant is notoriously forcing outdated upper bounds onto its users. -- It is usually safe to just ignore those. @@ -38,6 +44,5 @@ allow-newer: servant:* -- Required by trifecta (e.g. to allow mtl >=2.3) allow-newer: trifecta:* --- servant-0.20 does not yet support aeson-2.2 --- -constraints: aeson <2.2 +-- disable webauthn's overly restrictive upper bounds +allow-newer: webauthn:* From a95e0128b62fed15c0d4dd055962a9c97cf988f3 Mon Sep 17 00:00:00 2001 From: Lars Kuhtz Date: Mon, 16 Oct 2023 16:11:17 -0700 Subject: [PATCH 02/11] support webauthn 0.8 --- pact.cabal | 2 +- src/Pact/Types/Crypto.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/pact.cabal b/pact.cabal index b64668d09..829497d14 100644 --- a/pact.cabal +++ b/pact.cabal @@ -242,7 +242,7 @@ library , vector-algorithms >=0.7 , vector-space >=0.10.4 , yaml - , webauthn >= 0.7 + , webauthn >= 0.8 if flag(build-tool) cpp-options: -DBUILD_TOOL diff --git a/src/Pact/Types/Crypto.hs b/src/Pact/Types/Crypto.hs index 663592d75..ef8bce897 100644 --- a/src/Pact/Types/Crypto.hs +++ b/src/Pact/Types/Crypto.hs @@ -215,7 +215,7 @@ instance Scheme (SPPKScheme 'WebAuthn) where let payload = authData <> clientDataDigest -- Check the signature's validity. - first T.unpack $ WAVerify.verify publicKey payload sig + first T.unpack $ WAVerify.verify publicKey (WAVerify.Message payload) (WAVerify.Signature sig) -- Extract the original challenge from client data. ClientDataJSON { challenge } <- A.eitherDecode (BSL.fromStrict clientData) From 34d5b2678034c0130148d094899aab451af8f220 Mon Sep 17 00:00:00 2001 From: Lars Kuhtz Date: Mon, 16 Oct 2023 16:48:23 -0700 Subject: [PATCH 03/11] add GHC-9.8 CI build --- .github/workflows/applications.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/applications.yml b/.github/workflows/applications.yml index 7ba52e6a6..e5b30f379 100644 --- a/.github/workflows/applications.yml +++ b/.github/workflows/applications.yml @@ -18,7 +18,7 @@ jobs: strategy: fail-fast: false matrix: - ghc: ['9.6'] + ghc: ['9.6', '9.8'] cabal: ['3.10'] os: ['ubuntu-20.04', 'ubuntu-22.04', 'macOS-latest'] cabalcache: ['true'] From 17f5450050044f7688d24cd7de0b9ce44435d745 Mon Sep 17 00:00:00 2001 From: Lars Kuhtz Date: Mon, 16 Oct 2023 18:05:43 -0700 Subject: [PATCH 04/11] update github haskell setup action --- .github/workflows/applications.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/applications.yml b/.github/workflows/applications.yml index e5b30f379..7358a8ff4 100644 --- a/.github/workflows/applications.yml +++ b/.github/workflows/applications.yml @@ -78,7 +78,7 @@ jobs: if: startsWith(matrix.os, 'ubuntu-') run: sudo chown -R $USER /usr/local/.ghcup - name: Install GHC and Cabal - uses: haskell/actions/setup@v2 + uses: haskell-actions/setup@v2 with: ghc-version: ${{ matrix.ghc }} cabal-version: ${{ matrix.cabal }} From 0fb535e86e15d0b4e9e329b25302ae20a63803a6 Mon Sep 17 00:00:00 2001 From: Lars Kuhtz Date: Tue, 17 Oct 2023 08:56:53 -0700 Subject: [PATCH 05/11] Disable x-partial warning for GHC 9.8.1 --- cabal.project | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/cabal.project b/cabal.project index f88bbca11..ad34597a2 100644 --- a/cabal.project +++ b/cabal.project @@ -46,3 +46,9 @@ allow-newer: trifecta:* -- disable webauthn's overly restrictive upper bounds allow-newer: webauthn:* + +-- head and tail are marked deprecated in recent base. We'll +-- yet have to fix that in the code base. +if impl(ghc >= 9.8.1) + package chainweb + ghc-options: -Wno-x-partial From 12ec9a2822de8da9aaa13b5bcd238db79ea8af4f Mon Sep 17 00:00:00 2001 From: Greg Hale Date: Wed, 18 Oct 2023 15:00:06 -0700 Subject: [PATCH 06/11] bump nixpkgs to the version used by haskellNix --- flake.lock | 205 +++++++++++++++++++++++++++++++++++++---------------- flake.nix | 15 ++-- 2 files changed, 150 insertions(+), 70 deletions(-) diff --git a/flake.lock b/flake.lock index 17fec3a83..f75aeb99d 100644 --- a/flake.lock +++ b/flake.lock @@ -101,12 +101,15 @@ } }, "flake-utils": { + "inputs": { + "systems": "systems" + }, "locked": { - "lastModified": 1667395993, - "narHash": "sha256-nuEHfE/LcWyuSWnS8t12N1wc105Qtau+/OdUAjtQ0rA=", + "lastModified": 1694529238, + "narHash": "sha256-zsNZZGTGnMOf9YpHKJqMSsa0dXbfmxeoJ7xHlrt+xmY=", "owner": "numtide", "repo": "flake-utils", - "rev": "5aed5285a952e0b949eb3ba02c12fa4fcfef535f", + "rev": "ff7b65b44d01cf9ba6a71320833626af21126384", "type": "github" }, "original": { @@ -115,22 +118,6 @@ "type": "github" } }, - "flake-utils_2": { - "locked": { - "lastModified": 1679360468, - "narHash": "sha256-LGnza3cfXF10Biw3ZTg0u9o9t7s680Ww200t5KkHTh8=", - "owner": "hamishmack", - "repo": "flake-utils", - "rev": "e1ea268ff47ad475443dbabcd54744b4e5b9d4f5", - "type": "github" - }, - "original": { - "owner": "hamishmack", - "ref": "hkm/nested-hydraJobs", - "repo": "flake-utils", - "type": "github" - } - }, "ghc-8.6.5-iohk": { "flake": false, "locked": { @@ -148,14 +135,51 @@ "type": "github" } }, + "ghc98X": { + "flake": false, + "locked": { + "lastModified": 1696643148, + "narHash": "sha256-E02DfgISH7EvvNAu0BHiPvl1E5FGMDi0pWdNZtIBC9I=", + "ref": "ghc-9.8", + "rev": "443e870d977b1ab6fc05f47a9a17bc49296adbd6", + "revCount": 61642, + "submodules": true, + "type": "git", + "url": "https://gitlab.haskell.org/ghc/ghc" + }, + "original": { + "ref": "ghc-9.8", + "submodules": true, + "type": "git", + "url": "https://gitlab.haskell.org/ghc/ghc" + } + }, + "ghc99": { + "flake": false, + "locked": { + "lastModified": 1697054644, + "narHash": "sha256-kKarOuXUaAH3QWv7ASx+gGFMHaHKe0pK5Zu37ky2AL4=", + "ref": "refs/heads/master", + "rev": "f383a242c76f90bcca8a4d7ee001dcb49c172a9a", + "revCount": 62040, + "submodules": true, + "type": "git", + "url": "https://gitlab.haskell.org/ghc/ghc" + }, + "original": { + "submodules": true, + "type": "git", + "url": "https://gitlab.haskell.org/ghc/ghc" + } + }, "hackage": { "flake": false, "locked": { - "lastModified": 1690331094, - "narHash": "sha256-xGJlmbRruW61N0rEcFn2pRlpLnE1TCKvvyz2nytYzE4=", + "lastModified": 1697502410, + "narHash": "sha256-ovVSu35MN8WfTQ6bulPqAfklpnj+tqdMn+2vD+8Eq2M=", "owner": "input-output-hk", "repo": "hackage.nix", - "rev": "efc8a53a648a6a3b0973aaefc93ace7d0ddf198d", + "rev": "164b8c07dd4c7dd81adae9f372647078b27f828c", "type": "github" }, "original": { @@ -172,11 +196,15 @@ "cabal-36": "cabal-36", "cardano-shell": "cardano-shell", "flake-compat": "flake-compat", - "flake-utils": "flake-utils_2", "ghc-8.6.5-iohk": "ghc-8.6.5-iohk", + "ghc98X": "ghc98X", + "ghc99": "ghc99", "hackage": "hackage", "hls-1.10": "hls-1.10", "hls-2.0": "hls-2.0", + "hls-2.2": "hls-2.2", + "hls-2.3": "hls-2.3", + "hls-2.4": "hls-2.4", "hpc-coveralls": "hpc-coveralls", "hydra": "hydra", "iserv-proxy": "iserv-proxy", @@ -195,11 +223,11 @@ "stackage": "stackage" }, "locked": { - "lastModified": 1690332668, - "narHash": "sha256-GtrWrvYe5GlUH6adZjcs4Z0yEY+JrGBS2uentXjVNyI=", + "lastModified": 1697503832, + "narHash": "sha256-KtQ1si2TgXcK9HYD88pXWABun5n4nMNCHjQwWH1GD4Y=", "owner": "input-output-hk", "repo": "haskell.nix", - "rev": "d9c1f82b37b4226eb22718b657bb80fe961f1cdf", + "rev": "e2d31e63796dd24e9093f3cdcf9807b46dea9c25", "type": "github" }, "original": { @@ -242,6 +270,57 @@ "type": "github" } }, + "hls-2.2": { + "flake": false, + "locked": { + "lastModified": 1693064058, + "narHash": "sha256-8DGIyz5GjuCFmohY6Fa79hHA/p1iIqubfJUTGQElbNk=", + "owner": "haskell", + "repo": "haskell-language-server", + "rev": "b30f4b6cf5822f3112c35d14a0cba51f3fe23b85", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "2.2.0.0", + "repo": "haskell-language-server", + "type": "github" + } + }, + "hls-2.3": { + "flake": false, + "locked": { + "lastModified": 1695910642, + "narHash": "sha256-tR58doOs3DncFehHwCLczJgntyG/zlsSd7DgDgMPOkI=", + "owner": "haskell", + "repo": "haskell-language-server", + "rev": "458ccdb55c9ea22cd5d13ec3051aaefb295321be", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "2.3.0.0", + "repo": "haskell-language-server", + "type": "github" + } + }, + "hls-2.4": { + "flake": false, + "locked": { + "lastModified": 1696939266, + "narHash": "sha256-VOMf5+kyOeOmfXTHlv4LNFJuDGa7G3pDnOxtzYR40IU=", + "owner": "haskell", + "repo": "haskell-language-server", + "rev": "362fdd1293efb4b82410b676ab1273479f6d17ee", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "2.4.0.0", + "repo": "haskell-language-server", + "type": "github" + } + }, "hpc-coveralls": { "flake": false, "locked": { @@ -284,11 +363,11 @@ "iserv-proxy": { "flake": false, "locked": { - "lastModified": 1688517130, - "narHash": "sha256-hUqfxSlo+ffqVdkSZ1EDoB7/ILCL25eYkcCXW9/P3Wc=", + "lastModified": 1691634696, + "narHash": "sha256-MZH2NznKC/gbgBu8NgIibtSUZeJ00HTLJ0PlWKCBHb0=", "ref": "hkm/remote-iserv", - "rev": "9151db2a9a61d7f5fe52ff8836f18bbd0fd8933c", - "revCount": 13, + "rev": "43a979272d9addc29fbffc2e8542c5d96e993d73", + "revCount": 14, "type": "git", "url": "https://gitlab.haskell.org/hamishmack/iserv-proxy.git" }, @@ -401,11 +480,11 @@ }, "nixpkgs-2205": { "locked": { - "lastModified": 1682600000, - "narHash": "sha256-ha4BehR1dh8EnXSoE1m/wyyYVvHI9txjW4w5/oxsW5Y=", + "lastModified": 1685573264, + "narHash": "sha256-Zffu01pONhs/pqH07cjlF10NnMDLok8ix5Uk4rhOnZQ=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "50fc86b75d2744e1ab3837ef74b53f103a9b55a0", + "rev": "380be19fbd2d9079f677978361792cb25e8a3635", "type": "github" }, "original": { @@ -417,11 +496,11 @@ }, "nixpkgs-2211": { "locked": { - "lastModified": 1685314633, - "narHash": "sha256-8LXBPqTQXl5ofkjpJ18JcbmLJ/lWDoMxtUwiDYv0wro=", + "lastModified": 1688392541, + "narHash": "sha256-lHrKvEkCPTUO+7tPfjIcb7Trk6k31rz18vkyqmkeJfY=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "c8a17ce7abc03c50cd072e9e6c9b389c5f61836b", + "rev": "ea4c80b39be4c09702b0cb3b42eab59e2ba4f24b", "type": "github" }, "original": { @@ -433,11 +512,11 @@ }, "nixpkgs-2305": { "locked": { - "lastModified": 1685338297, - "narHash": "sha256-+Aq4O0Jn1W1q927ZHc3Zn6RO7bwQGmb6O8xYoGy0KrM=", + "lastModified": 1695416179, + "narHash": "sha256-610o1+pwbSu+QuF3GE0NU5xQdTHM3t9wyYhB9l94Cd8=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "6287b47dbfabbb8bfbb9b1b53d198ad58a774de4", + "rev": "715d72e967ec1dd5ecc71290ee072bcaf5181ed6", "type": "github" }, "original": { @@ -465,11 +544,11 @@ }, "nixpkgs-unstable": { "locked": { - "lastModified": 1685347552, - "narHash": "sha256-9woSppRyUFo26yUffORTzttJ+apOt8MmCv6RxpPNTU4=", + "lastModified": 1695318763, + "narHash": "sha256-FHVPDRP2AfvsxAdc+AsgFJevMz5VBmnZglFUMlxBkcY=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "f2f1ec390714d303cf84ba086e34e45b450dd8c4", + "rev": "e12483116b3b51a185a33a272bf351e357ba9a99", "type": "github" }, "original": { @@ -479,22 +558,6 @@ "type": "github" } }, - "nixpkgs_2": { - "locked": { - "lastModified": 1669833724, - "narHash": "sha256-/HEZNyGbnQecrgJnfE8d0WC5c1xuPSD2LUpB6YXlg4c=", - "owner": "NixOS", - "repo": "nixpkgs", - "rev": "4d2b37a84fad1091b9de401eb450aae66f1a741e", - "type": "github" - }, - "original": { - "owner": "NixOS", - "repo": "nixpkgs", - "rev": "4d2b37a84fad1091b9de401eb450aae66f1a741e", - "type": "github" - } - }, "old-ghc-nix": { "flake": false, "locked": { @@ -516,17 +579,20 @@ "inputs": { "flake-utils": "flake-utils", "haskellNix": "haskellNix", - "nixpkgs": "nixpkgs_2" + "nixpkgs": [ + "haskellNix", + "nixpkgs" + ] } }, "stackage": { "flake": false, "locked": { - "lastModified": 1690330226, - "narHash": "sha256-ApHKqIP/Ubi92lZ0fp8EwiVdM7cejhYA4Hd5Zf8b7d8=", + "lastModified": 1697501360, + "narHash": "sha256-lNMP6UioH7BmxdYKEthFj0UGf6QcTmj9QCZdP16MjGs=", "owner": "input-output-hk", "repo": "stackage.nix", - "rev": "22fbccd7b46469e9405a7c035b8f83682d9c68f1", + "rev": "d563c5580b1b6dca4c3ab92a5a261fd452a2599b", "type": "github" }, "original": { @@ -534,6 +600,21 @@ "repo": "stackage.nix", "type": "github" } + }, + "systems": { + "locked": { + "lastModified": 1681028828, + "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", + "owner": "nix-systems", + "repo": "default", + "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", + "type": "github" + }, + "original": { + "owner": "nix-systems", + "repo": "default", + "type": "github" + } } }, "root": "root", diff --git a/flake.nix b/flake.nix index c421869e2..34c8f5a95 100644 --- a/flake.nix +++ b/flake.nix @@ -2,8 +2,8 @@ description = "Kadena's Pact smart contract language"; inputs = { - # nixpkgs.follows = "haskellNix/nixpkgs"; - nixpkgs.url = "github:NixOS/nixpkgs?rev=4d2b37a84fad1091b9de401eb450aae66f1a741e"; + nixpkgs.follows = "haskellNix/nixpkgs"; + # nixpkgs.url = "github:NixOS/nixpkgs?rev=4d2b37a84fad1091b9de401eb450aae66f1a741e"; haskellNix.url = "github:input-output-hk/haskell.nix"; flake-utils.url = "github:numtide/flake-utils"; }; @@ -25,16 +25,16 @@ pact = final.haskell-nix.project' { src = ./.; - compiler-nix-name = "ghc962"; + compiler-nix-name = "ghc981"; shell.tools = { - cabal = {}; - haskell-language-server = {}; + # cabal = {}; + # haskell-language-server = {}; # hlint = {}; }; shell.buildInputs = with pkgs; [ zlib z3 - pkgconfig + pkg-config (python3.withPackages (ps: [ps.sphinx ps.sphinx_rtd_theme])) pandoc perl ]; @@ -70,8 +70,7 @@ devShell = pkgs.haskellPackages.shellFor { buildInputs = with pkgs.haskellPackages; [ - cabal-install - haskell-language-server + # haskell-language-server # hlint ]; From c048f90c7f9f8144967b10b3740a588380a7d0c0 Mon Sep 17 00:00:00 2001 From: Lars Kuhtz Date: Thu, 19 Oct 2023 10:39:28 -0700 Subject: [PATCH 07/11] Revert "support webauthn 0.8" This reverts commit a95e0128b62fed15c0d4dd055962a9c97cf988f3. --- src/Pact/Types/Crypto.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Pact/Types/Crypto.hs b/src/Pact/Types/Crypto.hs index 3806d47bd..03e75c7fc 100644 --- a/src/Pact/Types/Crypto.hs +++ b/src/Pact/Types/Crypto.hs @@ -216,7 +216,7 @@ instance Scheme (SPPKScheme 'WebAuthn) where let payload = authData <> clientDataDigest -- Check the signature's validity. - first T.unpack $ WAVerify.verify publicKey (WAVerify.Message payload) (WAVerify.Signature sig) + first T.unpack $ WAVerify.verify publicKey payload sig -- Extract the original challenge from client data. ClientDataJSON { challenge } <- A.eitherDecode (BSL.fromStrict clientData) From 99a3e06770d5a4d530b695ad0026a5bdc1985737 Mon Sep 17 00:00:00 2001 From: Greg Hale Date: Thu, 19 Oct 2023 13:56:23 -0700 Subject: [PATCH 08/11] Tell nix to ignore partial function warnings --- flake.nix | 1 + 1 file changed, 1 insertion(+) diff --git a/flake.nix b/flake.nix index 34c8f5a95..d7137a6a2 100644 --- a/flake.nix +++ b/flake.nix @@ -31,6 +31,7 @@ # haskell-language-server = {}; # hlint = {}; }; + modules = [{ghcOptions = ["-Wno-error=x-partial"];}]; shell.buildInputs = with pkgs; [ zlib z3 From 7f2665837442222d63dae0cf1fe884da705fe38e Mon Sep 17 00:00:00 2001 From: Lars Kuhtz Date: Thu, 19 Oct 2023 14:06:49 -0700 Subject: [PATCH 09/11] fix cabal.project --- cabal.project | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cabal.project b/cabal.project index ad34597a2..4e1e2eb72 100644 --- a/cabal.project +++ b/cabal.project @@ -50,5 +50,5 @@ allow-newer: webauthn:* -- head and tail are marked deprecated in recent base. We'll -- yet have to fix that in the code base. if impl(ghc >= 9.8.1) - package chainweb + package pact ghc-options: -Wno-x-partial From 0dee20cfe06227550e1231b139cb77adc4828e9b Mon Sep 17 00:00:00 2001 From: Greg Hale Date: Thu, 19 Oct 2023 15:50:41 -0700 Subject: [PATCH 10/11] Remove partial functions --- flake.nix | 1 - src-tool/Pact/Analyze/Eval/Term.hs | 11 +++++++---- src-tool/Pact/Analyze/Translate.hs | 7 ++++++- src/Pact/ApiReq.hs | 4 +++- src/Pact/Eval.hs | 5 +++-- src/Pact/PersistPactDb/Regression.hs | 12 +++++++----- src/Pact/Server/History/Persistence.hs | 4 ++-- src/Pact/Typechecker.hs | 12 ++++++++---- 8 files changed, 36 insertions(+), 20 deletions(-) diff --git a/flake.nix b/flake.nix index d7137a6a2..34c8f5a95 100644 --- a/flake.nix +++ b/flake.nix @@ -31,7 +31,6 @@ # haskell-language-server = {}; # hlint = {}; }; - modules = [{ghcOptions = ["-Wno-error=x-partial"];}]; shell.buildInputs = with pkgs; [ zlib z3 diff --git a/src-tool/Pact/Analyze/Eval/Term.hs b/src-tool/Pact/Analyze/Eval/Term.hs index 09b73d3a4..f4782c556 100644 --- a/src-tool/Pact/Analyze/Eval/Term.hs +++ b/src-tool/Pact/Analyze/Eval/Term.hs @@ -904,7 +904,10 @@ format s tms = do then Right (literalS (Str s)) else if plen - length tms > 1 then Left (AnalyzeFailure dummyInfo "format: not enough arguments for template") - else Right $ foldl' - (\r (e, t) -> r .++ rep e .++ t) - (head parts) - (zip tms (tail parts)) + else case parts of + partsHead:partsTail -> + Right $ foldl' + (\r (e, t) -> r .++ rep e .++ t) + partsHead + (zip tms partsTail) + [] -> error "Impossible case: We checked that this list is nonempty" diff --git a/src-tool/Pact/Analyze/Translate.hs b/src-tool/Pact/Analyze/Translate.hs index c8035b5f4..344ca2148 100644 --- a/src-tool/Pact/Analyze/Translate.hs +++ b/src-tool/Pact/Analyze/Translate.hs @@ -754,7 +754,12 @@ translatePact nodes = do -- The proper fix is recognizing the nested defpact dyn invoke and replacing it with -- the default value of what the invocation would return. -- For now, this unblocks the problem. - (if null protoSteps then [] else tail $ reverse protoSteps) + (if null protoSteps + then [] + else (\case + _:xs -> xs + [] -> error "Expected nonempty list" + ) $ reverse protoSteps) let steps = zipWith3 (\(Step exec p e _ _) mCancel mRb -> Step exec p e mCancel mRb) diff --git a/src/Pact/ApiReq.hs b/src/Pact/ApiReq.hs index bbd600de2..397bb8793 100644 --- a/src/Pact/ApiReq.hs +++ b/src/Pact/ApiReq.hs @@ -275,7 +275,9 @@ combineSigDatas sds outputLocal = do when (S.size hashes /= 1 || S.size cmds /= 1) $ do error "SigData files must contain exactly one unique hash and command. Aborting..." let sigs = foldl1 f $ map _sigDataSigs sds - returnCommandIfDone outputLocal $ SigData (head $ S.toList hashes) sigs (Just $ head $ S.toList cmds) + case (S.toList cmds, S.toList hashes) of + (cmd:_, hash':_) -> returnCommandIfDone outputLocal $ SigData hash' sigs (Just cmd) + _ -> error "Expected nonempty lists of commands and hashes" where f accum sigs | length accum /= length sigs = error "Sig lists have different lengths" diff --git a/src/Pact/Eval.hs b/src/Pact/Eval.hs index 061e2819d..a8e836d4f 100644 --- a/src/Pact/Eval.hs +++ b/src/Pact/Eval.hs @@ -659,8 +659,9 @@ enforceAcyclic -> Eval e [(Term (Either l r), key, [key])] enforceAcyclic info cs = forM cs $ \c -> case c of AcyclicSCC v -> return v - CyclicSCC vs -> do - let i = if null vs then info else _tInfo $ view _1 $ head vs + CyclicSCC [] -> error "Expected nonempty list" + CyclicSCC vs@(v:_) -> do + let i = if null vs then info else _tInfo $ view _1 $ v pl = over (traverse . _3) (SomeDoc . prettyList) $ over (traverse . _1) (fmap mkSomeDoc) $ vs diff --git a/src/Pact/PersistPactDb/Regression.hs b/src/Pact/PersistPactDb/Regression.hs index 91f3fe45d..70bad5e51 100644 --- a/src/Pact/PersistPactDb/Regression.hs +++ b/src/Pact/PersistPactDb/Regression.hs @@ -111,11 +111,13 @@ runRegression p = do (commit v) void $ begin v tids <- _txids pactdb user1 t1 v - assertEquals "user txids" [1] tids - assertEquals' "user txlogs" - [TxLog "USER_user1" "key1" row, - TxLog "USER_user1" "key1" row'] $ - _getTxLog pactdb usert (head tids) v + case tids of + tid:_ -> + assertEquals' "user txlogs" + [TxLog "USER_user1" "key1" row, + TxLog "USER_user1" "key1" row'] $ + _getTxLog pactdb usert tid v + _ -> error "Expected nonempty list of tids" _writeRow pactdb Insert usert "key2" row v assertEquals' "user insert key2 pre-rollback" (Just row) (_readRow pactdb usert "key2" v) assertEquals' "keys pre-rollback" ["key1","key2"] $ _keys pactdb (UserTables user1) v diff --git a/src/Pact/Server/History/Persistence.hs b/src/Pact/Server/History/Persistence.hs index 5bc6295c2..8d9bc2623 100644 --- a/src/Pact/Server/History/Persistence.hs +++ b/src/Pact/Server/History/Persistence.hs @@ -148,8 +148,8 @@ selectCompletedCommands e v = foldM f HashMap.empty v rs <- qrys (_qryCompletedStmt e) [hashToField $ unRequestKey rk] [RText,RInt,RInt] if null rs then return m - else case head rs of - [SText (Utf8 cr),SInt _, SInt _] -> + else case rs of + [SText (Utf8 cr),SInt _, SInt _]:_ -> return $ HashMap.insert rk (crFromField cr) m r -> dbError $ "Invalid result from query: " ++ show r diff --git a/src/Pact/Typechecker.hs b/src/Pact/Typechecker.hs index 2a56d059f..705819931 100644 --- a/src/Pact/Typechecker.hs +++ b/src/Pact/Typechecker.hs @@ -1005,10 +1005,11 @@ toAST (TApp Term.App{..} _) = do return app' Resume -> do app' <- specialBind - case head args' of -- 'specialBind' ensures non-empty args - (Binding _ _ _ (AstBindSchema sty)) -> + case Data.List.uncons args' of -- 'specialBind' ensures non-empty args + Just (Binding _ _ _ (AstBindSchema sty), _) -> setOrAssocYR yrResume sty - a -> die'' a "Expected binding" + Just (a,_) -> die'' a "Expected binding" + Nothing -> error "Impossible case" return app' _ -> mkApp fun' args' @@ -1204,7 +1205,10 @@ showFails = do -- | unsafe lens for using `typecheckBody` with const singLens :: Iso' a [a] -singLens = iso pure head +singLens = iso pure (\case + x:_ -> x + [] -> error "Expected nonempty list" + ) -- | Typecheck a top-level production. typecheck :: TopLevel Node -> TC (TopLevel Node) From b889e82cd8bdb84350c93de2c7fb690022997ff2 Mon Sep 17 00:00:00 2001 From: Greg Hale Date: Fri, 20 Oct 2023 10:40:27 -0700 Subject: [PATCH 11/11] whitespace to test CI rebuild time --- src/Pact/Repl.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Pact/Repl.hs b/src/Pact/Repl.hs index 6ca0f34db..90017bb4f 100644 --- a/src/Pact/Repl.hs +++ b/src/Pact/Repl.hs @@ -434,7 +434,8 @@ replLookupModule rs mn = do Right (modules,_) -> case HM.lookup mn modules of Nothing -> Left $ "module not found: " ++ show mn ++ ", modules=" ++ show (HM.keys modules) - Just moduleData -> Right moduleData + Just moduleData -> + Right moduleData -- | install repl lib functions into monad state useReplLib :: Repl ()