+{-# LANGUAGE
+ UnicodeSyntax
+ #-}
module Network.HTTP.Lucu.HandleLike
( HandleLike(..)
)
where
-
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 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 ()
-
- hPutChar :: h -> Char -> IO ()
+ hGetLBS ∷ h → IO L.ByteString
+ hPutLBS ∷ h → L.ByteString → IO ()
- hPutStr :: h -> String -> IO ()
- hPutStrLn :: h -> String -> IO ()
+ hGetBS ∷ h → Int → IO B.ByteString
+ hPutBS ∷ h → B.ByteString → 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