add derivationOutput(Parser|Builder), prop

This commit is contained in:
sorki 2023-12-05 19:34:44 +01:00
parent e6ed8f8069
commit 1bda8fd1fe
4 changed files with 94 additions and 11 deletions

View File

@ -4,19 +4,29 @@ Description : Derivation realisations
module System.Nix.Realisation (
DerivationOutput(..)
, DerivationOutputError(..)
, derivationOutputBuilder
, derivationOutputParser
, Realisation(..)
) where
import Crypto.Hash (Digest)
import Data.Map (Map)
import Data.Set (Set)
import Data.Text (Text)
import Data.Text.Lazy.Builder (Builder)
import Data.Dependent.Sum (DSum)
import GHC.Generics (Generic)
import System.Nix.Hash (HashAlgo)
import System.Nix.OutputName (OutputName)
import System.Nix.OutputName (OutputName, InvalidNameError)
import System.Nix.Signature (Signature)
import System.Nix.StorePath (StorePath)
import qualified Data.Bifunctor
import qualified Data.Text
import qualified Data.Text.Lazy.Builder
import qualified System.Nix.Hash
-- | Output of the derivation
data DerivationOutput outputName = DerivationOutput
{ derivationOutputHash :: DSum HashAlgo Digest
@ -25,6 +35,47 @@ data DerivationOutput outputName = DerivationOutput
-- ^ Name of the output
} deriving (Eq, Generic, Ord, Show)
data DerivationOutputError
= DerivationOutputError_Digest String
| DerivationOutputError_Name InvalidNameError
| DerivationOutputError_NoExclamationMark
| DerivationOutputError_NoColon
| DerivationOutputError_TooManyParts [Text]
deriving (Eq, Ord, Show)
derivationOutputParser
:: (Text -> Either InvalidNameError outputName)
-> Text
-> Either DerivationOutputError (DerivationOutput outputName)
derivationOutputParser outputName dOut =
case Data.Text.splitOn (Data.Text.singleton '!') dOut of
[] -> Left DerivationOutputError_NoColon
[sriHash, oName] -> do
hash <-
case Data.Text.splitOn (Data.Text.singleton ':') sriHash of
[] -> Left DerivationOutputError_NoColon
[hashName, digest] ->
Data.Bifunctor.first
DerivationOutputError_Digest
$ System.Nix.Hash.mkNamedDigest hashName digest
x -> Left $ DerivationOutputError_TooManyParts x
name <-
Data.Bifunctor.first
DerivationOutputError_Name
$ outputName oName
pure $ DerivationOutput hash name
x -> Left $ DerivationOutputError_TooManyParts x
derivationOutputBuilder
:: (outputName -> Text)
-> DerivationOutput outputName
-> Builder
derivationOutputBuilder outputName DerivationOutput{..} =
System.Nix.Hash.algoDigestBuilder derivationOutputHash
<> Data.Text.Lazy.Builder.singleton '!'
<> Data.Text.Lazy.Builder.fromText (outputName derivationOutputName)
-- | Build realisation context
--
-- realisationId is ommited since it is a key

View File

@ -134,7 +134,7 @@ import System.Nix.Derivation (Derivation(..), DerivationOutput(..))
import System.Nix.DerivedPath (DerivedPath, ParseOutputsError)
import System.Nix.Hash (HashAlgo(..))
import System.Nix.OutputName (OutputName)
import System.Nix.Realisation (Realisation(..))
import System.Nix.Realisation (DerivationOutputError, Realisation(..))
import System.Nix.Signature (Signature, NarSignature)
import System.Nix.Store.Types (FileIngestionMethod(..), RepairMode(..))
import System.Nix.StorePath (HasStoreDir(..), InvalidNameError, InvalidPathError, StorePath, StorePathHashPart, StorePathName)
@ -232,6 +232,7 @@ data SError
}
| SError_ContentAddress String
| SError_DerivedPath ParseOutputsError
| SError_DerivationOutput DerivationOutputError
| SError_Digest String
| SError_EnumOutOfMinBound Int
| SError_EnumOutOfMaxBound Int
@ -347,6 +348,7 @@ text = mapIsoSerializer
Data.Text.Encoding.encodeUtf8
byteString
-- TODO Parser Builder
_textBuilder :: NixSerializer r SError Builder
_textBuilder = Serializer
{ getS = Data.Text.Lazy.Builder.fromText <$> getS text
@ -596,15 +598,18 @@ outputName =
-- * Realisation
derivationOutputTyped :: NixSerializer r SError (System.Nix.Realisation.DerivationOutput OutputName)
derivationOutputTyped = Serializer
{ getS = do
derivationOutputHash <- getS namedDigest
derivationOutputName <- getS outputName
pure System.Nix.Realisation.DerivationOutput{..}
, putS = \System.Nix.Realisation.DerivationOutput{..} -> do
putS namedDigest derivationOutputHash
putS outputName derivationOutputName
}
derivationOutputTyped =
mapPrismSerializer
( Data.Bifunctor.first SError_DerivationOutput
. System.Nix.Realisation.derivationOutputParser
System.Nix.OutputName.mkOutputName
)
( Data.Text.Lazy.toStrict
. Data.Text.Lazy.Builder.toLazyText
. System.Nix.Realisation.derivationOutputBuilder
System.Nix.OutputName.unOutputName
)
text
realisation
:: HasStoreDir r

View File

@ -80,6 +80,7 @@ test-suite props
ContentAddressSpec
DerivationSpec
DerivedPathSpec
RealisationSpec
StorePathSpec
SignatureSpec
hs-source-dirs:

View File

@ -0,0 +1,26 @@
module RealisationSpec where
import Test.Hspec (Spec, describe)
import Test.Hspec.QuickCheck (prop)
import Test.Hspec.Nix (roundtrips)
import System.Nix.Arbitrary ()
import qualified Data.Text.Lazy
import qualified Data.Text.Lazy.Builder
import qualified System.Nix.OutputName
import qualified System.Nix.Realisation
spec :: Spec
spec = do
describe "DerivationOutput" $ do
prop "roundtrips" $
roundtrips
( Data.Text.Lazy.toStrict
. Data.Text.Lazy.Builder.toLazyText
. System.Nix.Realisation.derivationOutputBuilder
System.Nix.OutputName.unOutputName
)
( System.Nix.Realisation.derivationOutputParser
System.Nix.OutputName.mkOutputName
)