+{-# LANGUAGE
+ UnicodeSyntax
+ #-}
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
+ hPutLBS ∷ h → L.ByteString → IO ()
- 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
hGetBS = B.hGet
hPutBS = B.hPut
- hPutChar = I.hPutChar
-
- hPutStr = I.hPutStr
- hPutStrLn = I.hPutStrLn
-
hFlush = I.hFlush
hClose = I.hClose
hGetBS = SSL.read
hPutBS = SSL.write
- hPutChar s = hPutLBS s . L.singleton
-
- hPutStr s = hPutLBS s . L.pack
- hPutStrLn s = hPutLBS s . L.pack . (++ "\n")
-
hGetPeerCert s
= do isValid <- SSL.getVerifyResult s
if isValid then
else
return Nothing
- hFlush _ = return () -- unneeded
+ 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