module System.Socket.Family.Unix
( Unix
, SocketAddress
, socketAddressUnixPath
, socketAddressUnixAbstract
, getUnixPath
) where
import Foreign.Ptr (castPtr, plusPtr)
import Foreign.Storable (Storable(..))
import Foreign.Marshal.Utils (fillBytes, copyBytes)
import Data.Word (Word16, Word8)
import Data.ByteString (ByteString)
import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
import qualified Data.ByteString as B
import System.Socket (Family(..), SocketAddress, Protocol(..))
data Unix
instance Family Unix where
familyNumber _ = (1)
instance Protocol Unix where
protocolNumber _ = 0
data instance SocketAddress Unix
= SocketAddressUnixPath ByteString
| SocketAddressUnixAbstract ByteString
deriving (Eq, Show)
maxPathLength :: Int
maxPathLength = 107
socketAddressUnixPath :: ByteString -> Maybe (SocketAddress Unix)
socketAddressUnixPath path
| B.length path <= maxPathLength = Just $ SocketAddressUnixPath path
| otherwise = Nothing
socketAddressUnixAbstract :: ByteString -> Maybe (SocketAddress Unix)
socketAddressUnixAbstract path
| len <= maxPathLength = Just . SocketAddressUnixAbstract $
path `B.append` B.replicate (maxPathLength len) 0
| otherwise = Nothing
where len = B.length path
getUnixPath :: SocketAddress Unix -> Maybe (ByteString)
getUnixPath (SocketAddressUnixPath path) = Just path
getUnixPath _ = Nothing
instance Storable (SocketAddress Unix) where
sizeOf _ = ((110))
alignment _ = ((2))
peek ptr = do
first <- peek (sun_path ptr) :: IO Word8
case first of
0 -> SocketAddressUnixAbstract <$>
B.packCStringLen (castPtr $ sun_path ptr `plusPtr` 1, maxPathLength)
_ -> SocketAddressUnixPath <$> B.packCString (castPtr $ sun_path ptr)
where
sun_path = ((\hsc_ptr -> hsc_ptr `plusPtr` 2))
poke ptr socketAddress = do
fillBytes ptr 0 (110)
poke (sun_family ptr) ((1) :: Word16)
case socketAddress of
SocketAddressUnixPath path -> unsafeUseAsCStringLen path $
\(src, len) -> copyBytes (sun_path ptr) src len
SocketAddressUnixAbstract path -> unsafeUseAsCStringLen path $
\(src, len) -> copyBytes (sun_path ptr `plusPtr` 1) src len
where
sun_family = ((\hsc_ptr -> hsc_ptr `plusPtr` 0))
sun_path = ((\hsc_ptr -> hsc_ptr `plusPtr` 2))