-- | 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)

newtype SecureHash = SecureHash { SecureHash -> ByteString
_unSecureHash :: B.ByteString }
  deriving (Typeable SecureHash
Extractor SecureHash
BundleSerialise SecureHash
Decoder 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
Serialise, Int -> SecureHash -> ShowS
[SecureHash] -> ShowS
SecureHash -> String
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
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" forall a. Semigroup a => a -> a -> a
<> Builder -> ByteString
build (Integer -> Builder
BSB.integerDec Integer
i))
      IntAtom Int
i -> ByteString -> Ctx
up (ByteString
"IntAtom" forall a. Semigroup a => a -> a -> a
<> Builder -> ByteString
build (Int -> Builder
BSB.intDec Int
i))
      ScientificAtom Scientific
s -> ByteString -> Ctx
up (ByteString
"ScientificAtom" forall a. Semigroup a => a -> a -> a
<> Builder -> ByteString
build (Scientific -> Builder
BSB.scientificBuilder Scientific
s))
      DoubleAtom Double
d -> ByteString -> Ctx
up (ByteString
"DoubleAtom" forall a. Semigroup a => a -> a -> a
<> Builder -> ByteString
build (Double -> Builder
BSB.doubleDec Double
d))
      TextAtom RelVarName
t -> ByteString -> Ctx
up (ByteString
"TextAtom" forall a. Semigroup a => a -> a -> a
<> RelVarName -> ByteString
TE.encodeUtf8 RelVarName
t)
      DayAtom Day
