module U.Codebase.Sqlite.HashHandle
  ( HashHandle (..),
    HashMismatch (..),
    HashValidationError (..),
    DeclHashingError (..),
    HashingFailure (..),
    crashOnHashingFailure,
  )
where

import Control.Exception
import U.Codebase.Branch.Type (Branch)
import U.Codebase.BranchV3 (BranchV3)
import U.Codebase.HashTags
import U.Codebase.Reference qualified as C
import U.Codebase.Sqlite.Branch.Format (HashBranchLocalIds)
import U.Codebase.Sqlite.Branch.Full (LocalBranch)
import U.Codebase.Sqlite.Decl.Format qualified as DeclFormat
import U.Codebase.Sqlite.Patch.Format (HashPatchLocalIds)
import U.Codebase.Sqlite.Patch.Full (LocalPatch)
import U.Codebase.Sqlite.Symbol (Symbol)
import U.Codebase.Sqlite.Term.Format qualified as TermFormat
import U.Codebase.Term qualified as C.Term
import U.Codebase.Type qualified as C.Type
import Unison.Hash (Hash)
import Unison.Prelude

data HashMismatch = HashMismatch
  { HashMismatch -> Hash
expectedHash :: Hash,
    HashMismatch -> Hash
actualHash :: Hash
  }

data HashingFailure
  = -- | two or more component elements can not be completely ordered with respect to one another
    -- https://github.com/unisonweb/unison/issues/2787
    IncompleteElementOrderingError ComponentHash
  deriving (HashingFailure -> HashingFailure -> Bool
(HashingFailure -> HashingFailure -> Bool)
-> (HashingFailure -> HashingFailure -> Bool) -> Eq HashingFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HashingFailure -> HashingFailure -> Bool
== :: HashingFailure -> HashingFailure -> Bool
$c/= :: HashingFailure -> HashingFailure -> Bool
/= :: HashingFailure -> HashingFailure -> Bool
Eq, Eq HashingFailure
Eq HashingFailure =>
(HashingFailure -> HashingFailure -> Ordering)
-> (HashingFailure -> HashingFailure -> Bool)
-> (HashingFailure -> HashingFailure -> Bool)
-> (HashingFailure -> HashingFailure -> Bool)
-> (HashingFailure -> HashingFailure -> Bool)
-> (HashingFailure -> HashingFailure -> HashingFailure)
-> (HashingFailure -> HashingFailure -> HashingFailure)
-> Ord HashingFailure
HashingFailure -> HashingFailure -> Bool
HashingFailure -> HashingFailure -> Ordering
HashingFailure -> HashingFailure -> HashingFailure
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: HashingFailure -> HashingFailure -> Ordering
compare :: HashingFailure -> HashingFailure -> Ordering
$c< :: HashingFailure -> HashingFailure -> Bool
< :: HashingFailure -> HashingFailure -> Bool
$c<= :: HashingFailure -> HashingFailure -> Bool
<= :: HashingFailure -> HashingFailure -> Bool
$c> :: HashingFailure -> HashingFailure -> Bool
> :: HashingFailure -> HashingFailure -> Bool
$c>= :: HashingFailure -> HashingFailure -> Bool
>= :: HashingFailure -> HashingFailure -> Bool
$cmax :: HashingFailure -> HashingFailure -> HashingFailure
max :: HashingFailure -> HashingFailure -> HashingFailure
$cmin :: HashingFailure -> HashingFailure -> HashingFailure
min :: HashingFailure -> HashingFailure -> HashingFailure
Ord)
  deriving anyclass (Show HashingFailure
Typeable HashingFailure
(Typeable HashingFailure, Show HashingFailure) =>
(HashingFailure -> SomeException)
-> (SomeException -> Maybe HashingFailure)
-> (HashingFailure -> String)
-> Exception HashingFailure
SomeException -> Maybe HashingFailure
HashingFailure -> String
HashingFailure -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> String) -> Exception e
$ctoException :: HashingFailure -> SomeException
toException :: HashingFailure -> SomeException
$cfromException :: SomeException -> Maybe HashingFailure
fromException :: SomeException -> Maybe HashingFailure
$cdisplayException :: HashingFailure -> String
displayException :: HashingFailure -> String
Exception)

