-- | A unified class for walking the database structure to produce a hash used for Merkle trees and validation.
{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, RankNTypes, ExistentialQuantification, BangPatterns #-}
module ProjectM36.HashSecurely where
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString as B
import qualified Data.ByteString.Builder as BSB
import qualified Data.ByteString.Builder.Scientific as BSB
import ProjectM36.Base
import ProjectM36.Tuple (tupleAttributes, tupleAtoms)
import ProjectM36.Serialise.Base ()
import ProjectM36.IsomorphicSchema
import ProjectM36.Transaction
import qualified Data.HashSet as HS
import qualified ProjectM36.DataConstructorDef as DC
import ProjectM36.MerkleHash
import Data.List (sortOn)
import qualified Data.Map as M
import qualified ProjectM36.TypeConstructorDef as TCons
import qualified Crypto.Hash.SHA256 as SHA256
import qualified Data.Text.Encoding as TE
import qualified Data.Text as T
import qualified Data.UUID as UUID
import qualified Data.Vector as V
import qualified Data.Set as S
import Data.Time.Calendar
import Data.Time.Clock
import Codec.Winery (Serialise)
import Data.Int (Int64)

newtype SecureHash = SecureHash { SecureHash -> ByteString
_unSecureHash :: B.ByteString }
  deriving (Typeable SecureHash
BundleSerialise SecureHash
Extractor SecureHash
Decoder SecureHash
Typeable SecureHash
-> (Proxy SecureHash -> SchemaGen Schema)
-> (SecureHash -> Builder)
-> Extractor SecureHash
-> Decoder SecureHash
-> BundleSerialise SecureHash
-> Serialise SecureHash
Proxy SecureHash -> SchemaGen Schema
SecureHash -> Builder
forall a.
Typeable a
-> (Proxy a -> SchemaGen Schema)
-> (a -> Builder)
-> Extractor a
-> Decoder a
-> BundleSerialise a
-> Serialise a
bundleSerialise :: BundleSerialise SecureHash
$cbundleSerialise :: BundleSerialise SecureHash
decodeCurrent :: Decoder SecureHash
$cdecodeCurrent :: Decoder SecureHash
extractor :: Extractor SecureHash
$cextractor :: Extractor SecureHash
toBuilder :: SecureHash -> Builder
$ctoBuilder :: SecureHash -> Builder
schemaGen :: Proxy SecureHash -> SchemaGen Schema
$cschemaGen :: Proxy SecureHash -> SchemaGen Schema
$cp1Serialise :: Typeable SecureHash
Serialise, Int -> SecureHash -> ShowS
[SecureHash] -> ShowS
SecureHash -> String
(Int -> SecureHash -> ShowS)
-> (SecureHash -> String)
-> ([SecureHash] -> ShowS)
-> Show SecureHash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SecureHash] -> ShowS
$cshowList :: [SecureHash] -> ShowS
show :: SecureHash -> String
$cshow :: SecureHash -> String
showsPrec :: Int -> SecureHash -> ShowS
$cshowsPrec :: Int -> SecureHash -> ShowS
Show, SecureHash -> SecureHash -> Bool
(SecureHash -> SecureHash -> Bool)
-> (SecureHash -> SecureHash -> Bool) -> Eq SecureHash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SecureHash -> SecureHash -> Bool
$c/= :: SecureHash -> SecureHash -> Bool
== :: SecureHash -> SecureHash -> Bool
$c== :: SecureHash -> SecureHash -> Bool
Eq)

-- run a SHA256 hasher across the necessary data structures
class HashBytes a where
  hashBytes :: a -> SHA256.Ctx -> SHA256.Ctx

instance HashBytes Atom where
  hashBytes :: Atom -> Ctx -> Ctx
hashBytes Atom
atm Ctx
ctx =
    case Atom
atm of
      IntegerAtom Integer
i -> ByteString -> Ctx
up (ByteString
"IntegerAtom" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Builder -> ByteString
build (Integer -> Builder
BSB.integerDec Integer
i))
      IntAtom Int
i -> ByteString -> Ctx
up (ByteString
"IntAtom" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Builder -> ByteString
build (Int -> Builder
BSB.intDec Int
i))
      ScientificAtom Scientific
s -> ByteString -> Ctx
up (ByteString
"ScientificAtom" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Builder -> ByteString
build (Scientific -> Builder
BSB.scientificBuilder Scientific
s))
      DoubleAtom Double
d -> ByteString -> Ctx
up (ByteString
"DoubleAtom" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Builder -> ByteString
build (Double -> Builder
BSB.doubleDec Double
d))
      TextAtom Text
t -> ByteString -> Ctx
up (ByteString
"TextAtom" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
TE.encodeUtf8 Text
t)
      DayAtom Day
d -> ByteString -> Ctx
up (ByteString
"DayAtom" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Builder -> ByteString
build (Integer -> Builder
BSB.integerDec (Day -> Integer
toModifiedJulianDay Day
d)))
      DateTimeAtom UTCTime
dt -> ByteString -> Ctx
up (ByteString
"DateTimeAtom" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>
                             Builder -> ByteString
build (Integer -> Builder
BSB.integerDec (Day -> Integer
toModifiedJulianDay (UTCTime -> Day
utctDay UTCTime
dt)) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
                              Integer -> Builder
BSB.integerDec (DiffTime -> Integer
diffTimeToPicoseconds (UTCTime -> DiffTime
utctDayTime UTCTime
dt))))
      ByteStringAtom ByteString
bs -> ByteString -> Ctx
up (ByteString
"ByteStringAtom" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
bs)
      BoolAtom Bool
b -> ByteString -> Ctx
up (ByteString
"BoolAtom" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> if Bool
b then ByteString
"1" else ByteString
"0")
      UUIDAtom UUID
u -> ByteString -> Ctx
up (ByteString
"UUIDAtom" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
BL.toStrict (UUID -> ByteString
UUID.toByteString UUID
u))
      RelationAtom Relation
r -> Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"RelationAtom" [Relation -> SHash
forall a. HashBytes a => a -> SHash
SHash Relation
r]
      RelationalExprAtom RelationalExpr
e -> Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"RelationalExprAtom" [RelationalExpr -> SHash
forall a. HashBytes a => a -> SHash
SHash RelationalExpr
e]
      ConstructedAtom Text
d AtomType
typ [Atom]
args ->
          Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"ConstructedAtom" ([Text -> SHash
forall a. HashBytes a => a -> SHash
SHash Text
d, AtomType -> SHash
forall a. HashBytes a => a -> SHash
SHash AtomType
typ] [SHash] -> [SHash] -> [SHash]
forall a. Semigroup a => a -> a -> a
<> (Atom -> SHash) -> [Atom] -> [SHash]
forall a b. (a -> b) -> [a] -> [b]
map Atom -> SHash
forall a. HashBytes a => a -> SHash
SHash [Atom]
args)
      where
        build :: Builder -> ByteString
