@@ -14,7 +14,6 @@ import qualified Data.ByteString.Lazy as L
1414import Data.Conduit.Binary (sourceFileRange)
1515import qualified Data.Conduit as C
1616import qualified Data.Conduit.List as CL
17−import Control.Monad.IO.Class (liftIO)
1817import Control.Exception (bracket, handle, SomeException)
1918import qualified Network.TLS.Extra as TLSExtra
2019import qualified Data.Certificate.X509 as X509
@@ -22,6 +21,7 @@ import qualified Data.Certificate.PEM as PEM
2221import qualified Data.ByteString as B
2322import Control.Monad (unless)
2423import qualified Data.Certificate.KeyRSA as KeyRSA
24+import Control.Applicative ((<$>))
2525
2626data TLSSettings = TLSSettings
2727 { certFile :: FilePath
@@ -55,30 +55,14 @@ runTLS tset set app = do
5555 ctx <- TLS.server params (gen :: SystemRandom) h
5656 b <- TLS.handshake ctx
5757 unless b $ error "Invalid handshake"
58− let sink = C.Sink $ return $ C.SinkData
59− { C.sinkPush = \bs -> do
60− liftIO $ TLS.sendData ctx $ L.fromChunks [bs]
61− return C.Processing
62− , C.sinkClose = return ()
63− }
6458 let conn = Connection
6559 { connSendMany = TLS.sendData ctx . L.fromChunks
6660 , connSendAll = TLS.sendData ctx . L.fromChunks . return
6761 , connSendFile = \fp offset len _th -> C.runResourceT $ sourceFileRange fp (Just offset) (Just len) C.$$ CL.mapM_ (TLS.sendData ctx . L.fromChunks . return)
68− , connSink = \_th -> sink
6962 , connClose = do
7063 TLS.bye ctx
7164 hClose h
72− , connSource = \_th -> C.sourceState []
73− (\buffer ->
74− case buffer of
75− (bs:bss) -> return (bss, C.Open bs)
76− [] -> do
77− lbs <- TLS.recvData ctx
78− if L.null lbs
79− then return (undefined, C.Closed)
80− else let (bs:bss) = L.toChunks lbs
81− in return (bss, C.Open bs))
65+ , connRecv = B.concat . L.toChunks <$> TLS.recvData ctx
8266 }
8367 return (conn, sa)
8468