{-|
Description : Metadata about Nix store paths.
-}
module System.Nix.StorePath.Metadata
  ( Metadata(..)
  , StorePathTrust(..)
  ) where

import Crypto.Hash (Digest)
import Data.Dependent.Sum (DSum)
import Data.HashSet (HashSet)
import Data.Set (Set)
import Data.Time (UTCTime)
import Data.Word (Word64)
import GHC.Generics (Generic)

import System.Nix.Hash (HashAlgo)
import System.Nix.Signature (NarSignature)
import System.Nix.ContentAddress (ContentAddress)

-- | How much do we trust the path, based on its provenance?
-- This is called `Ultimate` in Nix, where Ultimate = True
-- means that the path is ultimately trusted, which
-- corresponds to our @BuiltLocally@
data StorePathTrust
  = -- | It was built locally and thus ultimately trusted
    BuiltLocally
  | -- | It was built elsewhere (and substituted or similar) and so
    -- is less trusted
    BuiltElsewhere
  deriving (StorePathTrust -> StorePathTrust -> Bool
(StorePathTrust -> StorePathTrust -> Bool)
-> (StorePathTrust -> StorePathTrust -> Bool) -> Eq StorePathTrust
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StorePathTrust -> StorePathTrust -> Bool
== :: StorePathTrust -> StorePathTrust -> Bool
$c/= :: StorePathTrust -> StorePathTrust -> Bool
/= :: StorePathTrust -> StorePathTrust -> Bool
Eq, Int -> StorePathTrust
StorePathTrust -> Int
StorePathTrust -> [StorePathTrust]
StorePathTrust -> StorePathTrust
StorePathTrust -> StorePathTrust -> [StorePathTrust]
StorePathTrust
-> StorePathTrust -> StorePathTrust -> [StorePathTrust]
(StorePathTrust -> StorePathTrust)
-> (StorePathTrust -> StorePathTrust)
-> (Int -> StorePathTrust)
-> (StorePathTrust -> Int)
-> (StorePathTrust -> [StorePathTrust])
-> (StorePathTrust -> StorePathTrust -> [StorePathTrust])
-> (StorePathTrust -> StorePathTrust -> [StorePathTrust])
-> (StorePathTrust
    -> StorePathTrust -> StorePathTrust -> [StorePathTrust])
-> Enum StorePathTrust
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: StorePathTrust -> StorePathTrust
succ :: StorePathTrust -> StorePathTrust
$cpred :: StorePathTrust -> StorePathTrust
pred :: StorePathTrust -> StorePathTrust
$ctoEnum :: Int -> StorePathTrust
toEnum :: Int -> StorePathTrust
$cfromEnum :: StorePathTrust -> Int
fromEnum :: StorePathTrust -> Int
$cenumFrom :: StorePathTrust -> [StorePathTrust]
enumFrom :: StorePathTrust -> [StorePathTrust]
$cenumFromThen :: StorePathTrust -> StorePathTrust -> [StorePathTrust]
enumFromThen :: StorePathTrust -> StorePathTrust -> [StorePathTrust]
$cenumFromTo :: StorePathTrust -> StorePathTrust -> [StorePathTrust]
enumFromTo :: StorePathTrust -> StorePathTrust -> [StorePathTrust]
$cenumFromThenTo :: StorePathTrust
-> StorePathTrust -> StorePathTrust -> [StorePathTrust]
enumFromThenTo :: StorePathTrust
-> StorePathTrust -> StorePathTrust -> [StorePathTrust]
Enum, (forall x. StorePathTrust -> Rep StorePathTrust x)
-> (forall x. Rep StorePathTrust x -> StorePathTrust)
-> Generic StorePathTrust
forall x. Rep StorePathTrust x -> StorePathTrust
forall x. StorePathTrust -> Rep StorePathTrust x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StorePathTrust -> Rep StorePathTrust x
from :: forall x. StorePathTrust -> Rep StorePathTrust x
$cto :: forall x. Rep StorePathTrust x -> StorePathTrust
to :: forall x. Rep StorePathTrust x -> StorePathTrust
Generic, Eq StorePathTrust
Eq StorePathTrust =>
(StorePathTrust -> StorePathTrust -> Ordering)
-> (StorePathTrust -> StorePathTrust -> Bool)
-> (StorePathTrust -> StorePathTrust -> Bool)
-> (StorePathTrust -> StorePathTrust -> Bool)
-> (StorePathTrust -> StorePathTrust -> Bool)
-> (StorePathTrust -> StorePathTrust -> StorePathTrust)
-> (StorePathTrust -> StorePathTrust -> StorePathTrust)
-> Ord StorePathTrust
StorePathTrust -> StorePathTrust -> Bool
StorePathTrust -> StorePathTrust -> Ordering
StorePathTrust -> StorePathTrust -> StorePathTrust
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 :: StorePathTrust -> StorePathTrust -> Ordering
compare :: StorePathTrust -> StorePathTrust -> Ordering
$c< :: StorePathTrust -> StorePathTrust -> Bool
< :: StorePathTrust -> StorePathTrust -> Bool
$c<= :: StorePathTrust -> StorePathTrust -> Bool
<= :: StorePathTrust -> StorePathTrust -> Bool
$c> :: StorePathTrust -> StorePathTrust -> Bool
> :: StorePathTrust -> StorePathTrust -> Bool
$c>= :: StorePathTrust -> StorePathTrust -> Bool
>= :: StorePathTrust -> StorePathTrust -> Bool
$cmax :: StorePathTrust -> StorePathTrust -> StorePathTrust
max :: StorePathTrust -> StorePathTrust -> StorePathTrust
$cmin :: StorePathTrust -> StorePathTrust -> StorePathTrust
min :: StorePathTrust -> StorePathTrust -> StorePathTrust
Ord, Int -> StorePathTrust -> ShowS
[StorePathTrust] -> ShowS
StorePathTrust -> String
(Int -> StorePathTrust -> ShowS)
-> (StorePathTrust -> String)
-> ([StorePathTrust] -> ShowS)
-> Show StorePathTrust
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StorePathTrust -> ShowS
showsPrec :: Int -> StorePathTrust -> ShowS
$cshow :: StorePathTrust -> String
show :: StorePathTrust -> String
$cshowList :: [StorePathTrust] -> ShowS
showList :: [StorePathTrust] -> ShowS
Show)

