{-|
Description : Representation of Nix store paths.
-}
{-# language ConstraintKinds #-}
{-# language RecordWildCards #-}
{-# language GeneralizedNewtypeDeriving #-}
{-# language ScopedTypeVariables #-}
{-# language AllowAmbiguousTypes #-}
{-# language DataKinds #-}

module System.Nix.Internal.StorePath
  ( -- * Basic store path types
    StorePath(..)
  , StorePathName(..)
  , StorePathSet
  , mkStorePathHashPart
  , StorePathHashPart(..)
  , ContentAddressableAddress(..)
  , NarHashMode(..)
  , -- * Manipulating 'StorePathName'
    makeStorePathName
  , validStorePathName
  , -- * Rendering out 'StorePath's
    storePathToFilePath
  , storePathToRawFilePath
  , storePathToText
  , storePathToNarInfo
  , -- * Parsing 'StorePath's
    parsePath
  , pathParser
  )
where

import qualified Relude.Unsafe as Unsafe
import qualified Text.Show
import           System.Nix.Internal.Hash
import           System.Nix.Internal.Base
import qualified System.Nix.Internal.Base32    as Nix.Base32

import qualified Data.ByteString.Char8         as Bytes.Char8
import qualified Data.Char                     as Char
import qualified Data.Text                     as Text
import           Data.Attoparsec.Text.Lazy      ( Parser
                                                , (<?>)
                                                )
import qualified Data.Attoparsec.Text.Lazy     as Parser.Text.Lazy
import qualified System.FilePath               as FilePath
import           Crypto.Hash                    ( SHA256
                                                , Digest
                                                )

-- | A path in a Nix store.
--
-- From the Nix thesis: A store path is the full path of a store
-- object. It has the following anatomy: storeDir/hashPart-name.
--
-- @storeDir@: The root of the Nix store (e.g. \/nix\/store).
--
-- See the 'StoreDir' haddocks for details on why we represent this at
-- the type level.
data StorePath = StorePath
  { -- | The 160-bit hash digest reflecting the "address" of the name.
    -- Currently, this is a truncated SHA256 hash.
    StorePath -> StorePathHashPart
storePathHash :: !StorePathHashPart
  , -- | The (typically human readable) name of the path. For packages
    -- this is typically the package name and version (e.g.
    -- hello-1.2.3).
    StorePath -> StorePathName
storePathName :: !StorePathName
  , -- | Root of the store
    StorePath -> [Char]
storePathRoot :: !FilePath
  }
  deriving (StorePath -> StorePath -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StorePath -> StorePath -> Bool
$c/= :: StorePath -> StorePath -> Bool
== :: StorePath -> StorePath -> Bool
$c== :: StorePath -> StorePath -> Bool
Eq, Eq StorePath
StorePath -> StorePath -> Bool
StorePath -> StorePath -> Ordering
StorePath -> StorePath -> StorePath
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
min :: StorePath -> StorePath -> StorePath
$cmin :: StorePath -> StorePath -> StorePath
max :: StorePath -> StorePath -> StorePath
$cmax :: StorePath -> StorePath -> StorePath
>= :: StorePath -> StorePath -> Bool
$c>= :: StorePath -> StorePath -> Bool
> :: StorePath -> StorePath -> Bool
$c> :: StorePath -> StorePath -> Bool
<= :: StorePath -> StorePath -> Bool
$c<= :: StorePath -> StorePath -> Bool
< :: StorePath -> StorePath -> Bool
$c< :: StorePath -> StorePath -> Bool
compare :: StorePath -> StorePath -> Ordering
$ccompare :: StorePath -> StorePath -> Ordering
Ord)

instance Hashable StorePath where
  hashWithSalt :: Int -> StorePath -> Int
hashWithSalt Int
s StorePath{[Char]
StorePathHashPart
StorePathName
storePathRoot :: [Char]
storePathName :: StorePathName
storePathHash :: StorePathHashPart
storePathRoot :: StorePath -> [Char]
storePathName :: StorePath -> StorePathName
storePathHash :: StorePath -> StorePathHashPart
..} =
    Int
s forall a. Hashable a => Int -> a -> Int
`hashWithSalt` StorePathHashPart
storePathHash forall a. Hashable a => Int -> a -> Int
`hashWithSalt` StorePathName
storePathName

instance Show StorePath where
  show :: StorePath -> [Char]
show StorePath
p = ByteString -> [Char]
Bytes.Char8.unpack forall a b. (a -> b) -> a -> b
$ StorePath -> ByteString
storePathToRawFilePath StorePath
p

-- | The name portion of a Nix path.
--
-- 'unStorePathName' must only contain a-zA-Z0-9+._?=-, can't start
-- with a -, and must have at least one character (i.e. it must match
-- 'storePathNameRegex').
newtype StorePathName = StorePathName
  { -- | Extract the contents of the name.
    StorePathName -> Text
unStorePathName :: Text
  } deriving (StorePathName -> StorePathName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StorePathName -> StorePathName -> Bool
$c/= :: StorePathName -> StorePathName -> Bool
== :: StorePathName -> StorePathName -> Bool
$c== :: StorePathName -> StorePathName -> Bool
Eq, Eq StorePathName
Int -> StorePathName -> Int
StorePathName -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: StorePathName -> Int
$chash :: StorePathName -> Int
hashWithSalt :: Int -> StorePathName -> Int
$chashWithSalt :: Int -> StorePathName -> Int
Hashable, Eq StorePathName
StorePathName -> StorePathName -> Bool
StorePathName -> StorePathName -> Ordering
StorePathName -> StorePathName -> StorePathName
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
min :: StorePathName -> StorePathName -> StorePathName
$cmin :: StorePathName -> StorePathName -> StorePathName
max :: StorePathName -> StorePathName -> StorePathName
$cmax :: StorePathName -> StorePathName -> StorePathName
>= :: StorePathName -> StorePathName -> Bool
$c>= :: StorePathName -> StorePathName -> Bool
> :: StorePathName -> StorePathName -> Bool
$c> :: StorePathName -> StorePathName -> Bool
<= :: StorePathName -> StorePathName -> Bool
$c<= :: StorePathName -> StorePathName -> Bool
< :: StorePathName -> StorePathName -> Bool
$c< :: StorePathName -> StorePathName -> Bool
compare :: StorePathName -> StorePathName -> Ordering
$ccompare :: StorePathName -> StorePathName -> Ordering
Ord)

-- | The hash algorithm used for store path hashes.
newtype StorePathHashPart = StorePathHashPart ByteString
  deriving (StorePathHashPart -> StorePathHashPart -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StorePathHashPart -> StorePathHashPart -> Bool
$c/= :: StorePathHashPart -> StorePathHashPart -> Bool
== :: StorePathHashPart -> StorePathHashPart -> Bool
$c== :: StorePathHashPart -> StorePathHashPart -> Bool
Eq, Eq StorePathHashPart
Int -> StorePathHashPart -> Int
StorePathHashPart -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: StorePathHashPart -> Int
$chash :: StorePathHashPart -> Int
hashWithSalt :: Int -> StorePathHashPart -> Int
$chashWithSalt :: Int -> StorePathHashPart -> Int
Hashable, Eq StorePathHashPart
StorePathHashPart -> StorePathHashPart -> Bool
StorePathHashPart -> StorePathHashPart -> Ordering
StorePathHashPart -> StorePathHashPart -> StorePathHashPart
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
min :: StorePathHashPart -> StorePathHashPart -> StorePathHashPart
$cmin :: StorePathHashPart -> StorePathHashPart -> StorePathHashPart
max :: StorePathHashPart -> StorePathHashPart -> StorePathHashPart
$cmax :: StorePathHashPart -> StorePathHashPart -> StorePathHashPart
>= :: StorePathHashPart -> StorePathHashPart -> Bool
$c>= :: StorePathHashPart -> StorePathHashPart -> Bool
> :: StorePathHashPart -> StorePathHashPart -> Bool
$c> :: StorePathHashPart -> StorePathHashPart -> Bool
<= :: StorePathHashPart -> StorePathHashPart -> Bool
$c<= :: StorePathHashPart -> StorePathHashPart -> Bool
< :: StorePathHashPart -> StorePathHashPart -> Bool
$c< :: StorePathHashPart -> StorePathHashPart -> Bool
compare :: StorePathHashPart -> StorePathHashPart -> Ordering
$ccompare :: StorePathHashPart -> StorePathHashPart -> Ordering
Ord, Int -> StorePathHashPart -> ShowS
[StorePathHashPart] -> ShowS
StorePathHashPart -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [StorePathHashPart] -> ShowS
$cshowList :: [StorePathHashPart] -> ShowS
show :: StorePathHashPart -> [Char]
$cshow :: StorePathHashPart -> [Char]
showsPrec :: Int -> StorePathHashPart -> ShowS
$cshowsPrec :: Int -> StorePathHashPart -> ShowS
Show)

mkStorePathHashPart :: ByteString -> StorePathHashPart
mkStorePathHashPart :: ByteString -> StorePathHashPart
mkStorePathHashPart = coerce :: forall a b. Coercible a b => a -> b
coerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HashAlgorithm a => ByteString -> ByteString
mkStorePathHash @SHA256

-- | A set of 'StorePath's.
type StorePathSet = HashSet StorePath

-- | An address for a content-addressable store path, i.e. one whose
-- store path hash is purely a function of its contents (as opposed to
-- paths that are derivation outputs, whose hashes are a function of
-- the contents of the derivation file instead).
--
-- For backwards-compatibility reasons, the same information is
-- encodable in multiple ways, depending on the method used to add the
-- path to the store. These unfortunately result in separate store
-- paths.
data ContentAddressableAddress
  = -- | The path is a plain file added via makeTextPath or
    -- addTextToStore. It is addressed according to a sha256sum of the
    -- file contents.
    Text !(Digest SHA256)
  | -- | The path was added to the store via makeFixedOutputPath or
    -- addToStore. It is addressed according to some hash algorithm
    -- applied to the nar serialization via some 'NarHashMode'.
    Fixed !NarHashMode !SomeNamedDigest

-- | Schemes for hashing a Nix archive.
--
-- For backwards-compatibility reasons, there are two different modes
-- here, even though 'Recursive' should be able to cover both.
data NarHashMode
  = -- | Require the nar to represent a non-executable regular file.
    RegularFile
  | -- | Hash an arbitrary nar, including a non-executable regular
    -- file if so desired.
    Recursive

makeStorePathName :: Text -> Either String StorePathName
makeStorePathName :: Text -> Either [Char] StorePathName
makeStorePathName Text
n =
  if Text -> Bool
validStorePathName Text
n
    then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> StorePathName
StorePathName Text
n
    else forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text -> [Char]
reasonInvalid Text
n

reasonInvalid :: Text -> String
reasonInvalid :: Text -> [Char]
reasonInvalid Text
n
  | Text
n forall a. Eq a => a -> a -> Bool
== Text
""          = [Char]
"Empty name"
  | Text -> Int
Text.length Text
n forall a. Ord a => a -> a -> Bool
> Int
211 = [Char]
"Path too long"
  | Text -> Char
Text.head Text
n forall a. Eq a => a -> a -> Bool
== Char
'.'  = [Char]
"Leading dot"
  | Bool
otherwise        = [Char]
"Invalid character"

validStorePathName :: Text -> Bool
validStorePathName :: Text -> Bool
validStorePathName Text
n =
  Text
n forall a. Eq a => a -> a -> Bool
/= Text
""
  Bool -> Bool -> Bool
&& Text -> Int
Text.length Text
n forall a. Ord a => a -> a -> Bool
<= Int
211
  Bool -> Bool -> Bool
&& Text -> Char
Text.head Text
n forall a. Eq a => a -> a -> Bool
/= Char
'.'
  Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
Text.all Char -> Bool
validStorePathNameChar Text
n

validStorePathNameChar :: Char -> Bool
validStorePathNameChar :: Char -> Bool
validStorePathNameChar Char
c =
  forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a b. (a -> b) -> a -> b
$ Char
c)
    [ Char -> Bool
Char.isAsciiLower -- 'a'..'z', isAscii..er probably faster then putting it out
    , Char -> Bool
Char.isAsciiUpper -- 'A'..'Z'
    , Char -> Bool
Char.isDigit
    , (forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` ([Char]
"+-._?=" :: String))
    ]

-- | Copied from @RawFilePath@ in the @unix@ package, duplicated here
-- to avoid the dependency.
type RawFilePath = ByteString

-- | Render a 'StorePath' as a 'RawFilePath'.
storePathToRawFilePath :: StorePath -> RawFilePath
storePathToRawFilePath :: StorePath -> ByteString
storePathToRawFilePath StorePath{[Char]
StorePathHashPart
StorePathName
storePathRoot :: [Char]
storePathName :: StorePathName
storePathHash :: StorePathHashPart
storePathRoot :: StorePath -> [Char]
storePathName :: StorePath -> StorePathName
storePathHash :: StorePath -> StorePathHashPart
..} =
  ByteString
root forall a. Semigroup a => a -> a -> a
<> ByteString
"/" forall a. Semigroup a => a -> a -> a
<> ByteString
hashPart forall a. Semigroup a => a -> a -> a
<> ByteString
"-" forall a. Semigroup a => a -> a -> a
<> ByteString
name
 where
  root :: ByteString
root     = [Char] -> ByteString
Bytes.Char8.pack [Char]
storePathRoot
  hashPart :: ByteString
hashPart = forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 forall a b. (a -> b) -> a -> b
$ BaseEncoding -> ByteString -> Text
encodeWith BaseEncoding
NixBase32 forall a b. (a -> b) -> a -> b
$ coerce :: forall a b. Coercible a b => a -> b
coerce StorePathHashPart
storePathHash
  name :: ByteString
name     = forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 forall a b. (a -> b) -> a -> b
$ StorePathName -> Text
unStorePathName StorePathName
storePathName

-- | Render a 'StorePath' as a 'FilePath'.
storePathToFilePath :: StorePath -> FilePath
storePathToFilePath :: StorePath -> [Char]
storePathToFilePath = ByteString -> [Char]
Bytes.Char8.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorePath -> ByteString
storePathToRawFilePath

-- | Render a 'StorePath' as a 'Text'.
storePathToText :: StorePath -> Text
storePathToText :: StorePath -> Text
storePathToText = forall a. ToText a => a -> Text
toText forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
Bytes.Char8.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorePath -> ByteString
storePathToRawFilePath

-- | Build `narinfo` suffix from `StorePath` which
-- can be used to query binary caches.
storePathToNarInfo :: StorePath -> Bytes.Char8.ByteString
storePathToNarInfo :: StorePath -> ByteString
storePathToNarInfo StorePath{[Char]
StorePathHashPart
StorePathName
storePathRoot :: [Char]
storePathName :: StorePathName
storePathHash :: StorePathHashPart
storePathRoot :: StorePath -> [Char]
storePathName :: StorePath -> StorePathName
storePathHash :: StorePath -> StorePathHashPart
..} =
  forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 forall a b. (a -> b) -> a -> b
$ BaseEncoding -> ByteString -> Text
encodeWith BaseEncoding
NixBase32 (coerce :: forall a b. Coercible a b => a -> b
coerce StorePathHashPart
storePathHash) forall a. Semigroup a => a -> a -> a
<> Text
".narinfo"

-- | Parse `StorePath` from `Bytes.Char8.ByteString`, checking
-- that store directory matches `expectedRoot`.
parsePath :: FilePath -> Bytes.Char8.ByteString -> Either String StorePath
parsePath :: [Char] -> ByteString -> Either [Char] StorePath
parsePath [Char]
expectedRoot ByteString
x =
  let
    ([Char]
rootDir, [Char]
fname) = [Char] -> ([Char], [Char])
FilePath.splitFileName forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
Bytes.Char8.unpack forall a b. (a -> b) -> a -> b
$ ByteString
x
    (Text
storeBasedHashPart, Text
namePart) = Text -> Text -> (Text, Text)
Text.breakOn Text
"-" forall a b. (a -> b) -> a -> b
$ forall a. ToText a => a -> Text
toText [Char]
fname
    storeHash :: Either [Char] ByteString
storeHash = BaseEncoding -> Text -> Either [Char] ByteString
decodeWith BaseEncoding
NixBase32 Text
storeBasedHashPart
    name :: Either [Char] StorePathName
name = Text -> Either [Char] StorePathName
makeStorePathName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
Text.drop Int
1 forall a b. (a -> b) -> a -> b
$ Text
namePart
    --rootDir' = dropTrailingPathSeparator rootDir
    -- cannot use ^^ as it drops multiple slashes /a/b/// -> /a/b
    rootDir' :: [Char]
rootDir' = forall a. [a] -> [a]
Unsafe.init [Char]
rootDir
    storeDir :: Either [Char] [Char]
storeDir =
      if [Char]
expectedRoot forall a. Eq a => a -> a -> Bool
== [Char]
rootDir'
        then forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
rootDir'
        else forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char]
"Root store dir mismatch, expected" forall a. Semigroup a => a -> a -> a
<> [Char]
expectedRoot forall a. Semigroup a => a -> a -> a
<> [Char]
"got" forall a. Semigroup a => a -> a -> a
<> [Char]
rootDir'
  in
    StorePathHashPart -> StorePathName -> [Char] -> StorePath
StorePath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> coerce :: forall a b. Coercible a b => a -> b
coerce Either [Char] ByteString
storeHash forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either [Char] StorePathName
name forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either [Char] [Char]
storeDir

pathParser :: FilePath -> Parser StorePath
pathParser :: [Char] -> Parser StorePath
pathParser [Char]
expectedRoot = do
  Text
_ <-
    Text -> Parser Text Text
Parser.Text.Lazy.string (forall a. ToText a => a -> Text
toText [Char]
expectedRoot)
      forall i a. Parser i a -> [Char] -> Parser i a
<?> [Char]
"Store root mismatch" -- e.g. /nix/store

  Char
_ <- Char -> Parser Text Char
Parser.Text.Lazy.char Char
'/'
      forall i a. Parser i a -> [Char] -> Parser i a
<?> [Char]
"Expecting path separator"

  Either [Char] ByteString
digest <-
    BaseEncoding -> Text -> Either [Char] ByteString
decodeWith BaseEncoding
NixBase32
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Text Text
Parser.Text.Lazy.takeWhile1 (forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` Vector Char
Nix.Base32.digits32)
      forall i a. Parser i a -> [Char] -> Parser i a
<?> [Char]
"Invalid Base32 part"

  Char
_  <- Char -> Parser Text Char
Parser.Text.Lazy.char Char
'-' forall i a. Parser i a -> [Char] -> Parser i a
<?> [Char]
"Expecting dash (path name separator)"

  Char
c0 <-
    (Char -> Bool) -> Parser Text Char
Parser.Text.Lazy.satisfy (\Char
c -> Char
c forall a. Eq a => a -> a -> Bool
/= Char
'.' Bool -> Bool -> Bool
&& Char -> Bool
validStorePathNameChar Char
c)
      forall i a. Parser i a -> [Char] -> Parser i a
<?> [Char]
"Leading path name character is a dot or invalid character"

  Text
rest <-
    (Char -> Bool) -> Parser Text Text
Parser.Text.Lazy.takeWhile Char -> Bool
validStorePathNameChar
      forall i a. Parser i a -> [Char] -> Parser i a
<?> [Char]
"Path name contains invalid character"

  let name :: Either [Char] StorePathName
name = Text -> Either [Char] StorePathName
makeStorePathName forall a b. (a -> b) -> a -> b
$ Char -> Text -> Text
Text.cons Char
c0 Text
rest

  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail
    forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (StorePathHashPart -> StorePathName -> [Char] -> StorePath
StorePath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> coerce :: forall a b. Coercible a b => a -> b
coerce Either [Char] ByteString
digest forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either [Char] StorePathName
name forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
expectedRoot)