+{-# LANGUAGE
+ CPP
+ , FlexibleContexts
+ , FlexibleInstances
+ , TypeFamilies
+ , UnicodeSyntax
+ #-}
+-- |Type class for things behaves like a 'So.Socket'.
module Network.HTTP.Lucu.SocketLike
( SocketLike(..)
)
where
-
+#if defined(HAVE_SSL)
+import Control.Exception
+#endif
import qualified Network.Socket as So
-import Network.HTTP.Lucu.HandleLike
+import Network.HTTP.Lucu.HandleLike
+#if defined(HAVE_SSL)
import qualified OpenSSL.Session as SSL
+import Prelude hiding (catch)
+import Prelude.Unicode
+#endif
import qualified System.IO as I
-
-class (HandleLike (Handle s)) => SocketLike s where
- type Handle s :: *
- accept :: s -> IO (Handle s, So.SockAddr)
- socketPort :: s -> IO So.PortNumber
-
+class (HandleLike (Handle s)) ⇒ SocketLike s where
+ type Handle s ∷ ★
+ accept ∷ s → IO (Handle s, So.SockAddr)
+ socketPort ∷ s → IO So.PortNumber
instance SocketLike So.Socket where
type Handle So.Socket = I.Handle
accept soSelf
- = do (soPeer, addr) <- So.accept soSelf
- hPeer <- So.socketToHandle soPeer I.ReadWriteMode
+ = do (soPeer, addr) ← So.accept soSelf
+ hPeer ← So.socketToHandle soPeer I.ReadWriteMode
return (hPeer, addr)
socketPort = So.socketPort
-
+#if defined(HAVE_SSL)
instance SocketLike (SSL.SSLContext, So.Socket) where
type Handle (SSL.SSLContext, So.Socket) = SSL.SSL
accept (ctx, soSelf)
- = do (soPeer, addr) <- So.accept soSelf
- ssl <- SSL.connection ctx soPeer
- SSL.accept ssl
- return (ssl, addr)
+ = do (soPeer, addr) ← So.accept soSelf
+ ssl ← SSL.connection ctx soPeer
+ handshake ssl addr `catch` next ssl addr
+ where
+ handshake ∷ SSL.SSL → So.SockAddr → IO (SSL.SSL, So.SockAddr)
+ handshake ssl addr
+ = do SSL.accept ssl
+ return (ssl, addr)
+
+ next ∷ SSL.SSL
+ → So.SockAddr
+ → SSL.SomeSSLException
+ → IO (SSL.SSL, So.SockAddr)
+ next ssl addr e
+ = do I.hPutStrLn I.stderr
+ $ "Lucu: failed to accept an SSL connection from "
+ ⧺ show addr
+ ⧺ ":"
+ I.hPutStrLn I.stderr
+ $ show e
+ SSL.shutdown ssl SSL.Bidirectional
+ accept (ctx, soSelf)
- socketPort = So.socketPort . snd
\ No newline at end of file
+ socketPort = So.socketPort ∘ snd
+#endif