FileTest.hs

-- |
-- Module      : Coreutils.FileTest
-- Copyright   : (c) 2021 Composewell Technologies
-- License     : Apache-2.0
-- Maintainer  : streamly@composewell.com
-- Stability   : experimental
-- Portability : GHC
--
-- A composable predicate DSL for testing file properties, inspired by the
-- GNU @test@ utility. This module is portable across Linux, macOS, and
-- Windows platforms.
--
-- Predicates can be combined using boolean operators. Multiple composed
-- predicates are evaluated using a single file status query, minimizing
-- system calls and providing better performance than performing each test
-- independently.
--
-- === GNU @test@ Utility Mapping
--
-- This module provides Haskell equivalents for the file-related functionality
-- of the GNU coreutils @test@ utility and the standard POSIX shell
-- style tests such as:
--
-- > [ -d path ]
-- > [ -r path ]
--
-- It offers greater composability and improved performance by allowing
-- multiple predicates to share a single file status query.
--
-- One important difference from the shell utility is that all the predicates
-- except 'doesItExist' raise an exception if the file does not exist so that
-- we can distinguish the cases when the predicate is actually false and when
-- the file does not exist. This is safer and avoids silent bugs.
--
-- String comparison tests provided by GNU @test@ are intentionally omitted,
-- as they can be expressed directly using standard Haskell operators.
--
-- The mapping below makes it straightforward to translate shell scripts
-- using @test@ or @[ ... ]@ file predicates directly into Haskell code.
--
-- The following table shows the correspondence between common GNU @test@
-- file predicates and the predicates provided by this module.
--
-- > test -b file        -> isBlockDevice
-- > test -c file        -> isCharDevice
-- > test -d file        -> isDir
-- > test -e file        -> doesItExist
-- > test -f file        -> isFile
-- > test -g file        -> hasSetGid
-- > test -G file        -> isOwnedByCurrentGroup
-- > test -h file        -> isSymLink
-- > test -k file        -> hasStickyBit
-- > test -L file        -> isSymLink
-- > test -N file        -> modifiedSinceLastAccess
-- > test -O file        -> isOwnedByCurrentUser
-- > test -p file        -> isPipe
-- > test -r file        -> isReadable
-- > test -s file        -> size (> 0)
-- > test -S file        -> isSocket
-- > test -t fd          -> isTerminalFd
-- > test -u file        -> hasSetUid
-- > test -w file        -> isWritable
-- > test -x file        -> isExecutable
--
-- > test file1 -nt file2  -> newerThanFile file2
-- > test file1 -ot file2  -> olderThanFile file2
-- > test file1 -ef file2  -> sameFileAs file2
--
-- Example:
--
-- >>> _ <- test [path|a|] doesItExist
-- >>> _ <- test [path|/usr/bin/ls|] (isReadable `and_` size (> 4096))
-- >>> _ <- test [path|/usr/bin/ls|] (modifyTimeComparedTo [path|reference.txt|] (>))

