Check code hashes in import

7 files changed, 57 insertions, 18 deletions

diff --git a/dhall/build.rs b/dhall/build.rs
index c79682d..ec31192 100644
--- a/dhall/build.rs
+++ b/dhall/build.rs
@@ -256,9 +256,7 @@ fn generate_tests() -> std::io::Result<()> {
             exclude_path: Rc::new(|path: &str| {
                 false
                     // TODO: import hash
-                    || path == "alternativeHashMismatch"
                     || path == "hashFromCache"
-                    || path == "unit/AlternativeHashMismatch"
                     // TODO: the standard does not respect https://tools.ietf.org/html/rfc3986#section-5.2
                     || path == "unit/asLocation/RemoteCanonicalize4"
                     // TODO: import headers
@@ -275,8 +273,6 @@ fn generate_tests() -> std::io::Result<()> {
             variant: "ImportFailure",
             exclude_path: Rc::new(|path: &str| {
                 false
-                    // TODO: import hash
-                    || path == "hashMismatch"
                     // TODO: import headers
                     || path == "customHeadersUsingBoundVariable"
             }),
diff --git a/dhall/src/semantics/resolve/hir.rs b/dhall/src/semantics/resolve/hir.rs
index 9256425..8869915 100644
--- a/dhall/src/semantics/resolve/hir.rs
+++ b/dhall/src/semantics/resolve/hir.rs
@@ -59,6 +59,10 @@ impl Hir {
         let opts = ToExprOptions { alpha: false };
         self.to_expr(opts)
     }
+    pub fn to_expr_alpha(&self) -> Expr {
+        let opts = ToExprOptions { alpha: true };
+        self.to_expr(opts)
+    }
     pub fn to_expr_tyenv(&self, env: &TyEnv) -> Expr {
         let opts = ToExprOptions { alpha: false };
         let mut env = env.as_nameenv().clone();
diff --git a/dhall/src/semantics/resolve/resolve.rs b/dhall/src/semantics/resolve/resolve.rs
index 7745e0b..6e50fa6 100644
--- a/dhall/src/semantics/resolve/resolve.rs
+++ b/dhall/src/semantics/resolve/resolve.rs
@@ -10,7 +10,7 @@ use crate::semantics::{mkerr, Hir, HirKind, ImportEnv, NameEnv, Type};
 use crate::syntax;
 use crate::syntax::map::DupTreeMap;
 use crate::syntax::{
-    BinOp, Builtin, Expr, ExprKind, FilePath, FilePrefix, ImportMode,
+    BinOp, Builtin, Expr, ExprKind, FilePath, FilePrefix, Hash, ImportMode,
     ImportTarget, Span, UnspannedExpr, URL,
 };
 use crate::{Parsed, Resolved};
@@ -208,6 +208,7 @@ fn resolve_one_import(
     env: &mut ImportEnv,
     import: &Import,
     location: &ImportLocation,
+    span: Span,
 ) -> Result<TypedHir, Error> {
     let do_sanity_check = import.mode != ImportMode::Location;
     let location = location.chain(&import.location, do_sanity_check)?;
@@ -215,7 +216,30 @@ fn resolve_one_import(
         ImportMode::Code => {
             let parsed = location.fetch_dhall()?;
             let typed = resolve_with_env(env, parsed)?.typecheck()?;
-            Ok((typed.normalize().to_hir(), typed.ty().clone()))
+            let hir = typed.normalize().to_hir();
+            let ty = typed.ty().clone();
+            match &import.hash {
+                Some(Hash::SHA256(hash)) => {
+                    let actual_hash = hir.to_expr_alpha().hash()?;
+                    if hash[..] != actual_hash[..] {
+                        mkerr(
+                            ErrorBuilder::new("hash mismatch")
+                                .span_err(span, "hash mismatch")
+                                .note(format!(
+                                    "Expected sha256:{}",
+                                    hex::encode(hash)
+                                ))
+                                .note(format!(
+                                    "Found    sha256:{}",
+                                    hex::encode(actual_hash)
+                                ))
+                                .format(),
+                        )?
+                    }
+                }
+                None => {}
+            }
+            Ok((hir, ty))
         }
         ImportMode::RawText => {
             let text = location.fetch_text()?;
@@ -268,7 +292,7 @@ fn desugar(expr: &Expr) -> Cow<'_, Expr> {
 fn traverse_resolve_expr(
     name_env: &mut NameEnv,
     expr: &Expr,
-    f: &mut impl FnMut(Import) -> Result<TypedHir, Error>,
+    f: &mut impl FnMut(Import, Span) -> Result<TypedHir, Error>,
 ) -> Result<Hir, Error> {
     let expr = desugar(expr);
     Ok(match expr.kind() {
@@ -307,7 +331,7 @@ fn traverse_resolve_expr(
                 ExprKind::Import(import) => {
                     // TODO: evaluate import headers
                     let import = import.traverse_ref(|_| Ok::<_, Error>(()))?;
-                    let imported = f(import)?;
+                    let imported = f(import, expr.span())?;
                     HirKind::Import(imported.0, imported.1)
                 }
                 kind => HirKind::Expr(kind),
@@ -322,10 +346,11 @@ fn resolve_with_env(
     parsed: Parsed,
 ) -> Result<Resolved, Error> {
     let Parsed(expr, location) = parsed;
-    let resolved =
-        traverse_resolve_expr(&mut NameEnv::new(), &expr, &mut |import| {
-            resolve_one_import(env, &import, &location)
-        })?;
+    let resolved = traverse_resolve_expr(
+        &mut NameEnv::new(),
+        &expr,
+        &mut |import, span| resolve_one_import(env, &import, &location, span),
+    )?;
     Ok(Resolved(resolved))
 }
 
@@ -334,7 +359,7 @@ pub fn resolve(parsed: Parsed) -> Result<Resolved, Error> {
 }
 
 pub fn skip_resolve_expr(expr: &Expr) -> Result<Hir, Error> {
-    traverse_resolve_expr(&mut NameEnv::new(), expr, &mut |import| {
+    traverse_resolve_expr(&mut NameEnv::new(), expr, &mut |import, _span| {
         Err(ImportError::UnexpectedImport(import).into())
     })
 }
diff --git a/dhall/src/syntax/ast/expr.rs b/dhall/src/syntax/ast/expr.rs
index 6ba6649..9e935dc 100644
--- a/dhall/src/syntax/ast/expr.rs
+++ b/dhall/src/syntax/ast/expr.rs
@@ -1,5 +1,6 @@
 use std::collections::BTreeMap;
 
+use crate::error::Error;
 use crate::semantics::Universe;
 use crate::syntax::map::{DupTreeMap, DupTreeSet};
 use crate::syntax::visitor;
@@ -255,6 +256,13 @@ impl Expr {
             span,
         }
     }
+
+    // Compute the sha256 hash of the binary form of the expression.
+    pub fn hash(&self) -> Result<Box<[u8]>, Error> {
+        use sha2::Digest;
+        let data = binary::encode(self)?;
+        Ok(sha2::Sha256::digest(&data).as_slice().into())
+    }
 }
 
 // Empty enum to indicate that no error can occur
diff --git a/dhall/src/tests.rs b/dhall/src/tests.rs
index a194c9a..5bcdb1c 100644
--- a/dhall/src/tests.rs
+++ b/dhall/src/tests.rs
@@ -304,12 +304,8 @@ fn run_test(test: Test) -> Result<()> {
             expected.compare_ui(err)?;
         }
         SemanticHash(expr, expected) => {
-            use sha2::Digest;
             let expr = expr.normalize()?.to_expr_alpha();
-            dbg!(&expr);
-            let expr_data = binary::encode(&expr)?;
-            let hash = sha2::Sha256::digest(&expr_data);
-            let hash = hex::encode(hash);
+            let hash = hex::encode(expr.hash()?);
             expected.compare_ui(format!("sha256:{}", hash))?;
         }
         TypeInferenceSuccess(expr, expected) => {
diff --git a/dhall/tests/import/failure/hashMismatch.txt b/dhall/tests/import/failure/hashMismatch.txt
new file mode 100644
index 0000000..2195959
--- /dev/null
+++ b/dhall/tests/import/failure/hashMismatch.txt
@@ -0,0 +1,8 @@
+Type error: error: hash mismatch
+ --> <current file>:1:1
+  |
+1 | ../data/simple.dhall sha256:aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
+  | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ hash mismatch
+  |
+  = note: Expected sha256:aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
+  = note: Found    sha256:15f52ecf91c94c1baac02d5a4964b2ed8fa401641a2c8a95e8306ec7c1e3b8d2
diff --git a/tests_buffer b/tests_buffer
index 6f5aae5..afb270f 100644
--- a/tests_buffer
+++ b/tests_buffer
@@ -17,6 +17,8 @@ import:
 failure/
     don't recover cycle
     don't resolve symlinks in canonicalizing
+as Text hash
+as Location hash
 
 normalization:
 move builtins and operators in their own folder ?