{-|
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 -> FilePath
storePathRoot :: !FilePath
  }
  deriving (StorePath -> StorePath -> Bool
(StorePath -> StorePath -> Bool)
-> (StorePath -> StorePath -> Bool) -> Eq StorePath
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
Eq StorePath
-> (StorePath -> StorePath -> Ordering)
-> (StorePath -> StorePath -> Bool)
-> (StorePath -> StorePath -> Bool)
-> (StorePath -> StorePath -> Bool)
-> (StorePath -> StorePath -> Bool)
-> (StorePath -> StorePath -> StorePath)
-> (StorePath -> StorePath -> StorePath)
-> Ord 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
$cp1Ord :: Eq StorePath
Ord)

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

instance Show StorePath where
  show :: StorePath -> FilePath
show StorePath
p = ByteString -> FilePath
Bytes.Char8.unpack (ByteString -> FilePath) -> ByteString -> FilePath
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
(StorePathName -> StorePathName -> Bool)
-> (StorePathName -> StorePathName -> Bool) -> Eq StorePathName
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, Int -> StorePathName -> Int
StorePathName -> Int
(Int -> StorePathName -> Int)
-> (StorePathName -> Int) -> Hashable StorePathName
forall 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
Eq StorePathName
-> (StorePathName -> StorePathName -> Ordering)
-> (StorePathName -> StorePathName -> Bool)
-> (StorePathName -> StorePathName -> Bool)
-> (StorePathName -> StorePathName -> Bool)
-> (StorePathName -> StorePathName -> Bool)
-> (StorePathName -> StorePathName -> StorePathName)
-> (StorePathName -> StorePathName -> StorePathName)
-> Ord 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
$cp1Ord :: Eq StorePathName
Ord)

-- | The hash algorithm used for store path hashes.
newtype StorePathHashPart = StorePathHashPart ByteString
  deriving (StorePathHashPart -> StorePathHashPart -> Bool
(StorePathHashPart -> StorePathHashPart -> Bool)
-> (StorePathHashPart -> StorePathHashPart -> Bool)
-> Eq StorePathHashPart
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, Int -> StorePathHashPart -> Int
StorePathHashPart -> Int
(Int -> StorePathHashPart -> Int)
-> (StorePathHashPart -> Int) -> Hashable StorePathHashPart
forall 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
Eq StorePathHashPart
-> (StorePathHashPart -> StorePathHashPart -> Ordering)
-> (StorePathHashPart -> StorePathHashPart -> Bool)
-> (StorePathHashPart -> StorePathHashPart -> Bool)
-> (StorePathHashPart -> StorePathHashPart -> Bool)
-> (StorePathHashPart -> StorePathHashPart -> Bool)
-> (StorePathHashPart -> StorePathHashPart -> StorePathHashPart)
-> (StorePathHashPart -> StorePathHashPart -> StorePathHashPart)
-> Ord 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
$cp1Ord :: Eq StorePathHashPart
Ord, Int -> StorePathHashPart -> ShowS
[StorePathHashPart] -> ShowS
StorePathHashPart -> FilePath
(Int -> StorePathHashPart -> ShowS)
-> (StorePathHashPart -> FilePath)
-> ([StorePathHashPart] -> ShowS)
-> Show StorePathHashPart
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [StorePathHashPart] -> ShowS
$cshowList :: [StorePathHashPart] -> ShowS
show :: StorePathHashPart -> FilePath
$cshow :: StorePathHashPart -> FilePath
showsPrec :: Int -> StorePathHashPart -> ShowS
$cshowsPrec :: Int -> StorePathHashPart -> ShowS
Show)

mkStorePathHashPart :: ByteString -> StorePathHashPart
mkStorePathHashPart :: ByteString -> StorePathHashPart
mkStorePathHashPart = ByteString -> StorePathHashPart
coerce (ByteString -> StorePathHashPart)
-> (ByteString -> ByteString) -> ByteString -> StorePathHashPart
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashAlgorithm SHA256 => ByteString -> ByteString
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 FilePath StorePathName
makeStorePathName Text
n =
  if Text -> Bool
validStorePathName Text
n
    then StorePathName -> Either FilePath StorePathName
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StorePathName -> Either FilePath StorePathName)
-> StorePathName -> Either FilePath StorePathName
forall a b. (a -> b) -> a -> b
$ Text -> StorePathName
StorePathName Text
n
    else FilePath -> Either FilePath StorePathName
forall a b. a -> Either a b
Left (FilePath -> Either FilePath StorePathName)
-> FilePath -> Either FilePath StorePathName
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
reasonInvalid Text
n

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

validStorePathName :: Text -> Bool
validStorePathName :: Text -> Bool
validStorePathName Text
n =
  Text
n Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
""
  Bool -> Bool -> Bool
&& Text -> Int
Text.length Text
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
211
  Bool -> Bool -> Bool
