mirror of
https://github.com/haskell-nix/hnix-store.git
synced 2024-08-17 13:51:21 +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 {
|
||||
narReadFile :: RawFilePath -> m BSL.ByteString
|
||||
, narWriteFile :: RawFilePath -> BSL.ByteString -> m ()
|
||||
, narWriteFile :: RawFilePath -> IsExecutable -> BSL.ByteString -> m ()
|
||||
, narListDir :: RawFilePath -> m [FilePathPart]
|
||||
, narCreateDir :: RawFilePath -> m ()
|
||||
, narCreateLink :: RawFilePath -> RawFilePath -> m ()
|
||||
, narGetPerms :: RawFilePath -> m Permissions
|
||||
, narSetPerms :: RawFilePath -> Permissions -> m ()
|
||||
, narIsExec :: RawFilePath -> m IsExecutable
|
||||
, narIsDir :: RawFilePath -> m Bool
|
||||
, narIsSymLink :: RawFilePath -> m Bool
|
||||
, narFileSize :: RawFilePath -> m Int64
|
||||
@ -214,10 +213,8 @@ localUnpackNar effs basePath (Nar fso) = localUnpackFSO basePath fso
|
||||
|
||||
localUnpackFSO basePath fso = case fso of
|
||||
|
||||
Regular isExec _ bs -> do
|
||||
(narWriteFile effs) basePath bs
|
||||
p <- narGetPerms effs basePath
|
||||
(narSetPerms effs) basePath (p {executable = isExec == Executable})
|
||||
Regular isExec _ bs ->
|
||||
(narWriteFile effs) basePath isExec bs
|
||||
|
||||
SymLink targ -> narCreateLink effs targ basePath
|
||||
|
||||
@ -237,14 +234,10 @@ localPackNar effs basePath = Nar <$> localPackFSO basePath
|
||||
fType <- (,) <$> narIsDir effs path' <*> narIsSymLink effs path'
|
||||
case fType of
|
||||
(_, True) -> SymLink <$> narReadLink effs path'
|
||||
(False, _) -> Regular <$> isExecutable effs path'
|
||||
(False, _) -> Regular <$> narIsExec effs path'
|
||||
<*> narFileSize effs path'
|
||||
<*> narReadFile effs path'
|
||||
(True , _) -> fmap (Directory . Map.fromList) $ do
|
||||
fs <- narListDir effs path'
|
||||
forM fs $ \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,
|
||||
isDirectory, readSymbolicLink)
|
||||
import System.Directory
|
||||
import Data.Bool (bool)
|
||||
|
||||
-- TODO: Move this to a unix-backed effects library
|
||||
narEffectsIO :: NarEffects IO
|
||||
narEffectsIO = NarEffects {
|
||||
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
|
||||
, narCreateDir = createDirectory . BSC.unpack
|
||||
, narCreateLink = (. BSC.unpack) . createSymbolicLink . BSC.unpack
|
||||
, narGetPerms = getPermissions . BSC.unpack
|
||||
, narSetPerms = setPermissions . BSC.unpack
|
||||
, narIsExec = (fmap (bool NonExecutable Executable . executable)) . getPermissions . BSC.unpack
|
||||
, narIsDir = fmap isDirectory <$> getFileStatus . BSC.unpack
|
||||
, narIsSymLink = pathIsSymbolicLink . BSC.unpack
|
||||
, narFileSize = fmap (fromIntegral . fileSize) <$> getFileStatus . BSC.unpack
|
||||
|
Loading…
Reference in New Issue
Block a user