Get hnix-store-aterm tests passing!

hnix-store-aterm/src/System/Nix/Derivation/ATerm/Builder.hs

@@ -133,7 +133,17 @@ vectorOf :: (a -> Builder) -> Vector a -> Builder
 vectorOf element xs = listOf element (Data.Vector.toList xs)
 
 string :: Text -> Builder
-string = Data.Text.Lazy.Builder.fromText . Data.Text.pack . show
+string =
+    Data.Text.Lazy.Builder.fromText
+    . (\input -> Data.Text.concat ["\"", Data.Text.concatMap escapeChar input, "\""])
+  where
+    escapeChar :: Char -> Text
+    escapeChar '\"' = "\\\""
+    escapeChar '\\' = "\\\\"
+    escapeChar '\n' = "\\n"
+    escapeChar '\r' = "\\r"
+    escapeChar '\t' = "\\t"
+    escapeChar c    = Data.Text.singleton c
 
 buildOutputName :: OutputName -> Builder
 buildOutputName = string . unStorePathName . unOutputName

hnix-store-aterm/src/System/Nix/Derivation/Traditional.hs

@@ -74,7 +74,9 @@ parseRawDerivationOutput storeDir drvName outputName (RawDerivationOutput {..})
               hash' <- either fail pure $ has @NamedAlgo hashAlgo $
                   decodeDigestWith NixBase32 hash0
               let hash = hashAlgo :=> hash'
-              let expectedPath = makeFixedOutputPath storeDir method hash mempty $ outputStoreObjectName drvName outputName
+              fullOutputName <- either (fail . show) pure $
+                outputStoreObjectName drvName outputName
+              let expectedPath = makeFixedOutputPath storeDir method hash mempty fullOutputName
               when (path /= expectedPath) $
                 fail "fixed output path does not match info"
               pure FixedDerivationOutput {..}
@@ -97,7 +99,9 @@ renderRawDerivationOutput storeDir drvName outputName = \case
     }
   FixedDerivationOutput {..} -> case hash of
     hashAlgo :=> hash' -> RawDerivationOutput
