|
@@ -4,7 +4,7 @@
|
|
|
{-# LANGUAGE InterruptibleFFI #-}
|
|
|
{-# LANGUAGE EmptyDataDecls #-}
|
|
|
|
|
|
-module System.IO.Uniform.Targets (TlsSettings(..), UniformIO(..), SocketIO, FileIO, TlsStream, BoundedPort, SomeIO(..), connectTo, connectToHost, bindPort, accept, openFile, getPeer, closePort) where
|
|
|
+module System.IO.Uniform.Targets (TlsSettings(..), UniformIO(..), SocketIO, FileIO, StdIO, TlsStream, BoundedPort, SomeIO(..), connectTo, connectToHost, bindPort, accept, openFile, getPeer, closePort) where
|
|
|
|
|
|
import Foreign
|
|
|
import Foreign.C.Types
|
|
@@ -74,6 +74,7 @@ newtype SocketIO = SocketIO {sock :: (Ptr Ds)}
|
|
|
newtype FileIO = FileIO {fd :: (Ptr Ds)}
|
|
|
data TlsDs
|
|
|
newtype TlsStream = TlsStream {tls :: (Ptr TlsDs)}
|
|
|
+data StdIO
|
|
|
|
|
|
-- | UniformIO IP connections.
|
|
|
instance UniformIO SocketIO where
|
|
@@ -109,6 +110,28 @@ instance UniformIO SocketIO where
|
|
|
)
|
|
|
isSecure _ = False
|
|
|
|
|
|
+-- | UniformIO IP connections.
|
|
|
+instance UniformIO StdIO where
|
|
|
+ uRead _ n = do
|
|
|
+ allocaArray n (
|
|
|
+ \b -> do
|
|
|
+ count <- c_recvStd b (fromIntegral n)
|
|
|
+ if count < 0
|
|
|
+ then throwErrno "could not read"
|
|
|
+ else BS.packCStringLen (b, fromIntegral count)
|
|
|
+ )
|
|
|
+ uPut _ t = do
|
|
|
+ BS.useAsCStringLen t (
|
|
|
+ \(str, n) -> do
|
|
|
+ count <- c_sendStd str $ fromIntegral n
|
|
|
+ if count < 0
|
|
|
+ then throwErrno "could not write"
|
|
|
+ else return ()
|
|
|
+ )
|
|
|
+ uClose _ = return ()
|
|
|
+ startTls _ _ = return . TlsStream $ nullPtr
|
|
|
+ isSecure _ = False
|
|
|
+
|
|
|
-- | UniformIO type for file IO.
|
|
|
instance UniformIO FileIO where
|
|
|
uRead s n = do
|
|
@@ -285,9 +308,9 @@ foreign import ccall safe "closeHandler" c_closePort :: Ptr Nethandler -> IO ()
|
|
|
foreign import ccall safe "closeTls" c_closeTls :: Ptr TlsDs -> IO (Ptr Ds)
|
|
|
|
|
|
foreign import ccall interruptible "sendDs" c_send :: Ptr Ds -> Ptr CChar -> CInt -> IO CInt
|
|
|
---foreign import ccall interruptible "stdDsSend" c_sendStd :: Ptr CChar -> CInt -> IO CInt
|
|
|
+foreign import ccall interruptible "stdDsSend" c_sendStd :: Ptr CChar -> CInt -> IO CInt
|
|
|
foreign import ccall interruptible "tlsDsSend" c_sendTls :: Ptr TlsDs -> Ptr CChar -> CInt -> IO CInt
|
|
|
|
|
|
foreign import ccall interruptible "recvDs" c_recv :: Ptr Ds -> Ptr CChar -> CInt -> IO CInt
|
|
|
---foreign import ccall interruptible "stdDsRecv" c_recvStd :: Ptr CChar -> CInt -> IO CInt
|
|
|
+foreign import ccall interruptible "stdDsRecv" c_recvStd :: Ptr CChar -> CInt -> IO CInt
|
|
|
foreign import ccall interruptible "tlsDsRecv" c_recvTls :: Ptr TlsDs -> Ptr CChar -> CInt -> IO CInt
|