]> gitweb @ CieloNegro.org - Lucu.git/blob - Network/HTTP/Lucu/SocketLike.hs
DefaultExtensionMap is now generated with TH.
[Lucu.git] / 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