{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE TypeInType #-}
module System.Nix.Internal.StorePath where
import System.Nix.Hash ( HashAlgorithm
( Truncated
, SHA256
)
, Digest
, BaseEncoding(..)
, encodeInBase
, decodeBase
, SomeNamedDigest
)
import qualified System.Nix.Internal.Base32 as Nix.Base32
( digits32 )
import Data.ByteString ( ByteString )
import qualified Data.ByteString.Char8 as Bytes.Char8
import qualified Data.Char as Char
import Data.Text ( Text )
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
( encodeUtf8 )
import Data.Attoparsec.Text.Lazy ( Parser
, (<?>)
)
import qualified Data.Attoparsec.Text.Lazy as Parser.Text.Lazy
import qualified System.FilePath as FilePath
import Data.Hashable ( Hashable(..) )
import Data.HashSet ( HashSet )
data StorePath = StorePath
{
StorePath -> Digest StorePathHashAlgo
storePathHash :: !(Digest StorePathHashAlgo)
,
StorePath -> StorePathName
storePathName :: !StorePathName
,
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
Digest StorePathHashAlgo
StorePathName
storePathRoot :: FilePath
storePathName :: StorePathName
storePathHash :: Digest StorePathHashAlgo
storePathRoot :: StorePath -> FilePath
storePathName :: StorePath -> StorePathName
storePathHash :: StorePath -> Digest StorePathHashAlgo
..} =
Int
s Int -> Digest StorePathHashAlgo -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Digest StorePathHashAlgo
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
newtype StorePathName = StorePathName
{
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)
type StorePathHashAlgo = 'Truncated 20 '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 FilePath StorePathName
makeStorePathName Text
n =
if Text -> Bool
validStorePathName Text
n
then StorePathName -> Either FilePath StorePathName
forall a b. b -> Either a b
Right (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
, Char -> Bool
Char.isAsciiUpper
, Char -> Bool
Char.isDigit
, (Char -> FilePath -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (FilePath
"+-._?=" :: String))
]
type RawFilePath = ByteString
storePathToRawFilePath :: StorePath -> RawFilePath
storePathToRawFilePath :: StorePath -> ByteString
storePathToRawFilePath StorePath{FilePath
Digest StorePathHashAlgo
StorePathName
storePathRoot :: FilePath
storePathName :: StorePathName
storePathHash :: Digest StorePathHashAlgo
storePathRoot :: StorePath -> FilePath
storePathName :: StorePath -> StorePathName
storePathHash :: StorePath -> Digest StorePathHashAlgo
..} =
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
Text.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ BaseEncoding -> Digest StorePathHashAlgo -> Text
forall (a :: HashAlgorithm). BaseEncoding -> Digest a -> Text
encodeInBase BaseEncoding
Base32 Digest StorePathHashAlgo
storePathHash
name :: ByteString
name = Text -> ByteString
Text.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ StorePathName -> Text
unStorePathName StorePathName
storePathName
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
storePathToText :: StorePath -> Text
storePathToText :: StorePath -> Text
storePathToText = FilePath -> Text
Text.pack (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
storePathToNarInfo :: StorePath -> Bytes.Char8.ByteString
storePathToNarInfo :: StorePath -> ByteString
storePathToNarInfo StorePath{FilePath
Digest StorePathHashAlgo
StorePathName
storePathRoot :: FilePath
storePathName :: StorePathName
storePathHash :: Digest StorePathHashAlgo
storePathRoot :: StorePath -> FilePath
storePathName :: StorePath -> StorePathName
storePathHash :: StorePath -> Digest StorePathHashAlgo
..} =
Text -> ByteString
Text.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ BaseEncoding -> Digest StorePathHashAlgo -> Text
forall (a :: HashAlgorithm). BaseEncoding -> Digest a -> Text
encodeInBase BaseEncoding
Base32 Digest StorePathHashAlgo
storePathHash Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".narinfo"
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
digestPart, Text
namePart) = Text -> Text -> (Text, Text)
Text.breakOn Text
"-" (Text -> (Text, Text)) -> Text -> (Text, Text)
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
Text.pack FilePath
fname
digest :: Either FilePath (Digest a)
digest = BaseEncoding -> Text -> Either FilePath (Digest a)
forall (a :: HashAlgorithm).
BaseEncoding -> Text -> Either FilePath (Digest a)
decodeBase BaseEncoding
Base32 Text
digestPart
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' :: FilePath
rootDir' = ShowS
forall a. [a] -> [a]
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 a b. b -> Either a b
Right 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
Digest StorePathHashAlgo -> StorePathName -> FilePath -> StorePath
StorePath (Digest StorePathHashAlgo
-> StorePathName -> FilePath -> StorePath)
-> Either FilePath (Digest StorePathHashAlgo)
-> Either FilePath (StorePathName -> FilePath -> StorePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either FilePath (Digest StorePathHashAlgo)
forall (a :: HashAlgorithm). Either FilePath (Digest a)
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
<*> 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
Text.pack FilePath
expectedRoot)
Parser Text -> FilePath -> Parser Text
forall i a. Parser i a -> FilePath -> Parser i a
<?> FilePath
"Store root mismatch"
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 (Digest StorePathHashAlgo)
digest <-
BaseEncoding -> Text -> Either FilePath (Digest StorePathHashAlgo)
forall (a :: HashAlgorithm).
BaseEncoding -> Text -> Either FilePath (Digest a)
decodeBase BaseEncoding
Base32
(Text -> Either FilePath (Digest StorePathHashAlgo))
-> Parser Text
-> Parser Text (Either FilePath (Digest StorePathHashAlgo))
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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Vector Char
Nix.Base32.digits32)
Parser Text (Either FilePath (Digest StorePathHashAlgo))
-> FilePath
-> Parser Text (Either FilePath (Digest StorePathHashAlgo))
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
(Digest StorePathHashAlgo -> StorePathName -> FilePath -> StorePath
StorePath (Digest StorePathHashAlgo
-> StorePathName -> FilePath -> StorePath)
-> Either FilePath (Digest StorePathHashAlgo)
-> Either FilePath (StorePathName -> FilePath -> StorePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either FilePath (Digest StorePathHashAlgo)
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)