haskell-nix/hnix-store
1
1
Fork 0
mirror of https://github.com/haskell-nix/hnix-store.git synced 2024-08-17 13:51:21 +03:00
Code Issues Projects Releases Wiki Activity

Fine-grain NarEffects to the perms we care about.

Browse Source
This commit is contained in:
Shea Levy 2019-03-23 07:39:01 -04:00
parent f79ba0f8e0
commit e5f1c7d9bc
No known key found for this signature in database
GPG Key ID: 5C0BD6957D86FE27
2 changed files with 12 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
hnix-store-core/src/System/Nix/Internal/Nar.hs
View File

@ -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

10
hnix-store-core/tests/NarFormat.hs
View File

@ -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