diff --git a/Changelog.markdown b/Changelog.markdown --- a/Changelog.markdown +++ b/Changelog.markdown @@ -1,3 +1,9 @@ +# 2023-12-30 (v0.9.8) + +* fix notification serialization in transaction (#362) +* require minimum GHC 9.2 (dropping GHC 8.10 and GHC 9.0) +* add support for GHC 9.4 + # 2023-07-18 (v0.9.7) * fix critical bug resulting in empty results from cross joins diff --git a/project-m36.cabal b/project-m36.cabal --- a/project-m36.cabal +++ b/project-m36.cabal @@ -1,6 +1,6 @@ Cabal-Version: 2.2 Name: project-m36 -Version: 0.9.7 +Version: 0.9.8 License: MIT --note that this license specification is erroneous and only labeled MIT to appease hackage which does not recognize public domain packages in cabal >2.2- Project:M36 is dedicated to the public domain Build-Type: Simple @@ -35,9 +35,9 @@ Default: True Library - Build-Depends: base>=4.8 && < 4.17, ghc-paths, mtl, containers, unordered-containers, hashable, haskeline, directory, MonadRandom, random-shuffle, uuid >= 1.3.12, cassava >= 0.4.5.1 && < 0.6, text, bytestring, deepseq, deepseq-generics, vector, parallel, monad-parallel, exceptions, transformers, gnuplot, filepath, zlib, directory, temporary, stm, time, old-locale, rset, attoparsec, either, base64-bytestring, data-interval, extended-reals, aeson >= 1.1, path-pieces, conduit, resourcet, http-api-data, semigroups, QuickCheck, quickcheck-instances, list-t, stm-containers >= 0.2.15, foldl, optparse-applicative, Glob, cryptohash-sha256, text-manipulate >= 0.2.0.1 && < 0.4, winery >= 1.4, curryer-rpc>=0.2.2, network, async, vector-instances, recursion-schemes, streamly >= 0.7.2, convertible, fast-builder, scientific, time-compat >= 1.9.6.1 + Build-Depends: base>=4.16 && < 4.19, ghc-paths, mtl, containers, unordered-containers, hashable, haskeline, directory, MonadRandom, random-shuffle, uuid >= 1.3.12, cassava >= 0.4.5.1 && < 0.6, text, bytestring, deepseq, deepseq-generics, vector, parallel, monad-parallel, exceptions, transformers, gnuplot, filepath, zlib, directory, temporary, stm, time, old-locale, rset, attoparsec, either, base64-bytestring, data-interval, extended-reals, aeson >= 1.1, path-pieces, conduit, resourcet, http-api-data, semigroups, QuickCheck, quickcheck-instances, list-t, stm-containers >= 0.2.15, foldl, optparse-applicative, Glob, cryptohash-sha256, text-manipulate >= 0.2.0.1 && < 0.4, winery >= 1.4, curryer-rpc>=0.3.2, network, async, vector-instances, recursion-schemes, streamly == 0.9.0, convertible, fast-builder, scientific if flag(haskell-scripting) - Build-Depends: ghc >= 8.2 && < 9.3 + Build-Depends: ghc >= 9.0 && < 9.5 CPP-Options: -DPM36_HASKELL_SCRIPTING if impl(ghc>= 8) && flag(haskell-scripting) build-depends: @@ -153,7 +153,7 @@ Executable tutd if flag(haskell-scripting) - Build-Depends: ghc >= 8.2 && < 9.3 + Build-Depends: ghc >= 9.0 && < 9.5 Build-Depends: base >=4.8, ghc-paths, project-m36, @@ -228,7 +228,7 @@ Executable project-m36-server if flag(haskell-scripting) - Build-Depends: ghc >= 8.2 && < 9.3 + Build-Depends: ghc >= 9.0 && < 9.5 Build-Depends: base, ghc-paths, transformers, @@ -421,7 +421,7 @@ Executable Example-Plantfarm Default-Language: Haskell2010 Default-Extensions: OverloadedStrings - Build-Depends: aeson, barbies, base, binary, containers, deepseq, hashable, project-m36, random, scotty, text, winery + Build-Depends: aeson, barbies, base, containers, deepseq, hashable, project-m36, random, scotty, text, winery Main-Is: examples/Plantfarm.hs GHC-Options: -Wall -threaded diff --git a/src/lib/ProjectM36/Base.hs b/src/lib/ProjectM36/Base.hs --- a/src/lib/ProjectM36/Base.hs +++ b/src/lib/ProjectM36/Base.hs @@ -20,8 +20,7 @@ import qualified Data.List as L import Data.Text (Text) import Data.Time.Clock -import Data.Time.Clock.Compat () -import Data.Time.Calendar (Day) +import Data.Time.Calendar (Day(..)) import Data.Typeable import Data.ByteString (ByteString) import qualified Data.List.NonEmpty as NE @@ -43,6 +42,17 @@ instance Hashable (S.Set AttributeName) where hashWithSalt salt s = salt `hashWithSalt` S.toList s #endif + +-- time-compat includes these instances but time-compat is a dependency that is problematic, so just copy the instances here +instance Hashable Day where + hashWithSalt salt (ModifiedJulianDay d) = hashWithSalt salt d + +instance Hashable UTCTime where + hashWithSalt salt (UTCTime d dt) = + salt `hashWithSalt` d `hashWithSalt` dt + +instance Hashable DiffTime where + hashWithSalt salt = hashWithSalt salt . toRational -- | Database atoms are the smallest, undecomposable units of a tuple. Common examples are integers, text, or unique identity keys. data Atom = IntegerAtom !Integer | diff --git a/src/lib/ProjectM36/HashSecurely.hs b/src/lib/ProjectM36/HashSecurely.hs --- a/src/lib/ProjectM36/HashSecurely.hs +++ b/src/lib/ProjectM36/HashSecurely.hs @@ -25,7 +25,6 @@ import Data.Time.Calendar import Data.Time.Clock import Codec.Winery (Serialise) -import Data.Int (Int64) newtype SecureHash = SecureHash { _unSecureHash :: B.ByteString } deriving (Serialise, Show, Eq) diff --git a/src/lib/ProjectM36/ScriptSession.hs b/src/lib/ProjectM36/ScriptSession.hs --- a/src/lib/ProjectM36/ScriptSession.hs +++ b/src/lib/ProjectM36/ScriptSession.hs @@ -23,7 +23,18 @@ import Unsafe.Coerce import GHC.LanguageExtensions (Extension(OverloadedStrings,ExtendedDefaultRules,ImplicitPrelude,ScopedTypeVariables)) -#if MIN_VERSION_ghc(9,2,0) +#if MIN_VERSION_ghc(9,4,0) +import GHC.Utils.Panic (handleGhcException) +import GHC.Driver.Session (projectVersion, PackageDBFlag(PackageDB), PkgDbRef(PkgDbPath), TrustFlag(TrustPackage), gopt_set, xopt_set, PackageFlag(ExposePackage), PackageArg(PackageArg), ModRenaming(ModRenaming)) +import GHC.Types.SourceText (SourceText(NoSourceText)) +import GHC.Unit.Types (IsBootInterface(NotBoot)) +import GHC.Driver.Ppr (showSDocForUser) +import GHC.Core.Type (eqType) +import GHC.Core.TyCo.Ppr (pprType) +import GHC.Utils.Encoding (zEncodeString) +import GHC.Unit.State (emptyUnitState) +import GHC.Types.PkgQual (RawPkgQual(NoRawPkgQual)) +#elif MIN_VERSION_ghc(9,2,0) -- GHC 9.2.2 import GHC.Utils.Panic (handleGhcException) import GHC.Driver.Session (projectVersion, PackageDBFlag(PackageDB), PkgDbRef(PkgDbPath), TrustFlag(TrustPackage), gopt_set, xopt_set, PackageFlag(ExposePackage), PackageArg(PackageArg), ModRenaming(ModRenaming)) @@ -168,7 +179,11 @@ #else ideclName = noLoc (mkModuleName fullModuleName), #endif +#if MIN_VERSION_ghc(9,4,0) + ideclPkgQual = NoRawPkgQual, +#else ideclPkgQual = Nothing, +#endif #if MIN_VERSION_ghc(9,0,0) ideclSource = NotBoot, #else @@ -212,7 +227,9 @@ setContext (IIDecl (simpleImportDecl (mkModuleName moduleNam)) : ctx) showType :: DynFlags -> Type -> String -#if MIN_VERSION_ghc(9,2,0) +#if MIN_VERSION_ghc(9,4,0) +showType dflags ty = showSDocForUser dflags emptyUnitState alwaysQualify (pprType ty) +#elif MIN_VERSION_ghc(9,2,0) showType dflags ty = showSDocForUser dflags emptyUnitState alwaysQualify (pprTypeForUser ty) #else showType dflags ty = showSDocForUser dflags alwaysQualify (pprTypeForUser ty) diff --git a/src/lib/ProjectM36/Transaction/Persist.hs b/src/lib/ProjectM36/Transaction/Persist.hs --- a/src/lib/ProjectM36/Transaction/Persist.hs +++ b/src/lib/ProjectM36/Transaction/Persist.hs @@ -45,6 +45,9 @@ transactionInfoPath :: FilePath -> FilePath transactionInfoPath transdir = transdir "info" +notificationsPath :: FilePath -> FilePath +notificationsPath transdir = transdir "notifs" + relvarsPath :: FilePath -> FilePath relvarsPath transdir = transdir "relvars" @@ -82,13 +85,14 @@ incDeps <- readIncDeps transDir typeCons <- readTypeConstructorMapping transDir sschemas <- readSubschemas transDir + notifs <- readNotifications transDir dbcFuncs <- readFuncs transDir (dbcFuncsPath transDir) basicDatabaseContextFunctions mScriptSession atomFuncs <- readFuncs transDir (atomFuncsPath transDir) precompiledAtomFunctions mScriptSession registeredQs <- readRegisteredQueries transDir let newContext = DatabaseContext { inclusionDependencies = incDeps, relationVariables = relvars, typeConstructorMapping = typeCons, - notifications = M.empty, + notifications = notifs, atomFunctions = atomFuncs, dbcFunctions = dbcFuncs, registeredQueries = registeredQs } @@ -108,6 +112,7 @@ writeIncDeps sync tempTransDir (inclusionDependencies context) writeFuncs sync (atomFuncsPath tempTransDir) (HS.toList (atomFunctions context)) writeFuncs sync (dbcFuncsPath tempTransDir) (HS.toList (dbcFunctions context)) + writeNotifications sync tempTransDir (notifications context) writeTypeConstructorMapping sync tempTransDir (typeConstructorMapping context) writeSubschemas sync tempTransDir (subschemas trans) writeRegisteredQueries sync tempTransDir (registeredQueries context) @@ -280,3 +285,16 @@ writeRegisteredQueries sync transDir regQs = do let regQsPath = registeredQueriesPath transDir traceBlock "write registered queries" $ writeSerialiseSync sync regQsPath regQs + +readNotifications :: FilePath -> IO Notifications +readNotifications transDir = do + let notifsPath = notificationsPath transDir + readFileDeserialise notifsPath + +writeNotifications :: DiskSync -> FilePath -> Notifications -> IO () +writeNotifications sync transDir notifs = do + let notifsPath = notificationsPath transDir + traceBlock "write notifications" $ writeSerialiseSync sync notifsPath notifs + + + diff --git a/test/TransactionGraph/Persist.hs b/test/TransactionGraph/Persist.hs --- a/test/TransactionGraph/Persist.hs +++ b/test/TransactionGraph/Persist.hs @@ -31,7 +31,6 @@ testDBSimplePersistence, testFunctionPersistence, testMerkleHashValidation] - stamp' :: UTCTime stamp' = UTCTime (fromGregorian 1980 01 01) (secondsToDiffTime 1000) @@ -85,6 +84,9 @@ conn <- assertIOEither $ connectProjectM36 connInfo sess <- assertIOEither $ createSessionAtHead conn "master" Right _ <- executeDatabaseContextExpr sess conn (Assign "x" (ExistingRelation relationTrue)) + -- add a notification because we forgot to read/write it as part of the transaction before + let relX = RelationVariable "x" () + Right _ <- executeDatabaseContextExpr sess conn (AddNotification "testnotif" relX relX relX) Right _ <- commit sess conn val <- C.validateMerkleHashes sess conn assertEqual "merkle success" (Right ()) val @@ -130,8 +132,6 @@ assertEqual "open connection merkle validation" (DatabaseValidationError [MerkleValidationError (transactionId trans) regMerkleHash malMerkleHash]) err Right _ -> assertFailure "open connection validation" - - --only Haskell-scripted dbc and atom functions can be serialized testFunctionPersistence :: Test #if !defined(PM36_HASKELL_SCRIPTING) @@ -159,7 +159,7 @@ let expectedRel = mkRelationFromList (attributesFromList [Attribute "a" IntAtomType]) [[IntAtom 3]] assertEqual "testdisk dbc function run" expectedRel res -#endif +#endif assertIOEither :: (Show a) => IO (Either a b) -> IO b assertIOEither x = do