|
@@ -11,33 +11,17 @@
|
|
module System.IO.Uniform (
|
|
module System.IO.Uniform (
|
|
UniformIO(..),
|
|
UniformIO(..),
|
|
TlsSettings(..),
|
|
TlsSettings(..),
|
|
- SomeIO(..), TlsIO,
|
|
|
|
|
|
+ SomeIO(..),
|
|
mapOverInput
|
|
mapOverInput
|
|
) where
|
|
) where
|
|
|
|
|
|
-import System.IO.Uniform.External
|
|
|
|
-
|
|
|
|
-import Foreign
|
|
|
|
---import Foreign.C.Types
|
|
|
|
---import Foreign.C.String
|
|
|
|
-import Foreign.C.Error
|
|
|
|
---import qualified Data.IP as IP
|
|
|
|
import Data.ByteString (ByteString)
|
|
import Data.ByteString (ByteString)
|
|
-import qualified Data.ByteString as BS
|
|
|
|
---import qualified Data.ByteString.Lazy as LBS
|
|
|
|
---import qualified Data.ByteString.Builder as BSBuild
|
|
|
|
---import qualified Data.List as L
|
|
|
|
import Control.Exception
|
|
import Control.Exception
|
|
import Control.Applicative ((<$>))
|
|
import Control.Applicative ((<$>))
|
|
---import Data.Monoid (mappend)
|
|
|
|
---import qualified Network.Socket as Soc
|
|
|
|
import System.IO.Error
|
|
import System.IO.Error
|
|
---import Control.Concurrent.MVar
|
|
|
|
|
|
|
|
import Data.Default.Class
|
|
import Data.Default.Class
|
|
|
|
|
|
-import System.Posix.Types (Fd(..))
|
|
|
|
-
|
|
|
|
-- |
|
|
-- |
|
|
-- Typeclass for uniform IO targets.
|
|
-- Typeclass for uniform IO targets.
|
|
class UniformIO a where
|
|
class UniformIO a where
|
|
@@ -61,7 +45,7 @@ class UniformIO a where
|
|
-- | startTLS fd
|
|
-- | startTLS fd
|
|
--
|
|
--
|
|
-- Starts a TLS connection over the IO target.
|
|
-- Starts a TLS connection over the IO target.
|
|
- startTls :: TlsSettings -> a -> IO TlsIO
|
|
|
|
|
|
+ startTls :: TlsSettings -> a -> IO a
|
|
-- | isSecure fd
|
|
-- | isSecure fd
|
|
--
|
|
--
|
|
-- Indicates whether the data written or read from fd is secure at transport.
|
|
-- Indicates whether the data written or read from fd is secure at transport.
|
|
@@ -74,7 +58,7 @@ instance UniformIO SomeIO where
|
|
uRead (SomeIO s) n = uRead s n
|
|
uRead (SomeIO s) n = uRead s n
|
|
uPut (SomeIO s) t = uPut s t
|
|
uPut (SomeIO s) t = uPut s t
|
|
uClose (SomeIO s) = uClose s
|
|
uClose (SomeIO s) = uClose s
|
|
- startTls set (SomeIO s) = startTls set s
|
|
|
|
|
|
+ startTls set (SomeIO s) = SomeIO <$> startTls set s
|
|
isSecure (SomeIO s) = isSecure s
|
|
isSecure (SomeIO s) = isSecure s
|
|
|
|
|
|
-- | Settings for starttls functions.
|
|
-- | Settings for starttls functions.
|
|
@@ -83,33 +67,6 @@ data TlsSettings = TlsSettings {tlsPrivateKeyFile :: String, tlsCertificateChain
|
|
instance Default TlsSettings where
|
|
instance Default TlsSettings where
|
|
def = TlsSettings "" "" ""
|
|
def = TlsSettings "" "" ""
|
|
|
|
|
|
--- | UniformIO wrapper that applies TLS to communication on IO target.
|
|
|
|
--- This type is constructed by calling startTls on other targets.
|
|
|
|
-instance UniformIO TlsIO where
|
|
|
|
- uRead s n = do
|
|
|
|
- allocaArray n (
|
|
|
|
- \b -> do
|
|
|
|
- count <- c_recvTls (tls s) b $ fromIntegral n
|
|
|
|
- if count < 0
|
|
|
|
- then throwErrno "could not read"
|
|
|
|
- else BS.packCStringLen (b, fromIntegral count)
|
|
|
|
- )
|
|
|
|
- uPut s t = do
|
|
|
|
- BS.useAsCStringLen t (
|
|
|
|
- \(str, n) -> do
|
|
|
|
- count <- c_sendTls (tls s) str $ fromIntegral n
|
|
|
|
- if count < 0
|
|
|
|
- then throwErrno "could not write"
|
|
|
|
- else return ()
|
|
|
|
- )
|
|
|
|
- uClose s = do
|
|
|
|
- d <- c_closeTls (tls s)
|
|
|
|
- f <- Fd <$> c_prepareToClose d
|
|
|
|
- closeFd f
|
|
|
|
- startTls _ s = return s
|
|
|
|
- isSecure _ = True
|
|
|
|
-
|
|
|
|
-
|
|
|
|
-- | mapOverInput io block_size f initial
|
|
-- | mapOverInput io block_size f initial
|
|
-- Reads io untill the end of file, evaluating a(i) <- f a(i-1) read_data
|
|
-- Reads io untill the end of file, evaluating a(i) <- f a(i-1) read_data
|
|
-- where a(0) = initial and the last value after io reaches EOF is returned.
|
|
-- where a(0) = initial and the last value after io reaches EOF is returned.
|