module Coreutils.FileTest
    (
    -- * File Test Predicate Type
      FileTest

    -- * Running Predicates
    , test
    , testl

    -- * Boolean Predicate Combinators
    , not_
    , and_
    , or_

    -- * Folding Predicates
    , true
    , false
    , and
    , or

    -- * Predicates

    -- ** General
    -- , predicate -- exposes FileStatus
    , doesItExist

    -- ** File Type
    , isDir
    , isFile
    , isSymLink
    , isCharDevice
    , isBlockDevice
    , isPipe
    , isSocket
    -- , isTerminalFd -- XXX needs to be fixed

    -- ** File Mode
    -- | We can define convenience operations by combining multiple elementary
    -- checks, for example:
    --
    -- @
    -- hasOwnerRWX = and [hasOwnerRead, hasOwnerWrite, hasOwnerExec]
    -- @
    --
    -- === Portability Notes
    --
    -- On POSIX systems, this checks the standard Unix permission bits.
    --
    -- On Windows, only select few predicates make sense:
    --
    -- * 'hasOwnerWrite' - returns false if the file is marked read only via attributes.
    -- * 'hasOwnerExec' - returns true based on the file extension: @.bat@, @.cmd@,
    -- @.com@, @.exe@.
    -- * 'hasOwnerRead' - always returns true.
    -- * Group, and Other predicates are same as owner predicates.

    , hasOwnerRead
    , hasOwnerWrite
    , hasOwnerExec

    , hasGroupRead
    , hasGroupWrite
    , hasGroupExec

    , hasOtherRead
    , hasOtherWrite
    , hasOtherExec

    , hasSetUid
    , hasSetGid
    , hasStickyBit

    -- ** File Access (Current User)

    -- XXX currently not working fully well, hasPermissions need to be fixed
    -- for checking acess via all groups.
    --
    -- These have limited use on Windows as windows uses mostly ACLs, only
    -- read only bit is used in modes.

    -- *** Mode based access
    -- | These APIs perform only the file permission mode checks, actual
    -- readability, writability or executability may depend on many other factors
    -- like filesystem mount permissions, access control lists (ACLs) etc. For
    -- more comprehensive checks see: 'isReadable', 'isWritable', 'isExecutable'.
    --
    , isReadableByMode
    , isWritableByMode
    , isExecutableByMode

    -- *** Real Access
    -- | These tests determine whether the file is actually accessible at this
    -- time including file permission mode, ACLs, mount permissions.
    , isReadable
    , isWritable
    , isExecutable

    {-
    -- *** Lock based
    -- | These do not make much sense on posix as posix does not use mandatory
    -- locks.
    , isReadableNow
    , isWritableNow
    , isExecutableNow
    -}

    -- ** File Ownership (Current User)
    {-
    , isOwnedByUserId
    , isOwnedByGroupId
    , isOwnedByUserName
    , isOwnedByGroupName
    -}
    , isOwnedByCurrentUser
    -- , isOwnedByCurrentGroup

    -- ** Hard Links
    , sameFileAs

    -- ** File size
    -- XXX Need convenient size units and conversions (e.g. kB 1, kiB 1, mB 2)
    , size
    , sizeComparedTo
    , largerThanFile
    , smallerThanFile
    , sameSizeAs

    -- ** File times
    -- | 'NominalDiffTime' is time duration specified in seconds possibly
    -- fractional. It has a Num instance so you can specify literals and cast
    -- common types as follows:
    --
    -- >>> let _ = (0.5 :: NominalDiffTime)
    -- >>> let _ = (fromIntegral :: Int -> NominalDiffTime)
    -- >>> let _ = (realToFrac :: Double -> NominalDiffTime)
    -- >>> let _ = (fromInteger :: Integer -> NominalDiffTime)
    --
    -- Unit helpers are convenient to specify time durations:
    --
    -- >>> let _ = modifiedWithin (days 1 + hours 5 + minutes 10 + seconds 20)

    -- XXX These can be moved to the streamly time module.

    -- *** Time units
    , seconds
    , minutes
    , hours
    , days

    -- *** File age
    , modifyAge
    , modifiedWithin
    -- , modifiedOlderThan -- (not_ modifiedWithin) is better
    , accessAge
    , metadataAge

    -- *** File timestamp
    , modifyTime
    , accessTime
    , metadataChangeTime

    -- *** Compare timestamps with file
    , modifyTimeComparedTo
    , olderThanFile
    , newerThanFile
    , accessTimeComparedTo

    -- * Deprecated
    , isExisting
    )
where

import System.Posix.Types (Fd, FileMode)

import qualified System.PosixCompat.Files as Files

#if !defined(CABAL_OS_WINDOWS)
import qualified Coreutils.FileTest.Posix as FileTest
#else
import qualified Coreutils.FileTest.Windows as FileTest
#endif

import Streamly.FileSystem.Path (Path)
import Coreutils.FileTest.Common
import Prelude hiding (and, or)

-- $setup
-- >>> :set -XQuasiQuotes
-- >>> import Prelude hiding (or, and)
-- >>> import Data.Time.Clock (NominalDiffTime)
-- >>> import Data.Time.Clock.POSIX (POSIXTime)
-- >>> import Streamly.FileSystem.Path (path)

-------------------------------------------------------------------------------
-- User and group ownerships
-------------------------------------------------------------------------------

{-
_isOwnedByUserId :: FileTest.Uid -> FileTest
_isOwnedByUserId = FileTest.isOwnedByUserId

_isOwnedByGroupId :: FileTest.Gid -> FileTest
_isOwnedByGroupId = FileTest.isOwnedByGroupId
-}

-- | Unimplemented
_isOwnedByUserName :: String -> FileTest
_isOwnedByUserName = undefined

-- | Unimplemented
_isOwnedByGroupName :: String -> FileTest
_isOwnedByGroupName = undefined

-- | True if the file owner matches the effective user id of the current
-- process.
--
-- On Windows, effective user id means effective SID.
--
-- Like coreutil @test -O file@
isOwnedByCurrentUser :: FileTest
isOwnedByCurrentUser = FileTest.isOwnedByCurrentUser

-- Unix files have a GID and group permission bits. A process has an effective
-- GID (egid) and a list of supplementary groups stored in its credentials.
-- These supplementary groups are typically initialized at login from the
-- user's group memberships and inherited by child processes; they can be
-- changed via setgroups(2), setgid(2), newgrp, or in user namespaces.
--
-- The egid and supplementary groups are used for:
--
-- * Permission checks: if a file's GID matches the egid or any supplementary
--   group, the group permission bits apply. Certain IPC and kernel security
--   checks based on group ownership.
-- * Default group ownership of newly created files (unless overridden by
--   a setgid bit on a directory).
-- * Execution of setgid binaries, which set the process's egid to the
--   file's group. For directories, setgid changes group inheritance semantics.
--
-- Windows files have an associated "group" SID, and process tokens contain
-- a primary group plus a list of group SIDs.
--
--  * file's gSID is not used in access checks; only ACLS determines access.
--  * process token's primary gSID is used as gSID for new files.
--  * there is no setgid concept or equivalent.
--
-- The group SID in Windows exists mainly for POSIX/NFS interoperability, where
-- a file must have a GID for Unix permission semantics.

