X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FHandleLike.hs;fp=Network%2FHTTP%2FLucu%2FHandleLike.hs;h=aa4dacbee7c3e00983c2f61afda2931fe10edb57;hb=73b5fba4907604681d778d3bd54cd65fd84b4454;hp=0000000000000000000000000000000000000000;hpb=c179f51aa7b15764807141c175f9fe8797424991;p=Lucu.git

diff --git a/Network/HTTP/Lucu/HandleLike.hs b/Network/HTTP/Lucu/HandleLike.hs
new file mode 100644
index 0000000..aa4dacb
--- /dev/null
+++ b/Network/HTTP/Lucu/HandleLike.hs
@@ -0,0 +1,68 @@
+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 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 ()
+
+    hPutStr   :: h -> String -> IO ()
+    hPutStrLn :: h -> String -> IO ()
+
+    hGetPeerCert :: h -> IO (Maybe X509)
+    hGetPeerCert = const $ return Nothing
+
+    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
+
+    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
+                 SSL.getPeerCertificate s
+               else
+                 return Nothing
+
+    hFlush _  = return () -- unneeded
+    hClose s  = SSL.shutdown s SSL.Bidirectional