build = ByteString -> ByteString
BL.toStrict (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BSB.toLazyByteString
        up :: ByteString -> Ctx
up = Ctx -> ByteString -> Ctx
SHA256.update Ctx
ctx


instance HashBytes T.Text where
  hashBytes :: Text -> Ctx -> Ctx
hashBytes Text
t Ctx
ctx = Ctx -> ByteString -> Ctx
SHA256.update Ctx
ctx (Text -> ByteString
TE.encodeUtf8 Text
t)
  
instance HashBytes Relation where
  hashBytes :: Relation -> Ctx -> Ctx
hashBytes (Relation Attributes
attrs RelationTupleSet
tupSet) Ctx
ctx =
    Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"Relation" [Attributes -> SHash
forall a. HashBytes a => a -> SHash
SHash Attributes
attrs, RelationTupleSet -> SHash
forall a. HashBytes a => a -> SHash
SHash RelationTupleSet
tupSet]

data SHash = forall a. HashBytes a => SHash !a

hashBytesL :: Foldable f => SHA256.Ctx -> B.ByteString -> f SHash -> SHA256.Ctx
hashBytesL :: Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
name = (SHash -> Ctx -> Ctx) -> Ctx -> f SHash -> Ctx
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(SHash a
i) ctx' :: Ctx
ctx'@(SHA256.Ctx !bs) -> ByteString
bs ByteString -> Ctx -> Ctx
`seq` a -> Ctx -> Ctx
forall a. HashBytes a => a -> Ctx -> Ctx
hashBytes a
i Ctx
ctx') (Ctx -> ByteString -> Ctx
SHA256.update Ctx
ctx ByteString
name)

instance HashBytes a => HashBytes (RelationalExprBase a) where
  hashBytes :: RelationalExprBase a -> Ctx -> Ctx
hashBytes (MakeRelationFromExprs Maybe [AttributeExprBase a]
mAttrs TupleExprsBase a
tupleExprs) Ctx
ctx =
    Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"MakeRelationFromExprs" [Maybe [AttributeExprBase a] -> SHash
forall a. HashBytes a => a -> SHash
SHash Maybe [AttributeExprBase a]
mAttrs, TupleExprsBase a -> SHash
forall a. HashBytes a => a -> SHash
SHash TupleExprsBase a
tupleExprs]
  hashBytes (MakeStaticRelation Attributes
attrs RelationTupleSet
tupSet) Ctx
ctx = -- blowing up here!
    Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"MakeStaticRelation" [Attributes -> SHash
forall a. HashBytes a => a -> SHash
SHash Attributes
attrs, RelationTupleSet -> SHash
forall a. HashBytes a => a -> SHash
SHash RelationTupleSet
tupSet]
--  hashBytes _ ctx = ctx
  hashBytes (ExistingRelation (Relation Attributes
attrs RelationTupleSet
tupSet)) Ctx
ctx =
    Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"ExistingRelation" [RelationTupleSet -> SHash
forall a. HashBytes a => a -> SHash
SHash RelationTupleSet
tupSet, Attributes -> SHash
forall a. HashBytes a => a -> SHash
SHash Attributes
attrs]
  hashBytes (RelationVariable Text
rvName a
marker) Ctx
ctx =
    Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"RelationVariable" [Text -> SHash
forall a. HashBytes a => a -> SHash
SHash Text
rvName, a -> SHash
forall a. HashBytes a => a -> SHash
SHash a
marker]
  hashBytes (Project AttributeNamesBase a
attrNames RelationalExprBase a
expr) Ctx
ctx =
    Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"Project" [AttributeNamesBase a -> SHash
forall a. HashBytes a => a -> SHash
SHash AttributeNamesBase a
attrNames, RelationalExprBase a -> SHash
forall a. HashBytes a => a -> SHash
SHash RelationalExprBase a
expr]
  hashBytes (Union RelationalExprBase a
exprA RelationalExprBase a
exprB) Ctx
ctx =
    Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"Union" [RelationalExprBase a -> SHash
forall a. HashBytes a => a -> SHash
SHash RelationalExprBase a
exprA, RelationalExprBase a -> SHash
forall a. HashBytes a => a -> SHash
SHash RelationalExprBase a
exprB]
  hashBytes (Join RelationalExprBase a
exprA RelationalExprBase a
exprB) Ctx
ctx =
    Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"Join" [RelationalExprBase a -> SHash
forall a. HashBytes a => a -> SHash
SHash RelationalExprBase a
exprA, RelationalExprBase a -> SHash
forall a. HashBytes a => a -> SHash
SHash RelationalExprBase a
exprB]
  hashBytes (Rename Text
nameA Text
nameB RelationalExprBase a
expr) Ctx
ctx =
    Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"Rename" [Text -> SHash
forall a. HashBytes a => a -> SHash
SHash Text
nameA, Text -> SHash
forall a. HashBytes a => a -> SHash
SHash Text
nameB, RelationalExprBase a -> SHash
forall a. HashBytes a => a -> SHash
SHash RelationalExprBase a
expr]
  hashBytes (Difference RelationalExprBase a
exprA RelationalExprBase a
exprB) Ctx
ctx =
    Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"Difference" [RelationalExprBase a -> SHash
forall a. HashBytes a => a -> SHash
SHash RelationalExprBase a
exprA, RelationalExprBase a -> SHash
forall a. HashBytes a => a -> SHash
SHash RelationalExprBase a
exprB]
  hashBytes (Group AttributeNamesBase a
names Text
name RelationalExprBase a
expr) Ctx
ctx =
    Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"Group" [AttributeNamesBase a -> SHash
forall a. HashBytes a => a -> SHash
SHash AttributeNamesBase a
names, Text -> SHash
forall a. HashBytes a => a -> SHash
SHash Text
name, RelationalExprBase a -> SHash
forall a. HashBytes a => a -> SHash
SHash RelationalExprBase a
expr]
  hashBytes (Ungroup Text
name RelationalExprBase a
expr) Ctx
ctx =
    Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"Ungroup" [Text -> SHash
forall a. HashBytes a => a -> SHash
SHash Text
name, RelationalExprBase a -> SHash
forall a. HashBytes a => a -> SHash
SHash RelationalExprBase a
expr]
  hashBytes (Restrict RestrictionPredicateExprBase a
pred' RelationalExprBase a
expr) Ctx
ctx =
    Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"Restrict" [RestrictionPredicateExprBase a -> SHash
forall a. HashBytes a => a -> SHash
SHash RestrictionPredicateExprBase a
pred', RelationalExprBase a -> SHash
forall a. HashBytes a => a -> SHash
SHash RelationalExprBase a
expr]
  hashBytes (Equals RelationalExprBase a
exprA RelationalExprBase a
exprB) Ctx
ctx =
    Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"Equals" [RelationalExprBase a -> SHash
forall a. HashBytes a => a -> SHash
SHash RelationalExprBase a
exprA, RelationalExprBase a -> SHash
forall a. HashBytes a => a -> SHash
SHash RelationalExprBase a
exprB]
  hashBytes (NotEquals RelationalExprBase a
exprA RelationalExprBase a
exprB) Ctx
ctx =
    Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"NotEquals" [RelationalExprBase a -> SHash
forall a. HashBytes a => a -> SHash
SHash RelationalExprBase a
exprA, RelationalExprBase a -> SHash
forall a. HashBytes a => a -> SHash
SHash RelationalExprBase a
exprB]
  hashBytes (Extend ExtendTupleExprBase a
ext RelationalExprBase a
expr) Ctx
ctx =
    Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"Extend" [ExtendTupleExprBase a -> SHash
forall a. HashBytes a => a -> SHash
SHash ExtendTupleExprBase a
ext, RelationalExprBase a -> SHash
forall a. HashBytes a => a -> SHash
SHash RelationalExprBase a
expr]
  hashBytes (With [(WithNameExprBase a, RelationalExprBase a)]
withExprs RelationalExprBase a
expr) Ctx
ctx =
    Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"With" (RelationalExprBase a -> SHash
forall a. HashBytes a => a -> SHash
SHash RelationalExprBase a
exprSHash -> [SHash] -> [SHash]
forall a. a -> [a] -> [a]
: ((WithNameExprBase a, RelationalExprBase a) -> SHash)
-> [(WithNameExprBase a, RelationalExprBase a)] -> [SHash]
forall a b. (a -> b) -> [a] -> [b]
map (WithNameExprBase a, RelationalExprBase a) -> SHash
forall a. HashBytes a => a -> SHash
SHash (((WithNameExprBase a, RelationalExprBase a) -> Text)
-> [(WithNameExprBase a, RelationalExprBase a)]
-> [(WithNameExprBase a, RelationalExprBase a)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (\(WithNameExpr Text
rv a
_, RelationalExprBase a
_) -> Text
rv) [(WithNameExprBase a, RelationalExprBase a)]
withExprs))

instance HashBytes a => HashBytes (AttributeNamesBase a) where
  hashBytes :: AttributeNamesBase a -> Ctx -> Ctx
hashBytes (AttributeNames Set Text
s) Ctx
ctx = Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"AttributeNames" ((Text -> SHash) -> [Text] -> [SHash]
forall a b. (a -> b) -> [a] -> [b]
map Text -> SHash
forall a. HashBytes a => a -> SHash
SHash (Set Text -> [Text]
forall a. Set a -> [a]
S.toAscList Set Text
s))
  hashBytes (InvertedAttributeNames Set Text
s) Ctx
ctx = Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"InvertedAttributeNames" ((Text -> SHash) -> [Text] -> [SHash]
forall a b. (a -> b) -> [a] -> [b]
map Text -> SHash
forall a. HashBytes a => a -> SHash
SHash (Set Text -> [Text]
forall a. Set a -> [a]
S.toAscList Set Text
s))
  hashBytes (UnionAttributeNames AttributeNamesBase a
a AttributeNamesBase a
b) Ctx
ctx = Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"UnionAttributeNames" [AttributeNamesBase a -> SHash
forall a. HashBytes a => a -> SHash
SHash AttributeNamesBase a
a, AttributeNamesBase a -> SHash
forall a. HashBytes a => a -> SHash
SHash AttributeNamesBase a
b]
  hashBytes (IntersectAttributeNames AttributeNamesBase a
a AttributeNamesBase a
b) Ctx
ctx = Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"IntersectAttributeNames" [AttributeNamesBase a -> SHash
forall a. HashBytes a => a -> SHash
SHash AttributeNamesBase a
a, AttributeNamesBase a -> SHash
forall a. HashBytes a => a -> SHash
SHash AttributeNamesBase a
b]
  hashBytes (RelationalExprAttributeNames RelationalExprBase a
r) Ctx
ctx = Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"RelationalExprAttributeNames" [RelationalExprBase a -> SHash
forall a. HashBytes a => a -> SHash
SHash RelationalExprBase a
r]

instance HashBytes a => HashBytes (ExtendTupleExprBase a) where
  hashBytes :: ExtendTupleExprBase a -> Ctx -> Ctx
hashBytes (AttributeExtendTupleExpr Text
name AtomExprBase a
expr) Ctx
ctx =
    Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"AttributeExtendTupleExpr" [Text -> SHash
forall a. HashBytes a => a -> SHash
SHash Text
name, AtomExprBase a -> SHash
forall a. HashBytes a => a -> SHash
SHash AtomExprBase a
expr]

instance HashBytes a => HashBytes (WithNameExprBase a) where
  hashBytes :: WithNameExprBase a -> Ctx -> Ctx
hashBytes (WithNameExpr Text
rv a
marker) Ctx
ctx = Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"WithNameExpr" [Text -> SHash
forall a. HashBytes a => a -> SHash
SHash Text
rv, a -> SHash
forall a. HashBytes a => a -> SHash
SHash a
marker]
  
instance HashBytes GraphRefTransactionMarker where
  hashBytes :: GraphRefTransactionMarker -> Ctx -> Ctx
hashBytes (TransactionMarker UUID
tid) Ctx
ctx = Ctx -> ByteString -> Ctx
SHA256.update Ctx
ctx (ByteString -> ByteString
BL.toStrict (ByteString
"TransactionMarker" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> UUID -> ByteString
UUID.toByteString UUID
tid))
  hashBytes GraphRefTransactionMarker
UncommittedContextMarker Ctx
ctx = Ctx -> ByteString -> Ctx
SHA256.update Ctx
ctx ByteString
"UncommittedContextMarker"


instance HashBytes a => HashBytes (TupleExprBase a) where
  hashBytes :: TupleExprBase a -> Ctx -> Ctx
hashBytes (TupleExpr Map Text (AtomExprBase a)
exprMap) Ctx
ctx =
    ((Text, AtomExprBase a) -> Ctx -> Ctx)
-> Ctx -> [(Text, AtomExprBase a)] -> Ctx
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Text
attrName, AtomExprBase a
atomExpr) Ctx
ctx' ->
             Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx' ByteString
