Network/HTTP/Lucu/SocketLike.hs

   1 {-# LANGUAGE
   2     FlexibleContexts
   3   , FlexibleInstances
   4   , TypeFamilies
   5   , UnicodeSyntax
   6   #-}
   7 module Network.HTTP.Lucu.SocketLike
   8     ( SocketLike(..)
   9     )
  10     where
  11
  12 import qualified Network.Socket as So
  13 import           Network.HTTP.Lucu.HandleLike
  14 import qualified OpenSSL.Session as SSL
  15 import qualified System.IO as I
  16
  17
  18 class (HandleLike (Handle s)) => SocketLike s where
  19     type Handle s :: *
  20     accept        :: s -> IO (Handle s, So.SockAddr)
  21     socketPort    :: s -> IO So.PortNumber
  22
  23
  24 instance SocketLike So.Socket where
  25     type Handle So.Socket = I.Handle
  26
  27     accept soSelf
  28         = do (soPeer, addr) <- So.accept soSelf
  29              hPeer          <- So.socketToHandle soPeer I.ReadWriteMode
  30              return (hPeer, addr)
  31
  32     socketPort = So.socketPort
  33
  34
  35 instance SocketLike (SSL.SSLContext, So.Socket) where
  36     type Handle (SSL.SSLContext, So.Socket) = SSL.SSL
  37
  38     accept (ctx, soSelf)
  39         = do (soPeer, addr) <- So.accept soSelf
  40              ssl            <- SSL.connection ctx soPeer
  41              SSL.accept ssl
  42              return (ssl, addr)
  43
  44     socketPort = So.socketPort . snd