{-|
Description : Derivation realisations
-}

module System.Nix.Realisation (
    DerivationOutput(..)
  , DerivationOutputError(..)
  , derivationOutputBuilder
  , derivationOutputParser
  , Realisation(..)
  , RealisationWithId(..)
  ) 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, 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 a = DerivationOutput
  { forall a. DerivationOutput a -> DSum HashAlgo Digest
derivationOutputHash :: DSum HashAlgo Digest
  -- ^ Hash modulo of the derivation
  , forall a. DerivationOutput a -> a
derivationOutputOutput :: a
  -- ^ Output (either a OutputName or StorePatH)
  } deriving (DerivationOutput a -> DerivationOutput a -> Bool
(DerivationOutput a -> DerivationOutput a -> Bool)
-> (DerivationOutput a -> DerivationOutput a -> Bool)
-> Eq (DerivationOutput a)
forall a. Eq a => DerivationOutput a -> DerivationOutput a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => DerivationOutput a -> DerivationOutput a -> Bool
== :: DerivationOutput a -> DerivationOutput a -> Bool
$c/= :: forall a. Eq a => DerivationOutput a -> DerivationOutput a -> Bool
/= :: DerivationOutput a -> DerivationOutput a -> Bool
Eq, (forall x. DerivationOutput a -> Rep (DerivationOutput a) x)
-> (forall x. Rep (DerivationOutput a) x -> DerivationOutput a)
-> Generic (DerivationOutput a)
forall x. Rep (DerivationOutput a) x -> DerivationOutput a
forall x. DerivationOutput a -> Rep (DerivationOutput a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (DerivationOutput a) x -> DerivationOutput a
forall a x. DerivationOutput a -> Rep (DerivationOutput a) x
$cfrom :: forall a x. DerivationOutput a -> Rep (DerivationOutput a) x
from :: forall x. DerivationOutput a -> Rep (DerivationOutput a) x
$cto :: forall a x. Rep (DerivationOutput a) x -> DerivationOutput a
to :: forall x. Rep (DerivationOutput a) x -> DerivationOutput a
Generic, Eq (DerivationOutput a)
Eq (DerivationOutput a) =>
(DerivationOutput a -> DerivationOutput a -> Ordering)
-> (DerivationOutput a -> DerivationOutput a -> Bool)
-> (DerivationOutput a -> DerivationOutput a -> Bool)
-> (DerivationOutput a -> DerivationOutput a -> Bool)
-> (DerivationOutput a -> DerivationOutput a -> Bool)
-> (DerivationOutput a -> DerivationOutput a -> DerivationOutput a)
-> (DerivationOutput a -> DerivationOutput a -> DerivationOutput a)
-> Ord (DerivationOutput a)
DerivationOutput a -> DerivationOutput a -> Bool
DerivationOutput a -> DerivationOutput a -> Ordering
DerivationOutput a -> DerivationOutput a -> DerivationOutput a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (DerivationOutput a)
forall a. Ord a => DerivationOutput a -> DerivationOutput a -> Bool
forall a.
Ord a =>
DerivationOutput a -> DerivationOutput a -> Ordering
forall a.
Ord a =>
DerivationOutput a -> DerivationOutput a -> DerivationOutput a
$ccompare :: forall a.
Ord a =>
DerivationOutput a -> DerivationOutput a -> Ordering
compare :: DerivationOutput a -> DerivationOutput a -> Ordering
$c< :: forall a. Ord a => DerivationOutput a -> DerivationOutput a -> Bool
< :: DerivationOutput a -> DerivationOutput a -> Bool
$c<= :: forall a. Ord a => DerivationOutput a -> DerivationOutput a -> Bool
<= :: DerivationOutput a -> DerivationOutput a -> Bool
$c> :: forall a. Ord a => DerivationOutput a -> DerivationOutput a -> Bool
> :: DerivationOutput a -> DerivationOutput a -> Bool
$c>= :: forall a. Ord a => DerivationOutput a -> DerivationOutput a -> Bool
>= :: DerivationOutput a -> DerivationOutput a -> Bool
$cmax :: forall a.
Ord a =>
DerivationOutput a -> DerivationOutput a -> DerivationOutput a
max :: DerivationOutput a -> DerivationOutput a -> DerivationOutput a
$cmin :: forall a.
Ord a =>
DerivationOutput a -> DerivationOutput a -> DerivationOutput a
min :: DerivationOutput a -> DerivationOutput a -> DerivationOutput a
Ord, Int -> DerivationOutput a -> ShowS
[DerivationOutput a] -> ShowS
DerivationOutput a -> String
(Int -> DerivationOutput a -> ShowS)
-> (DerivationOutput a -> String)
-> ([DerivationOutput a] -> ShowS)
-> Show (DerivationOutput a)
forall a. Show a => Int -> DerivationOutput a -> ShowS
forall a. Show a => [DerivationOutput a] -> ShowS
forall a. Show a => DerivationOutput a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> DerivationOutput a -> ShowS
showsPrec :: Int -> DerivationOutput a -> ShowS
$cshow :: forall a. Show a => DerivationOutput a -> String
show :: DerivationOutput a -> String
$cshowList :: forall a. Show a => [DerivationOutput a] -> ShowS
showList :: [DerivationOutput a] -> ShowS
Show)

data DerivationOutputError
  = DerivationOutputError_Digest String
  | DerivationOutputError_Name InvalidNameError
  | DerivationOutputError_NoExclamationMark
  | DerivationOutputError_NoColon
  | DerivationOutputError_TooManyParts [Text]
  deriving (DerivationOutputError -> DerivationOutputError -> Bool
(DerivationOutputError -> DerivationOutputError -> Bool)
-> (DerivationOutputError -> DerivationOutputError -> Bool)
-> Eq DerivationOutputError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DerivationOutputError -> DerivationOutputError -> Bool
== :: DerivationOutputError -> DerivationOutputError -> Bool
$c/= :: DerivationOutputError -> DerivationOutputError -> Bool
/= :: DerivationOutputError -> DerivationOutputError -> Bool
Eq, Eq DerivationOutputError
Eq DerivationOutputError =>
(DerivationOutputError -> DerivationOutputError -> Ordering)
-> (DerivationOutputError -> DerivationOutputError -> Bool)
-> (DerivationOutputError -> DerivationOutputError -> Bool)
-> (DerivationOutputError -> DerivationOutputError -> Bool)
-> (DerivationOutputError -> DerivationOutputError -> Bool)
-> (DerivationOutputError
    -> DerivationOutputError -> DerivationOutputError)
-> (DerivationOutputError
    -> DerivationOutputError -> DerivationOutputError)
-> Ord DerivationOutputError
DerivationOutputError -> DerivationOutputError -> Bool
DerivationOutputError -> DerivationOutputError -> Ordering
DerivationOutputError
-> DerivationOutputError -> DerivationOutputError
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DerivationOutputError -> DerivationOutputError -> Ordering
compare :: DerivationOutputError -> DerivationOutputError -> Ordering
$c< :: DerivationOutputError -> DerivationOutputError -> Bool
< :: DerivationOutputError -> DerivationOutputError -> Bool
$c<= :: DerivationOutputError -> DerivationOutputError -> Bool
<= :: DerivationOutputError -> DerivationOutputError -> Bool
$c> :: DerivationOutputError -> DerivationOutputError -> Bool
> :: DerivationOutputError -> DerivationOutputError -> Bool
$c>= :: DerivationOutputError -> DerivationOutputError -> Bool
>= :: DerivationOutputError -> DerivationOutputError -> Bool
$cmax :: DerivationOutputError
-> DerivationOutputError -> DerivationOutputError
max :: DerivationOutputError
-> DerivationOutputError -> DerivationOutputError
$cmin :: DerivationOutputError
-> DerivationOutputError -> DerivationOutputError
min :: DerivationOutputError
-> DerivationOutputError -> DerivationOutputError
Ord, Int -> DerivationOutputError -> ShowS
[DerivationOutputError] -> ShowS
DerivationOutputError -> String
(Int -> DerivationOutputError -> ShowS)
-> (DerivationOutputError -> String)
-> ([DerivationOutputError] -> ShowS)
-> Show DerivationOutputError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DerivationOutputError -> ShowS
showsPrec :: Int -> DerivationOutputError -> ShowS
$cshow :: DerivationOutputError -> String
show :: DerivationOutputError -> String
$cshowList :: [DerivationOutputError] -> ShowS
showList :: [DerivationOutputError] -> ShowS
Show)

derivationOutputParser
  :: (Text -> Either InvalidNameError outputName)
  -> Text
  -> Either DerivationOutputError (DerivationOutput outputName)
derivationOutputParser :: forall outputName.
(Text -> Either InvalidNameError outputName)
-> Text
-> Either DerivationOutputError (DerivationOutput outputName)
derivationOutputParser Text -> Either InvalidNameError outputName
outputName Text
dOut =
  case HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
Data.Text.splitOn (Char -> Text
Data.Text.singleton Char
'!') Text
dOut of
    [] -> DerivationOutputError
-> Either DerivationOutputError (DerivationOutput outputName)
forall a b. a -> Either a b
Left DerivationOutputError
DerivationOutputError_NoColon
    [Text
sriHash, Text
oName] -> do
      DSum HashAlgo Digest
hash <-
        case HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
Data.Text.splitOn (Char -> Text
Data.Text.singleton Char
':') Text
sriHash of
          [] -> DerivationOutputError
-> Either DerivationOutputError (DSum HashAlgo Digest)
forall a b. a -> Either a b
Left DerivationOutputError
DerivationOutputError_NoColon
          [Text
hashName, Text
digest] ->
            (String -> DerivationOutputError)
-> Either String (DSum HashAlgo Digest)
-> Either DerivationOutputError (DSum HashAlgo Digest)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
Data.Bifunctor.first
              String -> DerivationOutputError
DerivationOutputError_Digest
              (Either String (DSum HashAlgo Digest)
 -> Either DerivationOutputError (DSum HashAlgo Digest))
-> Either String (DSum HashAlgo Digest)
-> Either DerivationOutputError (DSum HashAlgo Digest)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Either String (DSum HashAlgo Digest)
System.Nix.Hash.mkNamedDigest Text
hashName Text
digest
          [Text]
x -> DerivationOutputError
-> Either DerivationOutputError (DSum HashAlgo Digest)
forall a b. a -> Either a b
Left (DerivationOutputError
 -> Either DerivationOutputError (DSum HashAlgo Digest))
-> DerivationOutputError
-> Either DerivationOutputError (DSum HashAlgo Digest)
forall a b. (a -> b) -> a -> b
$ [Text] -> DerivationOutputError
DerivationOutputError_TooManyParts [Text]
x
      outputName
name <-
        (InvalidNameError -> DerivationOutputError)
-> Either InvalidNameError outputName
-> Either DerivationOutputError outputName
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
Data.Bifunctor.first
          InvalidNameError -> DerivationOutputError
DerivationOutputError_Name
          (Either InvalidNameError outputName
 -> Either DerivationOutputError outputName)
-> Either InvalidNameError outputName
-> Either DerivationOutputError outputName
forall a b. (a -> b) -> a -> b
$ Text -> Either InvalidNameError outputName
outputName Text
oName

      DerivationOutput outputName
-> Either DerivationOutputError (DerivationOutput outputName)
forall a. a -> Either DerivationOutputError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DerivationOutput outputName
 -> Either DerivationOutputError (DerivationOutput outputName))