"TupleExpr" [Text -> SHash
forall a. HashBytes a => a -> SHash
SHash Text
attrName, AtomExprBase a -> SHash
forall a. HashBytes a => a -> SHash
SHash AtomExprBase a
atomExpr]) 
    Ctx
ctx (Map Text (AtomExprBase a) -> [(Text, AtomExprBase a)]
forall k a. Map k a -> [(k, a)]
M.toAscList Map Text (AtomExprBase a)
exprMap)

instance HashBytes a => HashBytes (AtomExprBase a) where
  hashBytes :: AtomExprBase a -> Ctx -> Ctx
hashBytes AtomExprBase a
atomExpr Ctx
ctx =
    case AtomExprBase a
atomExpr of
      (AttributeAtomExpr Text
a) -> Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"AttributeAtomExpr" [Text -> SHash
forall a. HashBytes a => a -> SHash
SHash Text
a]
      (NakedAtomExpr Atom
a) -> Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"NakedAtomExpr" [Atom -> SHash
forall a. HashBytes a => a -> SHash
SHash Atom
a]
      (FunctionAtomExpr Text
fname [AtomExprBase a]
args a
marker) ->
        Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"FunctionAtomExpr" ([SHash] -> Ctx) -> [SHash] -> Ctx
forall a b. (a -> b) -> a -> b
$ [Text -> SHash
forall a. HashBytes a => a -> SHash
SHash Text
fname, a -> SHash
forall a. HashBytes a => a -> SHash
SHash a
marker] [SHash] -> [SHash] -> [SHash]
forall a. Semigroup a => a -> a -> a
<> (AtomExprBase a -> SHash) -> [AtomExprBase a] -> [SHash]
forall a b. (a -> b) -> [a] -> [b]
map AtomExprBase a -> SHash
forall a. HashBytes a => a -> SHash
SHash [AtomExprBase a]
args
      (RelationAtomExpr RelationalExprBase a
r) -> Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"RelationAtomExpr" [RelationalExprBase a -> SHash
forall a. HashBytes a => a -> SHash
SHash RelationalExprBase a
r]
      (ConstructedAtomExpr Text
dConsName [AtomExprBase a]
args a
marker) ->
        Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"ConstructedAtomExpr" ([Text -> SHash
forall a. HashBytes a => a -> SHash
SHash Text
dConsName, a -> SHash
forall a. HashBytes a => a -> SHash
SHash a
marker] [SHash] -> [SHash] -> [SHash]
forall a. Semigroup a => a -> a -> a
<> (AtomExprBase a -> SHash) -> [AtomExprBase a] -> [SHash]
forall a b. (a -> b) -> [a] -> [b]
map AtomExprBase a -> SHash
forall a. HashBytes a => a -> SHash
SHash [AtomExprBase a]
args)