d -> ByteString -> Ctx
up (ByteString
"DayAtom" 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" forall a. Semigroup a => a -> a -> a
<>
                             Builder -> ByteString
build (Integer -> Builder
BSB.integerDec (Day -> Integer
toModifiedJulianDay (UTCTime -> Day
utctDay UTCTime
dt)) 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" forall a. Semigroup a => a -> a -> a
<> ByteString
bs)
      BoolAtom Bool
b -> ByteString -> Ctx
up (ByteString
"BoolAtom" forall a. Semigroup a => a -> a -> a
<> if Bool
b then ByteString
"1" else ByteString
"0")
      UUIDAtom UUID
u -> ByteString -> Ctx
up (ByteString
"UUIDAtom" forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
BL.toStrict (UUID -> ByteString
UUID.toByteString UUID
u))
      RelationAtom Relation
r -> forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"RelationAtom" [forall a. HashBytes a => a -> SHash
SHash Relation
r]
      RelationalExprAtom RelationalExpr
e -> forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"RelationalExprAtom" [forall a. HashBytes a => a -> SHash
SHash RelationalExpr
e]
      ConstructedAtom RelVarName
d AtomType
typ [Atom]
args ->
          forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"ConstructedAtom" ([forall a. HashBytes a => a -> SHash
SHash RelVarName
d, forall a. HashBytes a => a -> SHash
SHash AtomType
typ] forall a. Semigroup a => a -> a -> a
<> forall a b. (a -> b) -> [a] -> [b]
map forall a. HashBytes a => a -> SHash
SHash [Atom]
args)
      where
        build :: Builder -> ByteString
build = ByteString -> ByteString
BL.toStrict 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 :: RelVarName -> Ctx -> Ctx
hashBytes RelVarName
t Ctx
ctx = Ctx -> ByteString -> Ctx
SHA256.update Ctx
ctx (RelVarName -> ByteString
TE.encodeUtf8 RelVarName
t)
  
instance HashBytes Relation where
  hashBytes :: Relation -> Ctx -> Ctx
hashBytes (Relation Attributes
attrs RelationTupleSet
tupSet) Ctx
ctx =
    forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"Relation" [forall a. HashBytes a => a -> SHash
SHash Attributes
attrs, 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 :: forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
name = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(SHash a
i) ctx' :: Ctx
ctx'@(SHA256.Ctx !ByteString
bs) -> ByteString
bs seq :: forall a b. a -> b -> b
`seq` 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 =
    forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"MakeRelationFromExprs" [forall a. HashBytes a => a -> SHash
SHash Maybe [AttributeExprBase a]
mAttrs, forall a. HashBytes a => a -> SHash
SHash TupleExprsBase a
tupleExprs]
  hashBytes (MakeStaticRelation Attributes
attrs RelationTupleSet
tupSet) Ctx
ctx = -- blowing up here!
    forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"MakeStaticRelation" [forall a. HashBytes a => a -> SHash
SHash Attributes
attrs, forall a. HashBytes a => a -> SHash
SHash RelationTupleSet
tupSet]
--  hashBytes _ ctx = ctx
  hashBytes (ExistingRelation (Relation Attributes
attrs RelationTupleSet
tupSet)) Ctx
ctx =
    forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"ExistingRelation" [forall a. HashBytes a => a -> SHash
SHash RelationTupleSet
tupSet, forall a. HashBytes a => a -> SHash
SHash Attributes
attrs]
  hashBytes (RelationVariable RelVarName
rvName a
marker) Ctx
ctx =
    forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"RelationVariable" [forall a. HashBytes a => a -> SHash
SHash RelVarName
rvName, forall a. HashBytes a => a -> SHash
SHash a
marker]
  hashBytes (Project AttributeNamesBase a
attrNames RelationalExprBase a
expr) Ctx
ctx =
    forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"Project" [forall a. HashBytes a => a -> SHash
SHash AttributeNamesBase a
attrNames, forall a. HashBytes a => a -> SHash
SHash RelationalExprBase a
expr]
  hashBytes (Union RelationalExprBase a
exprA RelationalExprBase a
exprB) Ctx
ctx =
    forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"Union" [forall a. HashBytes a => a -> SHash
SHash RelationalExprBase a
exprA, forall a. HashBytes a => a -> SHash
SHash RelationalExprBase a
exprB]
  hashBytes (Join RelationalExprBase a
exprA RelationalExprBase a
exprB) Ctx
ctx =
    forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"Join" [forall a. HashBytes a => a -> SHash
SHash RelationalExprBase a
exprA, forall a. HashBytes a => a -> SHash
SHash RelationalExprBase a
exprB]
  hashBytes (Rename RelVarName
nameA RelVarName
nameB RelationalExprBase a
expr) Ctx
ctx =
    forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"Rename" [forall a. HashBytes a => a -> SHash
SHash RelVarName
nameA, forall a. HashBytes a => a -> SHash
SHash RelVarName
nameB, forall a. HashBytes a => a -> SHash
SHash RelationalExprBase a
expr]
  hashBytes (Difference RelationalExprBase a
exprA RelationalExprBase a
exprB) Ctx
ctx =
    forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"Difference" [forall a. HashBytes a => a -> SHash
SHash RelationalExprBase a
exprA, forall a. HashBytes a => a -> SHash
SHash RelationalExprBase a
exprB]
  hashBytes (Group AttributeNamesBase a
names RelVarName
name RelationalExprBase a
expr) Ctx
ctx =
    forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"Group" [forall a. HashBytes a => a -> SHash
SHash AttributeNamesBase a
names, forall a. HashBytes a => a -> SHash
SHash RelVarName
name, forall a. HashBytes a => a -> SHash
SHash RelationalExprBase a
expr]
  hashBytes (Ungroup RelVarName
name RelationalExprBase a
expr) Ctx
ctx =
    forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"Ungroup" [forall a. HashBytes a => a -> SHash
SHash RelVarName
name, forall a. HashBytes a => a -> SHash
SHash RelationalExprBase a
expr]
  hashBytes (Restrict RestrictionPredicateExprBase a
pred' RelationalExprBase a
expr) Ctx
ctx =
    forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"Restrict" [forall a. HashBytes a => a -> SHash
SHash RestrictionPredicateExprBase a
pred', forall a. HashBytes a => a -> SHash
SHash RelationalExprBase a
expr]
  hashBytes (Equals RelationalExprBase a
exprA RelationalExprBase a
exprB) Ctx
ctx =
    forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"Equals" [forall a. HashBytes a => a -> SHash
SHash RelationalExprBase a
exprA, forall a. HashBytes a => a -> SHash
SHash RelationalExprBase a
exprB]
  hashBytes (NotEquals RelationalExprBase a
exprA RelationalExprBase a
exprB) Ctx
ctx =
    forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"NotEquals" [forall a. HashBytes a => a -> SHash
SHash RelationalExprBase a
exprA, forall a. HashBytes a => a -> SHash
SHash RelationalExprBase a
exprB]
  hashBytes (Extend ExtendTupleExprBase a
ext RelationalExprBase a
expr) Ctx
ctx =
    forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"Extend" [forall a. HashBytes a => a -> SHash
SHash ExtendTupleExprBase a
ext, forall a. HashBytes a => a -> SHash
SHash RelationalExprBase a
expr]
  hashBytes (With [(WithNameExprBase a, RelationalExprBase a)]
withExprs RelationalExprBase a
expr) Ctx
ctx =
    forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"With" (forall a. HashBytes a => a -> SHash
SHash RelationalExprBase a
exprforall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. HashBytes a => a -> SHash
SHash (forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (\(WithNameExpr RelVarName
rv a
_, RelationalExprBase a
_) -> RelVarName
rv) [(WithNameExprBase a, RelationalExprBase a)]
withExprs))

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

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

instance HashBytes a => HashBytes (WithNameExprBase a) where
  hashBytes :: WithNameExprBase a -> Ctx -> Ctx
hashBytes (WithNameExpr RelVarName
rv a
marker) Ctx
ctx = forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"WithNameExpr" [forall a. HashBytes a => a -> SHash
SHash RelVarName
rv, 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" 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 RelVarName (AtomExprBase a)
exprMap) Ctx
ctx =
    forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(RelVarName
attrName, AtomExprBase a
atomExpr) Ctx
ctx' ->
             forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx' ByteString
"TupleExpr" [forall a. HashBytes a => a -> SHash
SHash RelVarName
attrName, forall a. HashBytes a => a -> SHash
SHash AtomExprBase a
atomExpr]) 
    Ctx
