    {-# 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 :: Word32 -> String
    showHostAddress Word32
    num = [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [Word32 -> String
    forall a. Show a => a -> String
    show Word32
    q1, String
    ".", Word32 -> String
    forall a. Show a => a -> String
    show Word32
    q2, String
    ".", Word32 -> String
    forall a. Show a => a -> String
    show Word32
    q3, String
    ".", Word32 -> String
    forall a. Show a => a -> String
    show Word32
    q4]
      where (Word32
    num',Word32
    q1)   = Word32
    num Word32 -> Word32 -> (Word32, Word32)
    forall a. Integral a => a -> a -> (a, a)
    `quotRem` Word32
    256
            (Word32
    num'',Word32
    q2)  = Word32
    num' Word32 -> Word32 -> (Word32, Word32)
    forall a. Integral a => a -> a -> (a, a)
    `quotRem` Word32
    256
            (Word32
    num''',Word32
    q3) = Word32
    num'' Word32 -> Word32 -> (Word32, Word32)
    forall a. Integral a => a -> a -> (a, a)
    `quotRem` Word32
    256
            (Word32
    _,Word32
    q4)      = Word32
    num''' Word32 -> Word32 -> (Word32, Word32)
    forall a. Integral a => a -> a -> (a, a)
    `quotRem` Word32
    256

    -- | Converts a IPv6 HostAddress6 to standard hex notation
    showHostAddress6 :: HostAddress6 -> String
    showHostAddress6 :: HostAddress6 -> String
    showHostAddress6 (Word32
    a,Word32
    b,Word32
    c,Word32
    d) =
      ([String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([String] -> String)
    -> ([Word32] -> [String]) -> [Word32] -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    intersperse String
    ":" ([String] -> [String])
    -> ([Word32] -> [String]) -> [Word32] -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Word32 -> String) -> [Word32] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Word32 -> String -> String) -> String -> Word32 -> String
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Word32 -> String -> String
    forall a. Integral a => a -> String -> String
    showHex String
    ""))
        [Word32
    p1,Word32
    p2,Word32
    p3,Word32
    p4,Word32
    p5,Word32
    p6,Word32
    p7,Word32
    p8]
      where (Word32
    a',Word32
    p2) = Word32
    a Word32 -> Word32 -> (Word32, Word32)
    forall a. Integral a => a -> a -> (a, a)
    `quotRem` Word32
    65536
            (Word32
    _,Word32
    p1)  = Word32
    a' Word32 -> Word32 -> (Word32, Word32)
    forall a. Integral a => a -> a -> (a, a)
    `quotRem` Word32
    65536
            (Word32
    b',Word32
    p4) = Word32
    b Word32 -> Word32 -> (Word32, Word32)
    forall a. Integral a => a -> a -> (a, a)
    `quotRem` Word32
    65536
            (Word32
    _,Word32
    p3)  = Word32
    b' Word32 -> Word32 -> (Word32, Word32)
    forall a. Integral a => a -> a -> (a, a)
    `quotRem` Word32
    65536
            (Word32
    c',Word32
    p6) = Word32
    c Word32 -> Word32 -> (Word32, Word32)
    forall a. Integral a => a -> a -> (a, a)
    `quotRem` Word32
    65536
            (Word32
    _,Word32
    p5)  = Word32
    c' Word32 -> Word32 -> (Word32, Word32)
    forall a. Integral a => a -> a -> (a, a)
    `quotRem` Word32
    65536
            (Word32
    d',Word32
    p8) = Word32
    d Word32 -> Word32 -> (Word32, Word32)
    forall a. Integral a => a -> a -> (a, a)
    `quotRem` Word32
    65536
            (Word32
    _,Word32
    p7)  = Word32
    d' Word32 -> Word32 -> (Word32, Word32)
    forall a. Integral a => a -> a -> (a, a)
    `quotRem` Word32
    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
      (sock', addr) <- Socket -> IO (Socket, SockAddr)
    S.accept Socket
    sock
      let (peer, port) = sockAddrToPeer addr
      return (sock', peer, port)

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