instance HashBytes () where
  hashBytes :: () -> Ctx -> Ctx
hashBytes () Ctx
ctx = Ctx -> ByteString -> Ctx
SHA256.update Ctx
ctx ByteString
"()"

instance HashBytes AtomType where
  hashBytes :: AtomType -> Ctx -> Ctx
hashBytes AtomType
typ Ctx
ctx =
    case AtomType
typ of
      AtomType
IntAtomType -> ByteString -> Ctx
hashb ByteString
"IntAtomType"
      AtomType
IntegerAtomType -> ByteString -> Ctx
hashb ByteString
"IntegerAtomType"
      AtomType
ScientificAtomType -> ByteString -> Ctx
hashb ByteString
"ScientificAtomType"
      AtomType
DoubleAtomType -> ByteString -> Ctx
hashb ByteString
"DoubleAtomType"
      AtomType
TextAtomType -> ByteString -> Ctx
hashb ByteString
"TextAtomType"
      AtomType
DayAtomType -> ByteString -> Ctx
hashb ByteString
"DayAtomType"
      AtomType
DateTimeAtomType -> ByteString -> Ctx
hashb ByteString
"DateTimeAtomType"
      AtomType
ByteStringAtomType -> ByteString -> Ctx
hashb ByteString
"ByteStringAtomType"
      AtomType
BoolAtomType -> ByteString -> Ctx
hashb ByteString
"BoolAtomType"
      AtomType
UUIDAtomType -> ByteString -> Ctx
hashb ByteString
"UUIDAtomType"
      RelationAtomType Attributes
attrs -> Ctx -> ByteString -> Vector SHash -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"RelationAtomType" ((Attribute -> SHash) -> Vector Attribute -> Vector SHash
forall a b. (a -> b) -> Vector a -> Vector b
V.map Attribute -> SHash
forall a. HashBytes a => a -> SHash
SHash (Attributes -> Vector Attribute
attributesVec Attributes
attrs))
      ConstructedAtomType Text
tConsName TypeVarMap
tvarMap -> Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"ConstructedAtomType" (Text -> SHash
forall a. HashBytes a => a -> SHash
SHash Text
tConsName SHash -> [SHash] -> [SHash]
forall a. a -> [a] -> [a]
: ((Text, AtomType) -> SHash) -> [(Text, AtomType)] -> [SHash]
forall a b. (a -> b) -> [a] -> [b]
map (Text, AtomType) -> SHash
forall a. HashBytes a => a -> SHash
SHash (TypeVarMap -> [(Text, AtomType)]
forall k a. Map k a -> [(k, a)]
M.toAscList TypeVarMap
tvarMap))
      AtomType
RelationalExprAtomType -> ByteString -> Ctx
hashb ByteString
"RelationalExprAtomType"
      TypeVariableType Text
tvn -> Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"TypeVariableType" [Text -> SHash
forall a. HashBytes a => a -> SHash
SHash Text
tvn]
    where
      hashb :: ByteString -> Ctx
hashb = Ctx -> ByteString -> Ctx
SHA256.update Ctx
ctx

instance HashBytes Attributes where
  hashBytes :: Attributes -> Ctx -> Ctx
hashBytes Attributes
attrs Ctx
ctx =
    Ctx -> ByteString -> Vector SHash -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"Attributes" ((Attribute -> SHash) -> Vector Attribute -> Vector SHash
forall a b. (a -> b) -> Vector a -> Vector b
V.map Attribute -> SHash
forall a. HashBytes a => a -> SHash
SHash (Attributes -> Vector Attribute
attributesVec Attributes
attrs))

instance HashBytes RelationTupleSet where
  hashBytes :: RelationTupleSet -> Ctx -> Ctx
hashBytes RelationTupleSet
tupSet Ctx
ctx =
    Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"RelationTupleSet" ((RelationTuple -> SHash) -> [RelationTuple] -> [SHash]
forall a b. (a -> b) -> [a] -> [b]
map RelationTuple -> SHash
forall a. HashBytes a => a -> SHash
SHash (RelationTupleSet -> [RelationTuple]
asList RelationTupleSet
tupSet))

instance HashBytes a => HashBytes (Maybe [AttributeExprBase a]) where
  hashBytes :: Maybe [AttributeExprBase a] -> Ctx -> Ctx
hashBytes Maybe [AttributeExprBase a]
Nothing Ctx
ctx = Ctx -> ByteString -> Ctx
SHA256.update Ctx
ctx ByteString
"MaybeAttributeExprBaseNothing"
  hashBytes (Just [AttributeExprBase a]
exprs) Ctx
ctx =
    Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"MaybeAttributeExprBase" ((AttributeExprBase a -> SHash) -> [AttributeExprBase a] -> [SHash]
forall a b. (a -> b) -> [a] -> [b]
map AttributeExprBase a -> SHash
forall a. HashBytes a => a -> SHash
SHash [AttributeExprBase a]
exprs)

instance HashBytes a => HashBytes (TupleExprsBase a) where
  hashBytes :: TupleExprsBase a -> Ctx -> Ctx
hashBytes (TupleExprs a
marker [TupleExprBase a]
tupleExprs) Ctx
ctx =
    Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"TupleExprs" (a -> SHash
forall a. HashBytes a => a -> SHash
SHash a
marker SHash -> [SHash] -> [SHash]
forall a. a -> [a] -> [a]
: (TupleExprBase a -> SHash) -> [TupleExprBase a] -> [SHash]
forall a b. (a -> b) -> [a] -> [b]
map TupleExprBase a -> SHash
forall a. HashBytes a => a -> SHash
SHash [TupleExprBase a]
tupleExprs)

instance HashBytes Attribute where
  hashBytes :: Attribute -> Ctx -> Ctx
hashBytes (Attribute Text
name AtomType
typ) Ctx
ctx =
    Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"Attribute" [Text -> SHash
forall a. HashBytes a => a -> SHash
SHash Text
name, AtomType -> SHash
forall a. HashBytes a => a -> SHash
SHash AtomType
typ]

instance (HashBytes a, HashBytes b) => HashBytes (a, b) where
  hashBytes :: (a, b) -> Ctx -> Ctx
