core,json: wrap (DerivationOutput OutputName, Realisation) tuple into newtype

Author: sorki

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

@@ -8,6 +8,7 @@ module System.Nix.Realisation (
   , derivationOutputBuilder
   , derivationOutputParser
   , Realisation(..)
+  , RealisationWithId(..)
   ) where
 
 import Crypto.Hash (Digest)
@@ -80,8 +81,7 @@ derivationOutputBuilder outputName DerivationOutput{..} =
 --
 -- realisationId is ommited since it is a key
 -- of type @DerivationOutput OutputName@ so
--- we will use a tuple like @(DerivationOutput OutputName, Realisation)@
--- instead.
+-- we will use @RealisationWithId@ newtype
 data Realisation = Realisation
   { realisationOutPath :: StorePath
   -- ^ Output path
@@ -90,3 +90,14 @@ data Realisation = Realisation
   , realisationDependencies :: Map (DerivationOutput OutputName) StorePath
   -- ^ Dependent realisations required for this one to be valid
   } deriving (Eq, Generic, Ord, Show)
+
+-- | For wire protocol
+--
+-- We store this normalized in @Build.buildResultBuiltOutputs@
+-- as @Map (DerivationOutput OutputName) Realisation@
+-- but wire protocol needs it de-normalized so we
+-- need a special (From|To)JSON instances for it
+newtype RealisationWithId = RealisationWithId
+  { unRealisationWithId :: (DerivationOutput OutputName, Realisation)
+  }
+  deriving (Eq, Generic, Ord, Show)

hnix-store-json/src/System/Nix/JSON.hs

@@ -13,7 +13,7 @@ import Data.Aeson
 import Deriving.Aeson
 import System.Nix.Base (BaseEncoding(NixBase32))
 import System.Nix.OutputName (OutputName)
-import System.Nix.Realisation (DerivationOutput, Realisation)
+import System.Nix.Realisation (DerivationOutput, Realisation, RealisationWithId(..))
 import System.Nix.Signature (Signature)
 import System.Nix.StorePath (StoreDir(..), StorePath, StorePathName, StorePathHashPart)
 
@@ -159,18 +159,18 @@ deriving
   instance FromJSON Realisation
 
 -- For a keyed version of Realisation
--- we use (DerivationOutput OutputName, Realisation)
+-- we use RealisationWithId (DerivationOutput OutputName, Realisation)
 -- instead of Realisation.id :: (DerivationOutput OutputName)
 -- field.
-instance {-# OVERLAPPING #-} ToJSON (DerivationOutput OutputName, Realisation) where
-  toJSON (drvOut, r) =
+instance ToJSON RealisationWithId where
+  toJSON (RealisationWithId (drvOut, r)) =
     case toJSON r of
       Object o -> Object $ Data.Aeson.KeyMap.insert "id" (toJSON drvOut) o
       _ -> error "absurd"
 
-instance {-# OVERLAPPING #-} FromJSON (DerivationOutput OutputName, Realisation) where
+instance FromJSON RealisationWithId where
   parseJSON v@(Object o) = do
     r <- parseJSON @Realisation v
     drvOut <- o .: "id"
-    pure (drvOut, r)
+    pure (RealisationWithId (drvOut, r))
   parseJSON x = fail $ "Expected Object but got " ++ show x

hnix-store-remote/src/System/Nix/Store/Remote/Serializer.hs

@@ -131,7 +131,7 @@ import System.Nix.DerivedPath (DerivedPath(..), ParseOutputsError)
 import System.Nix.Hash (HashAlgo(..))
 import System.Nix.JSON ()
 import System.Nix.OutputName (OutputName)
-import System.Nix.Realisation (DerivationOutputError, Realisation(..))
+import System.Nix.Realisation (DerivationOutputError, Realisation(..), RealisationWithId(..))
 import System.Nix.Signature (Signature, NarSignature)
 import System.Nix.Store.Types (FileIngestionMethod(..), RepairMode(..))
 import System.Nix.StorePath (HasStoreDir(..), InvalidNameError, InvalidPathError, StorePath, StorePathHashPart, StorePathName)
@@ -1398,7 +1398,7 @@ derivationOutputTyped = mapErrorS ReplySError_DerivationOutput $
 realisation :: NixSerializer r ReplySError Realisation
 realisation = mapErrorS ReplySError_Realisation json
 
-realisationWithId :: NixSerializer r ReplySError (System.Nix.Realisation.DerivationOutput OutputName, Realisation)
+realisationWithId :: NixSerializer r ReplySError RealisationWithId
 realisationWithId = mapErrorS ReplySError_RealisationWithId json
 
 -- *** BuildResult
@@ -1434,7 +1434,7 @@ buildResult = Serializer
         then
             pure
           . Data.Map.Strict.fromList
-          . map (\(_, (a, b)) -> (a, b))
+          . map (\(_, RealisationWithId (a, b)) -> (a, b))
           . Data.Map.Strict.toList
           <$> getS (mapS derivationOutputTyped realisationWithId)
         else pure Nothing
@@ -1453,7 +1453,7 @@ buildResult = Serializer
       Control.Monad.when (protoVersion_minor pv >= 28)
         $ putS (mapS derivationOutputTyped realisationWithId)
         $ Data.Map.Strict.fromList
-        $ map (\(a, b) -> (a, (a, b)))
+        $ map (\(a, b) -> (a, RealisationWithId (a, b)))
         $ Data.Map.Strict.toList
         $ Data.Maybe.fromMaybe mempty buildResultBuiltOutputs
   }