core: fix parseDerivedPath breaking when StoreDir contains exclamation mark

Author: sorki

hnix-store-core/src/System/Nix/DerivedPath.hs

@@ -14,8 +14,9 @@ import Data.Bifunctor (first)
 import GHC.Generics (Generic)
 import Data.Set (Set)
 import Data.Text (Text)
-import System.Nix.StorePath (StoreDir, StorePath, StorePathName, InvalidPathError)
+import System.Nix.StorePath (StoreDir(..), StorePath, StorePathName, InvalidPathError)
 
+import qualified Data.ByteString.Char8
 import qualified Data.Set
 import qualified Data.Text
 import qualified System.Nix.StorePath
@@ -33,6 +34,7 @@ data DerivedPath =
 data ParseOutputsError =
     ParseOutputsError_InvalidPath InvalidPathError
   | ParseOutputsError_NoNames
+  | ParseOutputsError_NoPrefix StoreDir Text
   deriving (Eq, Ord, Show)
 
 convertError
@@ -61,16 +63,32 @@ parseDerivedPath
   :: StoreDir
   -> Text
   -> Either ParseOutputsError DerivedPath
-parseDerivedPath root p =
-  -- TODO: breaks when root contains !
-  case Data.Text.breakOn "!" p of
-    (s, r) ->
-      if Data.Text.null r
-      then DerivedPath_Opaque
-           <$> (convertError $ System.Nix.StorePath.parsePathFromText root s)
-      else DerivedPath_Built
-           <$> (convertError $ System.Nix.StorePath.parsePathFromText root s)
-           <*> parseOutputsSpec (Data.Text.drop (Data.Text.length "!") r)
+parseDerivedPath root@(StoreDir sd) path =
+  let -- We need to do a bit more legwork for case
+      -- when StoreDir contains '!'
+      -- which is generated by its Arbitrary instance
+    textRoot = Data.Text.pack
+               $ Data.ByteString.Char8.unpack sd
+
+  in case Data.Text.stripPrefix textRoot path of
+    Nothing -> Left $ ParseOutputsError_NoPrefix root path
+    Just woRoot ->
+      case Data.Text.breakOn "!" woRoot of
+        (pathNoPrefix, r) ->
+          if Data.Text.null r
+          then DerivedPath_Opaque
+               <$> (convertError
+                   $ System.Nix.StorePath.parsePathFromText
+                      root
+                      path
+                   )
+          else DerivedPath_Built
+               <$> (convertError
+                   $ System.Nix.StorePath.parsePathFromText
+                       root
+                       (textRoot <> pathNoPrefix)
+                   )
+               <*> parseOutputsSpec (Data.Text.drop (Data.Text.length "!") r)
 
 derivedPathToText :: StoreDir -> DerivedPath -> Text
 derivedPathToText root = \case

hnix-store-tests/hnix-store-tests.cabal

@@ -81,7 +81,6 @@ test-suite props
     , hnix-store-tests
     , attoparsec
     , containers
-    , data-default-class
     , QuickCheck
     , text
     , hspec

hnix-store-tests/tests/DerivedPathSpec.hs

@@ -1,6 +1,5 @@
 module DerivedPathSpec where
 
-import Data.Default.Class (Default(def))
 import Test.Hspec (Spec, describe, shouldBe)
 import Test.Hspec.QuickCheck (prop)
 import Test.QuickCheck (Arbitrary(arbitrary), forAll, suchThat)
@@ -14,10 +13,10 @@ import qualified System.Nix.DerivedPath
 spec :: Spec
 spec = do
   describe "DerivedPath" $ do
-    prop "roundtrips" $
+    prop "roundtrips" $ \sd ->
       forAll (arbitrary `suchThat` nonEmptyOutputsSpec_Names) $ \p ->
-        System.Nix.DerivedPath.parseDerivedPath def
-          (System.Nix.DerivedPath.derivedPathToText def p)
+        System.Nix.DerivedPath.parseDerivedPath sd
+          (System.Nix.DerivedPath.derivedPathToText sd p)
         `shouldBe` pure p
   where
     nonEmptyOutputsSpec_Names :: DerivedPath -> Bool