hashBytes (a
a,b
b) Ctx
ctx =
    Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"HTuple" [a -> SHash
forall a. HashBytes a => a -> SHash
SHash a
a, b -> SHash
forall a. HashBytes a => a -> SHash
SHash b
b]

instance HashBytes RelationTuple where
  hashBytes :: RelationTuple -> Ctx -> Ctx
hashBytes RelationTuple
tup Ctx
ctx =
    Ctx -> ByteString -> Vector SHash -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"RelationTuple" (SHash -> Vector SHash -> Vector SHash
forall a. a -> Vector a -> Vector a
V.cons (Attributes -> SHash
forall a. HashBytes a => a -> SHash
SHash (RelationTuple -> Attributes
tupleAttributes RelationTuple
tup)) ((Atom -> SHash) -> Vector Atom -> Vector SHash
forall a b. (a -> b) -> Vector a -> Vector b
V.map Atom -> SHash
forall a. HashBytes a => a -> SHash
SHash (RelationTuple -> Vector Atom
tupleAtoms RelationTuple
tup)))

instance HashBytes a => HashBytes (AttributeExprBase a) where
  hashBytes :: AttributeExprBase a -> Ctx -> Ctx
hashBytes (AttributeAndTypeNameExpr Text
aname TypeConstructor
tcons a
marker) Ctx
ctx =
    Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"AttributeAndTypeNameExpr" [Text -> SHash
forall a. HashBytes a => a -> SHash
SHash Text
aname, TypeConstructor -> SHash
forall a. HashBytes a => a -> SHash
SHash TypeConstructor
tcons, a -> SHash
forall a. HashBytes a => a -> SHash
SHash a
marker]
  hashBytes (NakedAttributeExpr Attribute
attr) Ctx
ctx =
    Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"NakedAttributeExpr" [Attribute -> SHash
forall a. HashBytes a => a -> SHash
SHash Attribute
attr]

instance HashBytes TypeConstructor where
  hashBytes :: TypeConstructor -> Ctx -> Ctx
hashBytes TypeConstructor
tcons Ctx
ctx =
    case TypeConstructor
tcons of
      ADTypeConstructor Text
tName [TypeConstructor]
args ->
        Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"ADTypeConstructor" (Text -> SHash
forall a. HashBytes a => a -> SHash
SHash Text
tName SHash -> [SHash] -> [SHash]
forall a. a -> [a] -> [a]
: (TypeConstructor -> SHash) -> [TypeConstructor] -> [SHash]
forall a b. (a -> b) -> [a] -> [b]
map TypeConstructor -> SHash
forall a. HashBytes a => a -> SHash
SHash [TypeConstructor]
args)
      PrimitiveTypeConstructor Text
tConsName AtomType
typ ->
        Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"PrimitiveTypeConstructor" [Text -> SHash
forall a. HashBytes a => a -> SHash
SHash Text
tConsName, AtomType -> SHash
forall a. HashBytes a => a -> SHash
SHash AtomType
typ]
      RelationAtomTypeConstructor [AttributeExprBase ()]
attrExprs ->
        Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"RelationAtomTypeConstructor" ((AttributeExprBase () -> SHash)
-> [AttributeExprBase ()] -> [SHash]
forall a b. (a -> b) -> [a] -> [b]
map AttributeExprBase () -> SHash
forall a. HashBytes a => a -> SHash
SHash [AttributeExprBase ()]
attrExprs)
      TypeVariable Text
tv ->
        Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"TypeVariable" [Text -> SHash
forall a. HashBytes a => a -> SHash
SHash Text
tv]

instance HashBytes TransactionId where
  hashBytes :: UUID -> Ctx -> Ctx
hashBytes UUID
tid Ctx
ctx = Ctx -> ByteString -> Ctx
SHA256.update Ctx
ctx (ByteString
"TransactionId" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
BL.toStrict (UUID -> ByteString
UUID.toByteString UUID
tid))

instance HashBytes Schema where
  hashBytes :: Schema -> Ctx -> Ctx
hashBytes (Schema SchemaIsomorphs
morphs) Ctx
ctx =
    Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"Schema" ((SchemaIsomorph -> SHash) -> SchemaIsomorphs -> [SHash]
forall a b. (a -> b) -> [a] -> [b]
map SchemaIsomorph -> SHash
forall a. HashBytes a => a -> SHash
SHash ((SchemaIsomorph -> Text) -> SchemaIsomorphs -> SchemaIsomorphs
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn SchemaIsomorph -> Text
sortIso SchemaIsomorphs
morphs))
    where
      sortIso :: SchemaIsomorph -> Text
sortIso SchemaIsomorph
iso = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat (SchemaIsomorph -> [Text]
isomorphInRelVarNames SchemaIsomorph
iso)
                            

instance HashBytes SchemaIsomorph where
  hashBytes :: SchemaIsomorph -> Ctx -> Ctx
hashBytes (IsoRestrict Text
r RestrictionPredicateExpr
p (Text
a,Text
b)) Ctx
ctx =
    Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"IsoRestrict" [Text -> SHash
forall a. HashBytes a => a -> SHash
SHash Text
r, RestrictionPredicateExpr -> SHash
forall a. HashBytes a => a -> SHash
SHash RestrictionPredicateExpr
p, Text -> SHash
forall a. HashBytes a => a -> SHash
SHash Text
a, Text -> SHash
forall a. HashBytes a => a -> SHash
SHash Text
b]
  hashBytes (IsoRename Text
a Text
b) Ctx
ctx =
    Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"IsoRename" [Text -> SHash
forall a. HashBytes a => a -> SHash
SHash Text
a, Text -> SHash
forall a. HashBytes a => a -> SHash
SHash Text
b]
  hashBytes (IsoUnion (Text
a,Text
b) RestrictionPredicateExpr
p Text
r) Ctx
ctx =
    Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"IsoUnion" [Text -> SHash
forall a. HashBytes a => a -> SHash
SHash Text
a, Text -> SHash
forall a. HashBytes a => a -> SHash
SHash Text
b, RestrictionPredicateExpr -> SHash
forall a. HashBytes a => a -> SHash
SHash RestrictionPredicateExpr
p, Text -> SHash
forall a. HashBytes a => a -> SHash
SHash Text
r]

instance HashBytes a => HashBytes (RestrictionPredicateExprBase a) where
  hashBytes :: RestrictionPredicateExprBase a -> Ctx -> Ctx
