From 70276b82fbe3450a191d72d9104182e937561d99 Mon Sep 17 00:00:00 2001 From: Gabriel Gonzalez Date: Mon, 23 Oct 2017 07:51:10 -0700 Subject: [PATCH] Add support for SHA-256 integrity checks on imports (#166) Related to #162 You can now add `sha256:XXX...XXX` after any import to verify that the import has the expected hash. This allows you to purify import code and protect the code against malicious modifications This is analogous to an IPFS-style import except that the hash is verified directly by the interpreter instead of trusting that the IPFS URL has not been compromised --- default.nix | 20 ++++---- dhall.cabal | 2 + src/Dhall/Core.hs | 25 ++++++++-- src/Dhall/Import.hs | 118 +++++++++++++++++++++++++++++++++++++------- src/Dhall/Parser.hs | 24 +++++++-- 5 files changed, 155 insertions(+), 34 deletions(-) diff --git a/default.nix b/default.nix index 0dd4824..61dfc7a 100644 --- a/default.nix +++ b/default.nix @@ -1,8 +1,9 @@ -{ mkDerivation, ansi-wl-pprint, base, bytestring, case-insensitive -, charset, containers, contravariant, exceptions, http-client -, http-client-tls, lens, optparse-generic, parsers, prettyprinter -, stdenv, system-fileio, system-filepath, tasty, tasty-hunit, text -, text-format, transformers, trifecta, unordered-containers, vector +{ mkDerivation, ansi-wl-pprint, base, base16-bytestring, bytestring +, case-insensitive, charset, containers, contravariant, cryptohash +, exceptions, http-client, http-client-tls, lens, optparse-generic +, parsers, prettyprinter, stdenv, system-fileio, system-filepath +, tasty, tasty-hunit, text, text-format, transformers, trifecta +, unordered-containers, vector }: mkDerivation { pname = "dhall"; @@ -11,10 +12,11 @@ mkDerivation { isLibrary = true; isExecutable = true; libraryHaskellDepends = [ - ansi-wl-pprint base bytestring case-insensitive charset containers - contravariant exceptions http-client http-client-tls lens parsers - prettyprinter system-fileio system-filepath text text-format - transformers trifecta unordered-containers vector + ansi-wl-pprint base base16-bytestring bytestring case-insensitive + charset containers contravariant cryptohash exceptions http-client + http-client-tls lens parsers prettyprinter system-fileio + system-filepath text text-format transformers trifecta + unordered-containers vector ]; executableHaskellDepends = [ base optparse-generic prettyprinter system-filepath text trifecta diff --git a/dhall.cabal b/dhall.cabal index 886feb4..e65bc3f 100644 --- a/dhall.cabal +++ b/dhall.cabal @@ -93,11 +93,13 @@ Library Build-Depends: base >= 4.9.0.0 && < 5 , ansi-wl-pprint < 0.7 , + base16-bytestring < 0.2 , bytestring < 0.11, case-insensitive < 1.3 , charset < 0.4 , containers >= 0.5.0.0 && < 0.6 , contravariant < 1.5 , + cryptohash < 0.12, exceptions >= 0.8.3 && < 0.9 , http-client >= 0.4.30 && < 0.6 , http-client-tls >= 0.2.0 && < 0.4 , diff --git a/src/Dhall/Core.hs b/src/Dhall/Core.hs index 9b4531e..8d03793 100644 --- a/src/Dhall/Core.hs +++ b/src/Dhall/Core.hs @@ -19,6 +19,7 @@ module Dhall.Core ( Const(..) , HasHome(..) , PathType(..) + , PathHashed(..) , PathMode(..) , Path(..) , Var(..) @@ -63,6 +64,9 @@ import Numeric.Natural (Natural) import Prelude hiding (FilePath, succ) import qualified Control.Monad +import qualified Data.ByteString +import qualified Data.ByteString.Char8 +import qualified Data.ByteString.Base16 import qualified Data.Char import qualified Data.HashSet import qualified Data.List @@ -105,7 +109,7 @@ data HasHome = Home | Homeless deriving (Eq, Ord, Show) data PathType = File HasHome FilePath -- ^ Local path - | URL Text (Maybe PathType) + | URL Text (Maybe PathHashed) -- ^ URL of emote resource and optional headers stored in a path | Env Text -- ^ Environment variable @@ -132,14 +136,27 @@ instance Buildable PathType where -- | How to interpret the path's contents (i.e. as Dhall code or raw text) data PathMode = Code | RawText deriving (Eq, Ord, Show) +data PathHashed = PathHashed + { hash :: Maybe Data.ByteString.ByteString + , pathType :: PathType + } deriving (Eq, Ord, Show) + +instance Buildable PathHashed where + build (PathHashed Nothing p) = build p + build (PathHashed (Just h) p) = build p <> "sha256:" <> build string <> " " + where + bytes = Data.ByteString.Base16.encode h + + string = Data.ByteString.Char8.unpack bytes + -- | Path to an external resource data Path = Path - { pathType :: PathType - , pathMode :: PathMode + { pathHashed :: PathHashed + , pathMode :: PathMode } deriving (Eq, Ord, Show) instance Buildable Path where - build (Path {..}) = build pathType <> suffix + build (Path {..}) = build pathHashed <> suffix where suffix = case pathMode of RawText -> "as Text" diff --git a/src/Dhall/Import.hs b/src/Dhall/Import.hs index 6d8acc8..633915f 100644 --- a/src/Dhall/Import.hs +++ b/src/Dhall/Import.hs @@ -134,7 +134,13 @@ import Data.Traversable (traverse) import Data.Typeable (Typeable) import Filesystem.Path ((), FilePath) import Dhall.Core - (Expr(..), HasHome(..), PathMode(..), PathType(..), Path(..)) + ( Expr(..) + , HasHome(..) + , PathHashed(..) + , PathMode(..) + , PathType(..) + , Path(..) + ) import Dhall.Parser (Parser(..), ParseError(..), Src(..)) import Dhall.TypeCheck (X(..)) #if MIN_VERSION_http_client(0,5,0) @@ -148,7 +154,10 @@ import Text.Trifecta (Result(..)) import Text.Trifecta.Delta (Delta(..)) import qualified Control.Monad.Trans.State.Strict as State +import qualified Crypto.Hash.SHA256 import qualified Data.ByteString +import qualified Data.ByteString.Base16 +import qualified Data.ByteString.Char8 import qualified Data.ByteString.Lazy import qualified Data.CaseInsensitive import qualified Data.List as List @@ -157,6 +166,7 @@ import qualified Data.Text.Encoding import qualified Data.Text.Lazy as Text import qualified Data.Text.Lazy.Builder as Builder import qualified Data.Text.Lazy.Encoding +import qualified Data.Text.Lazy.IO import qualified Data.Vector import qualified Dhall.Core import qualified Dhall.Parser @@ -376,7 +386,7 @@ canonicalize (File hasHome0 file0:paths0) = go currPath (Env _ :_ ) = File Homeless (clean currPath) go currPath (URL url0 headers:rest ) = combine prefix suffix where - headers' = fmap (\h -> canonicalize (h:rest)) headers + headers' = fmap (onPathType (\h -> canonicalize (h:rest))) headers prefix = parentURL (removeAtFromURL url0) @@ -409,19 +419,29 @@ canonicalize (File hasHome0 file0:paths0) = file' = Filesystem.parent (removeAtFromFile file) currPath canonicalize (URL path headers:rest) = URL path headers' where - headers' = fmap (\h -> canonicalize (h:rest)) headers + headers' = fmap (onPathType (\h -> canonicalize (h:rest))) headers canonicalize (Env env :_ ) = Env env +onPathType :: (PathType -> PathType) -> PathHashed -> PathHashed +onPathType f (PathHashed a b) = PathHashed a (f b) + canonicalizePath :: [Path] -> Path canonicalizePath [] = Path - { pathMode = Code - , pathType = canonicalize [] + { pathMode = Code + , pathHashed = PathHashed + { hash = Nothing + , pathType = canonicalize [] + } } canonicalizePath (path:paths) = Path - { pathMode = pathMode path - , pathType = canonicalize (map pathType (path:paths)) + { pathMode = pathMode path + , pathHashed = (pathHashed path) + { hash = hash (pathHashed path) + , pathType = + canonicalize (map (pathType . pathHashed) (path:paths)) + } } parentURL :: Text -> Text @@ -503,6 +523,67 @@ instance Show InternalError where instance Exception InternalError +-- | Exception thrown when an integrity check fails +data HashMismatch = HashMismatch + { expectedHash :: Data.ByteString.ByteString + , actualHash :: Data.ByteString.ByteString + } deriving (Typeable) + +instance Exception HashMismatch + +instance Show HashMismatch where + show (HashMismatch {..}) = + "\n" + <> "\ESC[1;31mError\ESC[0m: Import integrity check failed\n" + <> "\n" + <> "Expected hash:\n" + <> "\n" + <> "↳ " <> toString expectedHash <> "\n" + <> "\n" + <> "Actual hash:\n" + <> "\n" + <> "↳ " <> toString actualHash <> "\n" + where + toString = + Data.ByteString.Char8.unpack . Data.ByteString.Base16.encode + +assertHash :: Maybe Data.ByteString.ByteString -> Text -> IO () +assertHash Nothing _ = + return () +assertHash (Just expectedHash) text = + if expectedHash == actualHash + then return () + else Control.Exception.throwIO (HashMismatch {..}) + where + actualBytes = Data.Text.Lazy.Encoding.encodeUtf8 text + + actualHash = Crypto.Hash.SHA256.hashlazy actualBytes + +parseFromFileEx + :: Maybe Data.ByteString.ByteString + -> Text.Trifecta.Parser a + -> FilePath + -> IO (Text.Trifecta.Result a) +parseFromFileEx hash parser path = do + text <- Data.Text.Lazy.IO.readFile stringPath + assertHash hash text + + let lazyBytes = Data.Text.Lazy.Encoding.encodeUtf8 text + + let strictBytes = Data.ByteString.Lazy.toStrict lazyBytes + + let delta = Directed bytesPath 0 0 0 0 + + return (Text.Trifecta.parseByteString parser delta strictBytes) + where + stringPath = Filesystem.Path.CurrentOS.encodeString path + + textPath = case Filesystem.Path.CurrentOS.toText path of + Left text -> text + Right text -> text + + bytesPath = Data.Text.Encoding.encodeUtf8 textPath + -- | Parse an expression from a `Path` containing a Dhall program exprFromPath :: Manager -> Path -> IO (Expr Src Path) exprFromPath m (Path {..}) = case pathType of @@ -521,23 +602,17 @@ exprFromPath m (Path {..}) = case pathType of then return () else Control.Exception.throwIO MissingFile - let string = Filesystem.Path.CurrentOS.encodeString path - -- Unfortunately, GHC throws an `InappropriateType` exception -- when trying to read a directory, but does not export the -- exception, so I must resort to a more heavy-handed `catch` let handler :: IOException -> IO (Result (Expr Src Path)) handler e = do - let string' = - Filesystem.Path.CurrentOS.encodeString - (path "@") - -- If the fallback fails, reuse the original exception -- to avoid user confusion - Text.Trifecta.parseFromFileEx parser string' + parseFromFileEx hash parser (path "@") `onException` throwIO e - x <- Text.Trifecta.parseFromFileEx parser string `catch` handler + x <- parseFromFileEx hash parser path `catch` handler case x of Failure errInfo -> do throwIO (ParseError (Text.Trifecta._errDoc errInfo)) @@ -545,6 +620,7 @@ exprFromPath m (Path {..}) = case pathType of return expr RawText -> do text <- Filesystem.readTextFile path + assertHash hash (Text.fromStrict text) return (TextLit (build text)) URL url headerPath -> do request <- HTTP.parseUrlThrow (Text.unpack url) @@ -605,6 +681,8 @@ exprFromPath m (Path {..}) = case pathType of Left err -> throwIO err Right text -> return text + assertHash hash text + case pathMode of Code -> do let urlBytes = Data.Text.Lazy.Encoding.encodeUtf8 url @@ -641,6 +719,8 @@ exprFromPath m (Path {..}) = case pathType of x <- System.Environment.lookupEnv (Text.unpack env) case x of Just str -> do + assertHash hash (Text.pack str) + case pathMode of Code -> do let envBytes = Data.Text.Lazy.Encoding.encodeUtf8 env @@ -654,6 +734,8 @@ exprFromPath m (Path {..}) = case pathType of RawText -> return (TextLit (build str)) Nothing -> throwIO (MissingEnvironmentVariable env) where + PathHashed {..} = pathHashed + parser = unParser (do Text.Parser.Token.whiteSpace r <- Dhall.Parser.expr @@ -691,15 +773,15 @@ loadStaticWith :: MonadCatch m => (Path -> m (Expr Src Path)) loadStaticWith from_path ctx path = do paths <- zoom stack State.get - let local (Path (URL url _) _) = + let local (Path (PathHashed _ (URL url _)) _) = case HTTP.parseUrlThrow (Text.unpack url) of Nothing -> False Just request -> case HTTP.host request of "127.0.0.1" -> True "localhost" -> True _ -> False - local (Path (File _ _ ) _) = True - local (Path (Env _ ) _) = True + local (Path (PathHashed _ (File _ _ )) _) = True + local (Path (PathHashed _ (Env _ )) _) = True let parent = canonicalizePath paths let here = canonicalizePath (path:paths) diff --git a/src/Dhall/Parser.hs b/src/Dhall/Parser.hs index 9f19c5f..dfdbf16 100644 --- a/src/Dhall/Parser.hs +++ b/src/Dhall/Parser.hs @@ -43,6 +43,7 @@ import Text.Trifecta import Text.Trifecta.Delta (Delta) import qualified Control.Monad +import qualified Data.ByteString.Base16.Lazy import qualified Data.Char import qualified Data.HashSet import qualified Data.Map @@ -931,7 +932,7 @@ http = do whitespace b <- optional (do _using - pathType_ ) + pathHashed_ ) return (URL (Data.Text.Lazy.Builder.toLazyText a) b) env :: Parser PathType @@ -1493,10 +1494,27 @@ exprA = completeExpression pathType_ :: Parser PathType pathType_ = choice [ file, http, env ] +pathHashed_ :: Parser PathHashed +pathHashed_ = do + pathType <- pathType_ + hash <- optional pathHash_ + return (PathHashed {..}) + where + pathHash_ = do + _ <- Text.Parser.Char.text "sha256:" + builder <- count 64 (satisfy hexdig "hex digit") + whitespace + let lazyText = Data.Text.Lazy.Builder.toLazyText builder + let lazyBytes = Data.Text.Lazy.Encoding.encodeUtf8 lazyText + let (hash, suffix) = Data.ByteString.Base16.Lazy.decode lazyBytes + if Data.ByteString.Lazy.null suffix + then return (Data.ByteString.Lazy.toStrict hash) + else fail "Invalid sha256 hash" + import_ :: Parser Path import_ = (do - pathType <- pathType_ - pathMode <- alternative <|> pure Code + pathHashed <- pathHashed_ + pathMode <- alternative <|> pure Code return (Path {..}) ) "import" where alternative = do