X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;ds=sidebyside;f=Network%2FHTTP%2FLucu%2FHandleLike.hs;h=a45ce6cbf066f3d0a6bac21335b4b16dbef6cca1;hb=cc074d0ce3f7df2544bc2baddca4e7730ecdf0a0;hp=aa4dacbee7c3e00983c2f61afda2931fe10edb57;hpb=73b5fba4907604681d778d3bd54cd65fd84b4454;p=Lucu.git diff --git a/Network/HTTP/Lucu/HandleLike.hs b/Network/HTTP/Lucu/HandleLike.hs index aa4dacb..a45ce6c 100644 --- a/Network/HTTP/Lucu/HandleLike.hs +++ b/Network/HTTP/Lucu/HandleLike.hs @@ -1,68 +1,59 @@ +{-# LANGUAGE + 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 import qualified OpenSSL.Session as SSL -import OpenSSL.X509 +import OpenSSL.X509 +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) + hGetPeerCert ∷ h → IO (Maybe X509) hGetPeerCert = const $ return Nothing - 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 - 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 + +hPutBuilder ∷ HandleLike h ⇒ h → Builder → IO () +{-# INLINE hPutBuilder #-} +hPutBuilder = BB.toByteStringIO ∘ hPutBS