hashBytes RestrictionPredicateExprBase a
TruePredicate Ctx
ctx = Ctx -> ByteString -> Ctx
SHA256.update Ctx
ctx ByteString
"TruePredicate"
  hashBytes (AndPredicate RestrictionPredicateExprBase a
a RestrictionPredicateExprBase a
b) Ctx
ctx = Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"AndPredicate" [RestrictionPredicateExprBase a -> SHash
forall a. HashBytes a => a -> SHash
SHash RestrictionPredicateExprBase a
a, RestrictionPredicateExprBase a -> SHash
forall a. HashBytes a => a -> SHash
SHash RestrictionPredicateExprBase a
b]
  hashBytes (OrPredicate RestrictionPredicateExprBase a
a RestrictionPredicateExprBase a
b) Ctx
ctx = Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"OrPredicate" [RestrictionPredicateExprBase a -> SHash
forall a. HashBytes a => a -> SHash
SHash RestrictionPredicateExprBase a
a, RestrictionPredicateExprBase a -> SHash
forall a. HashBytes a => a -> SHash
SHash RestrictionPredicateExprBase a
b]
  hashBytes (NotPredicate RestrictionPredicateExprBase a
a) Ctx
ctx = Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"NotPredicate" [RestrictionPredicateExprBase a -> SHash
forall a. HashBytes a => a -> SHash
SHash RestrictionPredicateExprBase a
a]
  hashBytes (RelationalExprPredicate RelationalExprBase a
e) Ctx
ctx = Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"RelationalExprPredicate" [RelationalExprBase a -> SHash
forall a. HashBytes a => a -> SHash
SHash RelationalExprBase a
e]
  hashBytes (AtomExprPredicate AtomExprBase a
a) Ctx
ctx = Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"AtomExprPredicate" [AtomExprBase a -> SHash
forall a. HashBytes a => a -> SHash
SHash AtomExprBase a
a]
  hashBytes (AttributeEqualityPredicate Text
a AtomExprBase a
e) Ctx
ctx = Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"AttributeEqualityPredicate" [Text -> SHash
forall a. HashBytes a => a -> SHash
SHash Text
a, AtomExprBase a -> SHash
forall a. HashBytes a => a -> SHash
SHash AtomExprBase a
e]


instance HashBytes MerkleHash where
  hashBytes :: MerkleHash -> Ctx -> Ctx
hashBytes MerkleHash
h Ctx
ctx =
    Ctx -> ByteString -> Ctx
SHA256.update Ctx
ctx (MerkleHash -> ByteString
_unMerkleHash MerkleHash
h)

instance HashBytes UTCTime where
  hashBytes :: UTCTime -> Ctx -> Ctx
hashBytes UTCTime
tim Ctx
ctx =
    Ctx -> ByteString -> Ctx
SHA256.update Ctx
ctx (ByteString -> ByteString
BL.toStrict (ByteString
"UTCTime" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>
                                    Builder -> ByteString
BSB.toLazyByteString (Integer -> Builder
BSB.integerDec (Day -> Integer
toModifiedJulianDay (UTCTime -> Day
utctDay UTCTime
tim))) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>
                                    Builder -> ByteString
BSB.toLazyByteString (Integer -> Builder
BSB.integerDec (DiffTime -> Integer
diffTimeToPicoseconds (UTCTime -> DiffTime
utctDayTime UTCTime
tim)))))

instance HashBytes DatabaseContext where
  hashBytes :: DatabaseContext -> Ctx -> Ctx
hashBytes DatabaseContext
db Ctx
ctx =
    Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"DatabaseContext" [InclusionDependencies -> SHash
forall a. HashBytes a => a -> SHash
SHash (DatabaseContext -> InclusionDependencies
inclusionDependencies DatabaseContext
db),
                                      RelationVariables -> SHash
forall a. HashBytes a => a -> SHash
SHash (DatabaseContext -> RelationVariables
relationVariables DatabaseContext
db),
                                      Notifications -> SHash
forall a. HashBytes a => a -> SHash
SHash (DatabaseContext -> Notifications
notifications DatabaseContext
db),
                                      TypeConstructorMapping -> SHash
forall a. HashBytes a => a -> SHash
SHash (DatabaseContext -> TypeConstructorMapping
typeConstructorMapping DatabaseContext
db),
                                      AtomFunctions -> SHash
forall a. HashBytes a => a -> SHash
SHash (DatabaseContext -> AtomFunctions
atomFunctions DatabaseContext
db),
                                      DatabaseContextFunctions -> SHash
forall a. HashBytes a => a -> SHash
SHash (DatabaseContext -> DatabaseContextFunctions
dbcFunctions DatabaseContext
db)]

instance HashBytes InclusionDependencies where
  hashBytes :: InclusionDependencies -> Ctx -> Ctx
hashBytes InclusionDependencies
incDeps Ctx
ctx =
    Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"InclusionDependencies" (((Text, InclusionDependency) -> SHash)
-> [(Text, InclusionDependency)] -> [SHash]
forall a b. (a -> b) -> [a] -> [b]
map (Text, InclusionDependency) -> SHash
forall a. HashBytes a => a -> SHash
SHash (InclusionDependencies -> [(Text, InclusionDependency)]
forall k a. Map k a -> [(k, a)]
M.toAscList InclusionDependencies
incDeps))

instance HashBytes RelationVariables where
  hashBytes :: RelationVariables -> Ctx -> Ctx
hashBytes RelationVariables
rvs Ctx
ctx =
    Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"RelationVariables" (((Text, GraphRefRelationalExpr) -> SHash)
-> [(Text, GraphRefRelationalExpr)] -> [SHash]
forall a b. (a -> b) -> [a] -> [b]
map (Text, GraphRefRelationalExpr) -> SHash
forall a. HashBytes a => a -> SHash
SHash (RelationVariables -> [(Text, GraphRefRelationalExpr)]
forall k a. Map k a -> [(k, a)]
M.toAscList RelationVariables
rvs))

instance HashBytes Notifications where
  hashBytes :: Notifications -> Ctx -> Ctx
hashBytes Notifications
nots Ctx
ctx =
    Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"Notifications" (((Text, Notification) -> SHash)
-> [(Text, Notification)] -> [SHash]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Notification) -> SHash
forall a. HashBytes a => a -> SHash
SHash (Notifications -> [(Text, Notification)]
forall k a. Map k a -> [(k, a)]
M.toAscList Notifications
nots))

instance HashBytes TypeConstructorMapping where
  hashBytes :: TypeConstructorMapping -> Ctx -> Ctx
hashBytes TypeConstructorMapping
tConsMap Ctx
ctx =
    Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"TypeConstructorMapping" (((TypeConstructorDef, DataConstructorDefs) -> SHash)
-> TypeConstructorMapping -> [SHash]
forall a b. (a -> b) -> [a] -> [b]
map (TypeConstructorDef, DataConstructorDefs) -> SHash
forall a. HashBytes a => a -> SHash
SHash (((TypeConstructorDef, DataConstructorDefs) -> Text)
-> TypeConstructorMapping -> TypeConstructorMapping
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (TypeConstructorDef -> Text
TCons.name (TypeConstructorDef -> Text)
-> ((TypeConstructorDef, DataConstructorDefs)
    -> TypeConstructorDef)
-> (TypeConstructorDef, DataConstructorDefs)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TypeConstructorDef, DataConstructorDefs) -> TypeConstructorDef
forall a b. (a, b) -> a
fst) TypeConstructorMapping
tConsMap))

instance HashBytes AtomFunctions where
  hashBytes :: AtomFunctions -> Ctx -> Ctx
