|
@@ -41,37 +41,59 @@ import System.Posix.Types (Fd(..))
|
|
|
|
|
|
|
|
|
instance UniformIO SocketIO where
|
|
|
- uRead s n = do
|
|
|
+ uRead (SocketIO s) n = do
|
|
|
allocaArray n (
|
|
|
\b -> do
|
|
|
- count <- c_recv (sock s) b (fromIntegral n)
|
|
|
+ count <- c_recv s b (fromIntegral n)
|
|
|
if count < 0
|
|
|
then throwErrno "could not read"
|
|
|
else BS.packCStringLen (b, fromIntegral count)
|
|
|
)
|
|
|
- uPut s t = do
|
|
|
+ uRead (TlsSocketIO s) n = do
|
|
|
+ allocaArray n (
|
|
|
+ \b -> do
|
|
|
+ count <- c_recvTls s b $ fromIntegral n
|
|
|
+ if count < 0
|
|
|
+ then throwErrno "could not read"
|
|
|
+ else BS.packCStringLen (b, fromIntegral count)
|
|
|
+ )
|
|
|
+ uPut (SocketIO s) t = do
|
|
|
BS.useAsCStringLen t (
|
|
|
\(str, n) -> do
|
|
|
- count <- c_send (sock s) str $ fromIntegral n
|
|
|
+ count <- c_send s str $ fromIntegral n
|
|
|
if count < 0
|
|
|
then throwErrno "could not write"
|
|
|
else return ()
|
|
|
)
|
|
|
- uClose s = do
|
|
|
- f <- Fd <$> c_prepareToClose (sock s)
|
|
|
+ uPut (TlsSocketIO s) t = do
|
|
|
+ BS.useAsCStringLen t (
|
|
|
+ \(str, n) -> do
|
|
|
+ count <- c_sendTls s str $ fromIntegral n
|
|
|
+ if count < 0
|
|
|
+ then throwErrno "could not write"
|
|
|
+ else return ()
|
|
|
+ )
|
|
|
+ uClose (SocketIO s) = do
|
|
|
+ f <- Fd <$> c_prepareToClose s
|
|
|
+ closeFd f
|
|
|
+ uClose (TlsSocketIO s) = do
|
|
|
+ d <- c_closeTls s
|
|
|
+ f <- Fd <$> c_prepareToClose d
|
|
|
closeFd f
|
|
|
- startTls st s = withCString (tlsCertificateChainFile st) (
|
|
|
+ startTls st (SocketIO s) = withCString (tlsCertificateChainFile st) (
|
|
|
\cert -> withCString (tlsPrivateKeyFile st) (
|
|
|
\key -> withCString (tlsDHParametersFile st) (
|
|
|
\para -> do
|
|
|
- r <- c_startSockTls (sock s) cert key para
|
|
|
+ r <- c_startSockTls s cert key para
|
|
|
if r == nullPtr
|
|
|
then throwErrno "could not start TLS"
|
|
|
- else return . TlsIO $ r
|
|
|
+ else return . TlsSocketIO $ r
|
|
|
)
|
|
|
)
|
|
|
)
|
|
|
- isSecure _ = False
|
|
|
+ startTls _ s@(TlsSocketIO _) = return s
|
|
|
+ isSecure (SocketIO _) = False
|
|
|
+ isSecure (TlsSocketIO _) = True
|
|
|
|
|
|
|
|
|
|