{-# LINE 1 "src/Netw/SockAddr.hsc" #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
{-|
Module      : Netw.SockAddr
Description : Various socket address types
Portabilty  : Linux
-}
module Netw.SockAddr 
( SockAddr (..), Addr(..)
, mkAddr
, newSockAddrStorage
, SockAddrNull (..), SockAddrUn (..)
, SockAddrIn (..), SockAddrIn6 (..)
) where



import Netw.Internal.Type (sizeofSockaddrStorage)
import Netw.Inet

import Control.Exception (assert)
import Control.Monad.Primitive

import Data.Char
import Data.Functor
import Data.Foldable

import Data.Primitive
import Data.Primitive.ByteArray.Unaligned

import GHC.Word

type CSaFamily = Word16 -- Don't export this, it is only used here
{-# LINE 36 "src/Netw/SockAddr.hsc" #-}

-- | A type that represent some socket address
newtype Addr = Addr { Addr -> forall a. SockAddr a => Maybe a
unAddr :: forall a. SockAddr a => Maybe a }
mkAddr :: ByteArray -> Addr
mkAddr :: ByteArray -> Addr
mkAddr ByteArray
ba = (forall a. SockAddr a => Maybe a) -> Addr
Addr (ByteArray -> Maybe a
forall a. SockAddr a => ByteArray -> Maybe a
byteArrayToSockAddr ByteArray
ba)

class SockAddr a where
  {-# MINIMAL sockAddrToByteArray, byteArrayToSockAddr #-}
  -- | Convert a socket address to its C equivalent
  sockAddrToByteArray :: a         -> ByteArray
  -- | Convert a socket address from its C equivalent
  byteArrayToSockAddr :: ByteArray -> Maybe a

  -- | Check if this bytearray contain a socket address of this type
  isByteArrayThisAddr :: ByteArray -> Bool
  isByteArrayThisAddr ByteArray
ba
    | Just a
_ <- forall a. SockAddr a => ByteArray -> Maybe a
byteArrayToSockAddr @a ByteArray
ba = Bool
True
    | Bool
otherwise = Bool
False

  -- | Find the required number of bytes to store the C struct
  sockAddrSize :: a -> Int
  sockAddrSize = ByteArray -> Int
sizeofByteArray (ByteArray -> Int) -> (a -> ByteArray) -> a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteArray
forall a. SockAddr a => a -> ByteArray
sockAddrToByteArray

-- TODO: Move this to an internal module
newSockAddrStorage :: PrimMonad m => m (MutableByteArray (PrimState m))
newSockAddrStorage :: forall (m :: * -> *).
PrimMonad m =>
m (MutableByteArray (PrimState m))
newSockAddrStorage = Int -> m (MutableByteArray (PrimState m))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray Int
sizeofSockaddrStorage

-- | A null socket address. Equivalent to not specifying a socket address.
data SockAddrNull = SockAddrNull
instance SockAddr SockAddrNull where
  isByteArrayThisAddr :: ByteArray -> Bool
isByteArrayThisAddr = (Int
0 ==) (Int -> Bool) -> (ByteArray -> Int) -> ByteArray -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteArray -> Int
sizeofByteArray
  sockAddrSize :: SockAddrNull -> Int
sockAddrSize = Int -> SockAddrNull -> Int
forall a b. a -> b -> a
const Int
0

  sockAddrToByteArray :: SockAddrNull -> ByteArray
sockAddrToByteArray SockAddrNull
_ = ByteArray
emptyByteArray
  byteArrayToSockAddr :: ByteArray -> Maybe SockAddrNull
byteArrayToSockAddr ByteArray
a
    | ByteArray -> Int
sizeofByteArray ByteArray
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = SockAddrNull -> Maybe SockAddrNull
forall a. a -> Maybe a
Just SockAddrNull
SockAddrNull
    | Bool
otherwise              = Maybe SockAddrNull
forall a. Maybe a
Nothing

-- | UNIX Socket address
newtype SockAddrUn = SockAddrUn FilePath deriving (SockAddrUn -> SockAddrUn -> Bool
(SockAddrUn -> SockAddrUn -> Bool)
-> (SockAddrUn -> SockAddrUn -> Bool) -> Eq SockAddrUn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SockAddrUn -> SockAddrUn -> Bool
== :: SockAddrUn -> SockAddrUn -> Bool
$c/= :: SockAddrUn -> SockAddrUn -> Bool
/= :: SockAddrUn -> SockAddrUn -> Bool
Eq, Int -> SockAddrUn -> ShowS
[SockAddrUn] -> ShowS
SockAddrUn -> FilePath
(Int -> SockAddrUn -> ShowS)
-> (SockAddrUn -> FilePath)
-> ([SockAddrUn] -> ShowS)
-> Show SockAddrUn
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SockAddrUn -> ShowS
showsPrec :: Int -> SockAddrUn -> ShowS
$cshow :: SockAddrUn -> FilePath
show :: SockAddrUn -> FilePath
$cshowList :: [SockAddrUn] -> ShowS
showList :: [SockAddrUn] -> ShowS
Show)
-- NOTE: There is an extension on linux that add abstract socket address for
-- unix sockets. It is quite nonportable according to the man page
-- might implement it
instance SockAddr SockAddrUn where
  sockAddrSize :: SockAddrUn -> Int
sockAddrSize (SockAddrUn FilePath
sunPath) = (Int
2) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
sunPath
{-# LINE 81 "src/Netw/SockAddr.hsc" #-}
  isByteArrayThisAddr = isSaFamily 1
{-# LINE 82 "src/Netw/SockAddr.hsc" #-}

  sockAddrToByteArray :: SockAddrUn -> ByteArray
sockAddrToByteArray addr :: SockAddrUn
addr@(SockAddrUn FilePath
sunPath) = (forall s. ST s (MutableByteArray s)) -> ByteArray
runByteArray ((forall s. ST s (MutableByteArray s)) -> ByteArray)
-> (forall s. ST s (MutableByteArray s)) -> ByteArray
forall a b. (a -> b) -> a -> b
$ do
    MutableByteArray s
sockaddr <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray Int
len
    MutableByteArray (PrimState (ST s)) -> CSaFamily -> ST s ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> CSaFamily -> m ()
writeSaFamily MutableByteArray s
MutableByteArray (PrimState (ST s))
sockaddr CSaFamily
1
{-# LINE 86 "src/Netw/SockAddr.hsc" #-}
    nullAt <- foldlM (\ idx char -> assert (isAscii char) (writeByteArray @Word8 sockaddr idx (toEnum (ord char))) >> return (succ idx)) (2) sunPath 
{-# LINE 87 "src/Netw/SockAddr.hsc" #-}
    writeByteArray @Word8 sockaddr nullAt 0
    MutableByteArray s -> ST s (MutableByteArray s)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return MutableByteArray s
sockaddr
    where len :: Int
len = SockAddrUn -> Int
forall a. SockAddr a => a -> Int
sockAddrSize SockAddrUn
addr
  byteArrayToSockAddr :: ByteArray -> Maybe SockAddrUn
byteArrayToSockAddr ByteArray
ba -- TODO: Check if the address is a linux abstract address (which start with a null byte)
    | forall a. SockAddr a => ByteArray -> Bool
isByteArrayThisAddr @SockAddrUn ByteArray
ba =
      let lstIdx :: Int
lstIdx  = ByteArray -> Int
sizeofByteArray ByteArray
ba Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 {- NOTE on linux a NULL byte is appened to the end if the NULL byte is present -}
          addrStr :: FilePath
addrStr = [let char :: Char
char = Int -> Char
chr (Word8 -> Int
forall a. Enum a => a -> Int
fromEnum Word8
ch) in Bool -> Char -> Char
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Char -> Bool
isAscii Char
char) Char
char | Word8
ch <- [(Int
2)..Int
lstIdx] [Int] -> (Int -> Word8) -> [Word8]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall a. Prim a => ByteArray -> Int -> a
indexByteArray @Word8 ByteArray
ba, Word8
ch Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0]
{-# LINE 94 "src/Netw/SockAddr.hsc" #-}
      in  SockAddrUn -> Maybe SockAddrUn
forall a. a -> Maybe a
Just (FilePath -> SockAddrUn
SockAddrUn FilePath
addrStr)
    | Bool
otherwise = Maybe SockAddrUn
forall a. Maybe a
Nothing

-- | IPv4 socket address
data SockAddrIn = SockAddrIn
  { SockAddrIn -> Port
sinPort :: !Port
  , SockAddrIn -> InAddr
sinAddr :: !InAddr
  }
instance SockAddr SockAddrIn where
  sockAddrSize :: SockAddrIn -> Int
sockAddrSize SockAddrIn
_      = (Int
16)
{-# LINE 104 "src/Netw/SockAddr.hsc" #-}
  isByteArrayThisAddr = isSaFamily 2
{-# LINE 105 "src/Netw/SockAddr.hsc" #-}

  sockAddrToByteArray :: SockAddrIn -> ByteArray
sockAddrToByteArray a :: SockAddrIn
a@(SockAddrIn Port
port InAddr
addr) = (forall s. ST s (MutableByteArray s)) -> ByteArray
runByteArray ((forall s. ST s (MutableByteArray s)) -> ByteArray)
-> (forall s. ST s (MutableByteArray s)) -> ByteArray
forall a b. (a -> b) -> a -> b
$ do
    MutableByteArray s
sockaddr <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray Int
len
    MutableByteArray (PrimState (ST s)) -> CSaFamily -> ST s ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> CSaFamily -> m ()
writeSaFamily MutableByteArray s
MutableByteArray (PrimState (ST s))
sockaddr CSaFamily
2
{-# LINE 109 "src/Netw/SockAddr.hsc" #-}
    writeAddr sockaddr portOffs (getPortInBE port)
    MutableByteArray (PrimState (ST s)) -> Int -> InAddr -> ST s ()
forall a (m :: * -> *).
(PrimUnaligned a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeAddr MutableByteArray s
MutableByteArray (PrimState (ST s))
sockaddr Int
addrOffs InAddr
addr
    MutableByteArray s -> ST s (MutableByteArray s)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return MutableByteArray s
sockaddr
    where len :: Int
len = SockAddrIn -> Int
forall a. SockAddr a => a -> Int
sockAddrSize SockAddrIn
a
          portOffs :: Int
portOffs = (Int
2)
{-# LINE 114 "src/Netw/SockAddr.hsc" #-}
          addrOffs :: Int
addrOffs = (Int
4) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
0)
{-# LINE 115 "src/Netw/SockAddr.hsc" #-}
  byteArrayToSockAddr ba
    | isByteArrayThisAddr @SockAddrIn ba && sizeofByteArray ba >= (16) = -- #{offset struct sockaddr_in, sin_addr} + #{size struct in_addr} =
{-# LINE 117 "src/Netw/SockAddr.hsc" #-}
      let portOffs = (2)
{-# LINE 118 "src/Netw/SockAddr.hsc" #-}
          addrOffs = (4) + (0)
{-# LINE 119 "src/Netw/SockAddr.hsc" #-}
          addr = SockAddrIn { sinPort = portFromBE $ indexAddr ba portOffs
                            , sinAddr = indexAddr ba addrOffs
                            }
      in  Just addr
    | otherwise = Nothing

-- | IPv6 socket address
data SockAddrIn6 = SockAddrIn6
  { SockAddrIn6 -> Port
sin6Port     :: !Port
  , SockAddrIn6 -> Word32
sin6Flowinfo :: !Word32
  , SockAddrIn6 -> In6Addr
sin6Addr     :: !In6Addr
  , SockAddrIn6 -> Word32
sin6ScopeId  :: !Word32
  }
instance SockAddr SockAddrIn6 where
  sockAddrSize :: SockAddrIn6 -> Int
sockAddrSize SockAddrIn6
_ = (Int
28)
{-# LINE 134 "src/Netw/SockAddr.hsc" #-}
  isByteArrayThisAddr = isSaFamily 10
{-# LINE 135 "src/Netw/SockAddr.hsc" #-}

  sockAddrToByteArray :: SockAddrIn6 -> ByteArray
sockAddrToByteArray a :: SockAddrIn6
a@(SockAddrIn6 Port
port Word32
flow (In6Addr# (# Word64#
high#, Word64#
low# #)) Word32
scope) = (forall s. ST s (MutableByteArray s)) -> ByteArray
runByteArray ((forall s. ST s (MutableByteArray s)) -> ByteArray)
-> (forall s. ST s (MutableByteArray s)) -> ByteArray
forall a b. (a -> b) -> a -> b
$ do
    MutableByteArray s
sockaddr <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray Int
len
    MutableByteArray (PrimState (ST s)) -> CSaFamily -> ST s ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> CSaFamily -> m ()
writeSaFamily MutableByteArray s
MutableByteArray (PrimState (ST s))
sockaddr CSaFamily
10
{-# LINE 139 "src/Netw/SockAddr.hsc" #-}
    writeAddr sockaddr portOffs     (getPortInBE port)
    MutableByteArray (PrimState (ST s)) -> Int -> Word32 -> ST s ()
forall a (m :: * -> *).
(PrimUnaligned a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeAddr MutableByteArray s
MutableByteArray (PrimState (ST s))
sockaddr Int
flowOffs     (Word32 -> Word32
hton32 Word32
flow)
    MutableByteArray (PrimState (ST s)) -> Int -> Word64 -> ST s ()
forall a (m :: * -> *).
(PrimUnaligned a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeAddr MutableByteArray s
MutableByteArray (PrimState (ST s))
sockaddr Int
addrHighOffs (Word64# -> Word64
W64# Word64#
high#)
    MutableByteArray (PrimState (ST s)) -> Int -> Word64 -> ST s ()
forall a (m :: * -> *).
(PrimUnaligned a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeAddr MutableByteArray s
MutableByteArray (PrimState (ST s))
sockaddr Int
addrLowOffs  (Word64# -> Word64
W64# Word64#
low#)
    MutableByteArray (PrimState (ST s)) -> Int -> Word32 -> ST s ()
forall a (m :: * -> *).
(PrimUnaligned a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeAddr MutableByteArray s
MutableByteArray (PrimState (ST s))
sockaddr Int
scopeOffs    (Word32 -> Word32
hton32 Word32
scope)
    MutableByteArray s -> ST s (MutableByteArray s)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return MutableByteArray s
sockaddr
    where len :: Int
len = SockAddrIn6 -> Int
forall a. SockAddr a => a -> Int
sockAddrSize SockAddrIn6
a
          portOffs :: Int
portOffs  = (Int
2)
{-# LINE 147 "src/Netw/SockAddr.hsc" #-}
          flowOffs :: Int
flowOffs  = (Int
4)
{-# LINE 148 "src/Netw/SockAddr.hsc" #-}
          scopeOffs :: Int
scopeOffs = (Int
24)
{-# LINE 149 "src/Netw/SockAddr.hsc" #-}
          addrOffs :: Int
addrOffs  = (Int
8) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
0)
{-# LINE 150 "src/Netw/SockAddr.hsc" #-}
          addrHighOffs :: Int
addrHighOffs = Int
addrOffs
          addrLowOffs :: Int
addrLowOffs  = Int
addrOffs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ forall a. Prim a => Int
sizeOfType @Word64

  byteArrayToSockAddr :: ByteArray -> Maybe SockAddrIn6
byteArrayToSockAddr ByteArray
ba
    | forall a. SockAddr a => ByteArray -> Bool
isByteArrayThisAddr @SockAddrIn6 ByteArray
ba Bool -> Bool -> Bool
&& ByteArray -> Int
sizeofByteArray ByteArray
ba Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= (Int
28) =
{-# LINE 155 "src/Netw/SockAddr.hsc" #-}
      let portOffs  = (2)
{-# LINE 156 "src/Netw/SockAddr.hsc" #-}
          flowOffs  = (4)
{-# LINE 157 "src/Netw/SockAddr.hsc" #-}
          scopeOffs = (24)
{-# LINE 158 "src/Netw/SockAddr.hsc" #-}
          addrOffs  = (8) + (0)
{-# LINE 159 "src/Netw/SockAddr.hsc" #-}
          addrHighOffs = addrOffs
          addrLowOffs  = addrOffs + sizeOfType @Word64
          !(W64# high#) = indexAddr ba addrHighOffs
          !(W64# low#)  = indexAddr ba addrLowOffs
          addr = SockAddrIn6 { sin6Port     = portFromBE $ indexAddr ba portOffs
                             , sin6Flowinfo = ntoh32 (indexAddr ba flowOffs)
                             , sin6Addr     = In6Addr# (# high#, low# #)
                             , sin6ScopeId  = ntoh32 (indexAddr ba scopeOffs)
                             }
      in  Just addr
    | Bool
otherwise = Maybe SockAddrIn6
forall a. Maybe a
Nothing

-- this is used internally
writeSaFamily :: PrimMonad m => MutableByteArray (PrimState m) -> CSaFamily -> m ()
writeSaFamily :: forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> CSaFamily -> m ()
writeSaFamily = (MutableByteArray (PrimState m) -> Int -> CSaFamily -> m ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
`writeByteArray` Int
0)

writeAddr :: (PrimUnaligned a, PrimMonad m) => MutableByteArray (PrimState m) -> Int -> a -> m ()
writeAddr :: forall a (m :: * -> *).
(PrimUnaligned a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeAddr = MutableByteArray (PrimState m) -> Int -> a -> m ()
forall (m :: * -> *) a.
(PrimMonad m, PrimUnaligned a) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeUnalignedByteArray

indexAddr :: PrimUnaligned a => ByteArray -> Int -> a
indexAddr :: forall a. PrimUnaligned a => ByteArray -> Int -> a
indexAddr = ByteArray -> Int -> a
forall a. PrimUnaligned a => ByteArray -> Int -> a
indexUnalignedByteArray

isSaFamily :: CSaFamily -> ByteArray -> Bool
isSaFamily :: CSaFamily -> ByteArray -> Bool
isSaFamily CSaFamily
fam ByteArray
ba = ByteArray -> Int
sizeofByteArray ByteArray
ba Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= (Int
2) Bool -> Bool -> Bool
&& CSaFamily
fam CSaFamily -> CSaFamily -> Bool
forall a. Eq a => a -> a -> Bool
== forall a. Prim a => ByteArray -> Int -> a
indexByteArray @CSaFamily ByteArray
ba Int
0
{-# LINE 183 "src/Netw/SockAddr.hsc" #-}