hashBytes AtomFunctions
afuncs Ctx
ctx =
    Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"AtomFunctions" ((Function AtomFunctionBodyType -> SHash)
-> [Function AtomFunctionBodyType] -> [SHash]
forall a b. (a -> b) -> [a] -> [b]
map Function AtomFunctionBodyType -> SHash
forall a. HashBytes a => a -> SHash
SHash ((Function AtomFunctionBodyType -> Text)
-> [Function AtomFunctionBodyType]
-> [Function AtomFunctionBodyType]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Function AtomFunctionBodyType -> Text
forall a. Function a -> Text
funcName (AtomFunctions -> [Function AtomFunctionBodyType]
forall a. HashSet a -> [a]
HS.toList AtomFunctions
afuncs)))

instance HashBytes AtomFunction where
  hashBytes :: Function AtomFunctionBodyType -> Ctx -> Ctx
hashBytes Function AtomFunctionBodyType
func Ctx
ctx =
    Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"AtomFunction" (Text -> SHash
forall a. HashBytes a => a -> SHash
SHash (Function AtomFunctionBodyType -> Text
forall a. Function a -> Text
funcName Function AtomFunctionBodyType
func)SHash -> [SHash] -> [SHash]
forall a. a -> [a] -> [a]
:
                                   FunctionBody AtomFunctionBodyType -> SHash
forall a. HashBytes a => a -> SHash
SHash (Function AtomFunctionBodyType -> FunctionBody AtomFunctionBodyType
forall a. Function a -> FunctionBody a
funcBody Function AtomFunctionBodyType
func)SHash -> [SHash] -> [SHash]
forall a. a -> [a] -> [a]
:
                                   (AtomType -> SHash) -> [AtomType] -> [SHash]
forall a b. (a -> b) -> [a] -> [b]
map AtomType -> SHash
forall a. HashBytes a => a -> SHash
SHash (Function AtomFunctionBodyType -> [AtomType]
forall a. Function a -> [AtomType]
funcType Function AtomFunctionBodyType
func))

instance HashBytes DatabaseContextFunction where
  hashBytes :: DatabaseContextFunction -> Ctx -> Ctx
hashBytes DatabaseContextFunction
func Ctx
ctx =
    Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"DatabaseContextFunction" (Text -> SHash
forall a. HashBytes a => a -> SHash
SHash (DatabaseContextFunction -> Text
forall a. Function a -> Text
funcName DatabaseContextFunction
func)SHash -> [SHash] -> [SHash]
forall a. a -> [a] -> [a]
:
                                              FunctionBody DatabaseContextFunctionBodyType -> SHash
forall a. HashBytes a => a -> SHash
SHash (DatabaseContextFunction
-> FunctionBody DatabaseContextFunctionBodyType
forall a. Function a -> FunctionBody a
funcBody DatabaseContextFunction
func)SHash -> [SHash] -> [SHash]
forall a. a -> [a] -> [a]
:
                                              (AtomType -> SHash) -> [AtomType] -> [SHash]
forall a b. (a -> b) -> [a] -> [b]
map AtomType -> SHash
forall a. HashBytes a => a -> SHash
SHash (DatabaseContextFunction -> [AtomType]
forall a. Function a -> [AtomType]
funcType DatabaseContextFunction
func))

instance HashBytes DatabaseContextFunctions where
  hashBytes :: DatabaseContextFunctions -> Ctx -> Ctx
hashBytes DatabaseContextFunctions
dbcfuncs Ctx
ctx =
    Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"DatabaseContextFunctions" ((DatabaseContextFunction -> SHash)
-> [DatabaseContextFunction] -> [SHash]
forall a b. (a -> b) -> [a] -> [b]
map DatabaseContextFunction -> SHash
forall a. HashBytes a => a -> SHash
SHash ((DatabaseContextFunction -> Text)
-> [DatabaseContextFunction] -> [DatabaseContextFunction]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn DatabaseContextFunction -> Text
forall a. Function a -> Text
funcName (DatabaseContextFunctions -> [DatabaseContextFunction]
forall a. HashSet a -> [a]
HS.toList DatabaseContextFunctions
dbcfuncs)))

instance HashBytes InclusionDependency where    
  hashBytes :: InclusionDependency -> Ctx -> Ctx
hashBytes (InclusionDependency RelationalExpr
exprA RelationalExpr
exprB) Ctx
ctx =
    Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"InclusionDependency" [RelationalExpr -> SHash
forall a. HashBytes a => a -> SHash
SHash RelationalExpr
exprA, RelationalExpr -> SHash
forall a. HashBytes a => a -> SHash
SHash RelationalExpr
exprB]

instance HashBytes Notification where
  hashBytes :: Notification -> Ctx -> Ctx
hashBytes Notification
notif Ctx
ctx =
    Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"Notification" [RelationalExpr -> SHash
forall a. HashBytes a => a -> SHash
SHash (Notification -> RelationalExpr
changeExpr Notification
notif),
                                   RelationalExpr -> SHash
forall a. HashBytes a => a -> SHash
SHash (Notification -> RelationalExpr
reportOldExpr Notification
notif),
                                   RelationalExpr -> SHash
forall a. HashBytes a => a -> SHash
SHash (Notification -> RelationalExpr
reportNewExpr Notification
notif)]

instance HashBytes DataConstructorDef where
  hashBytes :: DataConstructorDef -> Ctx -> Ctx
hashBytes (DataConstructorDef Text
dConsName [DataConstructorDefArg]
args) Ctx
ctx =
    Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"DataConstructorDef" (Text -> SHash
forall a. HashBytes a => a -> SHash
SHash Text
dConsName SHash -> [SHash] -> [SHash]
forall a. a -> [a] -> [a]
: (DataConstructorDefArg -> SHash)
-> [DataConstructorDefArg] -> [SHash]
forall a b. (a -> b) -> [a] -> [b]
map DataConstructorDefArg -> SHash
forall a. HashBytes a => a -> SHash
SHash [DataConstructorDefArg]
args)

instance HashBytes [DataConstructorDef] where
  hashBytes :: DataConstructorDefs -> Ctx -> Ctx
hashBytes DataConstructorDefs
defs Ctx
ctx =
    Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"DataConstructoDefList" ((DataConstructorDef -> SHash) -> DataConstructorDefs -> [SHash]
forall a b. (a -> b) -> [a] -> [b]
map DataConstructorDef -> SHash
forall a. HashBytes a => a -> SHash
SHash ((DataConstructorDef -> Text)
-> DataConstructorDefs -> DataConstructorDefs
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn DataConstructorDef -> Text
DC.name DataConstructorDefs
defs))

instance HashBytes TypeConstructorDef where
  hashBytes :: TypeConstructorDef -> Ctx -> Ctx
hashBytes (ADTypeConstructorDef Text
tCons [Text]
args) Ctx
ctx =
    Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"ADTypeConstructorDef" (Text -> SHash
forall a. HashBytes a => a -> SHash
SHash Text
tConsSHash -> [SHash] -> [SHash]
forall a. a -> [a] -> [a]
: (Text -> SHash) -> [Text] -> [SHash]
forall a b. (a -> b) -> [a] -> [b]
map Text -> SHash
forall a. HashBytes a => a -> SHash
SHash [Text]
args)
  hashBytes (PrimitiveTypeConstructorDef Text
tCons AtomType
typ) Ctx
ctx =
    Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"PrimitiveTypeConstructorDef" [Text -> SHash
forall a. HashBytes a => a -> SHash
SHash Text
tCons, AtomType -> SHash
forall a. HashBytes a => a -> SHash
SHash AtomType
typ]

