mirror of
https://github.com/haskell-nix/hnix-store.git
synced 2024-09-11 18:05:56 +03:00
Fine-grain NarEffects to the perms we care about.
This commit is contained in:
parent
f79ba0f8e0
commit
e5f1c7d9bc
@ -36,12 +36,11 @@ type RawFilePath = BS.ByteString
|
|||||||
|
|
||||||
data NarEffects (m :: * -> *) = NarEffects {
|
data NarEffects (m :: * -> *) = NarEffects {
|
||||||
narReadFile :: RawFilePath -> m BSL.ByteString
|
narReadFile :: RawFilePath -> m BSL.ByteString
|
||||||
, narWriteFile :: RawFilePath -> BSL.ByteString -> m ()
|
, narWriteFile :: RawFilePath -> IsExecutable -> BSL.ByteString -> m ()
|
||||||
, narListDir :: RawFilePath -> m [FilePathPart]
|
, narListDir :: RawFilePath -> m [FilePathPart]
|
||||||
, narCreateDir :: RawFilePath -> m ()
|
, narCreateDir :: RawFilePath -> m ()
|
||||||
, narCreateLink :: RawFilePath -> RawFilePath -> m ()
|
, narCreateLink :: RawFilePath -> RawFilePath -> m ()
|
||||||
, narGetPerms :: RawFilePath -> m Permissions
|
, narIsExec :: RawFilePath -> m IsExecutable
|
||||||
, narSetPerms :: RawFilePath -> Permissions -> m ()
|
|
||||||
, narIsDir :: RawFilePath -> m Bool
|
, narIsDir :: RawFilePath -> m Bool
|
||||||
, narIsSymLink :: RawFilePath -> m Bool
|
, narIsSymLink :: RawFilePath -> m Bool
|
||||||
, narFileSize :: RawFilePath -> m Int64
|
, narFileSize :: RawFilePath -> m Int64
|
||||||
@ -214,10 +213,8 @@ localUnpackNar effs basePath (Nar fso) = localUnpackFSO basePath fso
|
|||||||
|
|
||||||
localUnpackFSO basePath fso = case fso of
|
localUnpackFSO basePath fso = case fso of
|
||||||
|
|
||||||
Regular isExec _ bs -> do
|
Regular isExec _ bs ->
|
||||||
(narWriteFile effs) basePath bs
|
(narWriteFile effs) basePath isExec bs
|
||||||
p <- narGetPerms effs basePath
|
|
||||||
(narSetPerms effs) basePath (p {executable = isExec == Executable})
|
|
||||||
|
|
||||||
SymLink targ -> narCreateLink effs targ basePath
|
SymLink targ -> narCreateLink effs targ basePath
|
||||||
|
|
||||||
@ -237,14 +234,10 @@ localPackNar effs basePath = Nar <$> localPackFSO basePath
|
|||||||
fType <- (,) <$> narIsDir effs path' <*> narIsSymLink effs path'
|
fType <- (,) <$> narIsDir effs path' <*> narIsSymLink effs path'
|
||||||
case fType of
|
case fType of
|
||||||
(_, True) -> SymLink <$> narReadLink effs path'
|
(_, True) -> SymLink <$> narReadLink effs path'
|
||||||
(False, _) -> Regular <$> isExecutable effs path'
|
(False, _) -> Regular <$> narIsExec effs path'
|
||||||
<*> narFileSize effs path'
|
<*> narFileSize effs path'
|
||||||
<*> narReadFile effs path'
|
<*> narReadFile effs path'
|
||||||
(True , _) -> fmap (Directory . Map.fromList) $ do
|
(True , _) -> fmap (Directory . Map.fromList) $ do
|
||||||
fs <- narListDir effs path'
|
fs <- narListDir effs path'
|
||||||
forM fs $ \fp ->
|
forM fs $ \fp ->
|
||||||
(fp,) <$> localPackFSO (BSC.concat [path', "/", unFilePathPart fp])
|
(fp,) <$> localPackFSO (BSC.concat [path', "/", unFilePathPart fp])
|
||||||
|
|
||||||
isExecutable :: Functor m => NarEffects m -> RawFilePath -> m IsExecutable
|
|
||||||
isExecutable effs fp =
|
|
||||||
bool NonExecutable Executable . executable <$> narGetPerms effs fp
|
|
||||||
|
@ -36,17 +36,21 @@ import System.Nix.Nar
|
|||||||
import System.Posix.Files (createSymbolicLink, fileSize, getFileStatus,
|
import System.Posix.Files (createSymbolicLink, fileSize, getFileStatus,
|
||||||
isDirectory, readSymbolicLink)
|
isDirectory, readSymbolicLink)
|
||||||
import System.Directory
|
import System.Directory
|
||||||
|
import Data.Bool (bool)
|
||||||
|
|
||||||
-- TODO: Move this to a unix-backed effects library
|
-- TODO: Move this to a unix-backed effects library
|
||||||
narEffectsIO :: NarEffects IO
|
narEffectsIO :: NarEffects IO
|
||||||
narEffectsIO = NarEffects {
|
narEffectsIO = NarEffects {
|
||||||
narReadFile = BSL.readFile . BSC.unpack
|
narReadFile = BSL.readFile . BSC.unpack
|
||||||
, narWriteFile = BSL.writeFile . BSC.unpack
|
, narWriteFile = \f e c -> do
|
||||||
|
let f' = BSC.unpack f
|
||||||
|
BSL.writeFile f' c
|
||||||
|
p <- getPermissions f'
|
||||||
|
setPermissions f' (p { executable = e == Executable})
|
||||||
, narListDir = (fmap (map (FilePathPart . BSC.pack))) . listDirectory . BSC.unpack
|
, narListDir = (fmap (map (FilePathPart . BSC.pack))) . listDirectory . BSC.unpack
|
||||||
, narCreateDir = createDirectory . BSC.unpack
|
, narCreateDir = createDirectory . BSC.unpack
|
||||||
, narCreateLink = (. BSC.unpack) . createSymbolicLink . BSC.unpack
|
, narCreateLink = (. BSC.unpack) . createSymbolicLink . BSC.unpack
|
||||||
, narGetPerms = getPermissions . BSC.unpack
|
, narIsExec = (fmap (bool NonExecutable Executable . executable)) . getPermissions . BSC.unpack
|
||||||
, narSetPerms = setPermissions . BSC.unpack
|
|
||||||
, narIsDir = fmap isDirectory <$> getFileStatus . BSC.unpack
|
, narIsDir = fmap isDirectory <$> getFileStatus . BSC.unpack
|
||||||
, narIsSymLink = pathIsSymbolicLink . BSC.unpack
|
, narIsSymLink = pathIsSymbolicLink . BSC.unpack
|
||||||
, narFileSize = fmap (fromIntegral . fileSize) <$> getFileStatus . BSC.unpack
|
, narFileSize = fmap (fromIntegral . fileSize) <$> getFileStatus . BSC.unpack
|
||||||
|
Loading…
Reference in New Issue
Block a user