diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,11 @@ # Revision history for Z-IO +## 0.8.1.0 -- 2020-04-25 + +* Add `getInterface` to `Z.IO.Network`. +* `mkstemp` now return opend file, the type changed to `mkstemp :: CBytes -> CBytes -> Bool -> Resource (CBytes, File)`, which has an option for keep file or not. +* `initTempFile` and `initTempDir` now do not need a prefix argument, the prefix is hardcoded as `Z-IO-`. + ## 0.8.0.0 -- 2020-04-25 This is an experimental version to test new 'BIO' module. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -6,6 +6,9 @@ [![Windows Build Status](https://github.com/ZHaskell/z-io/workflows/win-ci/badge.svg)](https://github.com/ZHaskell/z-io/actions) [![Docker Build Status](https://github.com/ZHaskell/z-io/workflows/docker-ci/badge.svg)](https://github.com/ZHaskell/z-io/actions) [![Gitter chat](https://badges.gitter.im/gitterHQ/gitter.svg)](https://gitter.im/Z-Haskell/community) + + + This package is part of [Z.Haskell](https://z.haskell.world) project, provides basic IO operations: diff --git a/Z-IO.cabal b/Z-IO.cabal --- a/Z-IO.cabal +++ b/Z-IO.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: Z-IO -version: 0.8.0.0 +version: 0.8.1.0 synopsis: Simple and high performance IO toolkit for Haskell description: Simple and high performance IO toolkit for Haskell, including diff --git a/Z/IO/BIO.hs b/Z/IO/BIO.hs --- a/Z/IO/BIO.hs +++ b/Z/IO/BIO.hs @@ -42,6 +42,11 @@ -- run 'zcat "test.gz" | base64 -d' will give you original file @ +This module is intended to be imported qualified: +@ +import Z.IO.BIO (BIO, Source, Sink) +import qualified Z.IO.BIO as BIO +@ -} module Z.IO.BIO ( -- * The BIO type @@ -57,6 +62,7 @@ , runBlocks, runBlocks_, unsafeRunBlocks -- * Make new BIO , pureBIO, ioBIO + , filter, filterM -- ** Source , initSourceFromFile , initSourceFromFile' @@ -87,8 +93,9 @@ , consumedNode ) where +import Prelude hiding (filter) import Control.Concurrent.MVar -import Control.Monad +import Control.Monad hiding (filterM) import Control.Monad.IO.Class import Data.Bits ((.|.)) import Data.IORef @@ -476,6 +483,26 @@ ioBIO f = \ k x -> case x of Just x' -> f x' >>= k . Just _ -> k EOF + +-- | BIO node from a pure filter. +-- +-- BIO node made with this funtion are stateless, thus can be reused across chains. +filter :: (a -> Bool) -> BIO a a +filter f k = go + where + go (Just a) = when (f a) $ k (Just a) + go Nothing = k Nothing + +-- | BIO node from an impure filter. +-- +-- BIO node made with this funtion may not be stateless, it depends on if the IO function use +filterM :: (a -> IO Bool) -> BIO a a +filterM f k = go + where + go (Just a) = do + mbool <- f a + when mbool $ k (Just a) + go Nothing = k Nothing -- | Make a chunk size divider. -- diff --git a/Z/IO/FileSystem/Base.hs b/Z/IO/FileSystem/Base.hs --- a/Z/IO/FileSystem/Base.hs +++ b/Z/IO/FileSystem/Base.hs @@ -297,7 +297,7 @@ unlink path = throwUVIfMinus_ (withCBytesUnsafe path hs_uv_fs_unlink) --- | Equivalent to +-- | Equivalent to -- -- Creates a temporary directory in the most secure manner possible. -- There are no race conditions in the directory’s creation. @@ -316,14 +316,32 @@ throwUVIfMinus_ (hs_uv_fs_mkdtemp p size p') return p' --- | Equivalent to -mkstemp :: HasCallStack => CBytes -> IO CBytes -mkstemp template = do - let size = CBytes.length template - CBytes.withCBytesUnsafe template $ \p -> do - (p', _) <- CBytes.allocCBytesUnsafe (size + 7) $ \ p' -> do -- we append "XXXXXX\NUL" in C - throwUVIfMinus_ (hs_uv_fs_mkstemp p size p') - return p' +-- | Equivalent to +-- +-- The file is created with permissions 0600, that is, read plus +-- write for owner only. The returned 'File' provides both +-- read and write access to the file. The file is opened with the +-- 'O_EXCL' flag, guaranteeing that the caller is the process that creates the file. +-- +-- After resource is used, the file will be closed, and removed if keep param is 'False'. +mkstemp :: HasCallStack + => CBytes -- ^ directory where temp file are created. + -> CBytes -- ^ A file path prefix template, no "XXXXXX" needed. + -> Bool -- ^ Keep file after used? + -> Resource (CBytes, File) +mkstemp dir template keep = do + initResource + (do template' <- dir `P.join` template + let !size = CBytes.length template' + CBytes.withCBytesUnsafe template' $ \p -> do + (p', r) <- CBytes.allocCBytesUnsafe (size + 7) $ \ p' -> do -- we append "XXXXXX\NUL" in C + throwUVIfMinus (hs_uv_fs_mkstemp p size p') + closed <- newIORef False + return (p', File (fromIntegral r) closed)) + (\ (p, File r closed) -> do + unless keep (unlink p) + throwUVIfMinus_ (hs_uv_fs_close r) + writeIORef closed True) ------------------------------------------------------------------------------- diff --git a/Z/IO/FileSystem/FilePath.hsc b/Z/IO/FileSystem/FilePath.hsc --- a/Z/IO/FileSystem/FilePath.hsc +++ b/Z/IO/FileSystem/FilePath.hsc @@ -26,13 +26,13 @@ , absolute , relative -- * Extensions - , splitExtension, changeExtension + , splitExtension, changeExtension, dropExtension, takeExtension, hasExtension -- * Path Style , PathStyle(..) , pathStyle , getPathStyle, setPathStyle - , pathSeparator, pathSeparators - , searchPathSeparator, extensionSeparator + , pathSeparator, pathSeparators, isPathSeparator, isExtensionSeparator + , searchPathSeparator, extensionSeparator, isSearchPathSeparator -- * Search path , getSearchPath ) where @@ -105,25 +105,32 @@ -- | Configures which path style is used afterwards. -- -- This function configures which path style is used. --- call to this function is only required if a non-native behaviour is required. +-- call to this function is only required if a non-native behaviour is required. -- The style defaults to 'WindowsStyle' on windows builds and to 'UnixStyle' otherwise. setPathStyle :: PathStyle -> IO () setPathStyle = cwk_path_set_style . pathStyleToEnum_ --- | Get the default character that separates directories. +-- | Get the default character that separates directories. pathSeparator :: IO Word8 pathSeparator = do s <- getPathStyle case s of UnixStyle -> return (#const SLASH) _ -> return (#const BACKSLASH) --- | Get characters that separates directories. +-- | Get characters that separates directories. pathSeparators :: IO [Word8] pathSeparators = do s <- getPathStyle case s of UnixStyle -> return [(#const SLASH)] _ -> return [(#const SLASH), (#const BACKSLASH)] +-- | Test if a character is a path separator. +isPathSeparator :: Word8 -> IO Bool +isPathSeparator w = do + s <- getPathStyle + case s of UnixStyle -> return (w == #const SLASH) + _ -> return (w == #const BACKSLASH) + -- | The character that is used to separate the entries in the $PATH environment variable. -- -- * Windows: searchPathSeparator is ASCII @;@ @@ -135,12 +142,22 @@ case s of UnixStyle -> return (#const COLON) _ -> return (#const SEMICOLON) +-- | Test if a character is a file separator. +isSearchPathSeparator :: Word8 -> IO Bool +isSearchPathSeparator w = do + w' <- searchPathSeparator + return (w == w') + -- | File extension character -- -- ExtSeparator is ASCII @.@ extensionSeparator :: Word8 extensionSeparator = #const DOT +-- | Test if a character is a file extension separator. +isExtensionSeparator :: Word8 -> Bool +isExtensionSeparator = (== #const DOT) + -- | Get the basename of a file path. -- -- The basename is the last segment of a path. For instance, @logs@ is the basename of the path @\/var\/logs@. @@ -231,7 +248,7 @@ -- | WINDOWS | ..\\hello\\world.txt | "" | -- +---------+--------------------------+----------------------+ -- -splitRoot :: CBytes +splitRoot :: CBytes -> IO (CBytes, CBytes) -- ^ return (root, rest path) {-# INLINABLE splitRoot #-} splitRoot p = do @@ -506,8 +523,8 @@ -- -- This function generates a relative path based on a base path and another path. -- It determines how to get to the submitted path, starting from the base directory. --- --- Note the two arguments must be both absolute or both relative, otherwise an 'InvalidArgument' +-- +-- Note the two arguments must be both absolute or both relative, otherwise an 'InvalidArgument' -- will be thrown. -- -- +---------+--------------------------+--------------------------+-----------------+ @@ -554,6 +571,56 @@ -- -- This function extracts the extension portion of a file path. -- +-- +----------------------------+------------------------------------+ +-- | Path | Result | +-- +----------------------------+------------------------------------+ +-- | \/my\/path.txt | (\/my\/path, .txt) | +-- +----------------------------+------------------------------------+ +-- | \/my\/path | (\/my\/path, "") | +-- +----------------------------+------------------------------------+ +-- | \/my\/.ext | (\/my\/, .ext) | +-- +----------------------------+------------------------------------+ +-- | \/my\/path. | (\/my\/path, .) | +-- +----------------------------+------------------------------------+ +-- | \/my\/path.abc.txt.tests | (\/my\/path.abc.txt, .tests) | +-- +----------------------------+------------------------------------+ +-- +splitExtension :: CBytes -- ^ file path + -> IO (CBytes, CBytes) -- ^ return (file, ext) +{-# INLINABLE splitExtension #-} +splitExtension p = do + (len ,off) <- withCBytesUnsafe p $ \ pp -> + allocPrimUnsafe $ \ plen -> + hs_cwk_path_get_extension pp plen + if off == -1 + then return (p, CB.empty) + else return ( CB (V.PrimVector (CB.rawPrimArray p) 0 off) + , CB (V.PrimVector (CB.rawPrimArray p) off len)) + +-- | Remove the last extension and its correspondence \".\" of a file path. +-- +-- +----------------------------+--------------------+ +-- | Path | Result | +-- +----------------------------+--------------------+ +-- | \/my\/path.txt | \/my\/path | +-- +----------------------------+--------------------+ +-- | \/my\/path | \/my\/path | +-- +----------------------------+------- ------------+ +-- | \/my\/.ext | \/my\/ | +-- +----------------------------+--------------------+ +-- | \/my\/path. | \/my\/path | +-- +----------------------------+--------------------+ +-- | \/my\/path.abc.txt.tests | \/my\/path.abc.txt | +-- +----------------------------+--------------------+ +-- +dropExtension :: CBytes -- ^ file path + -> IO CBytes +{-# INLINE dropExtension #-} +dropExtension p = fst <$> splitExtension p + +-- | Get the extension of a file from a file path, returns @\"\"@ for no +-- extension, @.ext@ otherwise. +-- -- +----------------------------+------------+ -- | Path | Result | -- +----------------------------+------------+ @@ -568,18 +635,18 @@ -- | \/my\/path.abc.txt.tests | .tests | -- +----------------------------+------------+ -- -splitExtension :: CBytes - -> IO (CBytes, CBytes) -- ^ return (file, ext) -{-# INLINABLE splitExtension #-} -splitExtension p = do - (len ,off) <- withCBytesUnsafe p $ \ pp -> - allocPrimUnsafe $ \ plen -> - hs_cwk_path_get_extension pp plen - if off == -1 - then return (p, CB.empty) - else return ( CB (V.PrimVector (CB.rawPrimArray p) 0 off) - , CB (V.PrimVector (CB.rawPrimArray p) off len)) +takeExtension :: CBytes -- ^ file path + -> IO CBytes +{-# INLINE takeExtension #-} +takeExtension p = snd <$> splitExtension p +-- | Test if a file from a file path has an extension. +hasExtension :: CBytes -- ^ file path + -> IO Bool +hasExtension p = do + withCBytesUnsafe p $ \ p' -> + cwk_path_has_extension p' + -- | Changes the extension of a file path. -- -- This function changes the extension of a file name. @@ -640,6 +707,7 @@ foreign import ccall unsafe cwk_path_get_absolute :: BA## Word8 -> BA## Word8 -> MBA## Word8 -> CSize -> IO CSize foreign import ccall unsafe cwk_path_get_relative :: BA## Word8 -> BA## Word8 -> MBA## Word8 -> CSize -> IO CSize foreign import ccall unsafe hs_cwk_path_get_extension :: BA## Word8 -> MBA## CSize -> IO Int +foreign import ccall unsafe cwk_path_has_extension :: BA## Word8 -> IO Bool foreign import ccall unsafe cwk_path_change_extension :: BA## Word8 -> BA## Word8 -> MBA## Word8 -> CSize -> IO CSize foreign import ccall unsafe cwk_path_guess_style :: BA## Word8 -> IO CInt foreign import ccall unsafe cwk_path_get_style :: IO CInt diff --git a/Z/IO/FileSystem/Threaded.hs b/Z/IO/FileSystem/Threaded.hs --- a/Z/IO/FileSystem/Threaded.hs +++ b/Z/IO/FileSystem/Threaded.hs @@ -346,14 +346,32 @@ return p'' -- | Equivalent to -mkstemp :: HasCallStack => CBytes -> IO CBytes -mkstemp template = do - let size = CBytes.length template - CBytes.withCBytesUnsafe template $ \ p -> do - (p'', _) <- CBytes.allocCBytesUnsafe (size+7) $ \ p' -> do -- we append "XXXXXX\NUL" in C - uvm <- getUVManager - withUVRequest_ uvm (hs_uv_fs_mkstemp_threaded p size p') - return p'' +-- +-- The file is created with permissions 0600, that is, read plus +-- write for owner only. The returned 'File' provides both +-- read and write access to the file. The file is opened with the +-- 'O_EXCL' flag, guaranteeing that the caller is the process that creates the file. +-- +-- After resource is used, the file will be closed, and removed if keep param is 'False'. +mkstemp :: HasCallStack + => CBytes -- ^ directory where temp file are created. + -> CBytes -- ^ A file path prefix template, no "XXXXXX" needed. + -> Bool -- ^ Keep file after used? + -> Resource (CBytes, File) +mkstemp dir template keep = do + initResource + (do template' <- dir `P.join` template + let !size = CBytes.length template' + CBytes.withCBytesUnsafe template' $ \ p -> do + (p'', r) <- CBytes.allocCBytesUnsafe (size+7) $ \ p' -> do -- we append "XXXXXX\NUL" in C + uvm <- getUVManager + withUVRequest uvm (hs_uv_fs_mkstemp_threaded p size p') + closed <- newIORef False + return (p'', File (fromIntegral r) closed)) + (\ (p, File r closed) -> do + unless keep (unlink p) + throwUVIfMinus_ (hs_uv_fs_close r) + writeIORef closed True) -- | Equivalent to . -- diff --git a/Z/IO/Network/SocketAddr.hsc b/Z/IO/Network/SocketAddr.hsc --- a/Z/IO/Network/SocketAddr.hsc +++ b/Z/IO/Network/SocketAddr.hsc @@ -41,6 +41,9 @@ , tupleToIPv6Addr , FlowInfo , ScopeID + -- * Interface + , Interface(..) + , getInterface -- * port numbber , PortNumber(..) , portAny @@ -73,12 +76,14 @@ , pokeSocketAddr , peekSocketAddrMBA , pokeSocketAddrMBA + , peekInterface , htons , ntohs , ntohl , htonl ) where +import Control.Monad import Data.Bits import Foreign import Foreign.C @@ -93,6 +98,7 @@ import qualified Z.Data.JSON.Builder as B import qualified Z.Data.Vector as V import qualified Z.Data.Vector.Extra as V +import qualified Z.Data.Vector.Hex as V import Z.IO.Exception import Z.Foreign @@ -579,6 +585,76 @@ pokeMBA p (#offset struct sockaddr_in6, sin6_flowinfo) flow pokeMBA p (#offset struct sockaddr_in6, sin6_addr) (addr) pokeMBA p (#offset struct sockaddr_in6, sin6_scope_id) scope + +-------------------------------------------------------------------------------- + +-- | Data type for interface addresses. +-- +data Interface = Interface + { interfaceName :: {-# UNPACK #-} !CBytes + , interfacePhysAddr :: !V.HexBytes + , interfaceIsInternal :: !Bool + , interfaceAddr :: !SocketAddr + , interfaceMask :: !SocketAddr + } deriving (Eq, Ord, Generic) + deriving anyclass (Print, JSON) + +instance Show Interface where show = T.toString + +peekInterface :: HasCallStack => Ptr Interface -> IO Interface +peekInterface p = do + name' <- fromCString =<< (#peek struct uv_interface_address_s, name) p + phy <- fromPtr (p `plusPtr` (#offset struct uv_interface_address_s, phys_addr)) 6 + is_internal <- (#peek struct uv_interface_address_s, is_internal) p + + family <- (#peek struct uv_interface_address_s, address.address4.sin_family) p + addr' <- case family :: CSaFamily of + (#const AF_INET) -> do + addr <- (#peek struct uv_interface_address_s, address.address4.sin_addr) p + port <- (#peek struct uv_interface_address_s, address.address4.sin_port) p + return (SocketAddrIPv4 addr port) + (#const AF_INET6) -> do + port <- (#peek struct uv_interface_address_s, address.address6.sin6_port) p + flow <- (#peek struct uv_interface_address_s, address.address6.sin6_flowinfo) p + addr <- (#peek struct uv_interface_address_s, address.address6.sin6_addr) p + scope <- (#peek struct uv_interface_address_s, address.address6.sin6_scope_id) p + return (SocketAddrIPv6 addr port flow scope) + _ -> do let errno = UV_EAI_ADDRFAMILY + name <- uvErrName errno + desc <- uvStdError errno + throwUVError errno (IOEInfo name desc callStack) + + family' <- (#peek struct uv_interface_address_s, netmask.netmask4.sin_family) p + mask' <- case family' :: CSaFamily of + (#const AF_INET) -> do + addr <- (#peek struct uv_interface_address_s, netmask.netmask4.sin_addr) p + port <- (#peek struct uv_interface_address_s, netmask.netmask4.sin_port) p + return (SocketAddrIPv4 addr port) + (#const AF_INET6) -> do + port <- (#peek struct uv_interface_address_s, netmask.netmask6.sin6_port) p + flow <- (#peek struct uv_interface_address_s, netmask.netmask6.sin6_flowinfo) p + addr <- (#peek struct uv_interface_address_s, netmask.netmask6.sin6_addr) p + scope <- (#peek struct uv_interface_address_s, netmask.netmask6.sin6_scope_id) p + return (SocketAddrIPv6 addr port flow scope) + _ -> do let errno = UV_EAI_ADDRFAMILY + name <- uvErrName errno + desc <- uvStdError errno + throwUVError errno (IOEInfo name desc callStack) + + return (Interface name' (V.HexBytes phy) (is_internal == (1 :: CInt)) addr' mask') + + +foreign import ccall unsafe uv_interface_addresses :: MBA## (Ptr Interface) -> MBA## CInt -> IO CInt +foreign import ccall unsafe uv_free_interface_addresses :: Ptr Interface -> CInt -> IO () + +-- | Gets address information about the network interfaces on the system. +getInterface :: IO [Interface] +getInterface = bracket + (allocPrimUnsafe @(Ptr Interface) $ \ ppiface -> + fst <$> allocPrimUnsafe @CInt (uv_interface_addresses ppiface)) + (\ (piface, n) -> uv_free_interface_addresses piface n) + (\ (piface, n) -> forM [0..n-1] $ \ i -> + peekInterface (piface `plusPtr` (fromIntegral i * (#size struct uv_interface_address_s)))) -------------------------------------------------------------------------------- -- Port Numbers diff --git a/include/fs_shared.hs b/include/fs_shared.hs --- a/include/fs_shared.hs +++ b/include/fs_shared.hs @@ -137,20 +137,22 @@ -- | Make a temporary file under system 'Env.getTempDir' and automatically clean after used. -- --- >>> withResource (initTempFile "foo") $ printStd --- File 13 +-- This is a shortcut to 'mkstemp', the file name use @Z-IO-@ as prefix, and will be removed after use. -- -initTempFile :: CBytes -> Resource File -initTempFile prefix = - initResource initAction unlink >>= (\f -> initFile f O_RDWR DEFAULT_FILE_MODE) - where - initAction = Env.getTempDir >>= (`P.join` prefix) >>= mkstemp +-- >>> withResource initTempFile $ printStd +-- ("/var/folders/3l/cfdy03vd1gvd1x75gg_js7280000gn/T/Z-IO-bYgZDX",File 13) +-- +initTempFile :: HasCallStack => Resource (CBytes, File) +initTempFile = do + d <- liftIO $ Env.getTempDir + mkstemp d "Z-IO-" False -- | Make a temporary directory under system 'Env.getTempDir' and automatically clean after used. -- --- >>> withResource (initTempDir "foo") $ printStd --- "/tmp/fooxfWR0L" +-- This is a shortcut to 'mkdtemp', the directory name use @Z-IO-@ as prefix, and will be removed(with files within it) after use. -- -initTempDir :: CBytes -> Resource CBytes -initTempDir prefix = - initResource (Env.getTempDir >>= (`P.join` prefix) >>= mkdtemp) rmrf +-- >>> withResource initTempDir $ printStd +-- "/tmp/Z-IO-xfWR0L" +-- +initTempDir :: HasCallStack => Resource CBytes +initTempDir = initResource (Env.getTempDir >>= (`P.join` "Z-IO-") >>= mkdtemp) rmrf