instance HashBytes (FunctionBody a) where
  hashBytes :: FunctionBody a -> Ctx -> Ctx
hashBytes (FunctionScriptBody Text
s a
_) Ctx
ctx = Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"FunctionScriptBody" [Text -> SHash
forall a. HashBytes a => a -> SHash
SHash Text
s]
  hashBytes (FunctionBuiltInBody a
_) Ctx
ctx = Ctx -> ByteString -> Ctx
SHA256.update Ctx
ctx ByteString
"FunctionBuiltInBody"
  hashBytes (FunctionObjectLoadedBody String
a String
b String
c a
_) Ctx
ctx = Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"FunctionObjectLoadedBody" ((String -> SHash) -> [String] -> [SHash]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> SHash
forall a. HashBytes a => a -> SHash
SHash (Text -> SHash) -> (String -> Text) -> String -> SHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) [String
a,String
b,String
c])

instance HashBytes DataConstructorDefArg where
  hashBytes :: DataConstructorDefArg -> Ctx -> Ctx
hashBytes (DataConstructorDefTypeConstructorArg TypeConstructor
tCons) Ctx
ctx =
    Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"DataConstructorDefTypeConstructorArg" [TypeConstructor -> SHash
forall a. HashBytes a => a -> SHash
SHash TypeConstructor
tCons]
  hashBytes (DataConstructorDefTypeVarNameArg Text
tv) Ctx
ctx =
    Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"DataConstructorDefTypeVarNameArg" [Text -> SHash
forall a. HashBytes a => a -> SHash
SHash Text
tv]

instance HashBytes (M.Map RelVarName Relation) where
  hashBytes :: Map Text Relation -> Ctx -> Ctx
hashBytes Map Text Relation
m Ctx
ctx =
    Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"rvtypes" (((Text, Relation) -> SHash) -> [(Text, Relation)] -> [SHash]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Relation) -> SHash
forall a. HashBytes a => a -> SHash
SHash (Map Text Relation -> [(Text, Relation)]
forall k a. Map k a -> [(k, a)]
M.toAscList Map Text Relation
m))

-- | Hash a transaction within its graph context to create a Merkle hash for it.
hashTransaction :: Transaction -> S.Set Transaction -> MerkleHash
hashTransaction :: Transaction -> Set Transaction -> MerkleHash
hashTransaction Transaction
trans Set Transaction
parentTranses = ByteString -> MerkleHash
MerkleHash (Ctx -> ByteString
SHA256.finalize Ctx
newHash)
  where
    newHash :: Ctx
newHash = Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
SHA256.init ByteString
"Transaction" ((UUID -> SHash) -> [UUID] -> [SHash]
forall a b. (a -> b) -> [a] -> [b]
map UUID -> SHash
forall a. HashBytes a => a -> SHash
SHash [UUID]
transIds [SHash] -> [SHash] -> [SHash]
forall a. Semigroup a => a -> a -> a
<>
                                         ((Text, Schema) -> SHash) -> [(Text, Schema)] -> [SHash]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Schema) -> SHash
forall a. HashBytes a => a -> SHash
SHash (Map Text Schema -> [(Text, Schema)]
forall k a. Map k a -> [(k, a)]
M.toAscList (Transaction -> Map Text Schema
subschemas Transaction
trans)) [SHash] -> [SHash] -> [SHash]
forall a. Semigroup a => a -> a -> a
<>
                                         (MerkleHash -> SHash) -> [MerkleHash] -> [SHash]
forall a b. (a -> b) -> [a] -> [b]
map MerkleHash -> SHash
forall a. HashBytes a => a -> SHash
SHash [MerkleHash]
parentMerkleHashes [SHash] -> [SHash] -> [SHash]
forall a. Semigroup a => a -> a -> a
<>
                                         [UTCTime -> SHash
forall a. HashBytes a => a -> SHash
SHash UTCTime
tstamp,
                                         DatabaseContext -> SHash
forall a. HashBytes a => a -> SHash
SHash (Transaction -> DatabaseContext
concreteDatabaseContext Transaction
trans)]
                                                   )
    tstamp :: UTCTime
tstamp = TransactionInfo -> UTCTime
stamp (Transaction -> TransactionInfo
transactionInfo Transaction
trans)
    parentMerkleHashes :: [MerkleHash]
parentMerkleHashes = (Transaction -> MerkleHash) -> [Transaction] -> [MerkleHash]
forall a b. (a -> b) -> [a] -> [b]
map Transaction -> MerkleHash
getMerkleHash (Set Transaction -> [Transaction]
forall a. Set a -> [a]
S.toAscList Set Transaction
parentTranses)
    getMerkleHash :: Transaction -> MerkleHash
getMerkleHash Transaction
t = TransactionInfo -> MerkleHash
merkleHash (Transaction -> TransactionInfo
transactionInfo Transaction
t)
    transIds :: [UUID]
transIds = Transaction -> UUID
transactionId Transaction
trans UUID -> [UUID] -> [UUID]
forall a. a -> [a] -> [a]
: Set UUID -> [UUID]
forall a. Set a -> [a]
S.toAscList (Transaction -> Set UUID
parentIds Transaction
trans)

-- | Return a hash of just DDL-specific (schema) attributes. This is useful for determining if a client has the appropriate updates needed to work with the current schema.
mkDDLHash :: DatabaseContext -> M.Map RelVarName Relation -> SecureHash
mkDDLHash :: DatabaseContext -> Map Text Relation -> SecureHash
mkDDLHash DatabaseContext
ctx Map Text Relation
rvtypemap = do
  -- we cannot merely hash the relational representation of the type because the order of items matters when hashing
  -- registered queries are not included here because a client could be compatible with a schema even if the queries are not registered. The client should validate registered query state up-front. Perhaps there should be another hash for registered queries.
  ByteString -> SecureHash
SecureHash (ByteString -> SecureHash) -> ByteString -> SecureHash
forall a b. (a -> b) -> a -> b
$ Ctx -> ByteString
SHA256.finalize (Ctx -> ByteString) -> Ctx -> ByteString
forall a b. (a -> b) -> a -> b
$ Ctx -> ByteString -> [SHash] -> Ctx
forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
SHA256.init ByteString
"DDLHash" [InclusionDependencies -> SHash
forall a. HashBytes a => a -> SHash
SHash (DatabaseContext -> InclusionDependencies
inclusionDependencies DatabaseContext
ctx),
                                                                    AtomFunctions -> SHash
forall a. HashBytes a => a -> SHash
SHash (DatabaseContext -> AtomFunctions
atomFunctions DatabaseContext
ctx),
                                                                    DatabaseContextFunctions -> SHash
forall a. HashBytes a => a -> SHash
SHash (DatabaseContext -> DatabaseContextFunctions
dbcFunctions DatabaseContext
ctx),
                                                                    TypeConstructorMapping -> SHash
forall a. HashBytes a => a -> SHash
SHash (DatabaseContext -> TypeConstructorMapping
typeConstructorMapping DatabaseContext
ctx),
                                                                    Map Text Relation -> SHash
forall a. HashBytes a => a -> SHash
SHash Map Text Relation
rvtypemap]