ctx (forall k a. Map k a -> [(k, a)]
M.toAscList Map RelVarName (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 RelVarName
a) -> forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"AttributeAtomExpr" [forall a. HashBytes a => a -> SHash
SHash RelVarName
a]
      (NakedAtomExpr Atom
a) -> forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"NakedAtomExpr" [forall a. HashBytes a => a -> SHash
SHash Atom
a]
      (FunctionAtomExpr RelVarName
fname [AtomExprBase a]
args a
marker) ->
        forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"FunctionAtomExpr" forall a b. (a -> b) -> a -> b
$ [forall a. HashBytes a => a -> SHash
SHash RelVarName
fname, forall a. HashBytes a => a -> SHash
SHash a
marker] forall a. Semigroup a => a -> a -> a
<> forall a b. (a -> b) -> [a] -> [b]
map forall a. HashBytes a => a -> SHash
SHash [AtomExprBase a]
args
      (RelationAtomExpr RelationalExprBase a
r) -> forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"RelationAtomExpr" [forall a. HashBytes a => a -> SHash
SHash RelationalExprBase a
r]
      (ConstructedAtomExpr RelVarName
dConsName [AtomExprBase a]
args a
marker) ->
        forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"ConstructedAtomExpr" ([forall a. HashBytes a => a -> SHash
SHash RelVarName
dConsName, forall a. HashBytes a => a -> SHash
SHash a
marker] forall a. Semigroup a => a -> a -> a
<> forall a b. (a -> b) -> [a] -> [b]
map 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 -> forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"RelationAtomType" (forall a b. (a -> b) -> Vector a -> Vector b
V.map forall a. HashBytes a => a -> SHash
SHash (Attributes -> Vector Attribute
attributesVec Attributes
attrs))
      ConstructedAtomType RelVarName
tConsName TypeVarMap
tvarMap -> forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"ConstructedAtomType" (forall a. HashBytes a => a -> SHash
SHash RelVarName
tConsName forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. HashBytes a => a -> SHash
SHash (forall k a. Map k a -> [(k, a)]
M.toAscList TypeVarMap
tvarMap))
      AtomType
RelationalExprAtomType -> ByteString -> Ctx
hashb ByteString
"RelationalExprAtomType"
      TypeVariableType RelVarName
tvn -> forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"TypeVariableType" [forall a. HashBytes a => a -> SHash
SHash RelVarName
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 =
    forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"Attributes" (forall a b. (a -> b) -> Vector a -> Vector b
V.map 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 =
    forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"RelationTupleSet" (forall a b. (a -> b) -> [a] -> [b]
map 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 =
    forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"MaybeAttributeExprBase" (forall a b. (a -> b) -> [a] -> [b]
map 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 =
    forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"TupleExprs" (forall a. HashBytes a => a -> SHash
SHash a
marker forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. HashBytes a => a -> SHash
SHash [TupleExprBase a]
tupleExprs)

instance HashBytes Attribute where
  hashBytes :: Attribute -> Ctx -> Ctx
hashBytes (Attribute RelVarName
name AtomType
typ) Ctx
ctx =
    forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"Attribute" [forall a. HashBytes a => a -> SHash
SHash RelVarName
name, 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 =
    forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"HTuple" [forall a. HashBytes a => a -> SHash
SHash a
a, forall a. HashBytes a => a -> SHash
SHash b
b]

instance HashBytes RelationTuple where
  hashBytes :: RelationTuple -> Ctx -> Ctx
hashBytes RelationTuple
tup Ctx
ctx =
    forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"RelationTuple" (forall a. a -> Vector a -> Vector a
V.cons (forall a. HashBytes a => a -> SHash
SHash (RelationTuple -> Attributes
tupleAttributes RelationTuple
tup)) (forall a b. (a -> b) -> Vector a -> Vector b
V.map 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 RelVarName
aname TypeConstructor
tcons a
marker) Ctx
ctx =
    forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"AttributeAndTypeNameExpr" [forall a. HashBytes a => a -> SHash
SHash RelVarName
aname, forall a. HashBytes a => a -> SHash
SHash TypeConstructor
tcons, forall a. HashBytes a => a -> SHash
SHash a
marker]
  hashBytes (NakedAttributeExpr Attribute
attr) Ctx
ctx =
    forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"NakedAttributeExpr" [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 RelVarName
tName [TypeConstructor]
args ->
        forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"ADTypeConstructor" (forall a. HashBytes a => a -> SHash
SHash RelVarName
tName forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. HashBytes a => a -> SHash
SHash [TypeConstructor]
args)
      PrimitiveTypeConstructor RelVarName
tConsName AtomType
typ ->
        forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"PrimitiveTypeConstructor" [forall a. HashBytes a => a -> SHash
SHash RelVarName
tConsName, forall a. HashBytes a => a -> SHash
SHash AtomType
typ]
      RelationAtomTypeConstructor [AttributeExprBase ()]
attrExprs ->
        forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"RelationAtomTypeConstructor" (forall a b. (a -> b) -> [a] -> [b]
map forall a. HashBytes a => a -> SHash
SHash [AttributeExprBase ()]
attrExprs)
      TypeVariable RelVarName
tv ->
        forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"TypeVariable" [forall a. HashBytes a => a -> SHash
SHash RelVarName
tv]

instance HashBytes TransactionId where
  hashBytes :: UUID -> Ctx -> Ctx
hashBytes UUID
tid Ctx
ctx = Ctx -> ByteString -> Ctx
SHA256.update Ctx
ctx (ByteString
"TransactionId" 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 =
    forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"Schema" (forall a b. (a -> b) -> [a] -> [b]
map forall a. HashBytes a => a -> SHash
SHash (forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn SchemaIsomorph -> RelVarName
sortIso SchemaIsomorphs
morphs))
    where
      sortIso :: SchemaIsomorph -> RelVarName
sortIso SchemaIsomorph
iso = forall a. Monoid a => [a] -> a
mconcat (SchemaIsomorph -> [RelVarName]
isomorphInRelVarNames SchemaIsomorph
iso)
                            

instance HashBytes SchemaIsomorph where
  hashBytes :: SchemaIsomorph -> Ctx -> Ctx
hashBytes (IsoRestrict RelVarName
r RestrictionPredicateExpr
p (RelVarName
a,RelVarName
b)) Ctx
ctx =
    forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"IsoRestrict" [forall a. HashBytes a => a -> SHash
SHash RelVarName
r, forall a. HashBytes a => a -> SHash
SHash RestrictionPredicateExpr
p, forall a. HashBytes a => a -> SHash
SHash RelVarName
a, forall a. HashBytes a => a -> SHash
SHash RelVarName
b]
  hashBytes (IsoRename RelVarName
a RelVarName
b) Ctx
ctx =
    forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"IsoRename" [forall a. HashBytes a => a -> SHash
SHash RelVarName
a, forall a. HashBytes a => a -> SHash
SHash RelVarName
b]
  hashBytes (IsoUnion (RelVarName
a,RelVarName
b) RestrictionPredicateExpr
p RelVarName
r) Ctx
ctx =
    forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"IsoUnion" [forall a. HashBytes a => a -> SHash
SHash RelVarName
a, forall a. HashBytes a => a -> SHash
SHash RelVarName
b, forall a. HashBytes a => a -> SHash
SHash RestrictionPredicateExpr
p, forall a. HashBytes a => a -> SHash
SHash RelVarName
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 = forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"AndPredicate" [forall a. HashBytes a => a -> SHash
SHash RestrictionPredicateExprBase a
a, forall a. HashBytes a => a -> SHash
SHash RestrictionPredicateExprBase a
b]
  hashBytes (OrPredicate RestrictionPredicateExprBase a
a RestrictionPredicateExprBase a
b) Ctx
ctx = forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"OrPredicate" [forall a. HashBytes a => a -> SHash
SHash RestrictionPredicateExprBase a
a, forall a. HashBytes a => a -> SHash
SHash RestrictionPredicateExprBase a
b]
  hashBytes (NotPredicate RestrictionPredicateExprBase a
a) Ctx
ctx = forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"NotPredicate" [forall a. HashBytes a => a -> SHash
SHash RestrictionPredicateExprBase a
a]
  hashBytes (RelationalExprPredicate RelationalExprBase a
e) Ctx
ctx = forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"RelationalExprPredicate" [forall a. HashBytes a => a -> SHash
SHash RelationalExprBase a
e]
  hashBytes (AtomExprPredicate AtomExprBase a
a) Ctx
ctx = forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"AtomExprPredicate" [forall a. HashBytes a => a -> SHash
SHash AtomExprBase a
a]
  hashBytes (AttributeEqualityPredicate RelVarName
a AtomExprBase a
e) Ctx
ctx = forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"AttributeEqualityPredicate" [forall a. HashBytes a => a -> SHash
SHash RelVarName
a, 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" forall a. Semigroup a => a -> a -> a
<>
                                    Builder -> ByteString
BSB.toLazyByteString (Integer -> Builder
BSB.integerDec (Day -> Integer
toModifiedJulianDay (UTCTime -> Day
utctDay UTCTime
tim))) 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 =
    forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"DatabaseContext" [forall a. HashBytes a => a -> SHash
SHash (DatabaseContext -> InclusionDependencies
inclusionDependencies DatabaseContext
db),
                                      forall a. HashBytes a => a -> SHash
SHash (DatabaseContext -> RelationVariables
relationVariables DatabaseContext
db),
                                      forall a. HashBytes a => a -> SHash
SHash (DatabaseContext -> Notifications
notifications DatabaseContext
db),
                                      forall a. HashBytes a => a -> SHash
SHash (DatabaseContext -> TypeConstructorMapping
typeConstructorMapping DatabaseContext
db),
                                      forall a. HashBytes a => a -> SHash
SHash (DatabaseContext -> AtomFunctions
atomFunctions DatabaseContext
db),
                                      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 =
    forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"InclusionDependencies" (forall a b. (a -> b) -> [a] -> [b]
map forall a. HashBytes a => a -> SHash
SHash (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 =
    forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"RelationVariables" (forall a b. (a -> b) -> [a] -> [b]
map forall a. HashBytes a => a -> SHash
SHash (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 =
    forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"Notifications" (forall a b. (a -> b) -> [a] -> [b]
map forall a. HashBytes a => a -> SHash
SHash (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 =
    forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"TypeConstructorMapping" (forall a b. (a -> b) -> [a] -> [b]
map forall a. HashBytes a => a -> SHash
SHash (forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (TypeConstructorDef -> RelVarName
TCons.name forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) TypeConstructorMapping
tConsMap))

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

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

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

instance HashBytes DatabaseContextFunctions where
  hashBytes :: DatabaseContextFunctions -> Ctx -> Ctx
hashBytes DatabaseContextFunctions
dbcfuncs Ctx
ctx =
    forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"DatabaseContextFunctions" (forall a b. (a -> b) -> [a] -> [b]
map forall a. HashBytes a => a -> SHash
SHash (forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall a. Function a -> RelVarName
funcName (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 =
    forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"InclusionDependency" [forall a. HashBytes a => a -> SHash
SHash RelationalExpr
exprA, forall a. HashBytes a => a -> SHash
SHash RelationalExpr
exprB]

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

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

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

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

instance HashBytes (FunctionBody a) where
  hashBytes :: FunctionBody a -> Ctx -> Ctx
hashBytes (FunctionScriptBody RelVarName
s a
_) Ctx
ctx = forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"FunctionScriptBody" [forall a. HashBytes a => a -> SHash
SHash RelVarName
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 = forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"FunctionObjectLoadedBody" (forall a b. (a -> b) -> [a] -> [b]
map (forall a. HashBytes a => a -> SHash
SHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> RelVarName
T.pack) [String
a,String
b,String
c])

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

instance HashBytes (M.Map RelVarName Relation) where
  hashBytes :: Map RelVarName Relation -> Ctx -> Ctx
hashBytes Map RelVarName Relation
m Ctx
ctx =
    forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
ctx ByteString
"rvtypes" (forall a b. (a -> b) -> [a] -> [b]
map forall a. HashBytes a => a -> SHash
SHash (forall k a. Map k a -> [(k, a)]
M.toAscList Map RelVarName 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 = forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
SHA256.init ByteString
"Transaction" (forall a b. (a -> b) -> [a] -> [b]
map forall a. HashBytes a => a -> SHash
SHash [UUID]
transIds forall a. Semigroup a => a -> a -> a
<>
                                         forall a b. (a -> b) -> [a] -> [b]
map forall a. HashBytes a => a -> SHash
SHash (forall k a. Map k a -> [(k, a)]
M.toAscList (Transaction -> Subschemas
subschemas Transaction
trans)) forall a. Semigroup a => a -> a -> a
<>
                                         forall a b. (a -> b) -> [a] -> [b]
map forall a. HashBytes a => a -> SHash
SHash [MerkleHash]
parentMerkleHashes forall a. Semigroup a => a -> a -> a
<>
                                         [forall a. HashBytes a => a -> SHash
SHash UTCTime
tstamp,
                                         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 = forall a b. (a -> b) -> [a] -> [b]
map Transaction -> MerkleHash
getMerkleHash (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 forall a. a -> [a] -> [a]
: 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 RelVarName Relation -> SecureHash
mkDDLHash DatabaseContext
ctx Map RelVarName 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 forall a b. (a -> b) -> a -> b
$ Ctx -> ByteString
SHA256.finalize forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *).
Foldable f =>
Ctx -> ByteString -> f SHash -> Ctx
hashBytesL Ctx
SHA256.init ByteString
"DDLHash" [forall a. HashBytes a => a -> SHash
SHash (DatabaseContext -> InclusionDependencies
inclusionDependencies DatabaseContext
ctx),
                                                                    forall a. HashBytes a => a -> SHash
SHash (DatabaseContext -> AtomFunctions
atomFunctions DatabaseContext
ctx),
                                                                    forall a. HashBytes a => a -> SHash
SHash (DatabaseContext -> DatabaseContextFunctions
dbcFunctions DatabaseContext
ctx),
                                                                    forall a. HashBytes a => a -> SHash
SHash (DatabaseContext -> TypeConstructorMapping
typeConstructorMapping DatabaseContext
ctx),
                                                                    forall a. HashBytes a => a -> SHash
SHash Map RelVarName Relation
rvtypemap]