Z-IO 0.1.3.0 → 0.1.4.0

raw patch · 32 files changed

+1125/−545 lines, 32 filesdep ~Z-Datasetup-changedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: Z-Data

API changes (from Hackage documentation)

Files

• ChangeLog.md +9/−0
• README.md +16/−17
• Setup.hs +0/−2
• Z-IO.cabal +41/−5
• Z/Compression/Zlib.hsc +24/−31
• Z/IO/Buffered.hs +0/−7
• Z/IO/Environment.hs +209/−0
• Z/IO/Exception.hs +20/−12
• Z/IO/FileSystem.hs +46/−51
• Z/IO/FileSystem/Threaded.hs +49/−48
• Z/IO/Logger.hs +111/−66
• Z/IO/LowResTimer.hs +0/−4
• Z/IO/Network/DNS.hsc +6/−10
• Z/IO/Network/IPC.hs +4/−9
• Z/IO/Network/SocketAddr.hsc +26/−44
• Z/IO/Network/TCP.hs +23/−14
• Z/IO/Network/UDP.hs +50/−46
• Z/IO/Resource.hs +0/−4
• Z/IO/StdStream.hs +5/−11
• Z/IO/UV/Errno.hsc +5/−5
• Z/IO/UV/FFI.hsc +277/−126
• Z/IO/UV/Manager.hs +6/−11
• Z/IO/UV/Win.hs +0/−1
• cbits/hs_uv_base.c +31/−0
• cbits/hs_uv_file.c +21/−0
• cbits/hs_uv_udp.c +46/−7
• cbits/hs_zlib.c +9/−0
• include/hs_uv.h +16/−3
• test/Z/IO/LowResTimerSpec.hs +1/−1
• test/Z/IO/Network/TCPSpec.hs +1/−7
• test/Z/IO/Network/UDPSpec.hs +16/−3
• third_party/libuv/src/unix/random-getentropy.c +57/−0

@@ -1,5 +1,14 @@ # Revision history for Z-IO +## 0.1.4.0  -- 2020-10-02++* Add `Z.IO.Environment` module.+* Add various instances to data types in `Z.IO.UV.FFI`.+* Fix a UDP batch receiving bug.+* Remove `UV` prefix in config data types(`Z.IO.FileSystem`, `Z.IO.UDP`).+* Change `TCP`, `IPC` server config, move server worker to start params instead of config.+* `Logger` type rework, colorful logger are possible.+ ## 0.1.3.0  -- 2020-09-28 * Rename `newBufferedInput/Output` to `newBufferedInput'/Output'`, add default chunk `newBufferedInput/Output`. * Remove `ghc-pirm` depends.

