{-|
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
    StoreDir(..)
  , 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           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.
--
-- The store directory is *not* included, and must be known from the
-- context. This matches modern C++ Nix, and also represents the fact
-- that store paths for different store directories cannot be mixed.
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
  }
  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, Int -> StorePath -> ShowS
[StorePath] -> ShowS
StorePath -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [StorePath] -> ShowS
$cshowList :: [StorePath] -> ShowS
show :: StorePath -> [Char]
$cshow :: StorePath -> [Char]
showsPrec :: Int -> StorePath -> ShowS
$cshowsPrec :: Int -> StorePath -> ShowS
Show)

instance Hashable StorePath where
  hashWithSalt :: Int -> StorePath -> Int
hashWithSalt Int
s StorePath{StorePathHashPart
StorePathName
storePathName :: StorePathName
storePathHash :: StorePathHashPart
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

-- | 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, Int -> StorePathName -> ShowS
[StorePathName] -> ShowS
StorePathName -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [StorePathName] -> ShowS
$cshowList :: [StorePathName] -> ShowS
show :: StorePathName -> [Char]
$cshow :: StorePathName -> [Char]
showsPrec :: Int -> StorePathName -> ShowS
$cshowsPrec :: Int -> StorePathName -> ShowS
Show)

-- | 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

-- | The path to the store dir
--
-- Many operations need to be parameterized with this, since store paths
-- do not know their own store dir by design.
newtype StoreDir = StoreDir {
    StoreDir -> ByteString
unStoreDir :: RawFilePath
  } deriving (StoreDir -> StoreDir -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StoreDir -> StoreDir -> Bool
$c/= :: StoreDir -> StoreDir -> Bool
== :: StoreDir -> StoreDir -> Bool
$c== :: StoreDir -> StoreDir -> Bool
Eq, Eq StoreDir
Int -> StoreDir -> Int
StoreDir -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: StoreDir -> Int
$chash :: StoreDir -> Int
hashWithSalt :: Int -> StoreDir -> Int
$chashWithSalt :: Int -> StoreDir -> Int
Hashable, Eq StoreDir
StoreDir -> StoreDir -> Bool
StoreDir -> StoreDir -> Ordering
StoreDir -> StoreDir -> StoreDir
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 :: StoreDir -> StoreDir -> StoreDir
$cmin :: StoreDir -> StoreDir -> StoreDir
max :: StoreDir -> StoreDir -> StoreDir
$cmax :: StoreDir -> StoreDir -> StoreDir
>= :: StoreDir -> StoreDir -> Bool
$c>= :: StoreDir -> StoreDir -> Bool
> :: StoreDir -> StoreDir -> Bool
$c> :: StoreDir -> StoreDir -> Bool
<= :: StoreDir -> StoreDir -> Bool
$c<= :: StoreDir -> StoreDir -> Bool
< :: StoreDir -> StoreDir -> Bool
$c< :: StoreDir -> StoreDir -> Bool
compare :: StoreDir -> StoreDir -> Ordering
$ccompare :: StoreDir -> StoreDir -> Ordering
Ord, Int -> StoreDir -> ShowS
[StoreDir] -> ShowS
StoreDir -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [StoreDir] -> ShowS
$cshowList :: [StoreDir] -> ShowS
show :: StoreDir -> [Char]
$cshow :: StoreDir -> [Char]
showsPrec :: Int -> StoreDir -> ShowS
$cshowsPrec :: Int -> StoreDir -> ShowS
Show)

-- | Render a 'StorePath' as a 'RawFilePath'.
storePathToRawFilePath :: StoreDir -> StorePath -> RawFilePath
storePathToRawFilePath :: StoreDir -> StorePath -> ByteString
storePathToRawFilePath StoreDir
storeDir StorePath{StorePathHashPart
StorePathName
storePathName :: StorePathName
storePathHash :: StorePathHashPart
storePathName :: StorePath -> StorePathName
storePathHash :: StorePath -> StorePathHashPart
..} =
  StoreDir -> ByteString
unStoreDir StoreDir
storeDir 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
  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 :: StoreDir -> StorePath -> FilePath
storePathToFilePath :: StoreDir -> StorePath -> [Char]
storePathToFilePath StoreDir
storeDir = ByteString -> [Char]
Bytes.Char8.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoreDir -> StorePath -> ByteString
storePathToRawFilePath StoreDir
storeDir

-- | Render a 'StorePath' as a 'Text'.
storePathToText :: StoreDir -> StorePath -> Text
storePathToText :: StoreDir -> StorePath -> Text
storePathToText StoreDir
storeDir = 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
. StoreDir -> StorePath -> ByteString
storePathToRawFilePath StoreDir
storeDir

-- | Build `narinfo` suffix from `StorePath` which
-- can be used to query binary caches.
storePathToNarInfo :: StorePath -> Bytes.Char8.ByteString
storePathToNarInfo :: StorePath -> ByteString
storePathToNarInfo StorePath{StorePathHashPart
StorePathName
storePathName :: StorePathName
storePathHash :: StorePathHashPart
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 :: StoreDir -> Bytes.Char8.ByteString -> Either String StorePath
parsePath :: StoreDir -> ByteString -> Either [Char] StorePath
parsePath StoreDir
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
    expectedRootS :: [Char]
expectedRootS = ByteString -> [Char]
Bytes.Char8.unpack (StoreDir -> ByteString
unStoreDir StoreDir
expectedRoot)
    storeDir :: Either [Char] [Char]
storeDir =
      if [Char]
expectedRootS 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]
expectedRootS forall a. Semigroup a => a -> a -> a
<> [Char]
"got" forall a. Semigroup a => a -> a -> a
<> [Char]
rootDir'
  in
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a b. a -> Either a b
Left (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ StorePathHashPart -> StorePathName -> 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) Either [Char] [Char]
storeDir

pathParser :: StoreDir -> Parser StorePath
pathParser :: StoreDir -> Parser StorePath
pathParser StoreDir
expectedRoot = do
  let expectedRootS :: [Char]
expectedRootS = ByteString -> [Char]
Bytes.Char8.unpack (StoreDir -> ByteString
unStoreDir StoreDir
expectedRoot)

  Text
_ <-
    Text -> Parser Text Text
Parser.Text.Lazy.string (forall a. ToText a => a -> Text
toText [Char]
expectedRootS)
      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 -> 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)