00f6563 · typeable/wai

14import Data.Conduit.Binary (sourceFileRange)

15import qualified Data.Conduit as C

16import qualified Data.Conduit.List as CL

17−import Control.Monad.IO.Class (liftIO)

18import Control.Exception (bracket, handle, SomeException)

17import Control.Exception (bracket, handle, SomeException)

19import qualified Network.TLS.Extra as TLSExtra

18import qualified Network.TLS.Extra as TLSExtra

20import qualified Data.Certificate.X509 as X509

19import qualified Data.Certificate.X509 as X509

22import qualified Data.ByteString as B

21import qualified Data.ByteString as B

23import Control.Monad (unless)

22import Control.Monad (unless)

24import qualified Data.Certificate.KeyRSA as KeyRSA

23import qualified Data.Certificate.KeyRSA as KeyRSA

24+import Control.Applicative ((<$>))

25

26data TLSSettings = TLSSettings

27 { certFile :: FilePath

55 ctx <- TLS.server params (gen :: SystemRandom) h

56 b <- TLS.handshake ctx

57 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− }

64 let conn = Connection

58 let conn = Connection

65 { connSendMany = TLS.sendData ctx . L.fromChunks

59 { connSendMany = TLS.sendData ctx . L.fromChunks

66 , connSendAll = TLS.sendData ctx . L.fromChunks . return

60 , connSendAll = TLS.sendData ctx . L.fromChunks . return

67 , connSendFile = \fp offset len _th -> C.runResourceT $ sourceFileRange fp (Just offset) (Just len) C.$$ CL.mapM_ (TLS.sendData ctx . L.fromChunks . return)

61 , 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

69 , connClose = do

62 , connClose = do

70 TLS.bye ctx

63 TLS.bye ctx

71 hClose h

64 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

65+ , connRecv = B.concat . L.toChunks <$> 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))

82 }

66 }

83 return (conn, sa)

67 return (conn, sa)

84

68