]> gitweb @ CieloNegro.org - Lucu.git/blob - Network/HTTP/Lucu/HandleLike.hs
Make sure RequestReader tells the writer to stop when the reader stops.
[Lucu.git] / Network / HTTP / Lucu / HandleLike.hs
1 {-# LANGUAGE
2     CPP
3   , DoAndIfThenElse
4   , UnicodeSyntax
5   #-}
6 -- |Type class for things behaves like a 'I.Handle'.
7 module Network.HTTP.Lucu.HandleLike
8     ( HandleLike(..)
9     , hPutBuilder
10     )
11     where
12 import Blaze.ByteString.Builder (Builder)
13 import qualified Blaze.ByteString.Builder as BB
14 import qualified Data.ByteString as B
15 import qualified Data.ByteString.Lazy.Char8 as L
16 #if defined(HAVE_SSL)
17 import qualified OpenSSL.Session as SSL
18 import OpenSSL.X509
19 #endif
20 import Prelude.Unicode
21 import qualified System.IO as I
22
23 class HandleLike h where
24     hGetLBS ∷ h → IO L.ByteString
25
26     hGetBS  ∷ h → Int → IO B.ByteString
27     hPutBS  ∷ h → B.ByteString → IO ()
28
29 #if defined(HAVE_SSL)
30     hGetPeerCert ∷ h → IO (Maybe X509)
31     hGetPeerCert = const $ return Nothing
32 #endif
33
34     hFlush  ∷ h → IO ()
35     hClose  ∷ h → IO ()
36
37 instance HandleLike I.Handle where
38     hGetLBS = L.hGetContents
39
40     hGetBS  = B.hGet
41     hPutBS  = B.hPut
42
43     hFlush  = I.hFlush
44     hClose  = I.hClose
45
46 #if defined(HAVE_SSL)
47 instance HandleLike SSL.SSL where
48     hGetLBS = SSL.lazyRead
49
50     hGetBS  = SSL.read
51     hPutBS  = SSL.write
52
53     hGetPeerCert s
54         = do isValid <- SSL.getVerifyResult s
55              if isValid then
56                  SSL.getPeerCertificate s
57              else
58                  return Nothing
59
60     hFlush _ = return () -- No need to do anything.
61     hClose s = SSL.shutdown s SSL.Bidirectional
62 #endif
63
64 hPutBuilder ∷ HandleLike h ⇒ h → Builder → IO ()
65 {-# INLINE hPutBuilder #-}
66 hPutBuilder = BB.toByteStringIO ∘ hPutBS