-      { rawPath = storePathToText storeDir $ makeFixedOutputPath storeDir method hash mempty $ outputStoreObjectName drvName outputName
+      { rawPath = storePathToText storeDir $ makeFixedOutputPath storeDir method hash mempty
+          $ either (error . show) id -- TODO do better
+          $ outputStoreObjectName drvName outputName
       , rawMethodHashAlgo = buildMethodHashAlgo method $ Some hashAlgo
       , rawHash = encodeDigestWith NixBase32 hash'
       }
@@ -120,7 +124,7 @@ splitMethodHashAlgo :: MonadFail m => Text -> m (ContentAddressMethod, Some Hash
 splitMethodHashAlgo methodHashAlgo = do
   (method, hashAlgoS) <- case Data.Text.splitOn ":" methodHashAlgo of
     ["r", hashAlgo] -> pure (ContentAddressMethod_NixArchive, hashAlgo)
-    ["text", hashAlgo] -> pure (ContentAddressMethod_NixArchive, hashAlgo)
+    ["text", hashAlgo] -> pure (ContentAddressMethod_Text, hashAlgo)
     [hashAlgo] -> pure (ContentAddressMethod_Flat, hashAlgo)
     _ -> fail "invalid number of colons or unknown CA method prefix"
   hashAlgo <- either fail pure $ textToAlgo hashAlgoS

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

@@ -37,11 +37,12 @@ mkOutputName = fmap OutputName . System.Nix.StorePath.mkStorePathName
 
 -- | Compute the name of an output (store object) from the output name
 -- and the derivation name
-outputStoreObjectName :: StorePathName -> OutputName -> StorePathName
+--
+-- Invalid character errors are not possible, but total length errors are
+outputStoreObjectName :: StorePathName -> OutputName -> Either InvalidNameError StorePathName
 outputStoreObjectName drvName outputName = case outputNameS of
-  "out" -> drvName
-  _  -> either (error "impossible, internal error") id $
-    System.Nix.StorePath.mkStorePathName $
+  "out" -> Right drvName
+  _  -> System.Nix.StorePath.mkStorePathName $
       unStorePathName drvName
       <> "-"
       <> outputNameS

hnix-store-tests/src/System/Nix/Arbitrary/Derivation.hs

@@ -1,35 +1,57 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE GADTs #-}
 -- due to recent generic-arbitrary
 {-# OPTIONS_GHC -fconstraint-solver-iterations=0 #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 module System.Nix.Arbitrary.Derivation where
 
+import Data.Dependent.Sum
+import Data.Either (isRight)
+import Data.Map qualified
 import Data.Map.Monoidal
-import Data.These
-import Data.Text (Text)
+import Data.Some
 import Data.Text.Arbitrary ()
+import Data.These
 import Data.Vector.Arbitrary ()
-import System.Nix.Derivation
-import System.Nix.StorePath (StorePath)
+import Test.QuickCheck.Arbitrary.Generic
+import Test.QuickCheck.Gen
 
-import Test.QuickCheck (Arbitrary(..))
-import Test.QuickCheck.Arbitrary.Generic (Arg, GenericArbitrary(..))
+import System.Nix.Derivation
+import System.Nix.ContentAddress
+import System.Nix.Hash
+import System.Nix.OutputName
 import System.Nix.Arbitrary.ContentAddress ()
 import System.Nix.Arbitrary.Hash ()
 import System.Nix.Arbitrary.StorePath ()
 import System.Nix.Arbitrary.OutputName ()
 
-deriving via GenericArbitrary
-    (Derivation' inputs output)
-  instance
-    ( Arbitrary inputs
-    , Arbitrary output
-    , Arg (Derivation' inputs output) inputs
-    , Arg (Derivation' inputs output) output
-    ) => Arbitrary (Derivation' inputs output)
-
-deriving via GenericArbitrary DerivationOutput
-  instance Arbitrary DerivationOutput
+instance
+  ( Arbitrary inputs
+  , Arbitrary output
+  , Arg (Derivation' inputs output) inputs
+  , Arg (Derivation' inputs output) output
+  ) => Arbitrary (Derivation' inputs output)
+ where
+  arbitrary = genericArbitrary `suchThat` \drv ->
+    -- ensure output path name is not too long
+    all (\on -> isRight $ outputStoreObjectName (name drv) on)
+    $ Data.Map.keys (outputs drv)
+  shrink = genericShrink
+
+instance Arbitrary DerivationOutput where
+  arbitrary = genericArbitrary `suchThat` \case
+    InputAddressedDerivationOutput {} -> True
+    FixedDerivationOutput {method, hash = hashAlgo :=> _} -> f method hashAlgo
+    ContentAddressedDerivationOutput {method, hashAlgo = Some hashAlgo } -> f method hashAlgo
+    where
+      -- Ensure a valid combination
+      f = \case
+        ContentAddressMethod_Text -> \case
+          HashAlgo_SHA256 -> True
+          _ -> False
+        _ -> \_ -> True
+  shrink = genericShrink
 
 deriving via GenericArbitrary DerivationInputs
   instance Arbitrary DerivationInputs

hnix-store-tests/src/System/Nix/Arbitrary/OutputName.hs

@@ -3,20 +3,15 @@
 module System.Nix.Arbitrary.OutputName where
 
 import System.Nix.OutputName (OutputName)
-import Data.Text qualified
 import System.Nix.OutputName qualified
+import System.Nix.StorePath qualified
 
-import Test.QuickCheck (Arbitrary(arbitrary), choose, elements, vectorOf)
+import Test.QuickCheck (Arbitrary(arbitrary))
+import System.Nix.Arbitrary.StorePath ()
 
 instance Arbitrary OutputName where
   arbitrary =
-      either (error . show) id
+    either (error . show) id
     . System.Nix.OutputName.mkOutputName
-    . Data.Text.pack <$> ((:) <$> s1 <*> limited sn)
-   where
-    alphanum = ['a' .. 'z'] <> ['A' .. 'Z'] <> ['0' .. '9']
-    s1 = elements $ alphanum <> "+-_?="
-    sn = elements $ alphanum <> "+-._?="
-    limited n = do
-      k <- choose (0, 210)
-      vectorOf k n
+    . System.Nix.StorePath.unStorePathName
+    <$> arbitrary