-> DerivationOutput outputName
-> Either DerivationOutputError (DerivationOutput outputName)
forall a b. (a -> b) -> a -> b
$ DSum HashAlgo Digest -> outputName -> DerivationOutput outputName
forall a. DSum HashAlgo Digest -> a -> DerivationOutput a
DerivationOutput DSum HashAlgo Digest
hash outputName
name
    [Text]
x -> DerivationOutputError
-> Either DerivationOutputError (DerivationOutput outputName)
forall a b. a -> Either a b
Left (DerivationOutputError
 -> Either DerivationOutputError (DerivationOutput outputName))
-> DerivationOutputError
-> Either DerivationOutputError (DerivationOutput outputName)
forall a b. (a -> b) -> a -> b
$ [Text] -> DerivationOutputError
DerivationOutputError_TooManyParts [Text]
x

derivationOutputBuilder
  :: (outputName -> Text)
  -> DerivationOutput outputName
  -> Builder
derivationOutputBuilder :: forall outputName.
(outputName -> Text) -> DerivationOutput outputName -> Builder
derivationOutputBuilder outputName -> Text
outputName DerivationOutput{outputName
DSum HashAlgo Digest
derivationOutputHash :: forall a. DerivationOutput a -> DSum HashAlgo Digest
derivationOutputOutput :: forall a. DerivationOutput a -> a
derivationOutputHash :: DSum HashAlgo Digest
derivationOutputOutput :: outputName
..} =
     DSum HashAlgo Digest -> Builder