-- XXX On Windows we can match against the primary group SID of the process
-- token, though it won't mean much in terms of actual implications. But it can
-- still be used for Posix based semantics. But since there are no group based
-- permission bits even returning False is effectively equivalent.

-- | True if file exists and its group matches the effective
-- group id of the current process.
--
-- Like coreutil @test -G file@.
--
-- On Windows effective group id means the primary group SID.
--
{-
isOwnedByCurrentGroup :: FileTest
isOwnedByCurrentGroup = FileTest.isOwnedByCurrentGroup
-}

-------------------------------------------------------------------------------
-- Mode based access
-------------------------------------------------------------------------------

hasPermissions :: (FileMode, FileMode, FileMode) -> FileTest
hasPermissions (user, _group, _other) = withStateM $ \fp st -> do
    isOwner <- testWithStatus fp st isOwnedByCurrentUser
    let checkMode = testWithStatus fp st . hasMode
    if isOwner
    then checkMode user
#if !defined(CABAL_OS_WINDOWS)
    else do
        -- XXX need to check access via other group memberships as well
        isGroup <- testWithStatus fp st FileTest.isOwnedByCurrentGroup
        if isGroup
        then checkMode _group
        else checkMode _other
#else
    else return False
#endif

-- | True if the file mode bits allow the file to be read by the current
-- effective user id.
--
-- On Windows this is always true.
--
-- This does not check the ACLs and other conditions that can make the file
-- unreadable, see 'isReadable' for that.
--
isReadableByMode :: FileTest
isReadableByMode =
    hasPermissions
        (
          Files.ownerReadMode
        , Files.groupReadMode
        , Files.otherReadMode
        )

-- | True if the file mode bits make it writable for the current user.
--
-- On Windows this returns false if the read only flag is set on the file.
--
-- This does not check the ACLs, see 'isWritable' for that.
--
isWritableByMode :: FileTest
isWritableByMode =
    hasPermissions
        (
          Files.ownerWriteMode
        , Files.groupWriteMode
        , Files.otherWriteMode
        )

-- | True if the file mode bits make it executable for the current user.
--
-- On Windows this returns true if it is a directory or if it is a file with an
-- executable extension @.bat@, @.cmd@, @.com@, or @.exe@.
--
-- This does not check the ACLs, see isExecutable for that.
--
isExecutableByMode :: FileTest
isExecutableByMode =
    hasPermissions
        (
          Files.ownerExecuteMode
        , Files.groupExecuteMode
        , Files.otherExecuteMode
        )

-------------------------------------------------------------------------------
-- General access, excluding locks
-------------------------------------------------------------------------------

-- | True if the file is readable by the current process.
--
-- This is a dynamic check and determines the readability of the file at this
-- moment based on the permission checks applied by the kernel (e.g. dynamic
-- group membership based permissions, effective user id, acls).
--
-- Does not consider advisory or mandatory locks.
--
-- Like coreutil @test -r file@
--
isReadable :: FileTest
isReadable = FileTest.isReadable

-- XXX What does "isWritable" mean on windows? Windows has separate write and
-- modify permissions. We can use two separate functions, isWritableData (or
-- just isWritable), isWritableMeta. On unix both will have the same underlying
-- permission.

-- | True if the file is writable by the current process.
--
-- This is a dynamic check and determines the writability of the file at this
-- moment based on the permission checks applied by the kernel (e.g. mount
-- options, dynamic group membership based permissions, effective user id,
-- acls).
--
-- Does not consider advisory or mandatory locks.
--
-- Like coreutil @test -w file@
--
isWritable :: FileTest
isWritable = FileTest.isWritable

-- NOTE: On POSIX: You do NOT need directory read (r) permission to access a
-- known file. You DO need directory execute (x) permission. On Windows, the
-- (r) equivalent is "List Folder" and (x) equivalent is "Traverse Folder". By
-- default, almost all users have: SeChangeNotifyPrivilege ("Bypass traverse
-- checking"), it is a fast path to grant the access compared to giving
-- traverse folder access to everyone and checking it on each directory in the
-- path.

-- | True if the file is executable for the current user.
--
-- Like coreutil @test -x file@ .
--
isExecutable :: FileTest
isExecutable = FileTest.isExecutable

-- | True if the file being tested and the supplied file refer to the same
-- underlying file or directory.
--
-- Like coreutil @test file1 -ef file2@.
--
-- On POSIX systems this compares the device id and inode number. On Windows
-- it compares the volume serial number and file index.
--
-- The supplied file path is dereferenced if it is a symlink.
--
sameFileAs :: Path -> FileTest
sameFileAs = FileTest.sameFileAs

-- | True if the supplied file descriptor refers to a terminal device.
--
-- Equivalent to POSIX @isatty@ and the shell command @test -t fd@.
-- On Windows this checks whether the handle refers to a console device.
_isTerminalFd :: Fd -> FileTest
_isTerminalFd = FileTest.isTerminalFd