{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE OverloadedStrings #-}
{-|
Description : Representation of Nix store paths.
-}

module System.Nix.StorePath
  ( -- * Basic store path types
    StoreDir(..)
  , HasStoreDir(..)
  , StorePath
  , storePathHash
  , storePathName
  , StorePathName
  , unStorePathName
  , StorePathHashPart
  , mkStorePathHashPart
  , unStorePathHashPart
    -- * Manipulating 'StorePathName'
  , InvalidNameError(..)
  , mkStorePathName
  , parseNameText
    -- * Reason why a path is not valid
  , InvalidPathError(..)
  , -- * Rendering out 'StorePath's
    storePathToFilePath
  , storePathToRawFilePath
  , storePathToText
  , storePathToNarInfo
  , storePathHashPartToText
  , -- * Parsing 'StorePath's
    parsePath
  , parsePathFromText
  , pathParser
    -- * Utilities for tests
  , unsafeMakeStorePath
  , unsafeMakeStorePathHashPart
  ) where

import Crypto.Hash (HashAlgorithm)
import Data.Attoparsec.Text.Lazy (Parser, (<?>))
import Data.ByteString (ByteString)
import Data.Default.Class (Default(def))
import Data.Hashable (Hashable(hashWithSalt))
import Data.Text (Text)
import GHC.Generics (Generic)
import System.Nix.Base (BaseEncoding(NixBase32))

import qualified Data.Bifunctor
import qualified Data.ByteString.Char8
import qualified Data.Char
import qualified Data.Text
import qualified Data.Text.Encoding
import qualified Data.Attoparsec.Text.Lazy
import qualified System.FilePath

import qualified System.Nix.Base
import qualified System.Nix.Hash
import qualified System.Nix.Base32

-- | 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
(StorePath -> StorePath -> Bool)
-> (StorePath -> StorePath -> Bool) -> Eq StorePath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StorePath -> StorePath -> Bool
== :: StorePath -> StorePath -> Bool
$c/= :: StorePath -> StorePath -> Bool
/= :: StorePath -> StorePath -> Bool
Eq, (forall x. StorePath -> Rep StorePath x)
-> (forall x. Rep StorePath x -> StorePath) -> Generic StorePath
forall x. Rep StorePath x -> StorePath
forall x. StorePath -> Rep StorePath x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StorePath -> Rep StorePath x
from :: forall x. StorePath -> Rep StorePath x
$cto :: forall x. Rep StorePath x -> StorePath
to :: forall x. Rep StorePath x -> StorePath
Generic, 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
$ccompare :: StorePath -> StorePath -> Ordering
compare :: StorePath -> StorePath -> Ordering
$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
>= :: StorePath -> StorePath -> Bool
$cmax :: StorePath -> StorePath -> StorePath
max :: StorePath -> StorePath -> StorePath
$cmin :: StorePath -> StorePath -> StorePath
min :: StorePath -> StorePath -> StorePath
Ord)

instance Hashable StorePath where
  hashWithSalt :: Int -> StorePath -> Int
hashWithSalt Int
s StorePath{StorePathHashPart
StorePathName
storePathHash :: StorePath -> StorePathHashPart
storePathName :: StorePath -> StorePathName
storePathHash :: StorePathHashPart
storePathName :: StorePathName
..} =
    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 -> [Char]
show StorePath
s =
    [Char]
