Network/HTTP/Lucu/SocketLike.hs

   1 {-# LANGUAGE
   2     CPP
   3   , FlexibleContexts
   4   , FlexibleInstances
   5   , TypeFamilies
   6   , UnicodeSyntax
   7   #-}
   8 -- |Type class for things behaves like a 'So.Socket'.
   9 module Network.HTTP.Lucu.SocketLike
  10     ( SocketLike(..)
  11     )
  12     where
  13 import qualified Network.Socket as So
  14 import Network.HTTP.Lucu.HandleLike
  15 #if defined(HAVE_SSL)
  16 import qualified OpenSSL.Session as SSL
  17 import Prelude.Unicode
  18 #endif
  19 import qualified System.IO as I
  20
  21 class (HandleLike (Handle s)) ⇒ SocketLike s where
  22     type Handle s ∷ ★
  23     accept        ∷ s → IO (Handle s, So.SockAddr)
  24     socketPort    ∷ s → IO So.PortNumber
  25
  26 instance SocketLike So.Socket where
  27     type Handle So.Socket = I.Handle
  28
  29     accept soSelf
  30         = do (soPeer, addr) ← So.accept soSelf
  31              hPeer          ← So.socketToHandle soPeer I.ReadWriteMode
  32              return (hPeer, addr)
  33
  34     socketPort = So.socketPort
  35
  36 #if defined(HAVE_SSL)
  37 instance SocketLike (SSL.SSLContext, So.Socket) where
  38     type Handle (SSL.SSLContext, So.Socket) = SSL.SSL
  39
  40     accept (ctx, soSelf)
  41         = do (soPeer, addr) ← So.accept soSelf
  42              ssl            ← SSL.connection ctx soPeer
  43              SSL.accept ssl
  44              return (ssl, addr)
  45
  46     socketPort = So.socketPort ∘ snd
  47 #endif