-- | Metadata (typically about a 'StorePath')
-- This type corresponds to Nix-es `ValidPathInfo`
data Metadata a = Metadata
  { -- | The path to the derivation file that built this path, if any
    -- and known.
    forall a. Metadata a -> Maybe a
metadataDeriverPath :: !(Maybe a)
  , -- | The hash of the nar serialization of the path.
    forall a. Metadata a -> DSum HashAlgo Digest
metadataNarHash :: !(DSum HashAlgo Digest)
  , -- | The paths that this path directly references
    forall a. Metadata a -> HashSet a
metadataReferences :: !(HashSet a)
  , -- | When was this path registered valid in the store?
    forall a. Metadata a -> UTCTime
metadataRegistrationTime :: !UTCTime
  , -- | The size of the nar serialization of the path, in bytes.
    forall a. Metadata a -> Maybe Word64
metadataNarBytes :: !(Maybe Word64)
  , -- | How much we trust this path. Nix-es ultimate
    forall a. Metadata a -> StorePathTrust
metadataTrust :: !StorePathTrust
  , -- | A set of cryptographic attestations of this path's validity.
    --
    -- There is no guarantee from this type alone that these
    -- signatures are valid.
    forall a. Metadata a -> Set NarSignature
metadataSigs :: !(Set NarSignature)
  , -- | Whether and how this store path is content-addressable.
    --
    -- There is no guarantee from this type alone that this address
    -- is actually correct for this store path.
    forall a. Metadata a -> Maybe ContentAddress
metadataContentAddress :: !(Maybe ContentAddress)
  } deriving (Metadata a -> Metadata a -> Bool
(Metadata a -> Metadata a -> Bool)
-> (Metadata a -> Metadata a -> Bool) -> Eq (Metadata a)
forall a. Eq a => Metadata a -> Metadata a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Metadata a -> Metadata a -> Bool
== :: Metadata a -> Metadata a -> Bool
$c/= :: forall a. Eq a => Metadata a -> Metadata a -> Bool
/= :: Metadata a -> Metadata a -> Bool
Eq, (forall x. Metadata a -> Rep (Metadata a) x)
-> (forall x. Rep (Metadata a) x -> Metadata a)
-> Generic (Metadata a)
forall x. Rep (Metadata a) x -> Metadata a
forall x. Metadata a -> Rep (Metadata a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Metadata a) x -> Metadata a
forall a x. Metadata a -> Rep (Metadata a) x
$cfrom :: forall a x. Metadata a -> Rep (Metadata a) x
from :: forall x. Metadata a -> Rep (Metadata a) x
$cto :: forall a x. Rep (Metadata a) x -> Metadata a
to :: forall x. Rep (Metadata a) x -> Metadata a
Generic, Eq (Metadata a)
Eq (Metadata a) =>
(Metadata a -> Metadata a -> Ordering)
-> (Metadata a -> Metadata a -> Bool)
-> (Metadata a -> Metadata a -> Bool)
-> (Metadata a -> Metadata a -> Bool)
-> (Metadata a -> Metadata a -> Bool)
-> (Metadata a -> Metadata a -> Metadata a)
-> (Metadata a -> Metadata a -> Metadata a)
-> Ord (Metadata a)
Metadata a -> Metadata a -> Bool
Metadata a -> Metadata a -> Ordering
Metadata a -> Metadata a -> Metadata 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 (Metadata a)
forall a. Ord a => Metadata a -> Metadata a -> Bool
forall a. Ord a => Metadata a -> Metadata a -> Ordering
forall a. Ord a => Metadata a -> Metadata a -> Metadata a
$ccompare :: forall a. Ord a => Metadata a -> Metadata a -> Ordering
compare :: Metadata a -> Metadata a -> Ordering
$c< :: forall a. Ord a => Metadata a -> Metadata a -> Bool
< :: Metadata a -> Metadata a -> Bool
$c<= :: forall a. Ord a => Metadata a -> Metadata a -> Bool
<= :: Metadata a -> Metadata a -> Bool
$c> :: forall a. Ord a => Metadata a -> Metadata a -> Bool
> :: Metadata a -> Metadata a -> Bool
$c>= :: forall a. Ord a => Metadata a -> Metadata a -> Bool
>= :: Metadata a -> Metadata a -> Bool
$cmax :: forall a. Ord a => Metadata a -> Metadata a -> Metadata a
max :: Metadata a -> Metadata a -> Metadata a
$cmin :: forall a. Ord a => Metadata a -> Metadata a -> Metadata a
min :: Metadata a -> Metadata a -> Metadata a
Ord, Int -> Metadata a -> ShowS
[Metadata a] -> ShowS
Metadata a -> String
(Int -> Metadata a -> ShowS)
-> (Metadata a -> String)
-> ([Metadata a] -> ShowS)
-> Show (Metadata a)
forall a. Show a => Int -> Metadata a -> ShowS
forall a. Show a => [Metadata a] -> ShowS
forall a. Show a => Metadata a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Metadata a -> ShowS
showsPrec :: Int -> Metadata a -> ShowS
$cshow :: forall a. Show a => Metadata a -> String
show :: Metadata a -> String
$cshowList :: forall a. Show a => [Metadata a] -> ShowS
showList :: [Metadata a] -> ShowS
Show)