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 import qualified Network.Socket as So
  12 import Network.HTTP.Lucu.HandleLike
  13 import qualified OpenSSL.Session as SSL
  14 import Prelude.Unicode
  15 import qualified System.IO as I
  16
  17 class (HandleLike (Handle s)) ⇒ SocketLike s where
  18     type Handle s ∷ ★
  19     accept        ∷ s → IO (Handle s, So.SockAddr)
  20     socketPort    ∷ s → IO So.PortNumber
  21
  22 instance SocketLike So.Socket where
  23     type Handle So.Socket = I.Handle
  24
  25     accept soSelf
  26         = do (soPeer, addr) ← So.accept soSelf
  27              hPeer          ← So.socketToHandle soPeer I.ReadWriteMode
  28              return (hPeer, addr)
  29
  30     socketPort = So.socketPort
  31
  32 instance SocketLike (SSL.SSLContext, So.Socket) where
  33     type Handle (SSL.SSLContext, So.Socket) = SSL.SSL
  34
  35     accept (ctx, soSelf)
  36         = do (soPeer, addr) ← So.accept soSelf
  37              ssl            ← SSL.connection ctx soPeer
  38              SSL.accept ssl
  39              return (ssl, addr)
  40
  41     socketPort = So.socketPort ∘ snd