ifc: taint 'notmuch config-get' output

Create tainting version of readProcess and update
Storage.Notmuch.getDatabasePath to use it.

Part of: #269

src/Purebred/System/Process.hs

@@ -18,6 +18,7 @@ module Purebred.System.Process
   ( tryRunProcess
   , handleIOException
   , handleExitCode
+  , Purebred.System.Process.readProcess
 
   -- * Re-exports from @System.Process.Typed@
   , ProcessConfig
@@ -26,13 +27,15 @@ module Purebred.System.Process
   , byteStringInput
   ) where
 
+import Data.Bifunctor (bimap)
 import System.Exit (ExitCode(..))
 import Control.Exception (try, IOException)
 import System.Process.Typed
 import qualified Data.ByteString.Lazy as LB
 import Control.Lens (set, (&))
 import Data.Semigroup ((<>))
 
+import Control.Monad.IO.Class (MonadIO)
 import qualified Data.Text as T
 
 import Error
@@ -51,6 +54,9 @@ handleExitCode s (ExitSuccess, _) = s
 handleIOException :: AppState -> IOException -> IO AppState
 handleIOException s' ex = pure $ s' & setError (ProcessError (show ex))
 
+setError :: Error -> AppState -> AppState
+setError = set asError . Just
+
 -- | Try running a process given by the `FilePath` and catch an IOExceptions.
 -- This is to avoid a crashing process also take down the running Brick program.
 --
@@ -61,5 +67,9 @@ tryRunProcess
   -> IO (Either IOException (ExitCode, Tainted LB.ByteString))
 tryRunProcess = (fmap . fmap . fmap) taint . try . readProcessStderr
 
-setError :: Error -> AppState -> AppState
-setError = set asError . Just
+-- | Run process, returning stdout and stderr as @ByteString@.
+readProcess
+  :: (MonadIO m)
+  => ProcessConfig stdin stdoutIgnored stderrIgnored
+  -> m (ExitCode, Tainted LB.ByteString, Tainted LB.ByteString)
+readProcess = (fmap . fmap) (bimap taint taint) System.Process.Typed.readProcess

src/Storage/Notmuch.hs

@@ -17,7 +17,6 @@ import Data.Traversable (traverse)
 import Data.List (union, notElem, nub, sort)
 import Data.Maybe (fromMaybe)
 import qualified Data.Vector as Vec
-import System.Process.Typed (readProcess, proc)
 import System.Exit (ExitCode(..))
 import qualified Data.Text as T
 import Control.Lens (view, over, set, firstOf, folded, Lens')
@@ -27,6 +26,8 @@ import qualified Notmuch
 import Error
 import Types
 import Purebred.LazyVector
+import Purebred.System.Process (readProcess, proc)
+import Purebred.Types.IFC (sanitiseText, untaint)
 
 
 -- | apply tag operations on all given mails and write the resulting tags to the
@@ -164,10 +165,10 @@ getDatabasePath = do
   let args = ["config", "get", "database.path"]
   (exitc, stdout, err) <- readProcess $ proc cmd args
   case exitc of
-    ExitFailure _ -> error (decode err)
-    ExitSuccess -> pure (filter (/= '\n') (decode stdout))
+    ExitFailure _ -> error (untaint decode err)
+    ExitSuccess -> pure (filter (/= '\n') (untaint decode stdout))
   where
-      decode = T.unpack . decodeLenient . LB.toStrict
+      decode = T.unpack . sanitiseText . decodeLenient . LB.toStrict
 
 -- | creates a vector of threads from a notmuch search
 --