{-# language ConstraintKinds #-}
{-# language RecordWildCards #-}
{-# language GeneralizedNewtypeDeriving #-}
{-# language ScopedTypeVariables #-}
{-# language AllowAmbiguousTypes #-}
{-# language DataKinds #-}
module System.Nix.Internal.StorePath
(
StoreDir(..)
, StorePath(..)
, StorePathName(..)
, StorePathSet
, mkStorePathHashPart
, StorePathHashPart(..)
, ContentAddressableAddress(..)
, NarHashMode(..)
,
makeStorePathName
, validStorePathName
,
storePathToFilePath
, storePathToRawFilePath
, storePathToText
, storePathToNarInfo
,
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
)
data StorePath = StorePath
{
StorePath -> StorePathHashPart
storePathHash :: !StorePathHashPart
,
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
newtype StorePathName = StorePathName
{
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)
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
type StorePathSet = HashSet StorePath
data ContentAddressableAddress
=
Text !(Digest SHA256)
|
Fixed !NarHashMode !SomeNamedDigest
data NarHashMode
=
RegularFile
|
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
, Char -> Bool
Char.isAsciiUpper
, Char -> Bool
Char.isDigit
, (forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` ([Char]
"+-._?=" :: String))
]
type RawFilePath = ByteString
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)
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
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
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
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"
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' :: [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"
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)