@@ -36,27 +36,26 @@ > import qualified Z.Data.Text as T > -- send a simple HTTP request > :{-| let addr = SocketAddrInet 80 (tupleToInetAddr (13,107,21,200))-| -- addr = ipv4 "13.107.21.200" 80-| in withResource (initTCPClient defaultTCPClientConfig{ tcpRemoteAddr = addr}) $ \ tcp -> do-|     i <- newBufferedInput tcp -|     o <- newBufferedOutput tcp-|     writeBuffer o "GET http://www.bing.com HTTP/1.1\r\nHost: www.bing.com\r\n\r\n"-|     flushBuffer o-|     readBuffer i >>= pure . T.validate-| :}+let addr = SocketAddrInet 80 (tupleToInetAddr (13,107,21,200))+-- addr = ipv4 "13.107.21.200" 80+in withResource (initTCPClient defaultTCPClientConfig{ tcpRemoteAddr = addr}) $ \ tcp -> do+    i <- newBufferedInput tcp +    o <- newBufferedOutput tcp+    writeBuffer o "GET http://www.bing.com HTTP/1.1\r\nHost: www.bing.com\r\n\r\n"+    flushBuffer o+    readBuffer i >>= pure . T.validate+:} "HTTP/1.1 200 OK\r\nDate: Sat, 19 Sep 2020 06:11:08 GMT\r\nContent-Length: 0\r\n\r\n" > > -- Start a TCP echo server, use @nc -v localhost 8080@ to test > :{-| startTCPServer defaultTCPServerConfig{-| tcpListenAddr = SocketAddrInet 8080 inetLoopback,-| tcpServerWorker = \ tcp -> do-|     i <- newBufferedInput tcp -|     o <- newBufferedOutput tcp-|     forever $ readBuffer i >>= writeBuffer o >> flushBuffer o-| }-| :}+startTCPServer defaultTCPServerConfig{ +    tcpListenAddr = SocketAddrInet 8080 inetLoopback} $ \ tcp -> do+        i <- newBufferedInput tcp +        o <- newBufferedOutput tcp+        forever $ readBuffer i >>= writeBuffer o >> flushBuffer o+}+:} ```  ## Dev guide

@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain

@@ -1,6 +1,6 @@ cabal-version:              2.4 name:                       Z-IO-version:                    0.1.3.0+version:                    0.1.4.0 synopsis:                   Simple and high performance IO toolkit for Haskell description:                Simple and high performance IO toolkit for Haskell, including                             file system, network, ipc and more!@@ -100,16 +100,54 @@                             Z.IO.UV.Manager                             Z.IO.UV.Win +                            Z.IO.Environment+                             Z.Compression.Zlib      build-depends:          base                    >= 4.12 && <5.0-                          , Z-Data                  >= 0.1.4+                          , Z-Data                  >= 0.1.6 && <0.1.7                           , primitive               >= 0.7.1 && < 0.7.2                           , exceptions              == 0.10.*                           , time                    >= 1.8 && < 2.0                           , stm                     == 2.5.*      default-language:       Haskell2010+    default-extensions:     BangPatterns+                            CApiFFI+                            ConstraintKinds+                            CPP +                            DerivingStrategies+                            DeriveGeneric+                            DeriveAnyClass+                            DefaultSignatures+                            DataKinds+                            ExistentialQuantification+                            FlexibleContexts+                            FlexibleInstances+                            GeneralizedNewtypeDeriving +                            KindSignatures+                            MagicHash+                            MultiParamTypeClasses+                            MultiWayIf+                            PartialTypeSignatures+                            PatternSynonyms +                            PolyKinds+                            QuantifiedConstraints+                            QuasiQuotes+                            OverloadedStrings+                            RankNTypes+                            RecordWildCards+                            ScopedTypeVariables +                            StandaloneDeriving+                            TemplateHaskell+                            TypeApplications+                            TypeFamilyDependencies+                            TypeFamilies+                            TypeOperators+                            TupleSections+                            UnboxedTuples +                            UnliftedFFITypes +                            ViewPatterns     build-tool-depends:     hsc2hs:hsc2hs, hspec-discover:hspec-discover     ghc-options:            -Wall @@ -273,7 +311,7 @@                                     third_party/libuv/src/unix/fsevents.c                                     third_party/libuv/src/unix/kqueue.c                                     third_party/libuv/src/unix/proctitle.c-                                    third_party/libuv/src/unix/random-getrandom.c+                                    third_party/libuv/src/unix/random-getentropy.c                                                     include-dirs:       third_party/libuv/include                                     third_party/libuv/src/unix@@ -286,8 +324,6 @@                 else                     pkgconfig-depends:  libuv >= 1.32         -- test-suite Z-IO-Test     type:                   exitcode-stdio-1.0     main-is:                Spec.hs

@@ -1,13 +1,3 @@-{-# LANGUAGE PatternSynonyms #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE UnliftedFFITypes #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}- {-| Module      : Z.Compression.Zlib Description : The zlib@@ -44,18 +34,20 @@ import           Data.Word import           Foreign            hiding (void) import           Foreign.C-import           GHC.Stack+import           GHC.Generics import           System.IO.Unsafe   (unsafePerformIO) import           Z.Data.Array       as A import           Z.Data.CBytes      as CBytes import           Z.Data.Vector.Base as V+import           Z.Data.Text.ShowT  (ShowT) import           Z.Foreign import           Z.IO.Buffered import           Z.IO.Exception  #include "zlib.h" -newtype Strategy = Strategy CInt deriving (Eq, Ord, Show, Typeable)+newtype Strategy = Strategy CInt deriving (Eq, Ord, Show, Generic)+                                    deriving anyclass ShowT  pattern Z_FILTERED           :: Strategy pattern Z_HUFFMAN_ONLY       :: Strategy@@ -69,7 +61,8 @@ pattern Z_DEFAULT_STRATEGY   = Strategy (#const Z_DEFAULT_STRATEGY)  -newtype CompressLevel = CompressLevel CInt deriving (Eq, Ord, Show, Typeable)+newtype CompressLevel = CompressLevel CInt deriving (Eq, Ord, Show, Generic)+                                            deriving anyclass ShowT  -- pattern Z_NO_COMPRESSION       =  CompressLevel (#const Z_NO_COMPRESSION     ) pattern Z_BEST_SPEED          :: CompressLevel@@ -85,14 +78,18 @@ windowBits can also be greater than 15 for optional gzip decoding. Add 32 to windowBits to enable zlib and gzip decoding with automatic header detection, or add 16 to decode only the gzip format. -} newtype WindowBits = WindowBits CInt-    deriving (Eq, Ord, Read, Show, Num, Typeable)+    deriving (Eq, Ord, Read, Show, Generic)+        deriving newtype Num+        deriving anyclass ShowT  defaultWindowBits :: WindowBits defaultWindowBits = WindowBits 15  -- | The 'MemLevel' specifies how much memory should be allocated for the internal compression state. 1 uses minimum memory but is slow and reduces compression ratio; 9 uses maximum memory for optimal speed. The default value is 8. newtype MemLevel = MemLevel CInt-    deriving (Eq, Ord, Read, Show, Num, Typeable)+    deriving (Eq, Ord, Read, Show, Generic)+        deriving newtype Num+        deriving anyclass ShowT  defaultMemLevel :: MemLevel defaultMemLevel = MemLevel 9@@ -101,14 +98,14 @@     { compressLevel :: CompressLevel     , compressWindowBits :: WindowBits     , compressMemoryLevel :: MemLevel-    , compressDictionary :: CBytes+    , compressDictionary :: V.Bytes     , compressStrategy :: Strategy     }  defaultCompressConfig :: CompressConfig defaultCompressConfig =     CompressConfig Z_DEFAULT_COMPRESSION  defaultWindowBits-        defaultMemLevel CBytes.empty Z_DEFAULT_STRATEGY+        defaultMemLevel V.empty Z_DEFAULT_STRATEGY  -- | Compress all the data written to a output. --@@ -124,9 +121,9 @@      withForeignPtr zs $ \ ps -> do         throwZlibIfMinus_ $ deflate_init2 ps level windowBits memLevel strategy-        unless (CBytes.null dict) $-            throwZlibIfMinus_ . withCBytes dict $ \ pdict ->-            deflateSetDictionary ps pdict (fromIntegral $ CBytes.length dict)+        unless (V.null dict) $+            throwZlibIfMinus_ . withPrimVectorUnsafe dict $ \ pdict off len ->+            deflate_set_dictionary ps pdict off (fromIntegral $ len)      return (zwrite zs bufRef, zflush zs bufRef) @@ -187,11 +184,11 @@  data DecompressConfig = DecompressConfig     { decompressWindowBits :: WindowBits-    , decompressDictionary :: CBytes+    , decompressDictionary :: V.Bytes     }  defaultDecompressConfig :: DecompressConfig-defaultDecompressConfig = DecompressConfig defaultWindowBits CBytes.empty+defaultDecompressConfig = DecompressConfig defaultWindowBits V.empty  -- | Decompress bytes from source. decompressSource :: DecompressConfig@@ -235,9 +232,9 @@                     set_avail_in zs input' (V.length input')                     withForeignPtr zs $ \ ps -> do                         r <- throwZlibIfMinus (inflate ps (#const Z_NO_FLUSH))-                        when (r == (#const Z_NEED_DICT) && not (CBytes.null dict)) $ do-                            throwZlibIfMinus_ . withCBytes dict $ \ pdict ->-                                inflateSetDictionary ps pdict (fromIntegral $ CBytes.length dict)+                        when (r == (#const Z_NEED_DICT) && not (V.null dict)) $ do+                            throwZlibIfMinus_ . withPrimVectorUnsafe dict $ \ pdict off len ->+                                inflate_set_dictionary ps pdict off (fromIntegral len)                     zread zs bufRef                  _ -> zfinish zs bufRef []         else do@@ -314,7 +311,7 @@     deflate_init2 :: Ptr ZStream -> CompressLevel -> WindowBits -> MemLevel -> Strategy -> IO CInt  foreign import ccall unsafe-    deflateSetDictionary :: Ptr ZStream -> CString -> CUInt -> IO CInt+    deflate_set_dictionary :: Ptr ZStream -> BA## Word8 -> Int -> Int -> IO CInt  foreign import ccall unsafe     deflate :: Ptr ZStream -> CInt -> IO CInt@@ -323,14 +320,10 @@     inflate_init2 :: Ptr ZStream -> WindowBits -> IO CInt  foreign import ccall unsafe-    inflateSetDictionary :: Ptr ZStream -> CString -> CUInt -> IO CInt+    inflate_set_dictionary :: Ptr ZStream -> BA## Word8 -> Int -> Int -> IO CInt  foreign import ccall unsafe     inflate :: Ptr ZStream -> CInt -> IO CInt--foreign import ccall unsafe-    inflateEnd :: Ptr ZStream -> IO CInt-  set_avail_in :: ForeignPtr ZStream -> V.Bytes -> Int -> IO () set_avail_in zs buf buflen = do

@@ -1,10 +1,3 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE ImplicitParams #-}-{-# LANGUAGE RankNTypes #-}- {-| Module      : Z.IO.Buffered Description : Buffered IO interface

@@ -0,0 +1,209 @@+{-|+Module      : Z.IO.Environment+Description : Miscellaneous functions(environment variables, metrics, etc.)+Copyright   : (c) Dong Han, 2020+License     : BSD+Maintainer  : winterland1989@gmail.com+Stability   : experimental+Portability : non-portable++This module provide methods for retrieving various environment infomation. There's no encoding guarantee about these information, if you want textual representation, use UTF8 assumption is recommended. i.e. use "Z.Data.Text.validate".++-}+module Z.IO.Environment+  ( -- * arguments+    getArgs+    -- * environment variables+  , getAllEnv+  , getEnv, getEnv'+  , setEnv, unsetEnv+    -- * other environment infos+  , getResUsage+  , getResidentSetMemory+  , getUpTime+  , getHighResolutionTime+  , PID(..)+  , getPID, getPPID+  , getPriority, setPriority+  , pattern PRIORITY_LOW+  , pattern PRIORITY_BELOW_NORMAL+  , pattern PRIORITY_NORMAL+  , pattern PRIORITY_ABOVE_NORMAL+  , pattern PRIORITY_HIGH+  , pattern PRIORITY_HIGHEST+  , getHostname+  , getOSName, OSName(..)+  , getRandom, getRandomT+  ) where++import Control.Monad+import Data.Word+import Z.Data.Vector.Base as V+import Z.Data.CBytes+import Z.Foreign+import Z.IO.Exception+import Z.IO.UV.Errno+import Z.IO.UV.Manager+import Foreign.Storable+import Z.IO.UV.FFI++-- | Computation 'getArgs' returns a list of the program's command+-- line arguments (including the program path).+--+-- This is different from base's 'System.Environment.getArgs' since result+-- includes the program path(more like C's *argv).+getArgs :: IO [CBytes]+getArgs = do+    (argc :: CInt, (p_argv :: Ptr CString, _)) <- allocPrimUnsafe $ \ p_argc -> do+        allocPrimUnsafe $ \ p_p_argv -> do+            getProgArgv p_argc p_p_argv+    forM [0..fromIntegral (argc-1)] $ \ i -> do+        fromCString =<< peekElemOff p_argv i++-- | Retrieves the environment variable.+--+-- Warning: This function is not thread safe.+getAllEnv :: HasCallStack => IO [(CBytes, CBytes)]+getAllEnv = bracket+    (do (p_env :: Ptr CString, (envc :: CInt, _)) <- allocPrimUnsafe $ \ p_p_env -> do+            allocPrimUnsafe $ \ p_envc ->+                throwUVIfMinus_ (uv_os_environ p_p_env p_envc)+        return (p_env, envc))+    (\ (p_env, envc) -> uv_os_free_environ p_env envc)+    (\ (p_env, envc) -> do+        forM [0..fromIntegral (envc-1)] $ \ i -> do+            k <- fromCString =<< peekElemOff p_env (i*2)+            v <- fromCString =<< peekElemOff p_env (i*2+1)+            return (k, v))++-- | Retrieves the environment variable specified by name.+--+-- Warning: This function is not thread safe.+getEnv :: HasCallStack => CBytes -> IO (Maybe CBytes)+getEnv k = go 512+  where+    go siz = do+        (siz', (v, r))<- withPrimUnsafe siz $ \ p_siz ->+            withCBytesUnsafe k $ \ p_k ->+                allocCBytesUnsafe siz $ \ p_v ->+                    uv_os_getenv p_k p_v p_siz+        case r of+            UV_ENOBUFS -> go siz'+            UV_ENOENT -> return Nothing+            _ -> do+                throwUVIfMinus_ (return r)+                return (Just v)++-- | Retrieves the environment variable specified by name, throw 'NoSuchThing' if not exists.+--+-- Warning: This function is not thread safe.+getEnv' :: HasCallStack => CBytes -> IO CBytes+getEnv' k = getEnv k >>= \ mv -> case mv of+    Just v -> return v+    _ -> throwUVError UV_ENOENT (IOEInfo "ENOENT" "no such environment variable" callStack)++-- | Creates or updates the environment variable specified by name with value.+--+-- Warning: This function is not thread safe.+setEnv :: HasCallStack => CBytes -> CBytes -> IO ()+setEnv k v = withCBytesUnsafe k $ \ p_k ->+    withCBytesUnsafe v $ \ p_v ->+        throwUVIfMinus_ (uv_os_setenv p_k p_v)++-- | Deletes the environment variable specified by name if such environment variable exists.+--+-- Warning: This function is not thread safe.+unsetEnv :: HasCallStack => CBytes -> IO ()+unsetEnv k = void . withCBytesUnsafe k $ \ p -> throwUVIfMinus_ (uv_os_unsetenv p)++-- | Gets the resident set size (RSS) for the current process.+getResidentSetMemory :: HasCallStack => IO CSize+getResidentSetMemory = do+    (size, r) <- allocPrimUnsafe uv_resident_set_memory+    throwUVIfMinus_ (return r)+    return size++-- | Gets the current system uptime.+getUpTime :: HasCallStack => IO Double+getUpTime = do+    (size, r) <- allocPrimUnsafe uv_uptime+    throwUVIfMinus_ (return r)+    return size++-- | Returns the current high-resolution real time.+--+-- This is expressed in nanoseconds. It is relative to an arbitrary time in the past.+-- It is not related to the time of day and therefore not subject to clock drift.+-- The primary use is for measuring performance between intervals.+getHighResolutionTime :: IO Word64+getHighResolutionTime = uv_hrtime++-- | Gets the resource usage measures for the current process.+--+--  On Windows not all fields are set, the unsupported fields are filled with zeroes.+--  See 'ResUsage' for more details.+getResUsage :: HasCallStack => IO ResUsage+getResUsage = do+    (MutableByteArray mba#) <- newByteArray sizeOfResUsage+    throwUVIfMinus_ (uv_getrusage mba#)+    peekResUsage mba#++-- | Returns the current process ID.+getPID :: IO PID+getPID = uv_os_getpid++-- | Returns the parent process ID.+getPPID :: IO PID+getPPID = uv_os_getppid++-- | Retrieves the scheduling priority of the process specified by pid.+--+-- The returned value of priority is between -20 (high priority) and 19 (low priority).+-- On Windows, the returned priority will equal one of the PRIORITY constants.+getPriority :: HasCallStack => PID -> IO CInt+getPriority pid = do+    (p, _) <- allocPrimUnsafe $ \ p_p -> throwUVIfMinus_ (uv_os_getpriority pid p_p)+    return p++-- | Sets the scheduling priority of the process specified by pid.+--+-- The priority value range is between -20 (high priority) and 19 (low priority).+-- The constants 'PRIORITY_LOW', 'PRIORITY_BELOW_NORMAL', 'PRIORITY_NORMAL',+-- 'PRIORITY_ABOVE_NORMAL', 'PRIORITY_HIGH', and 'PRIORITY_HIGHEST' are also provided for convenience.+--+setPriority :: HasCallStack => PID -> CInt -> IO ()+setPriority pid p = throwUVIfMinus_ (uv_os_setpriority pid p)++-- | Returns the hostname as a null-terminated string.+--+getHostname :: HasCallStack => IO CBytes+getHostname = do+    (n, _) <- allocCBytesUnsafe (fromIntegral UV_MAXHOSTNAMESIZE) $ \ p_n ->+        withPrimUnsafe UV_MAXHOSTNAMESIZE $ \ p_siz ->+            throwUVIfMinus_ (uv_os_gethostname p_n p_siz)+    return n++-- | Fill buf with exactly buflen cryptographically strong random bytes acquired from the system CSPRNG.+--+-- The function may block indefinitely when not enough entropy is available, don't use it to get+-- long random sequences.+getRandom :: Int -> IO V.Bytes+getRandom siz = do+    (v, _) <- allocPrimVectorUnsafe siz $ \ mba# ->+        throwUVIfMinus_ (hs_uv_random mba# (fromIntegral siz) 0)+    return v++-- | Fill buf with exactly buflen cryptographically strong random bytes acquired from the system CSPRNG.+--+-- The function run 'getRandom' in libuv's threadpool, suitable for get long random byte sequences.+getRandomT :: Int -> IO V.Bytes+getRandomT siz = do+    (v, _) <- allocPrimVectorSafe siz $ \ p -> do+        uvm <- getUVManager+        withUVRequest_ uvm (hs_uv_random_threaded p (fromIntegral siz) 0)+    return v++--------------------------------------------------------------------------------++-- from base+foreign import ccall unsafe getProgArgv :: MBA# CInt -> MBA# (Ptr CString) -> IO ()

@@ -1,11 +1,3 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ScopedTypeVariables #-}- {-| Module      : Z.IO.Exception Description : Extensible IO exceptions@@ -87,7 +79,11 @@ import Foreign.C.Types import GHC.Stack import Z.IO.UV.Errno+import Z.Data.CBytes (CBytes)+import qualified Z.Data.CBytes as CB+import qualified Z.Data.Text.ShowT as T + -- | The root type of all io exceptions, you can catch all io exception by catching this root type. -- data SomeIOException = forall e . Exception e => SomeIOException e@@ -188,17 +184,29 @@  -- | IO exceptions informations. --+-- The 'ShowT' instances does not check if name and description are valid UTF8 string, it's your responsibility+-- to make sure. data IOEInfo = IOEInfo-    { ioeName        :: String      -- ^ the errno name, e.g. EADDRINUSE, etc. empty if no errno.-    , ioeDescription :: String      -- ^ description for this io error, can be errno description, or some custom description if no errno.+    { ioeName        :: CBytes      -- ^ the errno name, e.g. EADDRINUSE, etc. empty if no errno.+    , ioeDescription :: CBytes      -- ^ description for this io error, can be errno description, or some custom description if no errno.     , ioeCallStack   :: CallStack   -- ^ lightweight partial call-stack     }  instance Show IOEInfo where     show (IOEInfo errno desc cstack) =-         "{name:" ++ errno ++-         ", description:" ++ desc +++         "{name:" ++ CB.unpack errno +++         ", description:" ++ CB.unpack desc ++          ", callstack:" ++ prettyCallStack cstack ++ "}"++instance T.ShowT IOEInfo where+    toTextBuilder _ (IOEInfo errno desc cstack) = do+         "{name:"+         T.unsafeFromBuilder(CB.toBuilder errno)  -- we use UTF8 name here+         ", description:"+         T.unsafeFromBuilder (CB.toBuilder desc)+         ", callstack:"+         T.stringUTF8 (prettyCallStack cstack)+         "}"  throwUVError :: CInt -> IOEInfo -> IO a throwUVError e info = case e of

@@ -1,10 +1,3 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE MultiWayIf   #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE ScopedTypeVariables #-}- {-| Module      : Z.IO.FileSystem Description : Filesystem IO@@ -38,19 +31,19 @@   , rmdir   , DirEntType(..)   , scandir-  , UVStat(..), UVTimeSpec(..)+  , FStat(..), UVTimeSpec(..)   , stat, lstat, fstat   , rename   , fsync, fdatasync   , ftruncate-  , UVCopyFileFlag(COPYFILE_DEFAULT, COPYFILE_EXCL, COPYFILE_FICLONE)+  , CopyFileFlag(COPYFILE_DEFAULT, COPYFILE_EXCL, COPYFILE_FICLONE)   , copyfile-  , UVAccessMode(F_OK, R_OK, W_OK, X_OK)+  , AccessMode(F_OK, R_OK, W_OK, X_OK)   , AccessResult(..)   , access   , chmod, fchmod-  , utime, futime-  , UVSymlinkFlag(SYMLINK_DEFAULT, SYMLINK_DIR, SYMLINK_JUNCTION)+  , utime, futime, lutime+  , SymlinkFlag(SYMLINK_DEFAULT, SYMLINK_DIR, SYMLINK_JUNCTION)   , link, symlink   , readlink, realpath   ) where@@ -185,7 +178,7 @@            -> Resource File initFile path flags mode =     initResource-        (do !fd <- withCBytes path $ \ p ->+        (do !fd <- withCBytesUnsafe path $ \ p ->                 throwUVIfMinus $ hs_uv_fs_open p flags mode             File fd <$> newIORef False)         (\ (File fd closedRef) -> do@@ -200,12 +193,12 @@ -- -- Note mode is currently not implemented on Windows. mkdir :: HasCallStack => CBytes -> FileMode -> IO ()-mkdir path mode = throwUVIfMinus_ . withCBytes path $ \ p ->+mkdir path mode = throwUVIfMinus_ . withCBytesUnsafe path $ \ p ->      hs_uv_fs_mkdir p mode  -- | Equivalent to <http://linux.die.net/man/2/unlink unlink(2)>. unlink :: HasCallStack => CBytes -> IO ()-unlink path = throwUVIfMinus_ (withCBytes path hs_uv_fs_unlink)+unlink path = throwUVIfMinus_ (withCBytesUnsafe path hs_uv_fs_unlink)   -- | Equivalent to <mkdtemp http://linux.die.net/man/3/mkdtemp>@@ -222,14 +215,14 @@ mkdtemp :: HasCallStack => CBytes -> IO CBytes mkdtemp path = do     let size = CBytes.length path-    withCBytes path $ \ p ->-        CBytes.create (size+7) $ \ p' -> do  -- we append "XXXXXX\NUL" in C+    withCBytesUnsafe path $ \ p -> do+        (p',_) <- CBytes.allocCBytesUnsafe (size+7) $ \ p' -> do  -- we append "XXXXXX\NUL" in C             throwUVIfMinus_ (hs_uv_fs_mkdtemp p size p')-            return (size+6)+        return p'  -- | Equivalent to <http://linux.die.net/man/2/rmdir rmdir(2)>. rmdir :: HasCallStack => CBytes -> IO ()-rmdir path = throwUVIfMinus_ (withCBytes path hs_uv_fs_rmdir)+rmdir path = throwUVIfMinus_ (withCBytesUnsafe path hs_uv_fs_rmdir)  -- | Equivalent to <http://linux.die.net/man/3/scandir scandir(3)>. --@@ -239,7 +232,7 @@ scandir :: HasCallStack => CBytes -> IO [(CBytes, DirEntType)] scandir path = do     bracket-        (withCBytes path $ \ p ->+        (withCBytesUnsafe path $ \ p ->             allocPrimUnsafe $ \ dents ->                 throwUVIfMinus (hs_uv_fs_scandir p dents))         (\ (dents, n) -> hs_uv_fs_scandir_cleanup dents n)@@ -253,21 +246,21 @@ --------------------------------------------------------------------------------  -- | Equivalent to <http://linux.die.net/man/2/stat stat(2)>-stat :: HasCallStack => CBytes -> IO UVStat-stat path = withCBytes path $ \ p ->+stat :: HasCallStack => CBytes -> IO FStat+stat path = withCBytesUnsafe path $ \ p ->      allocaBytes uvStatSize $ \ s -> do         throwUVIfMinus_ (hs_uv_fs_stat p s)         peekUVStat s  -- | Equivalent to <http://linux.die.net/man/2/lstat lstat(2)>-lstat :: HasCallStack => CBytes -> IO UVStat-lstat path = withCBytes path $ \ p ->+lstat :: HasCallStack => CBytes -> IO FStat+lstat path = withCBytesUnsafe path $ \ p ->      allocaBytes uvStatSize $ \ s -> do         throwUVIfMinus_ (hs_uv_fs_lstat p s)         peekUVStat s  -- | Equivalent to <http://linux.die.net/man/2/fstat fstat(2)>-fstat :: HasCallStack => File -> IO UVStat+fstat :: HasCallStack => File -> IO FStat fstat uvf = checkFileClosed uvf $ \ fd ->     allocaBytes uvStatSize $ \ s -> do         throwUVIfMinus_ (hs_uv_fs_fstat fd s)@@ -279,8 +272,8 @@ -- -- Note On Windows if this function fails with UV_EBUSY, UV_EPERM or UV_EACCES, it will retry to rename the file up to four times with 250ms wait between attempts before giving up. If both path and new_path are existing directories this function will work only if target directory is empty. rename :: HasCallStack => CBytes -> CBytes -> IO ()-rename path path' = throwUVIfMinus_ . withCBytes path $ \ p ->-    withCBytes path' (hs_uv_fs_rename p)+rename path path' = throwUVIfMinus_ . withCBytesUnsafe path $ \ p ->+    withCBytesUnsafe path' (hs_uv_fs_rename p)  -- | Equivalent to <http://linux.die.net/man/2/fsync fsync(2)>. fsync :: HasCallStack => File -> IO ()@@ -297,15 +290,15 @@ -- | Copies a file from path to new_path. -- -- Warning: If the destination path is created, but an error occurs while copying the data, then the destination path is removed. There is a brief window of time between closing and removing the file where another process could access the file.-copyfile :: HasCallStack => CBytes -> CBytes -> UVCopyFileFlag -> IO ()-copyfile path path' flag = throwUVIfMinus_ . withCBytes path $ \ p ->-    withCBytes path' $ \ p' -> hs_uv_fs_copyfile p p' flag+copyfile :: HasCallStack => CBytes -> CBytes -> CopyFileFlag -> IO ()+copyfile path path' flag = throwUVIfMinus_ . withCBytesUnsafe path $ \ p ->+    withCBytesUnsafe path' $ \ p' -> hs_uv_fs_copyfile p p' flag  -- | Equivalent to <http://linux.die.net/man/2/access access(2)> on Unix. -- Windows uses GetFileAttributesW().-access :: HasCallStack => CBytes -> UVAccessMode -> IO AccessResult+access :: HasCallStack => CBytes -> AccessMode -> IO AccessResult access path mode = do-     r <- withCBytes path $ \ p -> fromIntegral <$> hs_uv_fs_access p mode+     r <- withCBytesUnsafe path $ \ p -> fromIntegral <$> hs_uv_fs_access p mode      if | r == 0           -> return AccessOK         | r == UV_ENOENT   -> return NoExistence         | r == UV_EACCES   -> return NoPermission@@ -316,7 +309,7 @@  -- | Equivalent to <http://linux.die.net/man/2/chmod chmod(2)>. chmod :: HasCallStack => CBytes -> FileMode -> IO ()-chmod path mode = throwUVIfMinus_ . withCBytes path $ \ p -> hs_uv_fs_chmod p mode+chmod path mode = throwUVIfMinus_ . withCBytesUnsafe path $ \ p -> hs_uv_fs_chmod p mode  -- | Equivalent to <http://linux.die.net/man/2/fchmod fchmod(2)>. fchmod :: HasCallStack => File -> FileMode -> IO ()@@ -324,33 +317,35 @@  -- | Equivalent to <http://linux.die.net/man/2/utime utime(2)>. ----- libuv choose 'Double' type due to cross platform concerns, we only provide micro-second precision:------   * second     = v---   * nanosecond = (v * 1000000) % 1000000 * 1000;------ second and nanosecond are fields in 'UVTimeSpec' respectively.------ Note libuv prior to v1.23.1 have issues which may result in nanosecond not set, 'futime' doesn't have--- that issue.+-- libuv choose 'Double' type due to cross platform concerns, we only provide micro-second precision. utime :: HasCallStack       => CBytes       -> Double     -- ^ atime, i.e. access time       -> Double     -- ^ mtime, i.e. modify time       -> IO ()-utime path atime mtime = throwUVIfMinus_ . withCBytes path $ \ p -> hs_uv_fs_utime p atime mtime+utime path atime mtime = throwUVIfMinus_ . withCBytesUnsafe path $ \ p -> hs_uv_fs_utime p atime mtime --- | Equivalent to <http://linux.die.net/man/2/futime futime(2)>.+-- | Equivalent to <https://man7.org/linux/man-pages/man3/futimes.3.html futime(3)>. -- -- Same precision notes with 'utime'. futime :: HasCallStack => File -> Double -> Double -> IO () futime uvf atime mtime = checkFileClosed uvf $ \ fd ->     throwUVIfMinus_ (hs_uv_fs_futime fd atime mtime) +-- | Equivalent to <https://man7.org/linux/man-pages/man3/lutimes.3.html lutime(3)>.+--+-- Same precision notes with 'utime'.+lutime :: HasCallStack+       => CBytes+       -> Double     -- ^ atime, i.e. access time+       -> Double     -- ^ mtime, i.e. modify time+       -> IO ()+lutime path atime mtime = throwUVIfMinus_ . withCBytesUnsafe path $ \ p -> hs_uv_fs_lutime p atime mtime+ -- | Equivalent to <http://linux.die.net/man/2/link link(2)>. link :: HasCallStack => CBytes -> CBytes -> IO ()-link path path' = throwUVIfMinus_ . withCBytes path $ \ p ->-    withCBytes path' $ hs_uv_fs_link p+link path path' = throwUVIfMinus_ . withCBytesUnsafe path $ \ p ->+    withCBytesUnsafe path' $ hs_uv_fs_link p  -- | Equivalent to <http://linux.die.net/man/2/symlink symlink(2)>. --@@ -360,15 +355,15 @@ --   * 'SYMLINK_JUNCTION': request that the symlink is created using junction points. -- -- On other platforms these flags are ignored.-symlink :: HasCallStack => CBytes -> CBytes -> UVSymlinkFlag -> IO ()-symlink path path' flag = throwUVIfMinus_ . withCBytes path $ \ p ->-    withCBytes path' $ \ p' -> hs_uv_fs_symlink p p' flag+symlink :: HasCallStack => CBytes -> CBytes -> SymlinkFlag -> IO ()+symlink path path' flag = throwUVIfMinus_ . withCBytesUnsafe path $ \ p ->+    withCBytesUnsafe path' $ \ p' -> hs_uv_fs_symlink p p' flag  -- | Equivalent to <http://linux.die.net/man/2/readlink readlink(2)>. readlink :: HasCallStack => CBytes -> IO CBytes readlink path = do     bracket-        (withCBytes path $ \ p ->+        (withCBytesUnsafe path $ \ p ->             allocPrimUnsafe $ \ p' ->                 throwUVIfMinus (hs_uv_fs_readlink p p'))         (hs_uv_fs_readlink_cleanup . fst)@@ -395,7 +390,7 @@ realpath :: HasCallStack => CBytes -> IO CBytes realpath path = do     bracket-        (withCBytes path $ \ p ->+        (withCBytesUnsafe path $ \ p ->             allocPrimUnsafe $ \ p' ->                 throwUVIfMinus (hs_uv_fs_realpath p p'))         (hs_uv_fs_readlink_cleanup . fst)

@@ -1,9 +1,3 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE ScopedTypeVariables #-}- {-| Module      : Z.IO.FileSystem.Threaded Description : Filesystem IO using threadpool@@ -43,19 +37,19 @@   , rmdir   , DirEntType(..)   , scandir-  , UVStat(..), UVTimeSpec(..)+  , FStat(..), UVTimeSpec(..)   , stat, lstat, fstat   , rename   , fsync, fdatasync   , ftruncate-  , UVCopyFileFlag(COPYFILE_DEFAULT, COPYFILE_EXCL, COPYFILE_FICLONE)+  , CopyFileFlag(COPYFILE_DEFAULT, COPYFILE_EXCL, COPYFILE_FICLONE)   , copyfile-  , UVAccessMode(F_OK, R_OK, W_OK, X_OK)+  , AccessMode(F_OK, R_OK, W_OK, X_OK)   , AccessResult(..)   , access   , chmod, fchmod-  , utime, futime-  , UVSymlinkFlag(SYMLINK_DEFAULT, SYMLINK_DIR, SYMLINK_JUNCTION)+  , utime, futime, lutime+  , SymlinkFlag(SYMLINK_DEFAULT, SYMLINK_DIR, SYMLINK_JUNCTION)   , link, symlink   , readlink, realpath   ) where@@ -203,7 +197,7 @@ initFileT path flags mode =     initResource         (do uvm <- getUVManager-            fd <- withCBytes path $ \ p ->+            fd <- withCBytesUnsafe path $ \ p ->                 withUVRequest uvm (hs_uv_fs_open_threaded p flags mode)             FileT (fromIntegral fd) <$> newIORef False)         (\ (FileT fd closedRef) -> do@@ -220,14 +214,14 @@ mkdir :: HasCallStack => CBytes -> FileMode -> IO () mkdir path mode = do     uvm <- getUVManager-    withCBytes path $ \ p ->+    withCBytesUnsafe path $ \ p ->         withUVRequest_ uvm (hs_uv_fs_mkdir_threaded p mode)  -- | Equivalent to <http://linux.die.net/man/2/unlink unlink(2)>. unlink :: HasCallStack => CBytes -> IO () unlink path = do     uvm <- getUVManager-    withCBytes path $ \ p ->+    withCBytesUnsafe path $ \ p ->         withUVRequest_ uvm (hs_uv_fs_unlink_threaded p)  -- | Equivalent to <mkdtemp http://linux.die.net/man/3/mkdtemp>@@ -243,17 +237,17 @@ mkdtemp :: HasCallStack => CBytes -> IO CBytes mkdtemp path = do     let size = CBytes.length path-    withCBytes path $ \ p ->-        CBytes.create (size+7) $ \ p' -> do  -- we append "XXXXXX\NUL" in C+    withCBytesUnsafe path $ \ p -> do+        (p'', _) <- CBytes.allocCBytesUnsafe (size+7) $ \ p' -> do  -- we append "XXXXXX\NUL" in C             uvm <- getUVManager             withUVRequest_ uvm (hs_uv_fs_mkdtemp_threaded p size p')-            return (size+6)+        return p''  -- | Equivalent to <http://linux.die.net/man/2/rmdir rmdir(2)>. rmdir :: HasCallStack => CBytes -> IO () rmdir path = do     uvm <- getUVManager-    withCBytes path (void . withUVRequest uvm . hs_uv_fs_rmdir_threaded)+    withCBytesUnsafe path (\ p -> void . withUVRequest uvm $ hs_uv_fs_rmdir_threaded p)  -------------------------------------------------------------------------------- @@ -266,7 +260,7 @@ scandir path = do     uvm <- getUVManager     bracket-        (withCBytes path $ \ p ->+        (withCBytesUnsafe path $ \ p ->             allocPrimSafe $ \ dents ->                 withUVRequestEx uvm                     (hs_uv_fs_scandir_threaded p dents)@@ -282,25 +276,25 @@ --------------------------------------------------------------------------------  -- | Equivalent to <http://linux.die.net/man/2/stat stat(2)>-stat :: HasCallStack => CBytes -> IO UVStat+stat :: HasCallStack => CBytes -> IO FStat stat path = do-    withCBytes path $ \ p ->+    withCBytesUnsafe path $ \ p ->          allocaBytes uvStatSize $ \ s -> do             uvm <- getUVManager             withUVRequest_ uvm (hs_uv_fs_stat_threaded p s)             peekUVStat s  -- | Equivalent to <http://linux.die.net/man/2/lstat lstat(2)>-lstat :: HasCallStack => CBytes -> IO UVStat+lstat :: HasCallStack => CBytes -> IO FStat lstat path =-    withCBytes path $ \ p ->+    withCBytesUnsafe path $ \ p ->          allocaBytes uvStatSize $ \ s -> do             uvm <- getUVManager             withUVRequest_ uvm (hs_uv_fs_lstat_threaded p s)             peekUVStat s  -- | Equivalent to <http://linux.die.net/man/2/fstat fstat(2)>-fstat :: HasCallStack => FileT -> IO UVStat+fstat :: HasCallStack => FileT -> IO FStat fstat uvf = checkFileTClosed uvf $ \ fd ->      (allocaBytes uvStatSize $ \ s -> do         uvm <- getUVManager@@ -315,8 +309,8 @@ rename :: HasCallStack => CBytes -> CBytes -> IO () rename path path' = do     uvm <- getUVManager-    withCBytes path $ \ p ->-        withCBytes path' $ \ p' ->+    withCBytesUnsafe path $ \ p ->+        withCBytesUnsafe path' $ \ p' ->             withUVRequest_ uvm (hs_uv_fs_rename_threaded p p')  -- | Equivalent to <http://linux.die.net/man/2/fsync fsync(2)>.@@ -340,19 +334,19 @@ -- | Copies a file from path to new_path. -- -- Warning: If the destination path is created, but an error occurs while copying the data, then the destination path is removed. There is a brief window of time between closing and removing the file where another process could access the file.-copyfile :: HasCallStack => CBytes -> CBytes -> UVCopyFileFlag -> IO ()+copyfile :: HasCallStack => CBytes -> CBytes -> CopyFileFlag -> IO () copyfile path path' flag = do     uvm <- getUVManager-    withCBytes path $ \ p ->-        withCBytes path' $ \ p' ->+    withCBytesUnsafe path $ \ p ->+        withCBytesUnsafe path' $ \ p' ->             withUVRequest_ uvm (hs_uv_fs_copyfile_threaded p p' flag)  -- | Equivalent to <http://linux.die.net/man/2/access access(2)> on Unix. -- Windows uses GetFileAttributesW().-access :: HasCallStack => CBytes -> UVAccessMode -> IO AccessResult+access :: HasCallStack => CBytes -> AccessMode -> IO AccessResult access path mode = do     uvm <- getUVManager-    withCBytes path $ \ p ->+    withCBytesUnsafe path $ \ p ->         withUVRequest' uvm (hs_uv_fs_access_threaded p mode) (handleResult . fromIntegral)   where     handleResult r@@ -368,7 +362,7 @@ chmod :: HasCallStack => CBytes -> FileMode -> IO () chmod path mode = do     uvm <- getUVManager-    withCBytes path $ \ p ->+    withCBytesUnsafe path $ \ p ->         withUVRequest_ uvm (hs_uv_fs_chmod_threaded p mode)  -- | Equivalent to <http://linux.die.net/man/2/fchmod fchmod(2)>.@@ -379,14 +373,8 @@  -- | Equivalent to <http://linux.die.net/man/2/utime utime(2)>. ----- libuv choose 'Double' type due to cross platform concerns, we only provide micro-second precision:------   * second     = v---   * nanosecond = (v * 1000000) % 1000000 * 1000;------ second and nanosecond are fields in 'UVTimeSpec' respectively.+-- libuv choose 'Double' type due to cross platform concerns, we only provide micro-second precision. ----- Note libuv prior to v1.23.1 have issues which may result in nanosecond not set, 'futime' doesn't have utime :: HasCallStack       => CBytes       -> Double     -- ^ atime, i.e. access time@@ -394,10 +382,10 @@       -> IO () utime path atime mtime = do     uvm <- getUVManager-    withCBytes path $ \ p ->+    withCBytesUnsafe path $ \ p ->         withUVRequest_ uvm (hs_uv_fs_utime_threaded p atime mtime) --- | Equivalent to <http://linux.die.net/man/2/futime futime(2)>.+-- | Equivalent to <https://man7.org/linux/man-pages/man3/futimes.3.html futime(3)>. -- -- Same precision notes with 'utime'. futime :: HasCallStack => FileT -> Double -> Double -> IO ()@@ -405,12 +393,25 @@     uvm <- getUVManager     withUVRequest_ uvm (hs_uv_fs_futime_threaded fd atime mtime) +-- | Equivalent to <https://man7.org/linux/man-pages/man3/lutimes.3.html lutime(3)>.+--+-- Same precision notes with 'utime'.+lutime :: HasCallStack+       => CBytes+       -> Double     -- ^ atime, i.e. access time+       -> Double     -- ^ mtime, i.e. modify time+       -> IO ()+lutime path atime mtime = do+    uvm <- getUVManager+    withCBytesUnsafe path $ \ p ->+        withUVRequest_ uvm (hs_uv_fs_lutime_threaded p atime mtime)+ -- | Equivalent to <http://linux.die.net/man/2/link link(2)>. link :: HasCallStack => CBytes -> CBytes -> IO () link path path' = do     uvm <- getUVManager-    withCBytes path $ \ p ->-        withCBytes path' $ \ p' ->+    withCBytesUnsafe path $ \ p ->+        withCBytesUnsafe path' $ \ p' ->             withUVRequest_ uvm (hs_uv_fs_link_threaded p p')  -- | Equivalent to <http://linux.die.net/man/2/symlink symlink(2)>.@@ -421,11 +422,11 @@ --   * 'SYMLINK_JUNCTION': request that the symlink is created using junction points. -- -- On other platforms these flags are ignored.-symlink :: HasCallStack => CBytes -> CBytes -> UVSymlinkFlag -> IO ()+symlink :: HasCallStack => CBytes -> CBytes -> SymlinkFlag -> IO () symlink path path' flag = do     uvm <- getUVManager-    withCBytes path $ \ p ->-        withCBytes path' $ \ p' ->+    withCBytesUnsafe path $ \ p ->+        withCBytesUnsafe path' $ \ p' ->             withUVRequest_ uvm (hs_uv_fs_symlink_threaded p p' flag)  -- | Equivalent to <http://linux.die.net/man/2/readlink readlink(2)>.@@ -433,7 +434,7 @@ readlink path = do     uvm <- getUVManager     bracket-        (withCBytes path $ \ p ->+        (withCBytesUnsafe path $ \ p ->             allocPrimSafe $ \ p' ->                 withUVRequestEx uvm                     (hs_uv_fs_readlink_threaded p p')@@ -462,7 +463,7 @@ realpath path = do     uvm <- getUVManager     bracket-        (withCBytes path $ \ p ->+        (withCBytesUnsafe path $ \ p ->             allocPrimSafe $ \ p' ->                 withUVRequestEx uvm                     (hs_uv_fs_realpath_threaded p p')

@@ -1,7 +1,3 @@-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE BangPatterns #-}- {-| Module      : Z.IO.Logger Description : High performance logger@@ -37,13 +33,12 @@  module Z.IO.Logger   ( -- * A simple Logger type-    Logger+    Logger(..)   , LoggerConfig(..)-  , newLogger-  , loggerFlush   , setStdLogger   , getStdLogger   , withStdLogger+  , newLogger     -- * logging functions   , debug   , info@@ -51,11 +46,16 @@   , fatal   , otherLevel     -- * logging functions with specific logger-  , debugWith-  , infoWith-  , warnWith-  , fatalWith-  , otherLevelWith+  , debugTo+  , infoTo+  , warnTo+  , fatalTo+  , otherLevelTo+    -- * Helper to write new logger+  , defaultTSCache+  , defaultFmtCallStack+  , LogFormatter, defaultFmt+  , flushLog   ) where  import Control.Monad@@ -67,37 +67,47 @@ import Z.IO.Exception import Data.IORef import Control.Concurrent.MVar-import qualified Z.Data.Builder.Base as B+import GHC.Stack+import qualified Z.Data.Builder as B import qualified Data.Time as Time +type LogFormatter = Maybe (B.Builder ())     -- ^ data/time string+                    -> B.Builder ()          -- ^ log level+                    -> B.Builder ()          -- ^ log content+                    -> CallStack             -- ^ call stack trace+                    -> B.Builder ()+ data Logger = Logger-    { loggerFlush           :: IO ()                -- ^ flush logger's buffer to output device-    , loggerThrottledFlush  :: IO ()-    , loggerBytesList       :: {-# UNPACK #-} !(IORef [V.Bytes])-    , loggerConfig          :: {-# UNPACK #-} !LoggerConfig+    { loggerPushBuilder     :: B.Builder () -> IO () -- ^ push log into buffer+    , flushLogger           :: IO ()                -- ^ flush logger's buffer to output device+    , flushLoggerThrottled  :: IO ()                -- ^ throttled flush, e.g. use 'throttleTrailing_' from "Z.IO.LowResTimer"+    , loggerTSCache         :: IO (Maybe (B.Builder ())) -- ^ A IO action return a formatted date/time string+    , loggerFmt             :: LogFormatter     }  data LoggerConfig = LoggerConfig     { loggerMinFlushInterval :: {-# UNPACK #-} !Int -- ^ Minimal flush interval, see Notes on 'debug'-    , loggerTsCache          :: IO (B.Builder ())   -- ^ A IO action return a formatted date/time string     , loggerLineBufSize      :: {-# UNPACK #-} !Int -- ^ Buffer size to build each log/line     , loggerShowDebug        :: Bool                -- ^ Set to 'False' to filter debug logs     , loggerShowTS           :: Bool                -- ^ Set to 'False' to disable auto data/time string prepending+    , loggerShowSourceLoc    :: Bool                -- ^ Set to 'True' to enable source location line     }  -- | A default logger config with -- --   * debug ON --   * 0.1s minimal flush interval---   * defaultTSCache --   * line buffer size 128 bytes --   * show debug True --   * show timestamp True---   * 'BufferedOutput' buffer size equals to 'V.defaultChunkSize'.+--   * don't show source location+--   * buffer size equals to 'V.defaultChunkSize'. defaultLoggerConfig :: LoggerConfig-defaultLoggerConfig = LoggerConfig 1 defaultTSCache 128 True True+defaultLoggerConfig = LoggerConfig 1 128 True True True  -- | A default timestamp cache with format @%Y-%m-%dT%H:%M:%S%Z@+--+-- The timestamp will updated in 0.1s granularity to ensure a seconds level precision. defaultTSCache :: IO (B.Builder ()) {-# NOINLINE defaultTSCache #-} defaultTSCache = unsafePerformIO $ do@@ -106,6 +116,15 @@         return . B.string8 $             Time.formatTime Time.defaultTimeLocale "%Y-%m-%dT%H:%M:%S%Z" t +-- | Use this function to implement a simple 'IORef' based concurrent logger.+--+-- @+-- bList <- newIORef []+-- let flush = flushLog buffered bList+-- ..+-- return $ Logger (pushLog bList) flush ...+-- @+-- flushLog :: (HasCallStack, Output o) => MVar (BufferedOutput o) -> IORef [V.Bytes] -> IO () flushLog oLock bList =     withMVar oLock $ \ o -> do@@ -113,7 +132,7 @@         forM_ (reverse bss) (writeBuffer o)         flushBuffer o --- | Make a new logger+-- | Make a new simple logger. newLogger :: Output o           => LoggerConfig           -> MVar (BufferedOutput o)@@ -122,8 +141,36 @@     bList <- newIORef []     let flush = flushLog oLock bList     throttledFlush <- throttleTrailing_ (loggerMinFlushInterval config) flush-    return $ Logger flush throttledFlush bList config+    return $ Logger (pushLog bList) flush throttledFlush tsCache (defaultFmt (loggerShowSourceLoc config))+  where+    tsCache = if (loggerShowTS config) then Just <$> defaultTSCache else pure Nothing+    pushLog bList b = do+        let !bs = B.buildBytesWith (loggerLineBufSize config) b+        atomicModifyIORef' bList (\ bss -> (bs:bss, ())) +-- | A default log formatter+--+-- @ [DEBUG][2020-10-09T07:44:14UTC][<interactive>:7:1]This a debug message@+defaultFmt :: Bool          -- ^ show call stack info?+           -> LogFormatter+defaultFmt showcstack maybeTS level content cstack = do+    B.square level+    forM_ maybeTS $ \ ts -> B.square ts+    when showcstack (B.square $ defaultFmtCallStack cstack)+    content++-- | Default stack formatter which fetch the logging source and location.+defaultFmtCallStack :: CallStack -> B.Builder ()+defaultFmtCallStack cs =+ case reverse $ getCallStack cs of+   [] -> "<no call stack found>"+   (_, loc):_ -> do+      B.string8 (srcLocFile loc)+      B.char8 ':'+      B.int (srcLocStartLine loc)+      B.char8 ':'+      B.int (srcLocStartCol loc)+ globalLogger :: IORef Logger {-# NOINLINE globalLogger #-} globalLogger = unsafePerformIO $@@ -139,12 +186,7 @@  -- | Manually flush stderr logger. flushDefaultLogger :: IO ()-flushDefaultLogger = getStdLogger >>= loggerFlush--pushLog :: IORef [V.Bytes] -> Int -> B.Builder () -> IO ()-pushLog blist bfsiz b = do-    let !bs = B.buildBytesWith bfsiz b-    atomicModifyIORef' blist (\ bss -> (bs:bss, ()))+flushDefaultLogger = getStdLogger >>= flushLogger  -- | Flush stderr logger when program exits. withStdLogger :: IO () -> IO ()@@ -152,54 +194,57 @@  -------------------------------------------------------------------------------- -debug :: B.Builder () -> IO ()-debug = otherLevel "DEBUG" False+debug :: HasCallStack => B.Builder () -> IO ()+debug = otherLevel_ "DEBUG" False callStack -info :: B.Builder () -> IO ()-info = otherLevel "INFO" False+info :: HasCallStack => B.Builder () -> IO ()+info = otherLevel_ "INFO" False callStack -warn :: B.Builder () -> IO ()-warn = otherLevel "WARN" False+warn :: HasCallStack => B.Builder () -> IO ()+warn = otherLevel_ "WARN" False callStack -fatal :: B.Builder () -> IO ()-fatal = otherLevel "FATAL" True+fatal :: HasCallStack => B.Builder () -> IO ()+fatal = otherLevel_ "FATAL" True callStack -otherLevel :: B.Builder ()      -- ^ log level+otherLevel :: HasCallStack+           => B.Builder ()      -- ^ log level            -> Bool              -- ^ flush immediately?            -> B.Builder ()      -- ^ log content            -> IO ()-otherLevel level flushNow b =-    getStdLogger >>= \ logger -> otherLevelWith logger level flushNow b+otherLevel level flushNow bu = otherLevel_ level flushNow callStack bu +otherLevel_ :: B.Builder () -> Bool -> CallStack -> B.Builder () -> IO ()+otherLevel_ level flushNow cstack bu = do+    logger <- getStdLogger+    otherLevelTo_ level flushNow cstack logger bu+ -------------------------------------------------------------------------------- -debugWith :: Logger -> B.Builder () -> IO ()-debugWith logger = otherLevelWith logger "DEBUG" False+debugTo :: HasCallStack => Logger -> B.Builder () -> IO ()+debugTo = otherLevelTo_ "DEBUG" False callStack -infoWith :: Logger -> B.Builder () -> IO ()-infoWith logger = otherLevelWith logger "INFO" False+infoTo :: HasCallStack => Logger -> B.Builder () -> IO ()+infoTo = otherLevelTo_ "INFO" False callStack -warnWith :: Logger -> B.Builder () -> IO ()-warnWith logger = otherLevelWith logger "WARN" False+warnTo :: HasCallStack => Logger -> B.Builder () -> IO ()+warnTo = otherLevelTo_ "WARN" False callStack -fatalWith :: Logger -> B.Builder () -> IO ()-fatalWith logger = otherLevelWith logger "FATAL" True+fatalTo :: HasCallStack => Logger -> B.Builder () -> IO ()+fatalTo = otherLevelTo_ "FATAL" True callStack -otherLevelWith :: Logger-               -> B.Builder ()      -- ^ log level-               -> Bool              -- ^ flush immediately?-               -> B.Builder ()      -- ^ log content-               -> IO ()-otherLevelWith logger level flushNow b = case logger of-    (Logger flush throttledFlush blist (LoggerConfig _ tscache lbsiz showdebug showts)) -> do-        ts <- if showts then tscache else return ""-        when showdebug $ do-            pushLog blist lbsiz $ do-                B.char8 '['-                level-                B.char8 ']'-                B.char8 ' '-                when showts $ ts >> B.char8 ' '-                b-                B.char8 '\n'-            if flushNow then flush else throttledFlush+otherLevelTo :: HasCallStack+             => Logger+             -> B.Builder ()      -- ^ log level+             -> Bool              -- ^ flush immediately?+             -> B.Builder ()      -- ^ log content+             -> IO ()+otherLevelTo logger level flushNow =+    otherLevelTo_ level flushNow callStack logger++otherLevelTo_ :: B.Builder () -> Bool -> CallStack -> Logger -> B.Builder () -> IO ()+otherLevelTo_ level flushNow cstack logger bu = do+    ts <- loggerTSCache logger+    (loggerPushBuilder logger) $ (loggerFmt logger) ts level bu cstack+    if flushNow+    then flushLogger logger+    else flushLoggerThrottled logger

@@ -1,7 +1,3 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE ScopedTypeVariables #-}- {-| Module      : Z.IO.LowResTimer Description : Low resolution (0.1s) timing wheel

@@ -1,7 +1,3 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE RecordWildCards #-}- {-| Module      : Z.IO.Network.DNS Description : TCP/UDP socket address API@@ -28,7 +24,7 @@  import           Data.Bits import           Data.List as List-import           Foreign.C.String+import           Data.Word import           Foreign.C.Types import           Foreign.Marshal.Utils import           Foreign.Ptr@@ -356,11 +352,11 @@  ----------------------------------------------------------------------------- foreign import ccall safe "hs_getaddrinfo"-    hs_getaddrinfo :: CString -- ^ host -                      -> CString -- ^ service-                      -> Ptr AddrInfo   -- ^ hints-                      -> Ptr (Ptr AddrInfo) -- ^ output addrinfo linked list-                      -> IO Int+    hs_getaddrinfo :: Ptr Word8 -- ^ host +                   -> Ptr Word8 -- ^ service+                   -> Ptr AddrInfo   -- ^ hints+                   -> Ptr (Ptr AddrInfo) -- ^ output addrinfo linked list+                   -> IO Int  foreign import ccall unsafe "freeaddrinfo" freeaddrinfo :: Ptr AddrInfo -> IO () 

@@ -1,9 +1,3 @@-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE OverloadedStrings #-}- {-| Module      : Z.IO.IPC Description : Named pipe/Unix domain servers and clients@@ -24,6 +18,7 @@ module Z.IO.Network.IPC (   -- * IPC Client     IPCClientConfig(..)+  , UVStream   , defaultIPCClientConfig   , initIPCClient   -- * IPC Server@@ -70,10 +65,10 @@     let hdl = uvsHandle client     liftIO $ do         forM_ cname $ \ cname' ->-            withCBytes cname' $ \ cname_p ->+            withCBytesUnsafe cname' $ \ cname_p ->                 -- bind is safe without withUVManager                 throwUVIfMinus_ (uv_pipe_bind hdl cname_p)-        withCBytes tname $ \ tname_p -> do+        withCBytesUnsafe tname $ \ tname_p -> do             void . withUVRequest uvm $ \ _ -> hs_uv_pipe_connect hdl tname_p     return client @@ -107,7 +102,7 @@     let backLog = max ipcListenBacklog 128     serverUVManager <- getUVManager     withResource (initIPCStream serverUVManager) $ \ (UVStream serverHandle serverSlot _ _) -> do-        withCBytes ipcListenName $ \ name_p -> do+        withCBytesUnsafe ipcListenName $ \ name_p -> do             throwUVIfMinus_ (uv_pipe_bind serverHandle name_p)         bracket             (throwOOMIfNull $ hs_uv_accept_check_alloc serverHandle)

@@ -1,11 +1,3 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE UnliftedFFITypes #-}-{-# LANGUAGE PatternSynonyms    #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE UnboxedTuples #-}-{-# LANGUAGE MagicHash #-}- {-| Module      : Z.IO.Network.SocketAddr Description : TCP/UDP socket address API@@ -72,10 +64,11 @@ import           Data.Typeable import           Foreign import           Foreign.C-import           Numeric                  (showHex)+import           GHC.Generics+import           Numeric                    (showHex) import           System.IO.Unsafe-import           Text.Read import           Z.Data.CBytes+import           Z.Data.Text.ShowT          (ShowT) import           Z.IO.Exception import           Z.IO.UV.Errno import           Z.Foreign@@ -117,14 +110,6 @@     showsPrec _ (SocketAddrInet6 port _ ia6 _)        = ('[':) . shows ia6 . showString "]:" . shows port --- Taken from showIPv6 in Data.IP.Addr.---- | Show an IPv6 address in the most appropriate notation, based on recommended--- representation proposed by <http://tools.ietf.org/html/rfc5952 RFC 5952>.------ /The implementation is completely compatible with the current implementation--- of the `inet_ntop` function in glibc./--- sockAddrFamily :: SocketAddr -> SocketFamily sockAddrFamily (SocketAddrInet _ _) = AF_INET sockAddrFamily (SocketAddrInet6 _ _ _ _) = AF_INET6@@ -137,14 +122,14 @@ -- This is partial function, wrong address will throw 'InvalidArgument' exception. ipv4:: HasCallStack => CBytes -> PortNumber -> SocketAddr ipv4 str (PortNumber port) = unsafeDupablePerformIO . withSocketAddrStorageUnsafe $ \ p ->-    withCBytes str $ \ cstr -> throwUVIfMinus_ $ uv_ip4_addr cstr (fromIntegral port) p+    withCBytesUnsafe str $ \ cstr -> throwUVIfMinus_ $ uv_ip4_addr cstr (fromIntegral port) p  -- | Convert a string containing an IPv6 addresses to a binary structure -- -- This is partial function, wrong address will throw 'InvalidArgument' exception. ipv6:: HasCallStack => CBytes -> PortNumber -> SocketAddr ipv6 str (PortNumber port) = unsafeDupablePerformIO . withSocketAddrStorageUnsafe $ \ p ->-    withCBytes str $ \ cstr -> throwUVIfMinus_ $ uv_ip6_addr cstr (fromIntegral port) p+    withCBytesUnsafe str $ \ cstr -> throwUVIfMinus_ $ uv_ip6_addr cstr (fromIntegral port) p  -------------------------------------------------------------------------------- @@ -187,13 +172,13 @@ inetMaxLocalGroup    = tupleToInetAddr (224,  0,  0,255)  instance Storable InetAddr where-    sizeOf _ = sizeOf (undefined :: Word32)+    sizeOf _ = 4     alignment _ = alignment (undefined :: Word32)      peek p = (InetAddr . ntohl) `fmap` peekByteOff p 0     poke p (InetAddr ia) = pokeByteOff p 0 (htonl ia) -instance UnalignedAccess InetAddr where-    unalignedSize = UnalignedSize 4+instance Unaligned InetAddr where+    unalignedSize _ = 4     pokeMBA p off x = pokeMBA p off (htonl (getInetAddr x))     peekMBA p off = InetAddr . ntohl <$> peekMBA p off     indexBA p off = InetAddr (ntohl (indexBA p off))@@ -313,8 +298,8 @@     pokeByte 2 (a `sr`  8)     pokeByte 3 (a `sr`  0) -instance UnalignedAccess Inet6Addr where-    unalignedSize   = UnalignedSize (#size struct in6_addr)+instance Unaligned Inet6Addr where+    unalignedSize _ = (#size struct in6_addr)      indexBA p off =          let a = indexBA p (off + s6_addr_offset + 0)@@ -400,11 +385,13 @@ -- withSocketAddrUnsafe :: SocketAddr -> (MBA## SocketAddr -> IO a) -> IO a withSocketAddrUnsafe sa@(SocketAddrInet _ _) f = do-    allocMutableByteArrayUnsafe (#size struct sockaddr_in) $ \ p ->-        pokeSocketAddrMBA p sa >> f p+    (MutableByteArray p) <- newByteArray (#size struct sockaddr_in) +    pokeSocketAddrMBA p sa +    f p withSocketAddrUnsafe sa@(SocketAddrInet6 _ _ _ _) f = do-    allocMutableByteArrayUnsafe (#size struct sockaddr_in6) $ \ p ->-        pokeSocketAddrMBA p sa >> f p+    (MutableByteArray p) <- newByteArray (#size struct sockaddr_in6) +    pokeSocketAddrMBA p sa +    f p  sizeOfSocketAddr :: SocketAddr -> CSize sizeOfSocketAddr (SocketAddrInet _ _) = #size struct sockaddr_in@@ -423,8 +410,9 @@ -- withSocketAddrStorageUnsafe :: (MBA## SocketAddr -> IO ()) -> IO SocketAddr withSocketAddrStorageUnsafe f = do-    allocMutableByteArrayUnsafe (#size struct sockaddr_storage) $ \ p ->-        f p >> peekSocketAddrMBA p+    (MutableByteArray p) <- newByteArray (#size struct sockaddr_storage) +    f p+    peekSocketAddrMBA p  sizeOfSocketAddrStorage :: CSize sizeOfSocketAddrStorage = (#size struct sockaddr_storage)@@ -491,28 +479,22 @@ -- True -- >>> 50000 + (10000 :: PortNumber) -- 60000-newtype PortNumber = PortNumber Word16 deriving (Eq, Ord, Num, Enum, Bounded, Real, Integral)+newtype PortNumber = PortNumber Word16 deriving (Eq, Ord, Enum, Generic)+                                        deriving newtype (Show, Read, Num, Bounded, Real, Integral)+                                        deriving anyclass ShowT  -- | @:0@ portAny :: PortNumber portAny = PortNumber 0 --- Print "n" instead of "PortNum n".-instance Show PortNumber where-  showsPrec p (PortNumber pn) = showsPrec p pn---- Read "n" instead of "PortNum n".-instance Read PortNumber where-  readPrec = PortNumber <$> readPrec- instance Storable PortNumber where    sizeOf    _ = sizeOf    (0 :: Word16)    alignment _ = alignment (0 :: Word16)    poke p (PortNumber po) = poke (castPtr p) (htons po)    peek p = PortNumber . ntohs <$> peek (castPtr p) -instance UnalignedAccess PortNumber where-   unalignedSize = UnalignedSize 2+instance Unaligned PortNumber where+   unalignedSize _ = 2    indexBA p off = PortNumber . ntohs $ indexBA p off    pokeMBA p off (PortNumber po) = pokeMBA p off (htons po)    peekMBA p off = PortNumber . ntohs <$> peekMBA p off@@ -584,5 +566,5 @@ foreign import #{CALLCONV} unsafe "ntohl" ntohl :: Word32 -> Word32 foreign import #{CALLCONV} unsafe "htonl" htonl :: Word32 -> Word32 -foreign import ccall unsafe uv_ip4_addr :: CString -> CInt -> MBA## SocketAddr -> IO CInt-foreign import ccall unsafe uv_ip6_addr :: CString -> CInt -> MBA## SocketAddr -> IO CInt+foreign import ccall unsafe uv_ip4_addr :: BA## Word8 -> CInt -> MBA## SocketAddr -> IO CInt+foreign import ccall unsafe uv_ip6_addr :: BA## Word8 -> CInt -> MBA## SocketAddr -> IO CInt

@@ -1,10 +1,3 @@-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}- {-| Module      : Z.IO.Network.TCP Description : TCP servers and clients@@ -21,6 +14,7 @@ module Z.IO.Network.TCP (   -- * TCP Client     TCPClientConfig(..)+  , UVStream   , defaultTCPClientConfig   , initTCPClient   , getTCPSockName@@ -29,6 +23,8 @@   , defaultTCPServerConfig   , startTCPServer   , getTCPPeerName+  , helloWorldWorker+  , echoWorker   -- * Internal helper   , setTCPNoDelay   , setTCPKeepAlive@@ -36,7 +32,6 @@   ) where  import           Control.Concurrent.MVar-import           Control.Monad.Primitive import           Control.Monad import           Control.Monad.IO.Class import           Data.Primitive.PrimArray@@ -97,13 +92,12 @@     , tcpListenBacklog    :: Int           -- ^ listening socket's backlog size, should be large enough(>128)     , tcpServerWorkerNoDelay :: Bool       -- ^ if we want to use @TCP_NODELAY@     , tcpServerWorkerKeepAlive :: CUInt    -- ^ set keepalive delay for worker socket, see 'setTCPKeepAlive'-    , tcpServerWorker     :: UVStream -> IO ()  -- ^ worker which get an accepted TCP stream,-                                            -- the socket will be closed upon exception or worker finishes.     }  -- | A default hello world server on localhost:8888 ----- Test it with @main = startTCPServer defaultTCPServerConfig@, now try @nc -v 127.0.0.1 8888@+-- Test it with @main = startTCPServer defaultTCPServerConfig helloWorldWorker@ or+-- @main = startTCPServer defaultTCPServerConfig echoWorker@, now try @nc -v 127.0.0.1 8888@ -- defaultTCPServerConfig :: TCPServerConfig defaultTCPServerConfig = TCPServerConfig@@ -111,14 +105,29 @@     128     True     30-    (\ uvs -> writeOutput uvs (Ptr "hello world"#) 11) +-- | A server worker output "hello world" and close the connection.+helloWorldWorker :: UVStream -> IO ()+helloWorldWorker uvs = writeOutput uvs (Ptr "hello world"#) 11++-- | A server worker echo whatever received bytes.+echoWorker :: UVStream -> IO ()+echoWorker uvs = do+    i <- newBufferedInput uvs+    o <- newBufferedOutput uvs+    forever $ readBuffer i >>= writeBuffer o >> flushBuffer o+ -- | Start a server -- -- Fork new worker thread upon a new connection. ---startTCPServer :: HasCallStack => TCPServerConfig -> IO ()-startTCPServer TCPServerConfig{..} = do+startTCPServer :: HasCallStack+               => TCPServerConfig+               -> (UVStream -> IO ())   -- ^ worker which will get an accepted TCP stream and+                                        -- run in a seperated haskell thread,+                                        -- the socket will be closed upon exception or worker finishes.+               -> IO ()+startTCPServer TCPServerConfig{..} tcpServerWorker = do     let backLog = max tcpListenBacklog 128     serverUVManager <- getUVManager     withResource (initTCPStream serverUVManager) $ \ (UVStream serverHandle serverSlot _ _) -> do

@@ -1,10 +1,3 @@-{-# LANGUAGE MultiWayIf #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE PatternSynonyms #-}- {-| Module      : Z.IO.Network.UDP Description : UDP servers and clients@@ -32,7 +25,7 @@   , initUDP   , UDPConfig(..)   , defaultUDPConfig-  , UVUDPFlag(UV_UDP_DEFAULT, UV_UDP_IPV6ONLY, UV_UDP_REUSEADDR)+  , UDPFlag(UDP_DEFAULT, UDP_IPV6ONLY, UDP_REUSEADDR)   , sendUDP   , UDPRecvConfig(..)   , defaultUDPRecvConfig@@ -46,7 +39,7 @@   , getPeerName   , sendConnectedUDP   -- * multicast and broadcast-  , UVMembership(UV_JOIN_GROUP, UV_LEAVE_GROUP)+  , Membership(JOIN_GROUP, LEAVE_GROUP)   , setMembership   , setSourceMembership   , setMulticastLoop@@ -56,9 +49,8 @@   , setTTL   ) where -import Control.Concurrent.MVar+import Control.Concurrent import Control.Monad-import Control.Monad.Primitive  (primitive_) import Data.Primitive.PrimArray as A import Data.IORef import Data.Word@@ -105,9 +97,9 @@ -- could be more likely dropped by routers, -- usually a packet(IPV4) with a payload <= 508 bytes is considered safe. data UDPConfig = UDPConfig-    { udpSendMsgSize :: {-# UNPACK #-} !Int           -- ^ maximum size of sending buffer-    , udpLocalAddr :: Maybe (SocketAddr, UVUDPFlag) -- ^ do we want bind a local address before receiving & sending?-                                                   --   set to Nothing to let OS pick a random one.+    { udpSendMsgSize :: {-# UNPACK #-} !Int         -- ^ maximum size of sending buffer+    , udpLocalAddr :: Maybe (SocketAddr, UDPFlag)   -- ^ do we want bind a local address before receiving & sending?+                                                    --   set to Nothing to let OS pick a random one.     } deriving (Show, Eq, Ord)  -- | @UDPConfig 512 Nothing@@@ -256,7 +248,7 @@ setMulticastInterface :: HasCallStack => UDP -> CBytes ->IO () setMulticastInterface udp@(UDP hdl _ _ _ _) iaddr = do     checkUDPClosed udp-    withCBytes iaddr $ \ iaddrp ->+    withCBytesUnsafe iaddr $ \ iaddrp ->         throwUVIfMinus_ (uv_udp_set_multicast_interface hdl iaddrp)  -- | Set broadcast on or off.@@ -279,12 +271,12 @@               => UDP               -> CBytes             -- ^ Multicast address to set membership for.               -> CBytes             -- ^ Interface address.-              -> UVMembership       -- ^ UV_JOIN_GROUP | UV_LEAVE_GROUP+              -> Membership       -- ^ UV_JOIN_GROUP | UV_LEAVE_GROUP               -> IO () setMembership udp@(UDP hdl _ _ _ _) gaddr iaddr member = do     checkUDPClosed udp-    withCBytes gaddr $ \ gaddrp ->-        withCBytes iaddr $ \ iaddrp ->+    withCBytesUnsafe gaddr $ \ gaddrp ->+        withCBytesUnsafe iaddr $ \ iaddrp ->             throwUVIfMinus_ (uv_udp_set_membership hdl gaddrp iaddrp member)  -- | Set membership for a source-specific multicast group.@@ -293,13 +285,13 @@                     -> CBytes           -- ^ Multicast address to set membership for.                     -> CBytes           -- ^ Interface address.                     -> CBytes           -- ^ Source address.-                    -> UVMembership     -- ^ UV_JOIN_GROUP | UV_LEAVE_GROUP+                    -> Membership     -- ^ UV_JOIN_GROUP | UV_LEAVE_GROUP                     -> IO () setSourceMembership udp@(UDP hdl _ _ _ _) gaddr iaddr source member = do     checkUDPClosed udp-    withCBytes gaddr $ \ gaddrp ->-        withCBytes iaddr $ \ iaddrp ->-            withCBytes source $ \ sourcep ->+    withCBytesUnsafe gaddr $ \ gaddrp ->+        withCBytesUnsafe iaddr $ \ iaddrp ->+            withCBytesUnsafe source $ \ sourcep ->                 throwUVIfMinus_ (uv_udp_set_source_membership hdl gaddrp iaddrp sourcep member)  --------------------------------------------------------------------------------@@ -371,67 +363,79 @@             -> UDP             -> ((Maybe SocketAddr, Bool, V.Bytes) -> IO a)             -> IO ()-recvUDPLoop (UDPRecvConfig bufSiz bufArrSiz) udp worker = do-    buf <- newRecvBuf bufSiz bufArrSiz-    forever $ do-        msgs <- recvUDPWith udp buf bufSiz-        forM_ msgs worker+recvUDPLoop (UDPRecvConfig bufSiz bufArrSiz) udp@(UDP hdl slot uvm _ _) worker = do+    bracket+        (throwOOMIfNull $ hs_uv_udp_check_alloc hdl)+        hs_uv_udp_check_close $+        \ check -> do+            buf@(_, rbufArr) <- newRecvBuf bufSiz bufArrSiz+            withMutablePrimArrayContents rbufArr $ \ p -> do+                pokeBufferTable uvm slot (castPtr p) (bufArrSiz-1)+                -- init uv_check_t must come after poking buffer+                throwUVIfMinus_ $ hs_uv_udp_check_init check+            forever $ do+                msgs <- recvUDPWith udp check buf bufSiz+                withMutablePrimArrayContents rbufArr $ \ p ->+                    pokeBufferTable uvm slot (castPtr p) (bufArrSiz-1)+                forM_ msgs worker  -- | Recv messages from UDP socket, return source address if available, and a `Bool` -- to indicate if the message is partial (larger than receive buffer size). -- recvUDP :: HasCallStack => UDPRecvConfig -> UDP -> IO [(Maybe SocketAddr, Bool, V.Bytes)]-recvUDP (UDPRecvConfig bufSiz bufArrSiz) udp = do-    buf <- newRecvBuf bufSiz bufArrSiz-    recvUDPWith udp buf bufSiz+recvUDP (UDPRecvConfig bufSiz bufArrSiz) udp@(UDP hdl slot uvm _ _)  = do+    bracket+        (throwOOMIfNull $ hs_uv_udp_check_alloc hdl)+        hs_uv_udp_check_close $+        \ check -> do+            buf@(_, rbufArr) <- newRecvBuf bufSiz bufArrSiz+            withMutablePrimArrayContents rbufArr $ \ p -> do+                pokeBufferTable uvm slot (castPtr p) (bufArrSiz-1)+                -- init uv_check_t must come after poking buffer+                throwUVIfMinus_ $ hs_uv_udp_check_init check+            recvUDPWith udp check buf bufSiz  recvUDPWith :: HasCallStack             => UDP+            -> Ptr UVHandle -- ^ uv_check_t             -> (A.MutablePrimArray RealWorld Word8, A.MutablePrimArray RealWorld (Ptr Word8))             -> Int32             -> IO [(Maybe SocketAddr, Bool, V.Bytes)]-recvUDPWith udp@(UDP hdl slot uvm _ _) (rubf, rbufArr) bufSiz =+recvUDPWith udp@(UDP hdl slot uvm _ _) check (rubf, rbufArr) bufSiz =     -- It's important to keep recv buffer alive, even if we don't directly use it     mask_ . withMutablePrimArrayContents rubf $ \ _ -> do         checkUDPClosed udp -        rbufArrSiz <- getSizeofMutablePrimArray rbufArr+        bufArrSiz <- getSizeofMutablePrimArray rbufArr         -- we have to reset the buffer size, during receiving it'll be overwritten-        forM_ [0..rbufArrSiz-1] $ \ i -> do+        forM_ [0..bufArrSiz-1] $ \ i -> do             p <- readPrimArray rbufArr i             poke (castPtr p :: Ptr Int32) bufSiz -        -- reset buffer table's size with buffer array's length, during receiving it'll be decreased-        withMutablePrimArrayContents rbufArr $ \ p ->-            pokeBufferTable uvm slot (castPtr p) rbufArrSiz-         m <- getBlockMVar uvm slot-        -- clean up-        _ <- tryTakeMVar m -        throwUVIfMinus_ $ withUVManager' uvm (hs_uv_udp_recv_start hdl)+        throwUVIfMinus_ . withUVManager' uvm $ do+            -- clean up+            _ <- tryTakeMVar m+            hs_uv_udp_recv_start hdl -        -- since we are inside mask, this is the only place-        -- async exceptions could possibly kick in, and we should stop reading         r <- takeMVar m `onException` (do                 -- normally we call 'uv_udp_recv_stop' in C read callback                 -- but when exception raise, here's the place to stop                 throwUVIfMinus_ $ withUVManager' uvm (uv_udp_recv_stop hdl)                 void (tryTakeMVar m)) -        if r < rbufArrSiz-        then forM [rbufArrSiz-1, rbufArrSiz-2 .. r] $ \ i -> do+        forM [r+1..bufArrSiz-1] $ \ i -> do             p        <- readPrimArray rbufArr i             -- see the buffer struct diagram above             result   <- throwUVIfMinus (fromIntegral <$> peek @Int32 (castPtr p))             flag     <- peek @Int32 (castPtr (p `plusPtr` 4))             addrFlag <- peek @Int32 (castPtr (p `plusPtr` 8))             !addr <- if addrFlag == 1-                then Just <$> peekSocketAddr (castPtr (p `plusPtr` 12))+                then Just <$!> peekSocketAddr (castPtr (p `plusPtr` 12))                 else return Nothing             let !partial = flag .&. UV_UDP_PARTIAL /= 0             mba <- A.newPrimArray result             copyPtrToMutablePrimArray mba 0 (p `plusPtr` 140) result             ba <- A.unsafeFreezePrimArray mba             return (addr, partial, V.PrimVector ba 0 result)-        else return []

@@ -1,7 +1,3 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE RankNTypes #-}- {-| Module      : Z.IO.Resource Description : The Resource monad

@@ -1,8 +1,3 @@-{-# LANGUAGE MultiWayIf #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE BangPatterns #-}-- {-| Module      : Z.IO.StdStream Description : TTY devices@@ -44,7 +39,7 @@   ( -- * Standard input & output streams     StdStream   , isStdStreamTTY-  , UVTTYMode(UV_TTY_MODE_NORMAL, UV_TTY_MODE_RAW)+  , TTYMode(TTY_MODE_NORMAL, TTY_MODE_RAW)   , setStdinTTYMode   , getStdoutWinSize   , stdin, stdout, stderr@@ -58,12 +53,11 @@  import Control.Monad import Control.Concurrent.MVar-import Foreign.C.Types (CInt) import Foreign.Ptr import System.IO.Unsafe import Z.Data.Builder as B import Z.Data.Vector as V-import Z.Data.Text.Builder (ToText, toBuilder)+import Z.Data.Text.ShowT (ShowT, toBuilder) import Z.IO.UV.FFI import Z.IO.UV.Manager import Z.IO.UV.Errno@@ -178,7 +172,7 @@     else return (StdFile fd)  -- | Change terminal's mode if stdin is connected to a terminal.-setStdinTTYMode :: UVTTYMode -> IO ()+setStdinTTYMode :: TTYMode -> IO () setStdinTTYMode mode = case stdin of     StdTTY hdl _ uvm ->         withUVManager' uvm . throwUVIfMinus_ $ uv_tty_set_mode hdl mode@@ -197,8 +191,8 @@  -------------------------------------------------------------------------------- --- | print a 'ToText' and flush to stdout.-printStd :: HasCallStack => ToText a => a -> IO ()+-- | print a 'ShowT' and flush to stdout.+printStd :: HasCallStack => ShowT a => a -> IO () printStd s = putStd (toBuilder s)  -- | print a 'Builder' and flush to stdout.

@@ -1,4 +1,3 @@-{-# LANGUAGE PatternSynonyms #-} {-| Module      : Z.IO.UVErrno Description : Errno provided by libuv@@ -16,16 +15,17 @@  import Foreign.C.Types import Foreign.C.String+import Z.Data.CBytes  #include "hs_uv.h" -uvStdError :: CInt -> IO String-uvStdError errno = peekCString =<< uv_strerror errno+uvStdError :: CInt -> IO CBytes+uvStdError errno = fromCString =<< uv_strerror errno  foreign import ccall unsafe uv_strerror :: CInt -> IO CString -uvErrName :: CInt -> IO String-uvErrName errno = peekCString =<< uv_err_name errno+uvErrName :: CInt -> IO CBytes+uvErrName errno = fromCString =<< uv_err_name errno  foreign import ccall unsafe uv_err_name :: CInt -> IO CString 

@@ -1,11 +1,3 @@-{-# LANGUAGE CPP                        #-}-{-# LANGUAGE DeriveGeneric              #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE MagicHash                  #-}-{-# LANGUAGE TypeFamilies               #-}-{-# LANGUAGE PatternSynonyms            #-}-{-# LANGUAGE UnliftedFFITypes           #-}- {-| Module      : Z.IO.UV Description : libuv operations@@ -23,13 +15,19 @@  import           Data.Bits import           Data.Int-import           Data.Typeable import           Data.Word import           Foreign.C.String import           Foreign.C.Types import           Foreign.Ptr import           Foreign.Storable+import           Z.Data.Array.Unaligned+import qualified Z.Data.Array  as A +import qualified Z.Data.Text   as T+import           Z.Data.Text.ShowT   (ShowT(..))+import           Z.Data.JSON         (EncodeJSON, ToValue, FromValue)+import           Z.Data.CBytes import           Z.Foreign+import           Z.IO.Exception (throwUVIfMinus_) import           Z.IO.Network.SocketAddr    (SocketAddr) import           System.Posix.Types (CSsize (..)) import           GHC.Generics@@ -47,9 +45,9 @@ -------------------------------------------------------------------------------- -- Type alias type UVSlot = Int--- | UVSlotUnSafe wrap a slot which may not have a 'MVar' in blocking table, +-- | UVSlotUnsafe wrap a slot which may not have a 'MVar' in blocking table,  --   i.e. the blocking table need to be resized.-newtype UVSlotUnSafe = UVSlotUnSafe { unsafeGetSlot :: UVSlot }+newtype UVSlotUnsafe = UVSlotUnsafe { unsafeGetSlot :: UVSlot } type UVFD = Int32  --------------------------------------------------------------------------------@@ -79,7 +77,8 @@     <$> (#{peek hs_loop_data, buffer_table          } p)     <*> (#{peek hs_loop_data, buffer_size_table     } p) -newtype UVRunMode = UVRunMode CInt deriving (Eq, Ord, Typeable)+newtype UVRunMode = UVRunMode CInt deriving (Show, Eq, Ord, Generic)+                                   deriving anyclass ShowT   pattern UV_RUN_DEFAULT :: UVRunMode pattern UV_RUN_DEFAULT = UVRunMode #{const UV_RUN_DEFAULT}@@ -113,8 +112,8 @@ -- handle data UVHandle -peekUVHandleData :: Ptr UVHandle -> IO UVSlotUnSafe-peekUVHandleData p =  UVSlotUnSafe <$> (#{peek uv_handle_t, data} p :: IO Int)+peekUVHandleData :: Ptr UVHandle -> IO UVSlotUnsafe+peekUVHandleData p =  UVSlotUnsafe <$> (#{peek uv_handle_t, data} p :: IO Int)  foreign import ccall unsafe hs_uv_fileno :: Ptr UVHandle -> IO UVFD foreign import ccall unsafe hs_uv_handle_alloc :: Ptr UVLoop -> IO (Ptr UVHandle)@@ -134,7 +133,7 @@  foreign import ccall unsafe hs_uv_read_start :: Ptr UVHandle -> IO CInt foreign import ccall unsafe uv_read_stop :: Ptr UVHandle -> IO CInt-foreign import ccall unsafe hs_uv_write :: Ptr UVHandle -> Ptr Word8 -> Int -> IO UVSlotUnSafe+foreign import ccall unsafe hs_uv_write :: Ptr UVHandle -> Ptr Word8 -> Int -> IO UVSlotUnsafe  foreign import ccall unsafe hs_uv_accept_check_alloc :: Ptr UVHandle -> IO (Ptr UVHandle) foreign import ccall unsafe hs_uv_accept_check_init :: Ptr UVHandle -> IO CInt@@ -154,39 +153,43 @@ uV_TCP_IPV6ONLY = #{const UV_TCP_IPV6ONLY}  foreign import ccall unsafe uv_tcp_bind :: Ptr UVHandle -> MBA## SocketAddr -> CUInt -> IO CInt-foreign import ccall unsafe hs_uv_tcp_connect :: Ptr UVHandle -> MBA## SocketAddr -> IO UVSlotUnSafe+foreign import ccall unsafe hs_uv_tcp_connect :: Ptr UVHandle -> MBA## SocketAddr -> IO UVSlotUnsafe foreign import ccall unsafe hs_set_socket_reuse :: Ptr UVHandle -> IO CInt  foreign import ccall unsafe hs_uv_pipe_open :: Ptr UVHandle -> UVFD -> IO CInt foreign import ccall unsafe uv_pipe_init :: Ptr UVLoop -> Ptr UVHandle -> CInt -> IO CInt-foreign import ccall unsafe uv_pipe_bind :: Ptr UVHandle -> CString -> IO CInt-foreign import ccall unsafe hs_uv_pipe_connect :: Ptr UVHandle -> CString -> IO UVSlotUnSafe+foreign import ccall unsafe uv_pipe_bind :: Ptr UVHandle -> BA## Word8 -> IO CInt+foreign import ccall unsafe hs_uv_pipe_connect :: Ptr UVHandle -> BA## Word8 -> IO UVSlotUnsafe  -------------------------------------------------------------------------------- -- udp foreign import ccall unsafe uv_udp_init :: Ptr UVLoop -> Ptr UVHandle -> IO CInt foreign import ccall unsafe uv_udp_init_ex :: Ptr UVLoop -> Ptr UVHandle -> CUInt -> IO CInt foreign import ccall unsafe uv_udp_open :: Ptr UVHandle -> UVFD -> IO CInt-foreign import ccall unsafe uv_udp_bind :: Ptr UVHandle -> MBA## SocketAddr -> UVUDPFlag -> IO CInt+foreign import ccall unsafe uv_udp_bind :: Ptr UVHandle -> MBA## SocketAddr -> UDPFlag -> IO CInt -newtype UVMembership = UVMembership CInt deriving (Show, Eq, Ord)+newtype Membership = Membership CInt deriving (Show, Eq, Ord, Generic)+                                        deriving newtype (EncodeJSON, ToValue, FromValue)+                                        deriving anyclass ShowT -pattern UV_LEAVE_GROUP :: UVMembership-pattern UV_LEAVE_GROUP = UVMembership #{const UV_LEAVE_GROUP}-pattern UV_JOIN_GROUP :: UVMembership-pattern UV_JOIN_GROUP = UVMembership #{const UV_JOIN_GROUP}+pattern LEAVE_GROUP :: Membership+pattern LEAVE_GROUP = Membership #{const UV_LEAVE_GROUP}+pattern JOIN_GROUP :: Membership+pattern JOIN_GROUP = Membership #{const UV_JOIN_GROUP} -newtype UVUDPFlag = UVUDPFlag CInt deriving (Show, Eq, Ord, Storable, Bits, FiniteBits, Num)+newtype UDPFlag = UDPFlag CInt deriving (Show, Eq, Ord, Generic)+                                deriving newtype (Storable, Unaligned, Bits, FiniteBits, Num, EncodeJSON, ToValue, FromValue)+                                deriving anyclass ShowT -pattern UV_UDP_DEFAULT :: UVUDPFlag-pattern UV_UDP_DEFAULT = UVUDPFlag 0-pattern UV_UDP_IPV6ONLY :: UVUDPFlag-pattern UV_UDP_IPV6ONLY = UVUDPFlag #{const UV_UDP_IPV6ONLY}-pattern UV_UDP_REUSEADDR :: UVUDPFlag-pattern UV_UDP_REUSEADDR = UVUDPFlag #{const UV_UDP_REUSEADDR}+pattern UDP_DEFAULT        :: UDPFlag+pattern UDP_DEFAULT         = UDPFlag 0+pattern UDP_IPV6ONLY       :: UDPFlag+pattern UDP_IPV6ONLY        = UDPFlag #{const UV_UDP_IPV6ONLY}+pattern UDP_REUSEADDR      :: UDPFlag+pattern UDP_REUSEADDR       = UDPFlag #{const UV_UDP_REUSEADDR} -pattern UV_UDP_PARTIAL :: Int32-pattern UV_UDP_PARTIAL = #{const UV_UDP_PARTIAL}+pattern UV_UDP_PARTIAL     :: Int32+pattern UV_UDP_PARTIAL      = #{const UV_UDP_PARTIAL}  foreign import ccall unsafe uv_udp_connect     :: Ptr UVHandle -> MBA## SocketAddr -> IO CInt@@ -195,22 +198,27 @@     :: Ptr UVHandle -> Ptr SocketAddr -> IO CInt  foreign import ccall unsafe uv_udp_set_membership ::-    Ptr UVHandle -> CString -> CString -> UVMembership -> IO CInt+    Ptr UVHandle -> BA## Word8 -> BA## Word8 -> Membership -> IO CInt foreign import ccall unsafe uv_udp_set_source_membership ::-    Ptr UVHandle -> CString -> CString -> CString -> UVMembership -> IO CInt+    Ptr UVHandle -> BA## Word8 -> BA## Word8 -> BA## Word8 -> Membership -> IO CInt  foreign import ccall unsafe uv_udp_set_multicast_loop :: Ptr UVHandle -> CInt -> IO CInt foreign import ccall unsafe uv_udp_set_multicast_ttl :: Ptr UVHandle -> CInt -> IO CInt-foreign import ccall unsafe uv_udp_set_multicast_interface :: Ptr UVHandle -> CString -> IO CInt+foreign import ccall unsafe uv_udp_set_multicast_interface :: Ptr UVHandle -> BA## Word8 -> IO CInt foreign import ccall unsafe uv_udp_set_broadcast :: Ptr UVHandle -> CInt -> IO CInt foreign import ccall unsafe uv_udp_set_ttl :: Ptr UVHandle -> CInt -> IO CInt  foreign import ccall unsafe hs_uv_udp_recv_start :: Ptr UVHandle -> IO CInt foreign import ccall unsafe uv_udp_recv_stop :: Ptr UVHandle -> IO CInt++foreign import ccall unsafe hs_uv_udp_check_alloc :: Ptr UVHandle -> IO (Ptr UVHandle)+foreign import ccall unsafe hs_uv_udp_check_init :: Ptr UVHandle -> IO CInt+foreign import ccall unsafe hs_uv_udp_check_close :: Ptr UVHandle -> IO ()+ foreign import ccall unsafe hs_uv_udp_send -    :: Ptr UVHandle -> MBA## SocketAddr -> Ptr Word8 -> Int -> IO UVSlotUnSafe+    :: Ptr UVHandle -> MBA## SocketAddr -> Ptr Word8 -> Int -> IO UVSlotUnsafe foreign import ccall unsafe hs_uv_udp_send_connected-    :: Ptr UVHandle -> Ptr Word8 -> Int -> IO UVSlotUnSafe+    :: Ptr UVHandle -> Ptr Word8 -> Int -> IO UVSlotUnsafe foreign import ccall unsafe uv_udp_getsockname      :: Ptr UVHandle -> MBA## SocketAddr -> MBA## CInt -> IO CInt foreign import ccall unsafe uv_udp_getpeername@@ -225,25 +233,29 @@ -- When in 'UV_TTY_MODE_RAW' mode, input is always available character-by-character, -- not including modifiers. Additionally, all special processing of characters by the terminal is disabled,  -- including echoing input characters. Note that CTRL+C will no longer cause a SIGINT when in this mode.-newtype UVTTYMode = UVTTYMode CInt-    deriving (Eq, Ord, Read, Show, FiniteBits, Bits, Storable, Num)+newtype TTYMode = TTYMode CInt+    deriving (Eq, Ord, Show, Generic)+    deriving newtype (Storable, Unaligned, Bits, FiniteBits, Num, EncodeJSON, ToValue, FromValue)+    deriving anyclass ShowT -pattern UV_TTY_MODE_NORMAL :: UVTTYMode-pattern UV_TTY_MODE_NORMAL = UVTTYMode #{const UV_TTY_MODE_NORMAL}-pattern UV_TTY_MODE_RAW :: UVTTYMode-pattern UV_TTY_MODE_RAW = UVTTYMode #{const UV_TTY_MODE_RAW}-pattern UV_TTY_MODE_IO :: UVTTYMode-pattern UV_TTY_MODE_IO = UVTTYMode #{const UV_TTY_MODE_IO}+pattern TTY_MODE_NORMAL :: TTYMode+pattern TTY_MODE_NORMAL = TTYMode #{const UV_TTY_MODE_NORMAL}+pattern TTY_MODE_RAW :: TTYMode+pattern TTY_MODE_RAW = TTYMode #{const UV_TTY_MODE_RAW}+pattern TTY_MODE_IO :: TTYMode+pattern TTY_MODE_IO = TTYMode #{const UV_TTY_MODE_IO}  foreign import ccall unsafe uv_tty_init :: Ptr UVLoop -> Ptr UVHandle -> CInt -> IO CInt-foreign import ccall unsafe uv_tty_set_mode :: Ptr UVHandle -> UVTTYMode -> IO CInt+foreign import ccall unsafe uv_tty_set_mode :: Ptr UVHandle -> TTYMode -> IO CInt foreign import ccall unsafe uv_tty_get_winsize :: Ptr UVHandle -> MBA## CInt -> MBA## CInt -> IO CInt  -------------------------------------------------------------------------------- -- fs  newtype FileMode = FileMode CInt-    deriving (Eq, Ord, Read, Show, FiniteBits, Bits, Storable, Num)+    deriving (Eq, Ord, Show, Generic)+    deriving newtype (Storable, Unaligned, Bits, FiniteBits, Num, EncodeJSON, ToValue, FromValue)+    deriving anyclass ShowT  -- | 00700 user (file owner) has read, write and execute permission pattern S_IRWXU :: FileMode@@ -298,35 +310,37 @@ pattern DEFAULT_MODE = FileMode 0o666  -- non-threaded functions-foreign import ccall unsafe hs_uv_fs_open    :: CString -> FileFlag -> FileMode -> IO UVFD+foreign import ccall unsafe hs_uv_fs_open    :: BA## Word8 -> FileFlag -> FileMode -> IO UVFD foreign import ccall unsafe hs_uv_fs_close   :: UVFD -> IO Int foreign import ccall unsafe hs_uv_fs_read    :: UVFD -> Ptr Word8 -> Int -> Int64 -> IO Int foreign import ccall unsafe hs_uv_fs_write   :: UVFD -> Ptr Word8 -> Int -> Int64 -> IO Int-foreign import ccall unsafe hs_uv_fs_unlink  :: CString -> IO Int-foreign import ccall unsafe hs_uv_fs_mkdir   :: CString -> FileMode -> IO Int-foreign import ccall unsafe hs_uv_fs_rmdir   :: CString -> IO Int-foreign import ccall unsafe hs_uv_fs_mkdtemp :: CString -> Int -> CString -> IO Int+foreign import ccall unsafe hs_uv_fs_unlink  :: BA## Word8 -> IO Int+foreign import ccall unsafe hs_uv_fs_mkdir   :: BA## Word8 -> FileMode -> IO Int+foreign import ccall unsafe hs_uv_fs_rmdir   :: BA## Word8 -> IO Int+foreign import ccall unsafe hs_uv_fs_mkdtemp :: BA## Word8 -> Int -> MBA## Word8 -> IO Int  -- threaded functions foreign import ccall unsafe hs_uv_fs_open_threaded -    :: CString -> FileFlag -> FileMode -> Ptr UVLoop -> IO UVSlotUnSafe+    :: BA## Word8 -> FileFlag -> FileMode -> Ptr UVLoop -> IO UVSlotUnsafe foreign import ccall unsafe hs_uv_fs_close_threaded -    :: UVFD -> Ptr UVLoop -> IO UVSlotUnSafe+    :: UVFD -> Ptr UVLoop -> IO UVSlotUnsafe foreign import ccall unsafe hs_uv_fs_read_threaded  -    :: UVFD -> Ptr Word8 -> Int -> Int64 -> Ptr UVLoop -> IO UVSlotUnSafe+    :: UVFD -> Ptr Word8 -> Int -> Int64 -> Ptr UVLoop -> IO UVSlotUnsafe foreign import ccall unsafe hs_uv_fs_write_threaded -    :: UVFD -> Ptr Word8 -> Int -> Int64 -> Ptr UVLoop -> IO UVSlotUnSafe+    :: UVFD -> Ptr Word8 -> Int -> Int64 -> Ptr UVLoop -> IO UVSlotUnsafe foreign import ccall unsafe hs_uv_fs_unlink_threaded-    :: CString -> Ptr UVLoop -> IO UVSlotUnSafe+    :: BA## Word8 -> Ptr UVLoop -> IO UVSlotUnsafe foreign import ccall unsafe hs_uv_fs_mkdir_threaded -    :: CString -> FileMode -> Ptr UVLoop -> IO UVSlotUnSafe+    :: BA## Word8 -> FileMode -> Ptr UVLoop -> IO UVSlotUnsafe foreign import ccall unsafe hs_uv_fs_rmdir_threaded -    :: CString -> Ptr UVLoop -> IO UVSlotUnSafe+    :: BA## Word8 -> Ptr UVLoop -> IO UVSlotUnsafe foreign import ccall unsafe hs_uv_fs_mkdtemp_threaded -    :: CString -> Int -> CString -> Ptr UVLoop -> IO UVSlotUnSafe+    :: BA## Word8 -> Int -> MBA## Word8 -> Ptr UVLoop -> IO UVSlotUnsafe  newtype FileFlag = FileFlag CInt-    deriving (Eq, Ord, Read, Show, FiniteBits, Bits, Storable, Num)+    deriving (Eq, Ord, Show, Generic)+    deriving newtype (Storable, Unaligned, Bits, FiniteBits, Num, EncodeJSON, ToValue, FromValue)+    deriving anyclass ShowT  -- | The file is opened in append mode. Before each write, the file offset is positioned at the end of the file. pattern O_APPEND :: FileFlag@@ -447,7 +461,9 @@ #else newtype UVDirEntType = UVDirEntType CChar #endif-    deriving (Eq, Ord, Read, Show, FiniteBits, Bits, Storable, Num)+    deriving (Eq, Ord, Show, Generic)+    deriving newtype (Storable, Unaligned, Bits, FiniteBits, Num, EncodeJSON, ToValue, FromValue)+    deriving anyclass ShowT  data DirEntType     = DirEntUnknown@@ -459,6 +475,7 @@     | DirEntChar     | DirEntBlock   deriving (Read, Show, Eq, Ord, Generic)+    deriving anyclass (ShowT, EncodeJSON, ToValue, FromValue)  fromUVDirEntType :: UVDirEntType -> DirEntType fromUVDirEntType t@@ -492,16 +509,17 @@ foreign import ccall unsafe hs_uv_fs_scandir_cleanup     :: Ptr (Ptr UVDirEnt) -> Int -> IO () foreign import ccall unsafe hs_uv_fs_scandir-    :: CString -> MBA## (Ptr UVDirEnt) -> IO Int+    :: BA## Word8 -> MBA## (Ptr UVDirEnt) -> IO Int foreign import ccall unsafe hs_uv_fs_scandir_extra_cleanup      :: Ptr (Ptr (Ptr UVDirEnt)) -> Int -> IO () foreign import ccall unsafe hs_uv_fs_scandir_threaded-    :: CString -> Ptr (Ptr (Ptr UVDirEnt)) -> Ptr UVLoop -> IO UVSlotUnSafe+    :: BA## Word8 -> Ptr (Ptr (Ptr UVDirEnt)) -> Ptr UVLoop -> IO UVSlotUnsafe  data UVTimeSpec = UVTimeSpec      { uvtSecond     :: {-# UNPACK #-} !CLong     , uvtNanoSecond :: {-# UNPACK #-} !CLong     } deriving (Show, Read, Eq, Ord, Generic)+        deriving anyclass (ShowT, EncodeJSON, ToValue, FromValue)  instance Storable UVTimeSpec where     sizeOf _  = #{size uv_timespec_t}@@ -512,7 +530,7 @@         (#{poke uv_timespec_t, tv_sec  } p sec)         (#{poke uv_timespec_t, tv_nsec } p nsec) -data UVStat = UVStat+data FStat = FStat     { stDev      :: {-# UNPACK #-} !Word64     , stMode     :: {-# UNPACK #-} !Word64     , stNlink    :: {-# UNPACK #-} !Word64@@ -530,12 +548,13 @@     , stCtim     :: {-# UNPACK #-} !UVTimeSpec     , stBirthtim :: {-# UNPACK #-} !UVTimeSpec     } deriving (Show, Read, Eq, Ord, Generic)+        deriving anyclass (ShowT, EncodeJSON, ToValue, FromValue)  uvStatSize :: Int uvStatSize = #{size uv_stat_t} -peekUVStat :: Ptr UVStat -> IO UVStat-peekUVStat p = UVStat+peekUVStat :: Ptr FStat -> IO FStat+peekUVStat p = FStat     <$> (#{peek uv_stat_t, st_dev          } p)     <*> (#{peek uv_stat_t, st_mode         } p)     <*> (#{peek uv_stat_t, st_nlink        } p)@@ -553,126 +572,139 @@     <*> (#{peek uv_stat_t, st_ctim         } p)     <*> (#{peek uv_stat_t, st_birthtim     } p) -foreign import ccall unsafe hs_uv_fs_stat :: CString -> Ptr UVStat -> IO Int-foreign import ccall unsafe hs_uv_fs_fstat :: UVFD -> Ptr UVStat -> IO Int-foreign import ccall unsafe hs_uv_fs_lstat :: CString -> Ptr UVStat -> IO Int-foreign import ccall unsafe hs_uv_fs_rename :: CString -> CString -> IO Int+foreign import ccall unsafe hs_uv_fs_stat :: BA## Word8 -> Ptr FStat -> IO Int+foreign import ccall unsafe hs_uv_fs_fstat :: UVFD -> Ptr FStat -> IO Int+foreign import ccall unsafe hs_uv_fs_lstat :: BA## Word8 -> Ptr FStat -> IO Int+foreign import ccall unsafe hs_uv_fs_rename :: BA## Word8 -> BA## Word8 -> IO Int foreign import ccall unsafe hs_uv_fs_fsync :: UVFD -> IO Int foreign import ccall unsafe hs_uv_fs_fdatasync :: UVFD -> IO Int foreign import ccall unsafe hs_uv_fs_ftruncate :: UVFD -> Int64 -> IO Int  foreign import ccall unsafe hs_uv_fs_stat_threaded-    :: CString -> Ptr UVStat -> Ptr UVLoop -> IO UVSlotUnSafe+    :: BA## Word8 -> Ptr FStat -> Ptr UVLoop -> IO UVSlotUnsafe foreign import ccall unsafe hs_uv_fs_fstat_threaded-    :: UVFD -> Ptr UVStat -> Ptr UVLoop -> IO UVSlotUnSafe+    :: UVFD -> Ptr FStat -> Ptr UVLoop -> IO UVSlotUnsafe foreign import ccall unsafe hs_uv_fs_lstat_threaded-    :: CString -> Ptr UVStat -> Ptr UVLoop -> IO UVSlotUnSafe+    :: BA## Word8 -> Ptr FStat -> Ptr UVLoop -> IO UVSlotUnsafe foreign import ccall unsafe hs_uv_fs_rename_threaded-    :: CString -> CString -> Ptr UVLoop -> IO UVSlotUnSafe+    :: BA## Word8 -> BA## Word8 -> Ptr UVLoop -> IO UVSlotUnsafe foreign import ccall unsafe hs_uv_fs_fsync_threaded-    :: UVFD -> Ptr UVLoop -> IO UVSlotUnSafe+    :: UVFD -> Ptr UVLoop -> IO UVSlotUnsafe foreign import ccall unsafe hs_uv_fs_fdatasync_threaded-    :: UVFD -> Ptr UVLoop -> IO UVSlotUnSafe+    :: UVFD -> Ptr UVLoop -> IO UVSlotUnsafe foreign import ccall unsafe hs_uv_fs_ftruncate_threaded -    :: UVFD -> Int64 -> Ptr UVLoop -> IO UVSlotUnSafe+    :: UVFD -> Int64 -> Ptr UVLoop -> IO UVSlotUnsafe  -- | Flags control copying. --  --   * 'COPYFILE_EXCL': If present, uv_fs_copyfile() will fail with UV_EEXIST if the destination path already exists. The default behavior is to overwrite the destination if it exists. --   * 'COPYFILE_FICLONE': If present, uv_fs_copyfile() will attempt to create a copy-on-write reflink. If the underlying platform does not support copy-on-write, then a fallback copy mechanism is used. -- -newtype UVCopyFileFlag = UVCopyFileFlag CInt-    deriving (Eq, Ord, Read, Show, FiniteBits, Bits, Storable, Num)+newtype CopyFileFlag = CopyFileFlag CInt+    deriving (Eq, Ord, Show, Generic)+    deriving newtype (Storable, Unaligned, Bits, FiniteBits, Num, EncodeJSON, ToValue, FromValue)+    deriving anyclass ShowT -pattern COPYFILE_DEFAULT :: UVCopyFileFlag-pattern COPYFILE_DEFAULT = UVCopyFileFlag 0+pattern COPYFILE_DEFAULT :: CopyFileFlag+pattern COPYFILE_DEFAULT = CopyFileFlag 0 -pattern COPYFILE_EXCL :: UVCopyFileFlag-pattern COPYFILE_EXCL = UVCopyFileFlag #{const UV_FS_COPYFILE_EXCL}+pattern COPYFILE_EXCL :: CopyFileFlag+pattern COPYFILE_EXCL = CopyFileFlag #{const UV_FS_COPYFILE_EXCL} -pattern COPYFILE_FICLONE :: UVCopyFileFlag+pattern COPYFILE_FICLONE :: CopyFileFlag #ifdef UV_FS_COPYFILE_FICLONE-pattern COPYFILE_FICLONE = UVCopyFileFlag #{const UV_FS_COPYFILE_FICLONE}+pattern COPYFILE_FICLONE = CopyFileFlag #{const UV_FS_COPYFILE_FICLONE} #else-pattern COPYFILE_FICLONE = UVCopyFileFlag 0   -- fallback to normal copy.+pattern COPYFILE_FICLONE = CopyFileFlag 0   -- fallback to normal copy. #endif -foreign import ccall unsafe hs_uv_fs_copyfile :: CString -> CString -> UVCopyFileFlag -> IO Int+foreign import ccall unsafe hs_uv_fs_copyfile :: BA## Word8 -> BA## Word8 -> CopyFileFlag -> IO Int foreign import ccall unsafe hs_uv_fs_copyfile_threaded-    :: CString -> CString -> UVCopyFileFlag -> Ptr UVLoop -> IO UVSlotUnSafe+    :: BA## Word8 -> BA## Word8 -> CopyFileFlag -> Ptr UVLoop -> IO UVSlotUnsafe -newtype UVAccessMode = UVAccessMode CInt-    deriving (Eq, Ord, Read, Show, FiniteBits, Bits, Storable, Num)+newtype AccessMode = AccessMode CInt+    deriving (Eq, Ord, Show, Generic)+    deriving newtype (Storable, Unaligned, Bits, FiniteBits, Num, EncodeJSON, ToValue, FromValue)+    deriving anyclass ShowT -pattern F_OK :: UVAccessMode-pattern F_OK = UVAccessMode #{const F_OK}-pattern R_OK :: UVAccessMode-pattern R_OK = UVAccessMode #{const R_OK}-pattern W_OK :: UVAccessMode-pattern W_OK = UVAccessMode #{const W_OK}-pattern X_OK :: UVAccessMode-pattern X_OK = UVAccessMode #{const X_OK}+pattern F_OK :: AccessMode+pattern F_OK = AccessMode #{const F_OK}+pattern R_OK :: AccessMode+pattern R_OK = AccessMode #{const R_OK}+pattern W_OK :: AccessMode+pattern W_OK = AccessMode #{const W_OK}+pattern X_OK :: AccessMode+pattern X_OK = AccessMode #{const X_OK} -data AccessResult = NoExistence | NoPermission | AccessOK deriving (Show, Eq, Ord)+data AccessResult = NoExistence | NoPermission | AccessOK deriving (Show, Eq, Ord, Generic)+                                                          deriving anyclass (ShowT, EncodeJSON, ToValue, FromValue) -foreign import ccall unsafe hs_uv_fs_access :: CString -> UVAccessMode -> IO Int+foreign import ccall unsafe hs_uv_fs_access :: BA## Word8 -> AccessMode -> IO Int foreign import ccall unsafe hs_uv_fs_access_threaded-    :: CString -> UVAccessMode -> Ptr UVLoop -> IO UVSlotUnSafe+    :: BA## Word8 -> AccessMode -> Ptr UVLoop -> IO UVSlotUnsafe -foreign import ccall unsafe hs_uv_fs_chmod :: CString -> FileMode -> IO Int+foreign import ccall unsafe hs_uv_fs_chmod :: BA## Word8 -> FileMode -> IO Int foreign import ccall unsafe hs_uv_fs_chmod_threaded-    :: CString -> FileMode -> Ptr UVLoop -> IO UVSlotUnSafe+    :: BA## Word8 -> FileMode -> Ptr UVLoop -> IO UVSlotUnsafe  foreign import ccall unsafe hs_uv_fs_fchmod :: UVFD -> FileMode -> IO Int foreign import ccall unsafe hs_uv_fs_fchmod_threaded-    :: UVFD -> FileMode -> Ptr UVLoop -> IO UVSlotUnSafe+    :: UVFD -> FileMode -> Ptr UVLoop -> IO UVSlotUnsafe -foreign import ccall unsafe hs_uv_fs_utime :: CString -> Double -> Double -> IO Int+foreign import ccall unsafe hs_uv_fs_utime :: BA## Word8 -> Double -> Double -> IO Int foreign import ccall unsafe hs_uv_fs_utime_threaded-    :: CString -> Double -> Double -> Ptr UVLoop -> IO UVSlotUnSafe+    :: BA## Word8 -> Double -> Double -> Ptr UVLoop -> IO UVSlotUnsafe  foreign import ccall unsafe hs_uv_fs_futime :: UVFD -> Double -> Double -> IO Int foreign import ccall unsafe hs_uv_fs_futime_threaded-    :: UVFD -> Double -> Double -> Ptr UVLoop -> IO UVSlotUnSafe+    :: UVFD -> Double -> Double -> Ptr UVLoop -> IO UVSlotUnsafe -newtype UVSymlinkFlag = UVSymlinkFlag CInt-    deriving (Eq, Ord, Read, Show, FiniteBits, Bits, Storable, Num)+foreign import ccall unsafe hs_uv_fs_lutime :: BA## Word8 -> Double -> Double -> IO Int+foreign import ccall unsafe hs_uv_fs_lutime_threaded+    :: BA## Word8 -> Double -> Double -> Ptr UVLoop -> IO UVSlotUnsafe -pattern SYMLINK_DEFAULT :: UVSymlinkFlag-pattern SYMLINK_DEFAULT = UVSymlinkFlag 0+newtype SymlinkFlag = SymlinkFlag CInt+    deriving (Eq, Ord, Show, Generic)+    deriving newtype (Storable, Unaligned, Bits, FiniteBits, Num, EncodeJSON, ToValue, FromValue)+    deriving anyclass ShowT -pattern SYMLINK_DIR :: UVSymlinkFlag-pattern SYMLINK_DIR = UVSymlinkFlag #{const UV_FS_SYMLINK_DIR}+pattern SYMLINK_DEFAULT :: SymlinkFlag+pattern SYMLINK_DEFAULT = SymlinkFlag 0 -pattern SYMLINK_JUNCTION :: UVSymlinkFlag-pattern SYMLINK_JUNCTION = UVSymlinkFlag #{const UV_FS_SYMLINK_JUNCTION}+pattern SYMLINK_DIR :: SymlinkFlag+pattern SYMLINK_DIR = SymlinkFlag #{const UV_FS_SYMLINK_DIR} -foreign import ccall unsafe hs_uv_fs_link :: CString -> CString -> IO Int+pattern SYMLINK_JUNCTION :: SymlinkFlag+pattern SYMLINK_JUNCTION = SymlinkFlag #{const UV_FS_SYMLINK_JUNCTION}++foreign import ccall unsafe hs_uv_fs_link :: BA## Word8 -> BA## Word8 -> IO Int foreign import ccall unsafe hs_uv_fs_link_threaded-    :: CString -> CString -> Ptr UVLoop -> IO UVSlotUnSafe+    :: BA## Word8 -> BA## Word8 -> Ptr UVLoop -> IO UVSlotUnsafe -foreign import ccall unsafe hs_uv_fs_symlink :: CString -> CString -> UVSymlinkFlag -> IO Int+foreign import ccall unsafe hs_uv_fs_symlink :: BA## Word8 -> BA## Word8 -> SymlinkFlag -> IO Int foreign import ccall unsafe hs_uv_fs_symlink_threaded-    :: CString -> CString -> UVSymlinkFlag -> Ptr UVLoop -> IO UVSlotUnSafe+    :: BA## Word8 -> BA## Word8 -> SymlinkFlag -> Ptr UVLoop -> IO UVSlotUnsafe  -- readlink and realpath share the same cleanup and callback foreign import ccall unsafe hs_uv_fs_readlink_cleanup     :: CString -> IO () foreign import ccall unsafe hs_uv_fs_readlink-    :: CString -> MBA## CString -> IO Int+    :: BA## Word8 -> MBA## CString -> IO Int foreign import ccall unsafe hs_uv_fs_realpath-    :: CString -> MBA## CString -> IO Int+    :: BA## Word8  -> MBA## CString -> IO Int foreign import ccall unsafe hs_uv_fs_readlink_extra_cleanup      :: Ptr CString -> IO () foreign import ccall unsafe hs_uv_fs_readlink_threaded-    :: CString -> Ptr CString -> Ptr UVLoop -> IO UVSlotUnSafe+    :: BA## Word8  -> Ptr CString -> Ptr UVLoop -> IO UVSlotUnsafe foreign import ccall unsafe hs_uv_fs_realpath_threaded-    :: CString -> Ptr CString -> Ptr UVLoop -> IO UVSlotUnSafe+    :: BA## Word8  -> Ptr CString -> Ptr UVLoop -> IO UVSlotUnsafe  -------------------------------------------------------------------------------- -- misc -newtype UVHandleType = UVHandleType CInt deriving (Eq, Ord, Read, Show, Storable)+newtype UVHandleType = UVHandleType CInt deriving (Eq, Ord, Show, Generic)+                                         deriving newtype (Storable, Unaligned, EncodeJSON, ToValue, FromValue)+                                         deriving anyclass ShowT  pattern UV_UNKNOWN_HANDLE :: UVHandleType pattern UV_UNKNOWN_HANDLE = UVHandleType #{const UV_UNKNOWN_HANDLE}@@ -713,3 +745,122 @@  foreign import ccall unsafe uv_guess_handle :: UVFD -> IO UVHandleType +foreign import ccall unsafe uv_resident_set_memory :: MBA## CSize -> IO CInt+foreign import ccall unsafe uv_uptime :: MBA## Double -> IO CInt+foreign import ccall unsafe uv_getrusage :: MBA## a -> IO CInt++-- | Data type for storing times.+-- typedef struct { long tv_sec; long tv_usec; } uv_timeval_t;+data TimeVal = TimeVal +    { tv_sec  :: {-# UNPACK #-} !CLong+    , tv_usec :: {-# UNPACK #-} !CLong+    } deriving (Show, Read, Eq, Ord, Generic)+      deriving anyclass (ShowT, EncodeJSON, ToValue, FromValue)++-- | Data type for resource usage results.+--+-- Members marked with (X) are unsupported on Windows. +-- See <https://man7.org/linux/man-pages/man2/getrusage.2.html getrusage(2)> for supported fields on Unix+data ResUsage = ResUsage+    { ru_utime    :: {-# UNPACK #-} !TimeVal   -- ^  user CPU time used, in microseconds+    , ru_stime    :: {-# UNPACK #-} !TimeVal   -- ^  system CPU time used, in microseconds+    , ru_maxrss   :: {-# UNPACK #-} !Word64    -- ^  maximum resident set size+    , ru_ixrss    :: {-# UNPACK #-} !Word64    -- ^  integral shared memory size (X)+    , ru_idrss    :: {-# UNPACK #-} !Word64    -- ^  integral unshared data size (X)+    , ru_isrss    :: {-# UNPACK #-} !Word64    -- ^  integral unshared stack size (X)+    , ru_minflt   :: {-# UNPACK #-} !Word64    -- ^  page reclaims (soft page faults) (X)+    , ru_majflt   :: {-# UNPACK #-} !Word64    -- ^  page faults (hard page faults)+    , ru_nswap    :: {-# UNPACK #-} !Word64    -- ^  swaps (X)+    , ru_inblock  :: {-# UNPACK #-} !Word64    -- ^  block input operations+    , ru_oublock  :: {-# UNPACK #-} !Word64    -- ^  block output operations+    , ru_msgsnd   :: {-# UNPACK #-} !Word64    -- ^  IPC messages sent (X)+    , ru_msgrcv   :: {-# UNPACK #-} !Word64    -- ^  IPC messages received (X)+    , ru_nsignals :: {-# UNPACK #-} !Word64    -- ^  signals received (X)+    , ru_nvcsw    :: {-# UNPACK #-} !Word64    -- ^  voluntary context switches (X)+    , ru_nivcsw   :: {-# UNPACK #-} !Word64    -- ^  involuntary context switches (X)+    } deriving (Show, Read, Eq, Ord, Generic)+      deriving anyclass (ShowT, EncodeJSON, ToValue, FromValue)++sizeOfResUsage :: Int+sizeOfResUsage = #size uv_rusage_t++peekResUsage :: MBA## a -> IO ResUsage+peekResUsage mba = do+    utime_sec :: CLong <- peekMBA mba (#offset  uv_rusage_t, ru_utime )+    utime_usec :: CLong <- peekMBA mba ((#offset  uv_rusage_t, ru_utime) + sizeOf (undefined :: CLong))+    stime_sec :: CLong <- peekMBA mba (#offset  uv_rusage_t, ru_stime )+    stime_usec :: CLong <- peekMBA mba ((#offset  uv_rusage_t, ru_stime) + sizeOf (undefined :: CLong))+    maxrss   <- peekMBA mba (#offset  uv_rusage_t, ru_maxrss  )+    ixrss    <- peekMBA mba (#offset  uv_rusage_t, ru_ixrss   )+    idrss    <- peekMBA mba (#offset  uv_rusage_t, ru_idrss   )+    isrss    <- peekMBA mba (#offset  uv_rusage_t, ru_isrss   )+    minflt   <- peekMBA mba (#offset  uv_rusage_t, ru_minflt  )+    majflt   <- peekMBA mba (#offset  uv_rusage_t, ru_majflt  )+    nswap    <- peekMBA mba (#offset  uv_rusage_t, ru_nswap   )+    inblock  <- peekMBA mba (#offset  uv_rusage_t, ru_inblock )+    oublock  <- peekMBA mba (#offset  uv_rusage_t, ru_oublock )+    msgsnd   <- peekMBA mba (#offset  uv_rusage_t, ru_msgsnd  )+    msgrcv   <- peekMBA mba (#offset  uv_rusage_t, ru_msgrcv  )+    nsignals <- peekMBA mba (#offset  uv_rusage_t, ru_nsignals)+    nvcsw    <- peekMBA mba (#offset  uv_rusage_t, ru_nvcsw   )+    nivcsw   <- peekMBA mba (#offset  uv_rusage_t, ru_nivcsw  )+    return (ResUsage (TimeVal utime_sec utime_usec) (TimeVal stime_sec stime_usec)+                    maxrss ixrss idrss isrss minflt majflt nswap inblock+                    oublock msgsnd msgrcv nsignals nvcsw nivcsw)++foreign import ccall unsafe uv_os_getpid :: IO PID+foreign import ccall unsafe uv_os_getppid :: IO PID+foreign import ccall unsafe uv_os_getpriority :: PID -> MBA## CInt -> IO CInt+foreign import ccall unsafe uv_os_setpriority :: PID -> CInt -> IO CInt++newtype PID = PID CInt deriving (Eq, Ord, Show, Generic)+                       deriving newtype (Storable, Unaligned, EncodeJSON, ToValue, FromValue)+                       deriving anyclass ShowT++pattern PRIORITY_LOW          :: CInt+pattern PRIORITY_BELOW_NORMAL :: CInt+pattern PRIORITY_NORMAL       :: CInt+pattern PRIORITY_ABOVE_NORMAL :: CInt+pattern PRIORITY_HIGH         :: CInt+pattern PRIORITY_HIGHEST      :: CInt+pattern PRIORITY_LOW           = (#const UV_PRIORITY_LOW           )+pattern PRIORITY_BELOW_NORMAL  = (#const UV_PRIORITY_BELOW_NORMAL  )+pattern PRIORITY_NORMAL        = (#const UV_PRIORITY_NORMAL        )+pattern PRIORITY_ABOVE_NORMAL  = (#const UV_PRIORITY_ABOVE_NORMAL  )+pattern PRIORITY_HIGH          = (#const UV_PRIORITY_HIGH          )+pattern PRIORITY_HIGHEST       = (#const UV_PRIORITY_HIGHEST       )++foreign import ccall unsafe uv_hrtime :: IO Word64++foreign import ccall unsafe uv_os_environ :: MBA## (Ptr a) -> MBA## CInt -> IO CInt+foreign import ccall unsafe uv_os_free_environ :: Ptr a -> CInt -> IO ()+foreign import ccall unsafe uv_os_getenv :: BA## Word8 -> MBA## Word8 -> MBA## CSize -> IO CInt+foreign import ccall unsafe uv_os_setenv :: BA## Word8 -> BA## Word8 -> IO CInt+foreign import ccall unsafe uv_os_unsetenv :: BA## Word8 -> IO CInt++pattern UV_MAXHOSTNAMESIZE :: CSize+pattern UV_MAXHOSTNAMESIZE = #const UV_MAXHOSTNAMESIZE+foreign import ccall unsafe uv_os_gethostname :: MBA## Word8 -> MBA## CSize -> IO CInt++data OSName = OSName+    { os_sysname :: T.Text+    , os_release :: T.Text+    , os_version :: T.Text+    , os_machine :: T.Text+    } deriving (Eq, Ord, Show, Generic)+       deriving anyclass (ShowT, EncodeJSON, ToValue, FromValue)++getOSName :: IO OSName+getOSName = do+    (A.MutablePrimArray mba## :: A.MutablePrimArray A.RealWorld Word8) <- A.newArr (#size uv_utsname_t)+    throwUVIfMinus_ (uv_os_uname mba##)+    sn <- toText <$> peekMBA mba## (#offset uv_utsname_t, sysname)+    re <- toText <$> peekMBA mba## (#offset uv_utsname_t, release)+    ve <- toText <$> peekMBA mba## (#offset uv_utsname_t, version)+    ma <- toText <$> peekMBA mba##  (#offset uv_utsname_t, machine) +    return (OSName sn re ve ma)+    +foreign import ccall unsafe uv_os_uname :: MBA## OSName -> IO CInt++foreign import ccall unsafe hs_uv_random :: MBA## Word8 -> CSize -> CInt -> IO CInt+foreign import ccall unsafe hs_uv_random_threaded :: Ptr Word8 -> CSize -> CInt -> Ptr UVLoop -> IO UVSlotUnsafe

@@ -1,8 +1,3 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE MultiWayIf #-}- {-| Module      : Z.IO.UV.Manager Description : IO manager based on libuv@@ -256,13 +251,13 @@                 tryPutMVar lock r             return c --- | Run a libuv FFI to get a 'UVSlotUnSafe' (which may exceed block table size),+-- | Run a libuv FFI to get a 'UVSlotUnsafe' (which may exceed block table size), -- resize the block table in that case, so that the returned slot always has an -- accompanying 'MVar' in block table. -- -- Always use this function to turn an 'UVSlotUnsafe' into 'UVSlot', so that the block -- table size synchronize with libuv side's slot table.-getUVSlot :: HasCallStack => UVManager -> IO UVSlotUnSafe -> IO UVSlot+getUVSlot :: HasCallStack => UVManager -> IO UVSlotUnsafe -> IO UVSlot {-# INLINE getUVSlot #-} getUVSlot (UVManager blockTableRef _ _ _ _) f = do     slot <- throwUVIfMinus (unsafeGetSlot <$> f)@@ -301,7 +296,7 @@ -- is received, in later case we will call 'cancelUVReq' to cancel the on-going -- async function with best efforts, withUVRequest :: HasCallStack-              => UVManager -> (Ptr UVLoop -> IO UVSlotUnSafe) -> IO Int+              => UVManager -> (Ptr UVLoop -> IO UVSlotUnsafe) -> IO Int withUVRequest uvm f = do     (slot, m) <- withUVManager uvm $ \ loop -> mask_ $ do         slot <- getUVSlot uvm (f loop)@@ -313,7 +308,7 @@  -- | Same with 'withUVRequest' but disgard the result. withUVRequest_ :: HasCallStack-               => UVManager -> (Ptr UVLoop -> IO UVSlotUnSafe) -> IO ()+               => UVManager -> (Ptr UVLoop -> IO UVSlotUnsafe) -> IO () withUVRequest_ uvm f = void (withUVRequest uvm f)  -- | Same with 'withUVRequest' but apply an convert function to result.@@ -323,7 +318,7 @@ -- if appropriate. withUVRequest' :: HasCallStack                => UVManager-               -> (Ptr UVLoop -> IO UVSlotUnSafe)+               -> (Ptr UVLoop -> IO UVSlotUnsafe)                -> (Int -> IO b)     -- ^ convert function                -> IO b withUVRequest' uvm f g = do@@ -340,7 +335,7 @@ -- if async exception hit this thread but the async action is already successfully performed, -- e.g. release result memory. withUVRequestEx :: HasCallStack-                => UVManager -> (Ptr UVLoop -> IO UVSlotUnSafe) -> (Int -> IO ()) -> IO Int+                => UVManager -> (Ptr UVLoop -> IO UVSlotUnsafe) -> (Int -> IO ()) -> IO Int withUVRequestEx uvm f extra_cleanup = do     (slot, m) <- withUVManager uvm $ \ loop -> mask_ $ do         slot <- getUVSlot uvm (f loop)

@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-| Module      : Z.IO.UV.Win Description : Special code on windows

@@ -293,3 +293,34 @@             uv_cancel(req);     } }++////////////////////////////////////////////////////////////////////////////////+// random++// non thread pool version of random+HsInt hs_uv_random(char* buf, size_t len, unsigned int flags){+    return (HsInt)uv_random(NULL, NULL, (void*)buf, len, flags, NULL);+}+void hs_uv_random_callback(uv_random_t* req, int status, void* buf, size_t buflen){+    uv_loop_t* loop = req->loop;+    hs_loop_data* loop_data = loop->data;+    HsInt slot = (HsInt)req->data; +    // push the slot to event queue+    loop_data->buffer_size_table[slot] = status;+    loop_data->event_queue[loop_data->event_counter] = slot;+    loop_data->event_counter += 1;+    free_slot(loop_data, slot);  // free the uv_req_t+}+HsInt hs_uv_random_threaded(char* buf, size_t len, unsigned int flags, uv_loop_t* loop){+    hs_loop_data* loop_data = loop->data;+    HsInt slot = alloc_slot(loop_data);+    if (slot < 0) return UV_ENOMEM;+    uv_random_t* req = +        (uv_random_t*)fetch_uv_struct(loop_data, slot);+    req->data = (void*)slot;+    int r = uv_random(loop, req, buf, len, flags, hs_uv_random_callback);+    if (r < 0) {+        free_slot(loop_data, slot);+        return (HsInt)r;+    } else return slot;+}

@@ -209,6 +209,13 @@     return (HsInt)req.result; } +HsInt hs_uv_fs_lutime(const char* path, double atime, double mtime){+    uv_fs_t req;+    uv_fs_lutime(NULL, &req, path, atime, mtime, NULL);+    uv_fs_req_cleanup(&req);    // maybe not neccessary+    return (HsInt)req.result;+}+ HsInt hs_uv_fs_link(const char* path, const char* path2){     uv_fs_t req;     uv_fs_link(NULL, &req, path, path2, NULL);@@ -646,6 +653,20 @@         (uv_fs_t*)fetch_uv_struct(loop_data, slot);     req->data = (void*)slot;     int r = uv_fs_futime(loop, req, file, atime, mtime, hs_uv_fs_callback);+    if (r < 0) {+        free_slot(loop_data, slot);+        return (HsInt)r;+    } else return slot;+}++HsInt hs_uv_fs_lutime_threaded(const char* path, double atime, double mtime, uv_loop_t* loop){+    hs_loop_data* loop_data = loop->data;+    HsInt slot = alloc_slot(loop_data);+    if (slot < 0) return UV_ENOMEM;+    uv_fs_t* req = +        (uv_fs_t*)fetch_uv_struct(loop_data, slot);+    req->data = (void*)slot;+    int r = uv_fs_lutime(loop, req, path, atime, mtime, hs_uv_fs_callback);     if (r < 0) {         free_slot(loop_data, slot);         return (HsInt)r;

@@ -35,17 +35,16 @@ // udp  // We do batch read per uv_run, the buffer index keep decreasing until hit zero-// then we call uv_udp_recv_stop to stop receiving. void hs_udp_alloc_cb(uv_handle_t* handle, size_t suggested_size, uv_buf_t* buf){     HsInt slot = (HsInt)handle->data;     hs_loop_data* loop_data = handle->loop->data;     // fetch buffer_table from buffer_table table     // the first 12 + 128 bytes is reserved for sockaddr and flag     char** buffer_array = (char**)loop_data->buffer_table[slot];-    (loop_data->buffer_size_table[slot])--;     ssize_t buffer_index = loop_data->buffer_size_table[slot];     if (buffer_index < 0) {-        uv_udp_recv_stop((uv_udp_t*)handle);+        //will be called in hs_udp_check_cb+        //uv_udp_recv_stop((uv_udp_t*)handle);         buf->base = NULL;         buf->len  = 0;     } else {@@ -60,6 +59,14 @@     HsInt slot = (HsInt)udp->data;     hs_loop_data* loop_data = udp->loop->data; +    // no bufs are available+    if (_buf->base == NULL) return;+    // EAGAIN, EWOULDBLOCK+    if (addr == NULL && nread == 0) return;+    +    // move buffer_index+    (loop_data->buffer_size_table[slot])--;+     char* buf = (char*)(_buf->base)-140;       struct sockaddr* addr_buf =  (struct sockaddr*)(buf+12);     // result@@ -82,17 +89,49 @@             memcpy(addr_buf, addr, sizeof(struct sockaddr));         }     }-    if (nread != 0) {+}++int hs_uv_udp_recv_start(uv_udp_t* handle){+    return uv_udp_recv_start(handle, hs_udp_alloc_cb, hs_udp_recv_cb);+}++// Check if the socket's udp buffer is filled with messages, if so, unlock the udp thread+//+void hs_udp_check_cb(uv_check_t* check){+    uv_udp_t* server=(uv_udp_t*)check->data;+    HsInt slot = (HsInt)server->data;+    hs_loop_data* loop_data = server->loop->data;+    ssize_t buffer_index = loop_data->buffer_size_table[slot];+    // This relys on GHC ByteArray# memory layout, ByteArray# length is recorded before content.+    HsInt* buffer_ptr = (HsInt*)loop_data->buffer_table[slot];+    HsInt buffer_total_len = *(buffer_ptr-1)/(sizeof(void*));+    if (buffer_index < buffer_total_len -1 ) {+        // we stopped if we got some messages, will resume from haskell+        uv_udp_recv_stop(server);         loop_data->event_queue[loop_data->event_counter] = slot; // push the slot to event queue         loop_data->event_counter += 1;-        uv_udp_recv_stop(udp);     } } -int hs_uv_udp_recv_start(uv_udp_t* handle){-    return uv_udp_recv_start(handle, hs_udp_alloc_cb, hs_udp_recv_cb);+// It's hard to arrange receiving notification without check handler, we can't+// do it in recv's callback, since it'll be called multiple times during uv_run.+uv_check_t* hs_uv_udp_check_alloc(uv_udp_t* server){+    uv_check_t* check = malloc(sizeof(uv_check_t));+    if (check == NULL) return NULL;+    check->data = (void*)server;    // we link server to check's data field+    return check; } +int hs_uv_udp_check_init(uv_check_t* check){+    uv_udp_t* server = check->data;+    int r = uv_check_init(server->loop, check);+    if (r < 0) return r;+    return uv_check_start(check, hs_udp_check_cb);+}++void hs_uv_udp_check_close(uv_check_t* check){+    uv_close((uv_handle_t*)check, (uv_close_cb)free);+} void hs_uv_udp_send_cb(uv_udp_send_t* req, int status){     HsInt slot = (HsInt)req->data;     uv_loop_t* loop = req->handle->loop;

@@ -30,6 +30,7 @@  #include <zlib.h> #include <stdlib.h>+#include <HsFFI.h>  z_stream * create_z_stream(void){     z_stream *stream = malloc(sizeof(z_stream));@@ -65,4 +66,12 @@ { 	inflateEnd(stream); 	free(stream);+}++unsigned int deflate_set_dictionary (z_stream* stream, const unsigned char* dict, HsInt off, HsInt len){+    return deflateSetDictionary(stream, dict+off, (unsigned int)len);+}++unsigned int inflate_set_dictionary (z_stream* stream, const unsigned char* dict, HsInt off, HsInt len){+    return inflateSetDictionary(stream, dict+off, (unsigned int)len); }

@@ -76,9 +76,10 @@ // // the memory pool item struct, we use the largest possible value, // except uv_getnameinfo_t, which is too large than average :(+// anyway we don't do getaddrinfo or getaddrname in libuv's thread pool // // following size data is from libuv v1.12, in bytes-//                         win  unix+//                     win  unix // uv_timer_t        : 160  152 // uv_prepare_t      : 120  120 // uv_check_t        : 120  120@@ -102,6 +103,7 @@ // uv_udp_send_t     : 128  320 // uv_fs_t           : 456  440 // uv_work_t         : 176  128+// uv_random_t       : 144  144 typedef union {     uv_timer_t          timer_t      ;     uv_prepare_t        prepare_t    ;@@ -118,14 +120,15 @@     uv_fs_event_t       fs_event_t   ;     uv_fs_poll_t        fs_poll_t    ;     uv_req_t            req_t        ;-    uv_getaddrinfo_t    getaddrinfo_t;-//   uv_getnameinfo_t    getnameinfo_t; !too large+//    uv_getaddrinfo_t    getaddrinfo_t;+//    uv_getnameinfo_t    getnameinfo_t; !too large     uv_shutdown_t       shutdown_t   ;     uv_write_t          write_t      ;     uv_connect_t        connect_t    ;     uv_udp_send_t       udp_send_t   ;     uv_fs_t             fs_t         ;     uv_work_t           work_t       ;+    uv_random_t         random_t     ; } hs_uv_struct;  typedef struct {@@ -295,6 +298,9 @@ int hs_uv_udp_recv_start(uv_udp_t* handle); HsInt hs_uv_udp_send_connected(uv_udp_t* handle, char* buf, HsInt buf_siz); HsInt hs_uv_upd_send(uv_udp_t* handle, const struct sockaddr* addr, char* buf, HsInt buf_siz);+uv_check_t* hs_uv_udp_check_alloc(uv_udp_t* server);+int hs_uv_udp_check_init(uv_check_t* check);+void hs_uv_udp_check_close(uv_check_t* check);  //////////////////////////////////////////////////////////////////////////////// // fs@@ -604,6 +610,7 @@ HsInt hs_uv_fs_fchmod(int32_t file, int mode); HsInt hs_uv_fs_utime(const char* path, double atime, double mtime); HsInt hs_uv_fs_futime(int32_t file, double atime, double mtime);+HsInt hs_uv_fs_lutime(const char* path, double atime, double mtime); HsInt hs_uv_fs_link(const char* path, const char* path2); HsInt hs_uv_fs_symlink(const char* path, const char* path2, int flag); HsInt hs_uv_fs_readlink(const char* path, char** result_path);@@ -634,6 +641,7 @@ HsInt hs_uv_fs_fchmod_threaded(int32_t file, int mode, uv_loop_t* loop); HsInt hs_uv_fs_utime_threaded(const char* path, double atime, double mtime, uv_loop_t* loop); HsInt hs_uv_fs_futime_threaded(int32_t file, double atime, double mtime, uv_loop_t* loop);+HsInt hs_uv_fs_lutime_threaded(const char* path, double atime, double mtime, uv_loop_t* loop); HsInt hs_uv_fs_link_threaded(const char* path, const char* path2, uv_loop_t* loop); HsInt hs_uv_fs_symlink_threaded(const char* path, const char* path2, int flag, uv_loop_t* loop); HsInt hs_uv_fs_readlink_threaded(const char* path, char** result_path, uv_loop_t* loop);@@ -648,3 +656,8 @@ HsInt hs_getnameinfo(const struct sockaddr *addr, socklen_t addrlen,                      char *host, socklen_t hostlen,                      char *serv, socklen_t servlen, int flags);++////////////////////////////////////////////////////////////////////////////////+// random+HsInt hs_uv_random(char* buf, size_t len, unsigned int flags);+HsInt hs_uv_random_threaded(char* buf, size_t len, unsigned int flags, uv_loop_t* loop);

@@ -21,7 +21,7 @@         running <- isLowResTimerManagerRunning lrtm         assertEqual "timer manager should start" True running -        threadDelay 1600000 -- make sure all timers are fired+        threadDelay 2000000 -- make sure all timers are fired         c' <- readPrimIORef c         assertEqual "timers registration counter" 100000 c' 

@@ -24,13 +24,7 @@             longMsg = V.cycleN 2048 "abcdefg"             addr = SocketAddrInet 12345 inetLoopback -        serverThread <- forkIO $ startTCPServer defaultTCPServerConfig{-                tcpListenAddr = addr-            ,   tcpServerWorker = \ tcp -> do-                    i <- newBufferedInput tcp-                    o <- newBufferedOutput tcp-                    forever $ readBuffer i >>= writeBuffer o >> flushBuffer o-            }+        serverThread <- forkIO $ startTCPServer defaultTCPServerConfig{ tcpListenAddr = addr } echoWorker          threadDelay 100000 

@@ -5,6 +5,7 @@ import           Control.Concurrent import           Control.Monad import           Data.Bits+import           Data.IORef import           Z.Data.Vector         as V import           Z.Data.Vector.Base    as V import           Data.List               as List@@ -23,7 +24,7 @@             longMsg = V.replicate 2048 48             addr = SocketAddrInet 12345 inetLoopback         withResource (initUDP defaultUDPConfig{udpSendMsgSize = 2048}) $ \ c ->-            withResource (initUDP defaultUDPConfig{udpLocalAddr = Just (addr,UV_UDP_DEFAULT)}) $ \ s -> do+            withResource (initUDP defaultUDPConfig{udpLocalAddr = Just (addr,UDP_DEFAULT)}) $ \ s -> do                 forkIO $ sendUDP c addr testMsg                 [(_, partial, rcvMsg)]<- recvUDP defaultUDPRecvConfig s                 partial @=? False@@ -39,8 +40,8 @@         let testMsg = V.replicate 256 48             addr = SocketAddrInet 12346 inetLoopback             addr' = SocketAddrInet 12347 inetLoopback-        withResource (initUDP defaultUDPConfig{udpLocalAddr = Just (addr,UV_UDP_DEFAULT)}) $ \ c ->-            withResource (initUDP defaultUDPConfig{udpLocalAddr = Just (addr',UV_UDP_DEFAULT)}) $ \ s -> do+        withResource (initUDP defaultUDPConfig{udpLocalAddr = Just (addr,UDP_DEFAULT)}) $ \ c ->+            withResource (initUDP defaultUDPConfig{udpLocalAddr = Just (addr',UDP_DEFAULT)}) $ \ s -> do                 forkIO $ sendUDP c addr' testMsg                 [(rcvAddr, _, _)]<- recvUDP defaultUDPRecvConfig s                 Just addr @=? rcvAddr@@ -51,3 +52,15 @@         withResource (initUDP defaultUDPConfig) $ \ c ->             withResource (initUDP defaultUDPConfig) $ \ s -> do                 sendUDP c addr testMsg `shouldThrow` anyException++    it "batch receiving(multiple messages)" $ do+        let testMsg = V.replicate 256 48+            addr = SocketAddrInet 12346 inetLoopback+        msgList <- newIORef []+        forkIO $ withResource (initUDP defaultUDPConfig{udpLocalAddr = Just (addr,UDP_DEFAULT)}) $ \ s -> do+            recvUDPLoop defaultUDPRecvConfig s $ \ msgs ->+                modifyIORef msgList (msgs:)+        withResource (initUDP defaultUDPConfig) $ \ c -> replicateM_ 100 $ sendUDP c addr testMsg+        msgs <- readIORef msgList+        True @=? (List.length msgs > 90)    -- ^ udp packet may get lost+        forM_ msgs $ \ (_,_,msg) -> testMsg @=? msg

@@ -0,0 +1,57 @@+/* Copyright libuv contributors. All rights reserved.+ *+ * Permission is hereby granted, free of charge, to any person obtaining a copy+ * of this software and associated documentation files (the "Software"), to+ * deal in the Software without restriction, including without limitation the+ * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or+ * sell copies of the Software, and to permit persons to whom the Software is+ * furnished to do so, subject to the following conditions:+ *+ * The above copyright notice and this permission notice shall be included in+ * all copies or substantial portions of the Software.+ *+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+ * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+ * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING+ * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS+ * IN THE SOFTWARE.+ */++#include "uv.h"+#include "internal.h"++#include <stddef.h>+#include <dlfcn.h>++typedef int (*uv__getentropy_cb)(void *, size_t);++static uv__getentropy_cb uv__getentropy;+static uv_once_t once = UV_ONCE_INIT;+++static void uv__random_getentropy_init(void) {+  uv__getentropy = (uv__getentropy_cb) dlsym(RTLD_DEFAULT, "getentropy");+}+++int uv__random_getentropy(void* buf, size_t buflen) {+  size_t pos;+  size_t stride;++  uv_once(&once, uv__random_getentropy_init);++  if (uv__getentropy == NULL)+    return UV_ENOSYS;++  /* getentropy() returns an error for requests > 256 bytes. */+  for (pos = 0, stride = 256; pos + stride < buflen; pos += stride)+    if (uv__getentropy((char *) buf + pos, stride))+      return UV__ERR(errno);++  if (uv__getentropy((char *) buf + pos, buflen - pos))+    return UV__ERR(errno);++  return 0;+}