System.Nix.Hash.algoDigestBuilder DSum HashAlgo Digest
derivationOutputHash
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
Data.Text.Lazy.Builder.singleton Char
'!'
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
Data.Text.Lazy.Builder.fromText (outputName -> Text
outputName outputName
derivationOutputOutput)

-- | Build realisation context
--
-- realisationId is ommited since it is a key
-- of type @DerivationOutput OutputName@ so
-- we will use @RealisationWithId@ newtype
data Realisation = Realisation
  { Realisation -> StorePath
realisationOutPath :: StorePath
  -- ^ Output path
  , Realisation -> Set Signature
realisationSignatures :: Set Signature
  -- ^ Signatures
  , Realisation -> Map (DerivationOutput OutputName) StorePath
realisationDependencies :: Map (DerivationOutput OutputName) StorePath
  -- ^ Dependent realisations required for this one to be valid
  } deriving (Realisation -> Realisation -> Bool
(Realisation -> Realisation -> Bool)
-> (Realisation -> Realisation -> Bool) -> Eq Realisation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Realisation -> Realisation -> Bool
== :: Realisation -> Realisation -> Bool
$c/= :: Realisation -> Realisation -> Bool
/= :: Realisation -> Realisation -> Bool
Eq, (forall x. Realisation -> Rep Realisation x)
-> (forall x. Rep Realisation x -> Realisation)
-> Generic Realisation
forall x. Rep Realisation x -> Realisation
forall x. Realisation -> Rep Realisation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Realisation -> Rep Realisation x
from :: forall x. Realisation -> Rep Realisation x
$cto :: forall x. Rep Realisation x -> Realisation
to :: forall x. Rep Realisation x -> Realisation
Generic, Eq Realisation
Eq Realisation =>
(Realisation -> Realisation -> Ordering)
-> (Realisation -> Realisation -> Bool)
-> (Realisation -> Realisation -> Bool)
-> (Realisation -> Realisation -> Bool)
-> (Realisation -> Realisation -> Bool)
-> (Realisation -> Realisation -> Realisation)
-> (Realisation -> Realisation -> Realisation)
-> Ord Realisation
Realisation -> Realisation -> Bool
Realisation -> Realisation -> Ordering
Realisation -> Realisation -> Realisation
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Realisation -> Realisation -> Ordering
compare :: Realisation -> Realisation -> Ordering
$c< :: Realisation -> Realisation -> Bool
< :: Realisation -> Realisation -> Bool
$c<= :: Realisation -> Realisation -> Bool
<= :: Realisation -> Realisation -> Bool
$c> :: Realisation -> Realisation -> Bool
> :: Realisation -> Realisation -> Bool
$c>= :: Realisation -> Realisation -> Bool
>= :: Realisation -> Realisation -> Bool
$cmax :: Realisation -> Realisation -> Realisation
max :: Realisation -> Realisation -> Realisation
$cmin :: Realisation -> Realisation -> Realisation
min :: Realisation -> Realisation -> Realisation
Ord, Int -> Realisation -> ShowS
[Realisation] -> ShowS
Realisation -> String
(Int -> Realisation -> ShowS)
-> (Realisation -> String)
-> ([Realisation] -> ShowS)
-> Show Realisation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Realisation -> ShowS
showsPrec :: Int -> Realisation -> ShowS
$cshow :: Realisation -> String
show :: Realisation -> String
$cshowList :: [Realisation] -> ShowS
showList :: [Realisation] -> ShowS
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
  { RealisationWithId -> (DerivationOutput OutputName, Realisation)
unRealisationWithId :: (DerivationOutput OutputName, Realisation)
  }
  deriving (RealisationWithId -> RealisationWithId -> Bool
(RealisationWithId -> RealisationWithId -> Bool)
-> (RealisationWithId -> RealisationWithId -> Bool)
-> Eq RealisationWithId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RealisationWithId -> RealisationWithId -> Bool
== :: RealisationWithId -> RealisationWithId -> Bool
$c/= :: RealisationWithId -> RealisationWithId -> Bool
/= :: RealisationWithId -> RealisationWithId -> Bool
Eq, (forall x. RealisationWithId -> Rep RealisationWithId x)
-> (forall x. Rep RealisationWithId x -> RealisationWithId)
-> Generic RealisationWithId
forall x. Rep RealisationWithId x -> RealisationWithId
forall x. RealisationWithId -> Rep RealisationWithId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RealisationWithId -> Rep RealisationWithId x
from :: forall x. RealisationWithId -> Rep RealisationWithId x
$cto :: forall x. Rep RealisationWithId x -> RealisationWithId
to :: forall x. Rep RealisationWithId x -> RealisationWithId
Generic, Eq RealisationWithId
Eq RealisationWithId =>
(RealisationWithId -> RealisationWithId -> Ordering)
-> (RealisationWithId -> RealisationWithId -> Bool)
-> (RealisationWithId -> RealisationWithId -> Bool)
-> (RealisationWithId -> RealisationWithId -> Bool)
-> (RealisationWithId -> RealisationWithId -> Bool)
-> (RealisationWithId -> RealisationWithId -> RealisationWithId)
-> (RealisationWithId -> RealisationWithId -> RealisationWithId)
-> Ord RealisationWithId
RealisationWithId -> RealisationWithId -> Bool
RealisationWithId -> RealisationWithId -> Ordering
RealisationWithId -> RealisationWithId -> RealisationWithId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RealisationWithId -> RealisationWithId -> Ordering
compare :: RealisationWithId -> RealisationWithId -> Ordering
$c< :: RealisationWithId -> RealisationWithId -> Bool
< :: RealisationWithId -> RealisationWithId -> Bool
$c<= :: RealisationWithId -> RealisationWithId -> Bool
<= :: RealisationWithId -> RealisationWithId -> Bool
$c> :: RealisationWithId -> RealisationWithId -> Bool
> :: RealisationWithId -> RealisationWithId -> Bool
$c>= :: RealisationWithId -> RealisationWithId -> Bool
>= :: RealisationWithId -> RealisationWithId -> Bool
$cmax :: RealisationWithId -> RealisationWithId -> RealisationWithId
max :: RealisationWithId -> RealisationWithId -> RealisationWithId
$cmin :: RealisationWithId -> RealisationWithId -> RealisationWithId
min :: RealisationWithId -> RealisationWithId -> RealisationWithId
Ord, Int -> RealisationWithId -> ShowS
[RealisationWithId] -> ShowS
RealisationWithId -> String
(Int -> RealisationWithId -> ShowS)
-> (RealisationWithId -> String)
-> ([RealisationWithId] -> ShowS)
-> Show RealisationWithId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RealisationWithId -> ShowS
showsPrec :: Int -> RealisationWithId -> ShowS
$cshow :: RealisationWithId -> String
show :: RealisationWithId -> String
$cshowList :: [RealisationWithId] -> ShowS
showList :: [RealisationWithId] -> ShowS
Show)