&& Text -> Char
Text.head Text
n Char -> Char -> Bool
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 =
  ((Char -> Bool) -> Bool) -> [Char -> Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Char -> Bool) -> Char -> Bool
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
    , (Char -> FilePath -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` (FilePath
"+-._?=" :: 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{FilePath
StorePathHashPart
StorePathName
storePathRoot :: FilePath
storePathName :: StorePathName
storePathHash :: StorePathHashPart
storePathRoot :: StorePath -> FilePath
storePathName :: StorePath -> StorePathName
storePathHash :: StorePath -> StorePathHashPart
..} =
  ByteString
root ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
hashPart ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"-" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
name
 where
  root :: ByteString
root     = FilePath -> ByteString
Bytes.Char8.pack FilePath
storePathRoot
  hashPart :: ByteString
hashPart = Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ BaseEncoding -> ByteString -> Text
encodeWith BaseEncoding
NixBase32 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ StorePathHashPart -> ByteString
coerce StorePathHashPart
storePathHash
  name :: ByteString
name     = Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ StorePathName -> Text
unStorePathName StorePathName
storePathName

-- | Render a 'StorePath' as a 'FilePath'.
storePathToFilePath :: StorePath -> FilePath
storePathToFilePath :: StorePath -> FilePath
storePathToFilePath = ByteString -> FilePath
Bytes.Char8.unpack (ByteString -> FilePath)
-> (StorePath -> ByteString) -> StorePath -> FilePath
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 = FilePath -> Text
forall a. ToText a => a -> Text
toText (FilePath -> Text) -> (StorePath -> FilePath) -> StorePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FilePath
Bytes.Char8.unpack (ByteString -> FilePath)
-> (StorePath -> ByteString) -> StorePath -> FilePath
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{FilePath
StorePathHashPart
StorePathName
storePathRoot :: FilePath
storePathName :: StorePathName
storePathHash :: StorePathHashPart
storePathRoot :: StorePath -> FilePath
storePathName :: StorePath -> StorePathName
storePathHash :: StorePath -> StorePathHashPart
..} =
  Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ BaseEncoding -> ByteString -> Text
encodeWith BaseEncoding
NixBase32 (StorePathHashPart -> ByteString
coerce StorePathHashPart
storePathHash) Text -> Text -> Text
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 :: FilePath -> ByteString -> Either FilePath StorePath
parsePath FilePath
expectedRoot ByteString
x =
  let
    (FilePath
rootDir, FilePath
fname) = FilePath -> (FilePath, FilePath)
FilePath.splitFileName (FilePath -> (FilePath, FilePath))
-> (ByteString -> FilePath) -> ByteString -> (FilePath, FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FilePath
Bytes.Char8.unpack (ByteString -> (FilePath, FilePath))
-> ByteString -> (FilePath, FilePath)
forall a b. (a -> b) -> a -> b
$ ByteString
x
    (Text
storeBasedHashPart, Text
namePart) = Text -> Text -> (Text, Text)
Text.breakOn Text
"-" (Text -> (Text, Text)) -> Text -> (Text, Text)
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
forall a. ToText a => a -> Text
toText FilePath
fname
    storeHash :: Either FilePath ByteString
storeHash = BaseEncoding -> Text -> Either FilePath ByteString
decodeWith BaseEncoding
NixBase32 Text
storeBasedHashPart
    name :: Either FilePath StorePathName
name = Text -> Either FilePath StorePathName
makeStorePathName (Text -> Either FilePath StorePathName)
-> (Text -> Text) -> Text -> Either FilePath StorePathName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
Text.drop Int
1 (Text -> Either FilePath StorePathName)
-> Text -> Either FilePath StorePathName
forall a b. (a -> b) -> a -> b
$ Text
namePart
    --rootDir' = dropTrailingPathSeparator rootDir
    -- cannot use ^^ as it drops multiple slashes /a/b/// -> /a/b
    rootDir' :: FilePath
rootDir' = ShowS
forall a. [a] -> [a]
Unsafe.init FilePath
rootDir
    storeDir :: Either FilePath FilePath
storeDir =
      if FilePath
expectedRoot FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
rootDir'
        then FilePath -> Either FilePath FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
rootDir'
        else FilePath -> Either FilePath FilePath
forall a b. a -> Either a b
Left (FilePath -> Either FilePath FilePath)
-> FilePath -> Either FilePath FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"Root store dir mismatch, expected" FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
expectedRoot FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
"got" FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
rootDir'
  in
    StorePathHashPart -> StorePathName -> FilePath -> StorePath
StorePath (StorePathHashPart -> StorePathName -> FilePath -> StorePath)
-> Either FilePath StorePathHashPart
-> Either FilePath (StorePathName -> FilePath -> StorePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either FilePath ByteString -> Either FilePath StorePathHashPart
coerce Either FilePath ByteString
storeHash Either FilePath (StorePathName -> FilePath -> StorePath)
-> Either FilePath StorePathName
-> Either FilePath (FilePath -> StorePath)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either FilePath StorePathName
name Either FilePath (FilePath -> StorePath)
-> Either FilePath FilePath -> Either FilePath StorePath
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either FilePath FilePath
storeDir

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

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

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

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

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

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

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

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