{-# LANGUAGE OverloadedStrings #-}

{-|
Description : Fingerprint of Nix store path metadata used for signature verification
-}
module System.Nix.Fingerprint
  ( fingerprint
  , metadataFingerprint
  ) where

import Crypto.Hash (Digest)
import Data.Dependent.Sum (DSum)
import Data.List (sort)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Data.Text.Lazy (toStrict)
import Data.Text.Lazy.Builder (toLazyText)
import Data.Word (Word64)
import System.Nix.Hash (HashAlgo, algoDigestBuilder)
import System.Nix.StorePath
import System.Nix.StorePath.Metadata (Metadata(..))

import qualified Data.HashSet as HashSet
import qualified Data.Text as Text

-- | Produce the message signed by a NAR signature
metadataFingerprint :: StoreDir -> StorePath -> Metadata StorePath -> Text
metadataFingerprint :: StoreDir -> StorePath -> Metadata StorePath -> Text
metadataFingerprint StoreDir
storeDir StorePath
storePath Metadata{Maybe Word64
Maybe ContentAddress
Maybe StorePath
Set NarSignature
DSum HashAlgo Digest
UTCTime
HashSet StorePath
StorePathTrust
metadataDeriverPath :: Maybe StorePath
metadataNarHash :: DSum HashAlgo Digest
metadataReferences :: HashSet StorePath
metadataRegistrationTime :: UTCTime
metadataNarBytes :: Maybe Word64
metadataTrust :: StorePathTrust
metadataSigs :: Set NarSignature
metadataContentAddress :: Maybe ContentAddress
metadataDeriverPath :: forall a. Metadata a -> Maybe a
metadataNarHash :: forall a. Metadata a -> DSum HashAlgo Digest
metadataReferences :: forall a. Metadata a -> HashSet a
metadataRegistrationTime :: forall a. Metadata a -> UTCTime
metadataNarBytes :: forall a. Metadata a -> Maybe Word64
metadataTrust :: forall a. Metadata a -> StorePathTrust
metadataSigs :: forall a. Metadata a -> Set NarSignature
metadataContentAddress :: forall a. Metadata a -> Maybe ContentAddress
..} = let
  narSize :: Word64
narSize = Word64 -> Maybe Word64 -> Word64
forall a. a -> Maybe a -> a
fromMaybe Word64
0 Maybe Word64
metadataNarBytes
  in StoreDir
-> StorePath
-> DSum HashAlgo Digest
-> Word64
-> [StorePath]
-> Text
fingerprint
       StoreDir
storeDir
       StorePath
storePath
       DSum HashAlgo Digest
metadataNarHash
       Word64
narSize
       (HashSet StorePath -> [StorePath]
forall a. HashSet a -> [a]
HashSet.toList HashSet StorePath
metadataReferences)

-- | Produce the message signed by a NAR signature
fingerprint :: StoreDir
            -> StorePath
            -> DSum HashAlgo Digest -- ^ NAR hash
            -> Word64 -- ^ NAR size, in bytes
            -> [StorePath] -- ^ References
            -> Text
fingerprint :: StoreDir
-> StorePath
-> DSum HashAlgo Digest
-> Word64
-> [StorePath]
-> Text
fingerprint StoreDir
storeDir StorePath
storePath DSum HashAlgo Digest
narHash Word64
narSize [StorePath]
refs = let
  encodedStorePath :: Text
encodedStorePath = StoreDir -> StorePath -> Text
storePathToText StoreDir
storeDir StorePath
storePath
  encodedNarHash :: Text
encodedNarHash = (Text -> Text
toStrict (Text -> Text)
-> (DSum HashAlgo Digest -> Text) -> DSum HashAlgo Digest -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText (Builder -> Text)
-> (DSum HashAlgo Digest -> Builder)
-> DSum HashAlgo Digest
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DSum HashAlgo Digest -> Builder
algoDigestBuilder) DSum HashAlgo Digest
narHash
  encodedNarSize :: Text
encodedNarSize = (String -> Text
Text.pack (String -> Text) -> (Word64 -> String) -> Word64 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> String
forall a. Show a => a -> String
show) Word64
narSize
  sortedRefs :: [Text]
sortedRefs = [Text] -> [Text]
forall a. Ord a => [a] -> [a]
sort (StoreDir -> StorePath -> Text
storePathToText StoreDir
storeDir (StorePath -> Text) -> [StorePath] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [StorePath]
refs)
  encodedRefs :: Text
encodedRefs = Text -> [Text] -> Text
Text.intercalate Text
"," [Text]
sortedRefs
  in Text -> [Text] -> Text
Text.intercalate Text
";" [ Text
"1", Text
encodedStorePath, Text
encodedNarHash, Text
encodedNarSize, Text
encodedRefs]