instance Show HashingFailure where
  show :: HashingFailure -> String
show HashingFailure
hf = String -> ShowS
reportBug String
"E253299" (HashingFailure -> String
renderHashingFailure HashingFailure
hf)
    where
      renderHashingFailure :: HashingFailure -> String
      renderHashingFailure :: HashingFailure -> String
renderHashingFailure = \case
        IncompleteElementOrderingError ComponentHash
h ->
          [String] -> String
unlines
            [ String
"Failed to hash the component: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ComponentHash -> String
forall a. Show a => a -> String
show ComponentHash
h,
              String
"Hashing failed because cyclic definitions because the definitions could not be completely ordered.",
              String
"This happens when multiple definitions in a mutually recursive cycle are identical except",
              String
"for references to other elements in the same cycle.",
              String
"If all elements are identical, consider simple recursion instead of mutual recursion,",
              String
"If mutual recursion is required, you may disambiguate identical definitions by",
              String
"adding a dummy comment like:",
              String
"_ = \"this is the foo definition\""
            ]

-- | We don't expect to encounter these, but if we do we should print a nice message.
--
-- In the future we will hopefully prevent this error entirely.
crashOnHashingFailure :: (HasCallStack) => Either HashingFailure a -> a
crashOnHashingFailure :: forall a. HasCallStack => Either HashingFailure a -> a
crashOnHashingFailure = \case
  Left HashingFailure
hf -> HashingFailure -> a
forall a e. Exception e => e -> a
throw HashingFailure
hf
  Right a
a -> a
a

data HashValidationError
  = HashValidationMismatch HashMismatch
  | HashingFailure HashingFailure

data DeclHashingError
  = DeclHashMismatch HashMismatch
  | DeclHashResolutionFailure

data HashHandle = HashHandle
  { -- | Hash type
    HashHandle -> Type Symbol -> Reference
toReference :: C.Term.Type Symbol -> C.Reference,
    -- | Hash type's mentions
    HashHandle -> Type Symbol -> Set Reference
toReferenceMentions :: C.Term.Type Symbol -> Set C.Reference,
    -- | Hash the type of a single constructor in a decl component. The provided hash argument is the hash of the decl component.
    HashHandle -> Hash -> TypeD Symbol -> Reference
toReferenceDecl :: Hash -> C.Type.TypeD Symbol -> C.Reference,
    -- | Hash decl's mentions
    HashHandle -> Hash -> TypeD Symbol -> Set Reference
toReferenceDeclMentions :: Hash -> C.Type.TypeD Symbol -> Set C.Reference,
    HashHandle
-> forall (m :: * -> *). Monad m => Branch m -> m BranchHash
hashBranch :: forall m. (Monad m) => Branch m -> m BranchHash,
    HashHandle -> forall (m :: * -> *). BranchV3 m -> BranchHash
hashBranchV3 :: forall m. BranchV3 m -> BranchHash,
    HashHandle -> BranchHash -> Set CausalHash -> CausalHash
hashCausal ::
      -- The causal's namespace hash
      BranchHash ->
      -- The causal's parents
      Set CausalHash ->
      CausalHash,
    HashHandle -> HashBranchLocalIds -> LocalBranch -> BranchHash
hashBranchFormatFull ::
      HashBranchLocalIds ->
      LocalBranch ->
      BranchHash,
    HashHandle -> HashPatchLocalIds -> LocalPatch -> PatchHash
hashPatchFormatFull ::
      HashPatchLocalIds ->
      LocalPatch ->
      PatchHash,
    HashHandle
-> ComponentHash -> HashTermFormat -> Maybe HashValidationError
verifyTermFormatHash ::
      ComponentHash ->
      TermFormat.HashTermFormat ->
      Maybe HashValidationError,
    HashHandle
-> ComponentHash -> HashDeclFormat -> Maybe DeclHashingError
verifyDeclFormatHash ::
      ComponentHash ->
      DeclFormat.HashDeclFormat ->
      Maybe DeclHashingError
  }