diff --git a/cabal.project b/cabal.project index 0a22c1ab57..a9d5708c50 100644 --- a/cabal.project +++ b/cabal.project @@ -75,8 +75,8 @@ package yet-another-logger source-repository-package type: git location: https://github.com/kadena-io/pact.git - tag: 4c0acc5fb322014b120c4a5942db8505968ab046 - --sha256: 0kyh6xwm06npbw73dil5xpngfr7h6ppsn5jz7hjkirq9hj33aqqv + tag: 6098d8034a7e4efc3bf40b1c5b9d180a13772c3d + --sha256: 11yh6xwm06npbw73dil5xpngfr7h6ppsn5jz7hjkirq9hj33aqqv source-repository-package type: git @@ -123,12 +123,13 @@ source-repository-package tag: d8019c3404d6f3b3c0b0416e9899cfdf614ef425 --sha256: 09msayidg23rsdz97fcfqqalm4pbawx3c1qihgab8hnlmjxby103 --- Patch merged into master (upcoming version 10.0). We are currently using 9.2 +-- Patch merged into master (upcoming verison 10.0). We are currently using 9.2. +-- This fork contains additional fixes for using 9.2 with recent compilers. source-repository-package type: git location: https://github.com/larskuhtz/sbv - tag: b66e3a04c20f753213fe7e5115a95b3fe34109f9 - --sha256: 0dca5pl56nz8ijnqavnpxw5f47qmpalszd5w0ag8bq3fd0l3839m + tag: 1f2d042718fcf9a140398bd3dedac77c207cce27 + --sha256: sha256-Y2ZRU9lkrClYiNc8apwy4uO1TAvJ8JZEPKF73ZuGdlA= -- Required for non-canonical decode in base64-bytestring (remove after 2.20 fork) source-repository-package diff --git a/chainweb.cabal b/chainweb.cabal index a8b1bfde49..6a6ab9726f 100644 --- a/chainweb.cabal +++ b/chainweb.cabal @@ -283,8 +283,6 @@ library , Network.X509.SelfSigned , Numeric.Cast - , Numeric.Additive - , Numeric.AffineSpace , P2P.BootstrapNodes , P2P.Node @@ -416,6 +414,7 @@ library , optparse-applicative >= 0.14 , pact >= 4.2.0.1 , pact-json >= 0.1 + , pact-time:numeric >=0.3.0.1 , parallel >= 3.2.2.0 , patience >= 0.3 , pem >=0.2 @@ -595,6 +594,7 @@ test-suite chainweb-tests , http-client-tls >=0.3 , pact , pact-json >= 0.1 + , pact-time:numeric >=0.3.0.1 , quickcheck-instances >= 0.3 , random >= 1.2 , resource-pool >= 0.4 @@ -778,6 +778,7 @@ executable cwtool , optparse-applicative >= 0.14 , pact , pact-json + , pact-time:numeric >=0.3.0.1 , patience >= 0.3 , process >= 1.5 , quickcheck-instances >= 0.3 @@ -856,6 +857,7 @@ benchmark bench , merkle-log >=0.2 , mtl >= 2.3 , pact + , pact-time:numeric >=0.3.0.1 , random >= 1.2 , streaming , text >= 2.0 diff --git a/src/Chainweb/Mempool/CurrentTxs.hs b/src/Chainweb/Mempool/CurrentTxs.hs index 32f50b1921..aa9a47f039 100644 --- a/src/Chainweb/Mempool/CurrentTxs.hs +++ b/src/Chainweb/Mempool/CurrentTxs.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -35,7 +36,9 @@ module Chainweb.Mempool.CurrentTxs import qualified Data.ByteString as B import qualified Data.ByteString.Short as BS +#if !MIN_VERSION_base(4,20,0) import Data.Foldable +#endif import qualified Data.List as L import qualified Data.Set as S import qualified Data.Vector as V diff --git a/src/Chainweb/Mempool/InMem.hs b/src/Chainweb/Mempool/InMem.hs index 8a275729b1..85c3ce2530 100644 --- a/src/Chainweb/Mempool/InMem.hs +++ b/src/Chainweb/Mempool/InMem.hs @@ -1,5 +1,6 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NumericUnderscores #-} @@ -36,7 +37,11 @@ import Data.Aeson import Data.Bifunctor (bimap) import qualified Data.ByteString.Short as SB import Data.Decimal +#if MIN_VERSION_base(4,20,0) +import Data.Foldable (foldlM) +#else import Data.Foldable (foldl', foldlM) +#endif import Data.Function (on) import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap diff --git a/src/Chainweb/Pact/Backend/RelationalCheckpointer.hs b/src/Chainweb/Pact/Backend/RelationalCheckpointer.hs index e7ffea5467..fa191eba15 100644 --- a/src/Chainweb/Pact/Backend/RelationalCheckpointer.hs +++ b/src/Chainweb/Pact/Backend/RelationalCheckpointer.hs @@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NumericUnderscores #-} @@ -31,7 +32,9 @@ import Control.Monad.IO.Class import Data.ByteString (intercalate) import qualified Data.ByteString.Short as BS +#if !MIN_VERSION_base(4,20,0) import Data.Foldable (foldl') +#endif import Data.Int import qualified Data.Map.Strict as M import Data.Maybe @@ -277,8 +280,7 @@ doGetEarliestBlock db = do [] -> return Nothing (!o:_) -> return (Just o) where - qtext = "SELECT blockheight, hash FROM BlockHistory \ - \ ORDER BY blockheight ASC LIMIT 1" + qtext = "SELECT blockheight, hash FROM BlockHistory ORDER BY blockheight ASC LIMIT 1" go [SInt hgt, SBlob blob] = let hash = either error id $ runGetEitherS decodeBlockHash blob @@ -292,8 +294,7 @@ doGetLatestBlock db = do [] -> return Nothing (!o:_) -> return (Just o) where - qtext = "SELECT blockheight, hash FROM BlockHistory \ - \ ORDER BY blockheight DESC LIMIT 1" + qtext = "SELECT blockheight, hash FROM BlockHistory ORDER BY blockheight DESC LIMIT 1" go [SInt hgt, SBlob blob] = let hash = either error id $ runGetEitherS decodeBlockHash blob @@ -308,8 +309,7 @@ doLookupBlock db (bheight, bhash) = do [SInt n] -> return $! n == 1 _ -> internalError "doLookupBlock: output type mismatch" where - qtext = "SELECT COUNT(*) FROM BlockHistory WHERE blockheight = ? \ - \ AND hash = ?;" + qtext = "SELECT COUNT(*) FROM BlockHistory WHERE blockheight = ? AND hash = ?;" doGetBlockParent :: ChainwebVersion -> ChainId -> SQLiteEnv -> (BlockHeight, BlockHash) -> IO (Maybe BlockHash) doGetBlockParent v cid db (bh, hash) @@ -335,11 +335,13 @@ doLookupSuccessful curHeight hashes = do callDb "doLookupSuccessful" $ \db -> do let hss = V.toList hashes - params = Utf8 $ intercalate "," (map (const "?") hss) - qtext = "SELECT blockheight, hash, txhash FROM \ - \TransactionIndex INNER JOIN BlockHistory \ - \USING (blockheight) WHERE txhash IN (" <> params <> ")" - <> " AND blockheight <= ?;" + params = intercalate "," (map (const "?") hss) + qtext = Utf8 $ intercalate " " + [ "SELECT blockheight, hash, txhash" + , "FROM TransactionIndex" + , "INNER JOIN BlockHistory USING (blockheight)" + , "WHERE txhash IN (" <> params <> ")" <> " AND blockheight <= ?;" + ] qvals -- match query params above. first, hashes = map (\(TypedHash h) -> SBlob $ BS.fromShort h) hss diff --git a/src/Chainweb/Rosetta/Internal.hs b/src/Chainweb/Rosetta/Internal.hs index b5f7b88732..53bd1a3a23 100644 --- a/src/Chainweb/Rosetta/Internal.hs +++ b/src/Chainweb/Rosetta/Internal.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -24,7 +25,11 @@ import Control.Monad.Except (throwError) import Control.Monad.IO.Class import Control.Monad.Trans.Except import Data.Map (Map) +#if MIN_VERSION_base(4,20,0) +import Data.List (find) +#else import Data.List (foldl', find) +#endif import Data.Default (def) import Data.Decimal import Data.Word (Word64) diff --git a/src/Chainweb/Rosetta/Utils.hs b/src/Chainweb/Rosetta/Utils.hs index ee45f60d0e..b1628bd8c3 100644 --- a/src/Chainweb/Rosetta/Utils.hs +++ b/src/Chainweb/Rosetta/Utils.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} @@ -18,7 +19,9 @@ import Data.Aeson import Data.Aeson.Types (Pair) import qualified Data.Aeson.KeyMap as KM import Data.Bifunctor (first) +#if !MIN_VERSION_base(4,20,0) import Data.Foldable (foldl') +#endif import Data.Decimal ( Decimal, DecimalRaw(Decimal) ) import Data.Hashable (Hashable(..)) import Data.List (sortOn, inits) diff --git a/src/Numeric/Additive.hs b/src/Numeric/Additive.hs deleted file mode 100644 index 41234fa989..0000000000 --- a/src/Numeric/Additive.hs +++ /dev/null @@ -1,317 +0,0 @@ -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE ScopedTypeVariables #-} - --- | --- Module: Numeric.Additive --- Copyright: Copyright © 2018 Kadena LLC. --- License: MIT --- Maintainer: Lars Kuhtz --- Stability: experimental --- --- Haskell's @Num@ class doesn't support fine grained control --- over what arithmetic operations are defined for a type. --- Sometimes only some operations have a well defined semantics --- and @Num@ instances are notorious for including undefined/error --- values or unlawful workarounds. --- -module Numeric.Additive -( --- * Additive Semigroup - AdditiveSemigroup(..) -, AdditiveAbelianSemigroup -, (^+^) - --- * Additive Monoid -, AdditiveMonoid(..) -, AdditiveAbelianMonoid - --- * Additive Group -, AdditiveGroup(..) - --- * Additive Abelian Group -, AdditiveAbelianGroup -, (^-^) -) where - -import Data.DoubleWord -import Data.Int -import Data.Word - -import Numeric.Natural - --- -------------------------------------------------------------------------- -- --- | Additive Semigroup --- --- prop> (a `plus` b) `plus` c == a `plus` (b `plus` c) --- -class AdditiveSemigroup g where - plus :: g -> g -> g - -instance AdditiveSemigroup Integer where - plus = (+) - {-# INLINE plus #-} - -instance AdditiveSemigroup Rational where - plus = (+) - {-# INLINE plus #-} - -instance AdditiveSemigroup Natural where - plus = (+) - {-# INLINE plus #-} - -instance AdditiveSemigroup Int where - plus = (+) - {-# INLINE plus #-} - -instance AdditiveSemigroup Word where - plus = (+) - {-# INLINE plus #-} - -instance AdditiveSemigroup Word8 where - plus = (+) - {-# INLINE plus #-} - -instance AdditiveSemigroup Word16 where - plus = (+) - {-# INLINE plus #-} - -instance AdditiveSemigroup Word32 where - plus = (+) - {-# INLINE plus #-} - -instance AdditiveSemigroup Word64 where - plus = (+) - {-# INLINE plus #-} - -instance AdditiveSemigroup Word128 where - plus = (+) - {-# INLINE plus #-} - -instance AdditiveSemigroup Word256 where - plus = (+) - {-# INLINE plus #-} - -instance AdditiveSemigroup Int8 where - plus = (+) - {-# INLINE plus #-} - -instance AdditiveSemigroup Int16 where - plus = (+) - {-# INLINE plus #-} - -instance AdditiveSemigroup Int32 where - plus = (+) - {-# INLINE plus #-} - -instance AdditiveSemigroup Int64 where - plus = (+) - {-# INLINE plus #-} - --- -------------------------------------------------------------------------- -- --- | Additive Abelian Semigroup --- --- prop> a `plus` b == b `plus` a --- -class AdditiveSemigroup g => AdditiveAbelianSemigroup g - -instance AdditiveAbelianSemigroup Integer -instance AdditiveAbelianSemigroup Rational -instance AdditiveAbelianSemigroup Natural -instance AdditiveAbelianSemigroup Int -instance AdditiveAbelianSemigroup Int8 -instance AdditiveAbelianSemigroup Int16 -instance AdditiveAbelianSemigroup Int32 -instance AdditiveAbelianSemigroup Int64 -instance AdditiveAbelianSemigroup Word -instance AdditiveAbelianSemigroup Word8 -instance AdditiveAbelianSemigroup Word16 -instance AdditiveAbelianSemigroup Word32 -instance AdditiveAbelianSemigroup Word64 -instance AdditiveAbelianSemigroup Word128 -instance AdditiveAbelianSemigroup Word256 - -infixl 6 ^+^ -(^+^) :: AdditiveAbelianSemigroup g => g -> g -> g -(^+^) = plus -{-# INLINE (^+^) #-} - --- -------------------------------------------------------------------------- -- --- | Additive Monoid --- --- prop> a `plus` zero == a --- prop> zero `plus` a == a --- -class AdditiveSemigroup g => AdditiveMonoid g where - zero :: g - -instance AdditiveMonoid Integer where - zero = 0 - {-# INLINE zero #-} - -instance AdditiveMonoid Rational where - zero = 0 - {-# INLINE zero #-} - -instance AdditiveMonoid Natural where - zero = 0 - {-# INLINE zero #-} - -instance AdditiveMonoid Int where - zero = 0 - {-# INLINE zero #-} - -instance AdditiveMonoid Word where - zero = 0 - {-# INLINE zero #-} - -instance AdditiveMonoid Word8 where - zero = 0 - {-# INLINE zero #-} - -instance AdditiveMonoid Word16 where - zero = 0 - {-# INLINE zero #-} - -instance AdditiveMonoid Word32 where - zero = 0 - {-# INLINE zero #-} - -instance AdditiveMonoid Word64 where - zero = 0 - {-# INLINE zero #-} - -instance AdditiveMonoid Word128 where - zero = 0 - {-# INLINE zero #-} - -instance AdditiveMonoid Word256 where - zero = 0 - {-# INLINE zero #-} - -instance AdditiveMonoid Int8 where - zero = 0 - {-# INLINE zero #-} - -instance AdditiveMonoid Int16 where - zero = 0 - {-# INLINE zero #-} - -instance AdditiveMonoid Int32 where - zero = 0 - {-# INLINE zero #-} - -instance AdditiveMonoid Int64 where - zero = 0 - {-# INLINE zero #-} - -type AdditiveAbelianMonoid g = (AdditiveMonoid g, AdditiveAbelianSemigroup g) - --- -------------------------------------------------------------------------- -- --- | Additive Group --- --- prop> a `plus` inverse a == zero --- prop> inverse a `plus` a == zero --- -class AdditiveMonoid g => AdditiveGroup g where - invert :: g -> g - invert a = zero `minus` a - - minus :: g -> g -> g - minus a b = a `plus` invert b - - {-# MINIMAL invert | minus #-} - -instance AdditiveGroup Integer where - invert a = -a - minus = (-) - {-# INLINE invert #-} - {-# INLINE minus #-} - -instance AdditiveGroup Rational where - invert a = -a - minus = (-) - {-# INLINE invert #-} - {-# INLINE minus #-} - -instance AdditiveGroup Int where - invert a = -a - minus = (-) - {-# INLINE invert #-} - {-# INLINE minus #-} - -instance AdditiveGroup Word where - invert a = -a - minus = (-) - {-# INLINE invert #-} - {-# INLINE minus #-} - -instance AdditiveGroup Word8 where - invert a = -a - minus = (-) - {-# INLINE invert #-} - {-# INLINE minus #-} - -instance AdditiveGroup Word16 where - invert a = -a - minus = (-) - {-# INLINE invert #-} - {-# INLINE minus #-} - -instance AdditiveGroup Word32 where - invert a = -a - minus = (-) - {-# INLINE invert #-} - {-# INLINE minus #-} - -instance AdditiveGroup Word64 where - invert a = -a - minus = (-) - {-# INLINE invert #-} - {-# INLINE minus #-} - -instance AdditiveGroup Word128 where - invert a = -a - minus = (-) - {-# INLINE invert #-} - {-# INLINE minus #-} - -instance AdditiveGroup Word256 where - invert a = -a - minus = (-) - {-# INLINE invert #-} - {-# INLINE minus #-} - -instance AdditiveGroup Int8 where - invert a = -a - minus = (-) - {-# INLINE invert #-} - {-# INLINE minus #-} - -instance AdditiveGroup Int16 where - invert a = -a - minus = (-) - {-# INLINE invert #-} - {-# INLINE minus #-} - -instance AdditiveGroup Int32 where - invert a = -a - minus = (-) - {-# INLINE invert #-} - {-# INLINE minus #-} - -instance AdditiveGroup Int64 where - invert a = -a - minus = (-) - {-# INLINE invert #-} - {-# INLINE minus #-} - --- -------------------------------------------------------------------------- -- --- | Additive Abelian Group --- -type AdditiveAbelianGroup g = (AdditiveGroup g, AdditiveAbelianMonoid g) - -infix 6 ^-^ -(^-^) :: AdditiveAbelianGroup g => g -> g -> g -(^-^) = minus -{-# INLINE (^-^) #-} diff --git a/src/Numeric/AffineSpace.hs b/src/Numeric/AffineSpace.hs deleted file mode 100644 index 7d95e77c81..0000000000 --- a/src/Numeric/AffineSpace.hs +++ /dev/null @@ -1,110 +0,0 @@ -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} - --- | --- Module: Numeric.AffineSpace --- Copyright: Copyright © 2018 Kadena LLC. --- License: MIT --- Maintainer: Lars Kuhtz --- Stability: experimental --- -module Numeric.AffineSpace -( --- * Torsor - LeftTorsor(..) -, (.+^) -, (^+.) -, (.-.) -, (.-^) - --- * Vector Space -, FractionalVectorSpace(..) - --- * AfficeSpace -, AffineSpace -) where - -import Numeric.Additive - --- -------------------------------------------------------------------------- -- --- Torsor - --- | A torsor is a generalization of affine spaces. It doesn't require the --- underlying structure to be vector space, but an additive group suffices. --- This means that it doesn't support scalar multiplication. In particular --- it doesn't require an inverse operation to multiplication, which would --- add unneeded complexity to the formal definition of the operational --- semantics. --- --- A Torsor is also called principal homogeous space. --- --- prop> zero `add` a == a --- prop> (a `plus` b) `add` t == a `add` (b `add` t) --- prop> (s `diff` t) `add` t == s --- --- The last property is states that `add` is a bijection. --- -class (AdditiveGroup (Diff t)) => LeftTorsor t where - type Diff t - add :: Diff t -> t -> t - diff :: t -> t -> Diff t - -instance LeftTorsor Integer where - type Diff Integer = Integer - add = (+) - diff = (-) - {-# INLINE add #-} - {-# INLINE diff #-} - -instance LeftTorsor Rational where - type Diff Rational = Rational - add = (+) - diff = (-) - {-# INLINE add #-} - {-# INLINE diff #-} - -infix 6 .-. -(.-.) :: AdditiveAbelianGroup (Diff t) => LeftTorsor t => t -> t -> Diff t -(.-.) = diff - -infixl 6 ^+. -(^+.) :: AdditiveAbelianGroup (Diff t) => LeftTorsor t => Diff t -> t -> t -(^+.) = add - -infixl 6 .+^ -(.+^) :: AdditiveAbelianGroup (Diff t) => LeftTorsor t => t -> Diff t -> t -(.+^) = flip add - -infixl 6 .-^ -(.-^) :: AdditiveAbelianGroup (Diff t) => LeftTorsor t => t -> Diff t -> t -(.-^) t d = t .+^ invert d - --- -------------------------------------------------------------------------- -- --- | Vector Space over Fractional Numbers --- --- A real vector space is an additive abelian group that forms an module --- with the field of real numbers. --- --- prop> a * (b `scale` c) == (a * b) `scale` c --- prop> 1 `scale` a == a --- prop> a `scale` (b `plus` c) == (a `scale` b) `plus` (a `scale` c) --- prop> (a + b) `scale` c == (a `scale` c) `plus` (b `scale` c) --- -class (AdditiveAbelianGroup v, Fractional (Scalar v)) => FractionalVectorSpace v where - type Scalar v - scale :: Scalar v -> v -> v - -instance FractionalVectorSpace Rational where - type Scalar Rational = Rational - scale = (*) - --- -------------------------------------------------------------------------- -- --- Affine Space - --- | An affine space is a torsor for the action of the additive group --- of a vector space. --- -type AffineSpace t = (FractionalVectorSpace (Diff t), LeftTorsor t) diff --git a/src/P2P/Node/PeerDB.hs b/src/P2P/Node/PeerDB.hs index 6ad8a83575..12e677d0b8 100644 --- a/src/P2P/Node/PeerDB.hs +++ b/src/P2P/Node/PeerDB.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} @@ -85,7 +86,9 @@ import Control.Monad.STM import Data.Aeson import Data.Bits +#if !MIN_VERSION_base(4,20,0) import Data.Foldable (foldl') +#endif import qualified Data.Foldable as F import Data.Hashable import Data.IxSet.Typed