X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FHandleLike.hs;h=cc90cd6746ed7a74e8a1ed979e4f343423585863;hb=db4a546d0d462cb94639b1f273bf0b78bccc960c;hp=aa4dacbee7c3e00983c2f61afda2931fe10edb57;hpb=73b5fba4907604681d778d3bd54cd65fd84b4454;p=Lucu.git diff --git a/Network/HTTP/Lucu/HandleLike.hs b/Network/HTTP/Lucu/HandleLike.hs index aa4dacb..cc90cd6 100644 --- a/Network/HTTP/Lucu/HandleLike.hs +++ b/Network/HTTP/Lucu/HandleLike.hs @@ -1,68 +1,66 @@ +{-# LANGUAGE + 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 +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 () + hGetLBS ∷ h → IO L.ByteString - hPutChar :: h -> Char -> IO () + hGetBS ∷ h → Int → IO B.ByteString + hPutBS ∷ h → B.ByteString → IO () - hPutStr :: h -> String -> IO () - hPutStrLn :: h -> String -> IO () - - hGetPeerCert :: h -> IO (Maybe X509) +#if defined(HAVE_SSL) + hGetPeerCert ∷ h → IO (Maybe X509) hGetPeerCert = const $ return Nothing +#endif - hFlush :: h -> IO () - hClose :: h -> IO () - + hFlush ∷ h → IO () + hClose ∷ h → IO () instance HandleLike I.Handle where hGetLBS = L.hGetContents - hPutLBS = L.hPut hGetBS = B.hGet hPutBS = B.hPut - hPutChar = I.hPutChar - - hPutStr = I.hPutStr - hPutStrLn = I.hPutStrLn - hFlush = I.hFlush hClose = I.hClose - +#if defined(HAVE_SSL) instance HandleLike SSL.SSL where - hGetLBS = SSL.lazyRead - hPutLBS = SSL.lazyWrite - - hGetBS = SSL.read - hPutBS = SSL.write + hGetLBS = SSL.lazyRead - hPutChar s = hPutLBS s . L.singleton - - hPutStr s = hPutLBS s . L.pack - hPutStrLn s = hPutLBS s . L.pack . (++ "\n") + 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