X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FHandleLike.hs;h=cc90cd6746ed7a74e8a1ed979e4f343423585863;hb=HEAD;hp=f38fa5b88057090f3014289790b0674a6a0dc07c;hpb=cc55fb9a095c9c583ed6fe2ded3eaf6401fb760f;p=Lucu.git diff --git a/Network/HTTP/Lucu/HandleLike.hs b/Network/HTTP/Lucu/HandleLike.hs index f38fa5b..cc90cd6 100644 --- a/Network/HTTP/Lucu/HandleLike.hs +++ b/Network/HTTP/Lucu/HandleLike.hs @@ -1,6 +1,9 @@ {-# LANGUAGE - UnicodeSyntax + CPP + , DoAndIfThenElse + , UnicodeSyntax #-} +-- |Type class for things behaves like a 'I.Handle'. module Network.HTTP.Lucu.HandleLike ( HandleLike(..) , hPutBuilder @@ -10,28 +13,29 @@ 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 +#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 () +#if defined(HAVE_SSL) hGetPeerCert ∷ h → IO (Maybe X509) hGetPeerCert = const $ return Nothing +#endif hFlush ∷ h → IO () hClose ∷ h → IO () - instance HandleLike I.Handle where hGetLBS = L.hGetContents - hPutLBS = L.hPut hGetBS = B.hGet hPutBS = B.hPut @@ -39,23 +43,23 @@ instance HandleLike I.Handle where hFlush = I.hFlush hClose = I.hClose - +#if defined(HAVE_SSL) instance HandleLike SSL.SSL where - hGetLBS = SSL.lazyRead - hPutLBS = SSL.lazyWrite + hGetLBS = SSL.lazyRead - hGetBS = SSL.read - hPutBS = SSL.write + 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 () -- No need to do anything. - 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 #-}