{-# LANGUAGE CPP #-}
module Happstack.Server.Internal.Socket
    ( acceptLite
    , sockAddrToPeer
    ) where

import Data.List (intersperse)
import Data.Word (Word32)
import qualified Network.Socket as S
  ( Socket
  , PortNumber()
  , SockAddr(..)
  , HostName
  , accept
  )
import Numeric (showHex)

type HostAddress = Word32
type HostAddress6 = (Word32, Word32, Word32, Word32)

-- | Converts a HostAddress to a String in dot-decimal notation
showHostAddress :: HostAddress -> String
showHostAddress :: HostAddress -> String
showHostAddress HostAddress
num = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [HostAddress -> String
forall a. Show a => a -> String
show HostAddress
q1, String
".", HostAddress -> String
forall a. Show a => a -> String
show HostAddress
q2, String
".", HostAddress -> String
forall a. Show a => a -> String
show HostAddress
q3, String
".", HostAddress -> String
forall a. Show a => a -> String
show HostAddress
q4]
  where (HostAddress
num',HostAddress
q1)   = HostAddress
num HostAddress -> HostAddress -> (HostAddress, HostAddress)
forall a. Integral a => a -> a -> (a, a)
`quotRem` HostAddress
256
        (HostAddress
num'',HostAddress
q2)  = HostAddress
num' HostAddress -> HostAddress -> (HostAddress, HostAddress)
forall a. Integral a => a -> a -> (a, a)
`quotRem` HostAddress
256
        (HostAddress
num''',HostAddress
q3) = HostAddress
num'' HostAddress -> HostAddress -> (HostAddress, HostAddress)
forall a. Integral a => a -> a -> (a, a)
`quotRem` HostAddress
256
        (HostAddress
_,HostAddress
q4)      = HostAddress
num''' HostAddress -> HostAddress -> (HostAddress, HostAddress)
forall a. Integral a => a -> a -> (a, a)
`quotRem` HostAddress
256

-- | Converts a IPv6 HostAddress6 to standard hex notation
showHostAddress6 :: HostAddress6 -> String
showHostAddress6 :: HostAddress6 -> String
showHostAddress6 (HostAddress
a,HostAddress
b,HostAddress
c,HostAddress
d) =
  ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([HostAddress] -> [String]) -> [HostAddress] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
":" ([String] -> [String])
-> ([HostAddress] -> [String]) -> [HostAddress] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HostAddress -> String) -> [HostAddress] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((HostAddress -> String -> String)
-> String -> HostAddress -> String
forall a b c. (a -> b -> c) -> b -> a -> c
flip HostAddress -> String -> String
forall a. (Integral a, Show a) => a -> String -> String
showHex String
""))
    [HostAddress
p1,HostAddress
p2,HostAddress
p3,HostAddress
p4,HostAddress
p5,HostAddress
p6,HostAddress
p7,HostAddress
p8]
  where (HostAddress
a',HostAddress
p2) = HostAddress
a HostAddress -> HostAddress -> (HostAddress, HostAddress)
forall a. Integral a => a -> a -> (a, a)
`quotRem` HostAddress
65536
        (HostAddress
_,HostAddress
p1)  = HostAddress
a' HostAddress -> HostAddress -> (HostAddress, HostAddress)
forall a. Integral a => a -> a -> (a, a)
`quotRem` HostAddress
65536
        (HostAddress
b',HostAddress
p4) = HostAddress
b HostAddress -> HostAddress -> (HostAddress, HostAddress)
forall a. Integral a => a -> a -> (a, a)
`quotRem` HostAddress
65536
        (HostAddress
_,HostAddress
p3)  = HostAddress
b' HostAddress -> HostAddress -> (HostAddress, HostAddress)
forall a. Integral a => a -> a -> (a, a)
`quotRem` HostAddress
65536
        (HostAddress
c',HostAddress
p6) = HostAddress
c HostAddress -> HostAddress -> (HostAddress, HostAddress)
forall a. Integral a => a -> a -> (a, a)
`quotRem` HostAddress
65536
        (HostAddress
_,HostAddress
p5)  = HostAddress
c' HostAddress -> HostAddress -> (HostAddress, HostAddress)
forall a. Integral a => a -> a -> (a, a)
`quotRem` HostAddress
65536
        (HostAddress
d',HostAddress
p8) = HostAddress
d HostAddress -> HostAddress -> (HostAddress, HostAddress)
forall a. Integral a => a -> a -> (a, a)
`quotRem` HostAddress
65536
        (HostAddress
_,HostAddress
p7)  = HostAddress
d' HostAddress -> HostAddress -> (HostAddress, HostAddress)
forall a. Integral a => a -> a -> (a, a)
`quotRem` HostAddress
65536

-- | alternative implementation of accept to work around EAI_AGAIN errors
acceptLite :: S.Socket -> IO (S.Socket, S.HostName, S.PortNumber)
acceptLite :: Socket -> IO (Socket, String, PortNumber)
acceptLite Socket
sock = do
  (Socket
sock', SockAddr
addr) <- Socket -> IO (Socket, SockAddr)
S.accept Socket
sock
  let (String
peer, PortNumber
port) = SockAddr -> (String, PortNumber)
sockAddrToPeer SockAddr
addr
  (Socket, String, PortNumber) -> IO (Socket, String, PortNumber)
forall (m :: * -> *) a. Monad m => a -> m a
return (Socket
sock', String
peer, PortNumber
port)

sockAddrToPeer ::  S.SockAddr -> (S.HostName, S.PortNumber)
sockAddrToPeer :: SockAddr -> (String, PortNumber)
sockAddrToPeer SockAddr
addr =
  case SockAddr
addr of
    (S.SockAddrInet PortNumber
p HostAddress
ha)      -> (HostAddress -> String
showHostAddress HostAddress
ha, PortNumber
p)
    (S.SockAddrInet6 PortNumber
p HostAddress
_ HostAddress6
ha HostAddress
_) -> (HostAddress6 -> String
showHostAddress6 HostAddress6
ha, PortNumber
p)
    SockAddr
_                          -> String -> (String, PortNumber)
forall a. HasCallStack => String -> a
error String
"sockAddrToPeer: Unsupported socket type"