"StorePath"
    [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" "
    [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> StoreDir -> StorePath -> [Char]
storePathToFilePath (RawFilePath -> StoreDir
StoreDir RawFilePath
forall a. Monoid a => a
mempty) StorePath
s

-- | 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
$c== :: StorePathName -> StorePathName -> Bool
== :: StorePathName -> StorePathName -> Bool
$c/= :: StorePathName -> StorePathName -> Bool
/= :: StorePathName -> StorePathName -> Bool
Eq, (forall x. StorePathName -> Rep StorePathName x)
-> (forall x. Rep StorePathName x -> StorePathName)
-> Generic StorePathName
forall x. Rep StorePathName x -> StorePathName
forall x. StorePathName -> Rep StorePathName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StorePathName -> Rep StorePathName x
from :: forall x. StorePathName -> Rep StorePathName x
$cto :: forall x. Rep StorePathName x -> StorePathName
to :: forall x. Rep StorePathName x -> StorePathName
Generic, Eq StorePathName
Eq StorePathName =>
(Int -> StorePathName -> Int)
-> (StorePathName -> Int) -> Hashable StorePathName
Int -> StorePathName -> Int
StorePathName -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> StorePathName -> Int
hashWithSalt :: Int -> StorePathName -> Int
$chash :: StorePathName -> Int
hash :: 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
$ccompare :: StorePathName -> StorePathName -> Ordering
compare :: StorePathName -> StorePathName -> Ordering
$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
>= :: StorePathName -> StorePathName -> Bool
$cmax :: StorePathName -> StorePathName -> StorePathName
max :: StorePathName -> StorePathName -> StorePathName
$cmin :: StorePathName -> StorePathName -> StorePathName
min :: StorePathName -> StorePathName -> StorePathName
Ord, Int -> StorePathName -> ShowS
[StorePathName] -> ShowS
StorePathName -> [Char]
(Int -> StorePathName -> ShowS)
-> (StorePathName -> [Char])
-> ([StorePathName] -> ShowS)
-> Show StorePathName
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StorePathName -> ShowS
showsPrec :: Int -> StorePathName -> ShowS
$cshow :: StorePathName -> [Char]
show :: StorePathName -> [Char]
$cshowList :: [StorePathName] -> ShowS
showList :: [StorePathName] -> ShowS
Show)

-- | The hash algorithm used for store path hashes.
newtype StorePathHashPart = StorePathHashPart
  { -- | Extract the contents of the hash.
    StorePathHashPart -> RawFilePath
unStorePathHashPart :: ByteString
  }
  deriving (StorePathHashPart -> StorePathHashPart -> Bool
(StorePathHashPart -> StorePathHashPart -> Bool)
-> (StorePathHashPart -> StorePathHashPart -> Bool)
-> Eq StorePathHashPart
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StorePathHashPart -> StorePathHashPart -> Bool
== :: StorePathHashPart -> StorePathHashPart -> Bool
$c/= :: StorePathHashPart -> StorePathHashPart -> Bool
/= :: StorePathHashPart -> StorePathHashPart -> Bool
Eq, (forall x. StorePathHashPart -> Rep StorePathHashPart x)
-> (forall x. Rep StorePathHashPart x -> StorePathHashPart)
-> Generic StorePathHashPart
forall x. Rep StorePathHashPart x -> StorePathHashPart
forall x. StorePathHashPart -> Rep StorePathHashPart x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StorePathHashPart -> Rep StorePathHashPart x
from :: forall x. StorePathHashPart -> Rep StorePathHashPart x
$cto :: forall x. Rep StorePathHashPart x -> StorePathHashPart
to :: forall x. Rep StorePathHashPart x -> StorePathHashPart
Generic, Eq StorePathHashPart
Eq StorePathHashPart =>
(Int -> StorePathHashPart -> Int)
-> (StorePathHashPart -> Int) -> Hashable StorePathHashPart
Int -> StorePathHashPart -> Int
StorePathHashPart -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> StorePathHashPart -> Int
hashWithSalt :: Int -> StorePathHashPart -> Int
$chash :: StorePathHashPart -> Int
hash :: 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
$ccompare :: StorePathHashPart -> StorePathHashPart -> Ordering
compare :: StorePathHashPart -> StorePathHashPart -> Ordering
$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
>= :: StorePathHashPart -> StorePathHashPart -> Bool
$cmax :: StorePathHashPart -> StorePathHashPart -> StorePathHashPart
max :: StorePathHashPart -> StorePathHashPart -> StorePathHashPart
$cmin :: StorePathHashPart -> StorePathHashPart -> StorePathHashPart
min :: StorePathHashPart -> StorePathHashPart -> StorePathHashPart
Ord, Int -> StorePathHashPart -> ShowS
[StorePathHashPart] -> ShowS
StorePathHashPart -> [Char]
(Int -> StorePathHashPart -> ShowS)
-> (StorePathHashPart -> [Char])
-> ([StorePathHashPart] -> ShowS)
-> Show StorePathHashPart
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StorePathHashPart -> ShowS
showsPrec :: Int -> StorePathHashPart -> ShowS
$cshow :: StorePathHashPart -> [Char]
show :: StorePathHashPart -> [Char]
$cshowList :: [StorePathHashPart] -> ShowS
showList :: [StorePathHashPart] -> ShowS
Show)

-- | Make @StorePathHashPart@ from @ByteString@ (hash part of the @StorePath@)
-- using specific @HashAlgorithm@
mkStorePathHashPart
  :: forall hashAlgo
   . HashAlgorithm hashAlgo
  => ByteString
  -> StorePathHashPart
mkStorePathHashPart :: forall hashAlgo.
HashAlgorithm hashAlgo =>
RawFilePath -> StorePathHashPart
mkStorePathHashPart =
  RawFilePath -> StorePathHashPart
StorePathHashPart
  (RawFilePath -> StorePathHashPart)
-> (RawFilePath -> RawFilePath) -> RawFilePath -> StorePathHashPart
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HashAlgorithm a => RawFilePath -> RawFilePath
System.Nix.Hash.mkStorePathHash @hashAlgo

-- | Reason why a path name or output name is not valid
data InvalidNameError
  = EmptyName
  | NameTooLong Int
  | LeadingDot
  | InvalidCharacters Text
  deriving (InvalidNameError -> InvalidNameError -> Bool
(InvalidNameError -> InvalidNameError -> Bool)
-> (InvalidNameError -> InvalidNameError -> Bool)
-> Eq InvalidNameError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InvalidNameError -> InvalidNameError -> Bool
== :: InvalidNameError -> InvalidNameError -> Bool
$c/= :: InvalidNameError -> InvalidNameError -> Bool
/= :: InvalidNameError -> InvalidNameError -> Bool
Eq, (forall x. InvalidNameError -> Rep InvalidNameError x)
-> (forall x. Rep InvalidNameError x -> InvalidNameError)
-> Generic InvalidNameError
forall x. Rep InvalidNameError x -> InvalidNameError
forall x. InvalidNameError -> Rep InvalidNameError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InvalidNameError -> Rep InvalidNameError x
from :: forall x. InvalidNameError -> Rep InvalidNameError x
$cto :: forall x. Rep InvalidNameError x -> InvalidNameError
to :: forall x. Rep InvalidNameError x -> InvalidNameError
Generic, Eq InvalidNameError
Eq InvalidNameError =>
(Int -> InvalidNameError -> Int)
-> (InvalidNameError -> Int) -> Hashable InvalidNameError
Int -> InvalidNameError -> Int
InvalidNameError -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> InvalidNameError -> Int
hashWithSalt :: Int -> InvalidNameError -> Int
$chash :: InvalidNameError -> Int
hash :: InvalidNameError -> Int
Hashable, Eq InvalidNameError
Eq InvalidNameError =>
(InvalidNameError -> InvalidNameError -> Ordering)
-> (InvalidNameError -> InvalidNameError -> Bool)
-> (InvalidNameError -> InvalidNameError -> Bool)
-> (InvalidNameError -> InvalidNameError -> Bool)
-> (InvalidNameError -> InvalidNameError -> Bool)
-> (InvalidNameError -> InvalidNameError -> InvalidNameError)
-> (InvalidNameError -> InvalidNameError -> InvalidNameError)
-> Ord InvalidNameError
InvalidNameError -> InvalidNameError -> Bool
InvalidNameError -> InvalidNameError -> Ordering
InvalidNameError -> InvalidNameError -> InvalidNameError
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 :: InvalidNameError -> InvalidNameError -> Ordering
compare :: InvalidNameError -> InvalidNameError -> Ordering
$c< :: InvalidNameError -> InvalidNameError -> Bool
< :: InvalidNameError -> InvalidNameError -> Bool
$c<= :: InvalidNameError -> InvalidNameError -> Bool
<= :: InvalidNameError -> InvalidNameError -> Bool
$c> :: InvalidNameError -> InvalidNameError -> Bool
> :: InvalidNameError -> InvalidNameError -> Bool
$c>= :: InvalidNameError -> InvalidNameError -> Bool
>= :: InvalidNameError -> InvalidNameError -> Bool
$cmax :: InvalidNameError -> InvalidNameError -> InvalidNameError
max :: InvalidNameError -> InvalidNameError -> InvalidNameError
$cmin :: InvalidNameError -> InvalidNameError -> InvalidNameError
min :: InvalidNameError -> InvalidNameError -> InvalidNameError
Ord, Int -> InvalidNameError -> ShowS
[InvalidNameError] -> ShowS
InvalidNameError -> [Char]
(Int -> InvalidNameError -> ShowS)
-> (InvalidNameError -> [Char])
-> ([InvalidNameError] -> ShowS)
-> Show InvalidNameError
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InvalidNameError -> ShowS
showsPrec :: Int -> InvalidNameError -> ShowS
$cshow :: InvalidNameError -> [Char]
show :: InvalidNameError -> [Char]
$cshowList :: [InvalidNameError] -> ShowS
showList :: [InvalidNameError] -> ShowS
Show)

-- | Reason why a path is not valid
data InvalidPathError
  = PathNameInvalid InvalidNameError
  | HashDecodingFailure String
  | RootDirMismatch
      { InvalidPathError -> StoreDir
rdMismatchExpected :: StoreDir
      , InvalidPathError -> StoreDir
rdMismatchGot      :: StoreDir
      }
  deriving (InvalidPathError -> InvalidPathError -> Bool
(InvalidPathError -> InvalidPathError -> Bool)
-> (InvalidPathError -> InvalidPathError -> Bool)
-> Eq InvalidPathError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InvalidPathError -> InvalidPathError -> Bool
== :: InvalidPathError -> InvalidPathError -> Bool
$c/= :: InvalidPathError -> InvalidPathError -> Bool
/= :: InvalidPathError -> InvalidPathError -> Bool
Eq, (forall x. InvalidPathError -> Rep InvalidPathError x)
-> (forall x. Rep InvalidPathError x -> InvalidPathError)
-> Generic InvalidPathError
forall x. Rep InvalidPathError x -> InvalidPathError
forall x. InvalidPathError -> Rep InvalidPathError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InvalidPathError -> Rep InvalidPathError x
from :: forall x. InvalidPathError -> Rep InvalidPathError x
$cto :: forall x. Rep InvalidPathError x -> InvalidPathError
to :: forall x. Rep InvalidPathError x -> InvalidPathError
Generic, Eq InvalidPathError
Eq InvalidPathError =>
(Int -> InvalidPathError -> Int)
-> (InvalidPathError -> Int) -> Hashable InvalidPathError
Int -> InvalidPathError -> Int
InvalidPathError -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> InvalidPathError -> Int
hashWithSalt :: Int -> InvalidPathError -> Int
$chash :: InvalidPathError -> Int
hash :: InvalidPathError -> Int
Hashable, Eq InvalidPathError
Eq InvalidPathError =>
(InvalidPathError -> InvalidPathError -> Ordering)
-> (InvalidPathError -> InvalidPathError -> Bool)
-> (InvalidPathError -> InvalidPathError -> Bool)
-> (InvalidPathError -> InvalidPathError -> Bool)
-> (InvalidPathError -> InvalidPathError -> Bool)
-> (InvalidPathError -> InvalidPathError -> InvalidPathError)
-> (InvalidPathError -> InvalidPathError -> InvalidPathError)
-> Ord InvalidPathError
InvalidPathError -> InvalidPathError -> Bool
InvalidPathError -> InvalidPathError -> Ordering
InvalidPathError -> InvalidPathError -> InvalidPathError
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 :: InvalidPathError -> InvalidPathError -> Ordering
compare :: InvalidPathError -> InvalidPathError -> Ordering
$c< :: InvalidPathError -> InvalidPathError -> Bool
< :: InvalidPathError -> InvalidPathError -> Bool
$c<= :: InvalidPathError -> InvalidPathError -> Bool
<= :: InvalidPathError -> InvalidPathError -> Bool
$c> :: InvalidPathError -> InvalidPathError -> Bool
> :: InvalidPathError -> InvalidPathError -> Bool
$c>= :: InvalidPathError -> InvalidPathError -> Bool
>= :: InvalidPathError -> InvalidPathError -> Bool
$cmax :: InvalidPathError -> InvalidPathError -> InvalidPathError
max :: InvalidPathError -> InvalidPathError -> InvalidPathError
$cmin :: InvalidPathError -> InvalidPathError -> InvalidPathError
min :: InvalidPathError -> InvalidPathError -> InvalidPathError
Ord, Int -> InvalidPathError -> ShowS
[InvalidPathError] -> ShowS
InvalidPathError -> [Char]
(Int -> InvalidPathError -> ShowS)
-> (InvalidPathError -> [Char])
-> ([InvalidPathError] -> ShowS)
-> Show InvalidPathError
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InvalidPathError -> ShowS
showsPrec :: Int -> InvalidPathError -> ShowS
$cshow :: InvalidPathError -> [Char]
show :: InvalidPathError -> [Char]
$cshowList :: [InvalidPathError] -> ShowS
showList :: [InvalidPathError] -> ShowS
Show)

-- | Make @StorePathName@ from @Text@ (name part of the @StorePath@)
-- or fail with @InvalidNameError@ if it isn't valid
mkStorePathName :: Text -> Either InvalidNameError StorePathName
mkStorePathName :: Text -> Either InvalidNameError StorePathName
mkStorePathName = (Text -> StorePathName)
-> Either InvalidNameError Text
-> Either InvalidNameError StorePathName
forall a b.
(a -> b) -> Either InvalidNameError a -> Either InvalidNameError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> StorePathName
StorePathName (Either InvalidNameError Text
 -> Either InvalidNameError StorePathName)
-> (Text -> Either InvalidNameError Text)
-> Text
-> Either InvalidNameError StorePathName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either InvalidNameError Text
parseNameText

-- | Parse name (either @StorePathName@ or @OutputName@)
parseNameText :: Text -> Either InvalidNameError Text
parseNameText :: Text -> Either InvalidNameError Text
parseNameText Text
n
  | Text
n Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
""
    = InvalidNameError -> Either InvalidNameError Text
forall a b. a -> Either a b
Left InvalidNameError
EmptyName
  | Text -> Int
Data.Text.length Text
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
211
    = InvalidNameError -> Either InvalidNameError Text
forall a b. a -> Either a b
Left (InvalidNameError -> Either InvalidNameError Text)
-> InvalidNameError -> Either InvalidNameError Text
forall a b. (a -> b) -> a -> b
$ Int -> InvalidNameError
NameTooLong (Text -> Int
Data.Text.length Text
n)
  | HasCallStack => Text -> Char
Text -> Char
Data.Text.head Text
n Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.'
    = InvalidNameError -> Either InvalidNameError Text
forall a b. a -> Either a b
Left (InvalidNameError -> Either InvalidNameError Text)
-> InvalidNameError -> Either InvalidNameError Text
forall a b. (a -> b) -> a -> b
$ InvalidNameError
LeadingDot
  | Bool -> Bool
not
    (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Bool
Data.Text.null
    (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
Data.Text.filter
        (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
validStorePathNameChar)
        Text
n
    = InvalidNameError -> Either InvalidNameError Text
forall a b. a -> Either a b
Left
      (InvalidNameError -> Either InvalidNameError Text)
-> InvalidNameError -> Either InvalidNameError Text
forall a b. (a -> b) -> a -> b
$ Text -> InvalidNameError
InvalidCharacters
      (Text -> InvalidNameError) -> Text -> InvalidNameError
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
Data.Text.filter (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
validStorePathNameChar) Text
n
  | Bool
otherwise = Text -> Either InvalidNameError Text
forall a. a -> Either InvalidNameError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure 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
Data.Char.isAsciiLower -- 'a'..'z', isAscii..er probably faster then putting it out
    , Char -> Bool
Data.Char.isAsciiUpper -- 'A'..'Z'
    , Char -> Bool
Data.Char.isDigit
    , (Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t 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 -> RawFilePath
unStoreDir :: RawFilePath
  } deriving (StoreDir -> StoreDir -> Bool
(StoreDir -> StoreDir -> Bool)
-> (StoreDir -> StoreDir -> Bool) -> Eq StoreDir
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StoreDir -> StoreDir -> Bool
== :: StoreDir -> StoreDir -> Bool
$c/= :: StoreDir -> StoreDir -> Bool
/= :: StoreDir -> StoreDir -> Bool
Eq, (forall x. StoreDir -> Rep StoreDir x)
-> (forall x. Rep StoreDir x -> StoreDir) -> Generic StoreDir
forall x. Rep StoreDir x -> StoreDir
forall x. StoreDir -> Rep StoreDir x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StoreDir -> Rep StoreDir x
from :: forall x. StoreDir -> Rep StoreDir x
$cto :: forall x. Rep StoreDir x -> StoreDir
to :: forall x. Rep StoreDir x -> StoreDir
Generic, Eq StoreDir
Eq StoreDir =>
(Int -> StoreDir -> Int) -> (StoreDir -> Int) -> Hashable StoreDir
Int -> StoreDir -> Int
StoreDir -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> StoreDir -> Int
hashWithSalt :: Int -> StoreDir -> Int
$chash :: StoreDir -> Int
hash :: StoreDir -> Int
Hashable, Eq StoreDir
Eq StoreDir =>
(StoreDir -> StoreDir -> Ordering)
-> (StoreDir -> StoreDir -> Bool)
-> (StoreDir -> StoreDir -> Bool)
-> (StoreDir -> StoreDir -> Bool)
-> (StoreDir -> StoreDir -> Bool)
-> (StoreDir -> StoreDir -> StoreDir)
-> (StoreDir -> StoreDir -> StoreDir)
-> Ord 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
$ccompare :: StoreDir -> StoreDir -> Ordering
compare :: StoreDir -> StoreDir -> Ordering
$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
>= :: StoreDir -> StoreDir -> Bool
$cmax :: StoreDir -> StoreDir -> StoreDir
max :: StoreDir -> StoreDir -> StoreDir
$cmin :: StoreDir -> StoreDir -> StoreDir
min :: StoreDir -> StoreDir -> StoreDir
Ord, Int -> StoreDir -> ShowS
[StoreDir] -> ShowS
StoreDir -> [Char]
(Int -> StoreDir -> ShowS)
-> (StoreDir -> [Char]) -> ([StoreDir] -> ShowS) -> Show StoreDir
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StoreDir -> ShowS
showsPrec :: Int -> StoreDir -> ShowS
$cshow :: StoreDir -> [Char]
show :: StoreDir -> [Char]
$cshowList :: [StoreDir] -> ShowS
showList :: [StoreDir] -> ShowS
Show)

instance Default StoreDir where
  def :: StoreDir
def = RawFilePath -> StoreDir
StoreDir RawFilePath
"/nix/store"

class HasStoreDir r where
  hasStoreDir :: r -> StoreDir

-- | Render a 'StorePath' as a 'RawFilePath'.
storePathToRawFilePath :: StoreDir -> StorePath -> RawFilePath
storePathToRawFilePath :: StoreDir -> StorePath -> RawFilePath
storePathToRawFilePath StoreDir
storeDir StorePath{StorePathHashPart
StorePathName
storePathHash :: StorePath -> StorePathHashPart
storePathName :: StorePath -> StorePathName
storePathHash :: StorePathHashPart
storePathName :: StorePathName
..} =
  StoreDir -> RawFilePath
unStoreDir StoreDir
storeDir RawFilePath -> RawFilePath -> RawFilePath
forall a. Semigroup a => a -> a -> a
<> RawFilePath
"/" RawFilePath -> RawFilePath -> RawFilePath
forall a. Semigroup a => a -> a -> a
<> RawFilePath
hashPart RawFilePath -> RawFilePath -> RawFilePath
forall a. Semigroup a => a -> a -> a
<> RawFilePath
"-" RawFilePath -> RawFilePath -> RawFilePath
forall a. Semigroup a => a -> a -> a
<> RawFilePath
name
 where
  hashPart :: RawFilePath
hashPart = Text -> RawFilePath
Data.Text.Encoding.encodeUtf8 (Text -> RawFilePath) -> Text -> RawFilePath
forall a b. (a -> b) -> a -> b
$ StorePathHashPart -> Text
storePathHashPartToText StorePathHashPart
storePathHash
  name :: RawFilePath
name     = Text -> RawFilePath
Data.Text.Encoding.encodeUtf8 (Text -> RawFilePath) -> Text -> RawFilePath
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 = RawFilePath -> [Char]
Data.ByteString.Char8.unpack (RawFilePath -> [Char])
-> (StorePath -> RawFilePath) -> StorePath -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoreDir -> StorePath -> RawFilePath
storePathToRawFilePath StoreDir
storeDir

-- | Render a 'StorePath' as a 'Text'.
storePathToText :: StoreDir -> StorePath -> Text
storePathToText :: StoreDir -> StorePath -> Text
storePathToText StoreDir
storeDir =
  [Char] -> Text
Data.Text.pack
  ([Char] -> Text) -> (StorePath -> [Char]) -> StorePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawFilePath -> [Char]
Data.ByteString.Char8.unpack
  (RawFilePath -> [Char])
-> (StorePath -> RawFilePath) -> StorePath -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoreDir -> StorePath -> RawFilePath
storePathToRawFilePath StoreDir
storeDir

-- | Build `narinfo` suffix from `StorePath` which
-- can be used to query binary caches.
storePathToNarInfo :: StorePath -> ByteString
storePathToNarInfo :: StorePath -> RawFilePath
storePathToNarInfo StorePath{StorePathHashPart
StorePathName
storePathHash :: StorePath -> StorePathHashPart
storePathName :: StorePath -> StorePathName
storePathHash :: StorePathHashPart
storePathName :: StorePathName
..} =
  Text -> RawFilePath
Data.Text.Encoding.encodeUtf8
  (Text -> RawFilePath) -> Text -> RawFilePath
forall a b. (a -> b) -> a -> b
$ BaseEncoding -> RawFilePath -> Text
System.Nix.Base.encodeWith BaseEncoding
NixBase32
      (StorePathHashPart -> RawFilePath
unStorePathHashPart StorePathHashPart
storePathHash) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".narinfo"

-- | Render a 'StorePathHashPart' as a 'Text'.
-- This is used by remote store / database
-- via queryPathFromHashPart
storePathHashPartToText :: StorePathHashPart -> Text
storePathHashPartToText :: StorePathHashPart -> Text
storePathHashPartToText =
  BaseEncoding -> RawFilePath -> Text
System.Nix.Base.encodeWith BaseEncoding
NixBase32 (RawFilePath -> Text)
-> (StorePathHashPart -> RawFilePath) -> StorePathHashPart -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorePathHashPart -> RawFilePath
unStorePathHashPart

-- | Parse `StorePath` from `String`, internal
parsePath'
  :: StoreDir
  -> String
  -> Either InvalidPathError StorePath
parsePath' :: StoreDir -> [Char] -> Either InvalidPathError StorePath
parsePath' StoreDir
expectedRoot [Char]
stringyPath =
  let
    ([Char]
rootDir, [Char]
fname) = [Char] -> ([Char], [Char])
System.FilePath.splitFileName [Char]
stringyPath
    (Text
storeBasedHashPart, Text
namePart) = HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
Data.Text.breakOn Text
"-" (Text -> (Text, Text)) -> Text -> (Text, Text)
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
Data.Text.pack [Char]
fname
    hashPart :: Either InvalidPathError StorePathHashPart
hashPart =
      ([Char] -> InvalidPathError)
-> (RawFilePath -> StorePathHashPart)
-> Either [Char] RawFilePath
-> Either InvalidPathError StorePathHashPart
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
Data.Bifunctor.bimap
        [Char] -> InvalidPathError
HashDecodingFailure
        RawFilePath -> StorePathHashPart
StorePathHashPart
        (Either [Char] RawFilePath
 -> Either InvalidPathError StorePathHashPart)
-> Either [Char] RawFilePath
-> Either InvalidPathError StorePathHashPart
forall a b. (a -> b) -> a -> b
$ BaseEncoding -> Text -> Either [Char] RawFilePath
System.Nix.Base.decodeWith BaseEncoding
NixBase32 Text
storeBasedHashPart
    name :: Either InvalidPathError StorePathName
name =
      (InvalidNameError -> InvalidPathError)
-> Either InvalidNameError StorePathName
-> Either InvalidPathError StorePathName
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
Data.Bifunctor.first
        InvalidNameError -> InvalidPathError
PathNameInvalid
        (Either InvalidNameError StorePathName
 -> Either InvalidPathError StorePathName)
-> Either InvalidNameError StorePathName
-> Either InvalidPathError StorePathName
forall a b. (a -> b) -> a -> b
$ Text -> Either InvalidNameError StorePathName
mkStorePathName (Text -> Either InvalidNameError StorePathName)
-> (Text -> Text) -> Text -> Either InvalidNameError StorePathName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
Data.Text.drop Int
1 (Text -> Either InvalidNameError StorePathName)
-> Text -> Either InvalidNameError 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' :: [Char]
rootDir' = ShowS
forall a. HasCallStack => [a] -> [a]
init [Char]
rootDir
    expectedRootS :: [Char]
expectedRootS = RawFilePath -> [Char]
Data.ByteString.Char8.unpack (StoreDir -> RawFilePath
unStoreDir StoreDir
expectedRoot)
    storeDir :: Either InvalidPathError [Char]
storeDir =
      if [Char]
expectedRootS [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
rootDir'
        then [Char] -> Either InvalidPathError [Char]
forall a. a -> Either InvalidPathError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
rootDir'
        else InvalidPathError -> Either InvalidPathError [Char]
forall a b. a -> Either a b
Left (InvalidPathError -> Either InvalidPathError [Char])
-> InvalidPathError -> Either InvalidPathError [Char]
forall a b. (a -> b) -> a -> b
$ RootDirMismatch
                      { rdMismatchExpected :: StoreDir
rdMismatchExpected = StoreDir
expectedRoot
                      , rdMismatchGot :: StoreDir
rdMismatchGot = RawFilePath -> StoreDir
StoreDir (RawFilePath -> StoreDir) -> RawFilePath -> StoreDir
forall a b. (a -> b) -> a -> b
$ [Char] -> RawFilePath
Data.ByteString.Char8.pack [Char]
rootDir
                      }
  in
    (InvalidPathError -> Either InvalidPathError StorePath)
-> ([Char] -> Either InvalidPathError StorePath)
-> Either InvalidPathError [Char]
-> Either InvalidPathError StorePath
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either InvalidPathError -> Either InvalidPathError StorePath
forall a b. a -> Either a b
Left (Either InvalidPathError StorePath
-> [Char] -> Either InvalidPathError StorePath
forall a. a -> [Char] -> a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either InvalidPathError StorePath
 -> [Char] -> Either InvalidPathError StorePath)
-> Either InvalidPathError StorePath
-> [Char]
-> Either InvalidPathError StorePath
forall a b. (a -> b) -> a -> b
$ StorePathHashPart -> StorePathName -> StorePath
StorePath (StorePathHashPart -> StorePathName -> StorePath)
-> Either InvalidPathError StorePathHashPart
-> Either InvalidPathError (StorePathName -> StorePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either InvalidPathError StorePathHashPart
hashPart Either InvalidPathError (StorePathName -> StorePath)
-> Either InvalidPathError StorePathName
-> Either InvalidPathError StorePath
forall a b.
Either InvalidPathError (a -> b)
-> Either InvalidPathError a -> Either InvalidPathError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either InvalidPathError StorePathName
name) Either InvalidPathError [Char]
storeDir

-- | Parse `StorePath` from `ByteString`, checking
-- that store directory matches `expectedRoot`.
parsePath
  :: StoreDir -- ^ expected @StoreDir@
  -> ByteString
  -> Either InvalidPathError StorePath
parsePath :: StoreDir -> RawFilePath -> Either InvalidPathError StorePath
parsePath StoreDir
sd = StoreDir -> [Char] -> Either InvalidPathError StorePath
parsePath' StoreDir
sd ([Char] -> Either InvalidPathError StorePath)
-> (RawFilePath -> [Char])
-> RawFilePath
-> Either InvalidPathError StorePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawFilePath -> [Char]
Data.ByteString.Char8.unpack

-- | Parse `StorePath` from `Text`, checking
-- that store directory matches `expectedRoot`.
parsePathFromText
  :: StoreDir -- ^ expected @StoreDir@
  -> Text
  -> Either InvalidPathError StorePath
parsePathFromText :: StoreDir -> Text -> Either InvalidPathError StorePath
parsePathFromText StoreDir
sd = StoreDir -> [Char] -> Either InvalidPathError StorePath
parsePath' StoreDir
sd ([Char] -> Either InvalidPathError StorePath)
-> (Text -> [Char]) -> Text -> Either InvalidPathError StorePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
Data.Text.unpack

-- | Attoparsec @StorePath@ @Parser@
pathParser :: StoreDir -> Parser StorePath
pathParser :: StoreDir -> Parser StorePath
pathParser StoreDir
expectedRoot = do
  let expectedRootT :: Text
expectedRootT =
          [Char] -> Text
Data.Text.pack
        ([Char] -> Text) -> (RawFilePath -> [Char]) -> RawFilePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawFilePath -> [Char]
Data.ByteString.Char8.unpack
        (RawFilePath -> Text) -> RawFilePath -> Text
forall a b. (a -> b) -> a -> b
$ StoreDir -> RawFilePath
unStoreDir StoreDir
expectedRoot

  Text
_ <- Text -> Parser Text
Data.Attoparsec.Text.Lazy.string Text
expectedRootT
      Parser Text -> [Char] -> Parser Text
forall i a. Parser i a -> [Char] -> Parser i a
<?> [Char]
"Store root mismatch" -- e.g. /nix/store

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

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

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

  Char
c0 <-
    (Char -> Bool) -> Parser Char
Data.Attoparsec.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 -> [Char] -> Parser Char
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
Data.Attoparsec.Text.Lazy.takeWhile
    Char -> Bool
validStorePathNameChar
      Parser Text -> [Char] -> Parser Text
forall i a. Parser i a -> [Char] -> Parser i a
<?> [Char]
"Path name contains invalid character"

  let name :: Either InvalidPathError StorePathName
name =
        (InvalidNameError -> InvalidPathError)
-> Either InvalidNameError StorePathName
-> Either InvalidPathError StorePathName
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
Data.Bifunctor.first
          InvalidNameError -> InvalidPathError
PathNameInvalid
          (Either InvalidNameError StorePathName
 -> Either InvalidPathError StorePathName)
-> Either InvalidNameError StorePathName
-> Either InvalidPathError StorePathName
forall a b. (a -> b) -> a -> b
$ Text -> Either InvalidNameError StorePathName
mkStorePathName (Text -> Either InvalidNameError StorePathName)
-> Text -> Either InvalidNameError StorePathName
forall a b. (a -> b) -> a -> b
$ Char -> Text -> Text
Data.Text.cons Char
c0 Text
rest
      hashPart :: Either InvalidPathError StorePathHashPart
hashPart =
        ([Char] -> InvalidPathError)
-> (RawFilePath -> StorePathHashPart)
-> Either [Char] RawFilePath
-> Either InvalidPathError StorePathHashPart
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
Data.Bifunctor.bimap
          [Char] -> InvalidPathError
HashDecodingFailure
          RawFilePath -> StorePathHashPart
StorePathHashPart
          Either [Char] RawFilePath
digest

  (InvalidPathError -> Parser StorePath)
-> (StorePath -> Parser StorePath)
-> Either InvalidPathError StorePath
-> Parser StorePath
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    ([Char] -> Parser StorePath
forall a. [Char] -> Parser Text a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser StorePath)
-> (InvalidPathError -> [Char])
-> InvalidPathError
-> Parser StorePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InvalidPathError -> [Char]
forall a. Show a => a -> [Char]
show)
    StorePath -> Parser StorePath
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (StorePathHashPart -> StorePathName -> StorePath
StorePath (StorePathHashPart -> StorePathName -> StorePath)
-> Either InvalidPathError StorePathHashPart
-> Either InvalidPathError (StorePathName -> StorePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either InvalidPathError StorePathHashPart
hashPart Either InvalidPathError (StorePathName -> StorePath)
-> Either InvalidPathError StorePathName
-> Either InvalidPathError StorePath
forall a b.
Either InvalidPathError (a -> b)
-> Either InvalidPathError a -> Either InvalidPathError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either InvalidPathError StorePathName
name)

-- * Utilities for tests

-- | Paths rarely need to be constructed directly.
-- Prefer @parsePath@ or @parsePathFromText@
unsafeMakeStorePath
  :: StorePathHashPart
  -> StorePathName
  -> StorePath
unsafeMakeStorePath :: StorePathHashPart -> StorePathName -> StorePath
unsafeMakeStorePath = StorePathHashPart -> StorePathName -> StorePath
StorePath

-- | Path hash parts rarely need to be constructed directly.
-- Prefer @mkStorePathHashPart@
-- Used by remote store in wire protocol
unsafeMakeStorePathHashPart
  :: ByteString
  -> StorePathHashPart
unsafeMakeStorePathHashPart :: RawFilePath -> StorePathHashPart
unsafeMakeStorePathHashPart = RawFilePath -> StorePathHashPart
StorePathHashPart