X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FHandleLike.hs;h=cc90cd6746ed7a74e8a1ed979e4f343423585863;hb=90fca0675b1694e69b8e431c989343855cbd125d;hp=f58264d9c6abd2b3fd5761c7fc0bd6cdfd5782e1;hpb=db4b61223e0d8b34079d3b190fb3e3644b0b4866;p=Lucu.git diff --git a/Network/HTTP/Lucu/HandleLike.hs b/Network/HTTP/Lucu/HandleLike.hs index f58264d..cc90cd6 100644 --- a/Network/HTTP/Lucu/HandleLike.hs +++ b/Network/HTTP/Lucu/HandleLike.hs @@ -1,33 +1,41 @@ {-# LANGUAGE - UnicodeSyntax + CPP + , DoAndIfThenElse + , UnicodeSyntax #-} +-- |Type class for things behaves like a 'I.Handle'. module Network.HTTP.Lucu.HandleLike ( HandleLike(..) + , hPutBuilder ) where +import Blaze.ByteString.Builder (Builder) +import qualified Blaze.ByteString.Builder as BB import qualified Data.ByteString as B import qualified Data.ByteString.Lazy.Char8 as L +#if defined(HAVE_SSL) import qualified OpenSSL.Session as SSL import OpenSSL.X509 +#endif +import Prelude.Unicode import qualified System.IO as I class HandleLike h where hGetLBS ∷ h → IO L.ByteString - hPutLBS ∷ h → L.ByteString → IO () hGetBS ∷ h → Int → IO B.ByteString hPutBS ∷ h → B.ByteString → IO () +#if defined(HAVE_SSL) hGetPeerCert ∷ h → IO (Maybe X509) hGetPeerCert = const $ return Nothing +#endif hFlush ∷ h → IO () hClose ∷ h → IO () - instance HandleLike I.Handle where hGetLBS = L.hGetContents - hPutLBS = L.hPut hGetBS = B.hGet hPutBS = B.hPut @@ -35,20 +43,24 @@ instance HandleLike I.Handle where hFlush = I.hFlush hClose = I.hClose - +#if defined(HAVE_SSL) instance HandleLike SSL.SSL where - hGetLBS = SSL.lazyRead - hPutLBS = SSL.lazyWrite + hGetLBS = SSL.lazyRead - hGetBS = SSL.read - hPutBS = SSL.write + hGetBS = SSL.read + hPutBS = SSL.write hGetPeerCert s = do isValid <- SSL.getVerifyResult s if isValid then SSL.getPeerCertificate s - else + else return Nothing - hFlush _ = return () -- unneeded - hClose s = SSL.shutdown s SSL.Bidirectional + hFlush _ = return () -- No need to do anything. + hClose s = SSL.shutdown s SSL.Bidirectional +#endif + +hPutBuilder ∷ HandleLike h ⇒ h → Builder → IO () +{-# INLINE hPutBuilder #-} +hPutBuilder = BB.toByteStringIO ∘ hPutBS