{-# LINE 1 "src-linux/Posix/Socket/Platform.hsc" #-}
{-# language BangPatterns #-}
{-# language DerivingStrategies #-}
{-# language DuplicateRecordFields #-}
{-# language GeneralizedNewtypeDeriving #-}
{-# language MagicHash #-}
{-# language NamedFieldPuns #-}
{-# language UnboxedTuples #-}
{-# language ScopedTypeVariables #-}
module Posix.Socket.Platform
(
encodeSocketAddressInternet
, encodeSocketAddressUnix
, decodeSocketAddressInternet
, indexSocketAddressInternet
, sizeofSocketAddressInternet
) where
import Control.Monad (when)
import Data.Primitive (MutableByteArray,ByteArray(..),writeByteArray,indexByteArray)
import Data.Primitive.Addr (Addr(..))
import Data.Word (Word8)
import Foreign.C.Types (CUShort,CInt)
import GHC.Exts (ByteArray#,State#,RealWorld,runRW#,Ptr(..))
import GHC.ST (ST(..))
import Posix.Socket.Types (SocketAddress(..))
import Posix.Socket.Types (SocketAddressInternet(..),SocketAddressUnix(..))
import Foreign.Storable (peekByteOff)
import qualified Data.Primitive as PM
import qualified Data.Primitive.Addr as PMA
import qualified Foreign.Storable as FS
sizeofSocketAddressInternet :: CInt
sizeofSocketAddressInternet = (16)
{-# LINE 46 "src-linux/Posix/Socket/Platform.hsc" #-}
internalWriteSocketAddressInternet ::
MutableByteArray s
-> SocketAddressInternet
-> ST s ()
internalWriteSocketAddressInternet bs (SocketAddressInternet {port, address}) = do
PM.setByteArray bs 0 (16) (0 :: Word8)
{-# LINE 55 "src-linux/Posix/Socket/Platform.hsc" #-}
(\hsc_arr hsc_ix -> writeByteArray hsc_arr (0 + (hsc_ix * 8))) bs 0 (2 :: CUShort)
{-# LINE 62 "src-linux/Posix/Socket/Platform.hsc" #-}
(\hsc_arr hsc_ix -> writeByteArray hsc_arr (1 + (hsc_ix * 8))) bs 0 port
{-# LINE 65 "src-linux/Posix/Socket/Platform.hsc" #-}
(\hsc_arr hsc_ix -> writeByteArray hsc_arr (1 + (hsc_ix * 4))) bs 0 address
{-# LINE 66 "src-linux/Posix/Socket/Platform.hsc" #-}
encodeSocketAddressInternet :: SocketAddressInternet -> SocketAddress
encodeSocketAddressInternet sockAddrInternet =
SocketAddress $ runByteArrayST $ unboxByteArrayST $ do
bs <- PM.newByteArray (16)
{-# LINE 73 "src-linux/Posix/Socket/Platform.hsc" #-}
internalWriteSocketAddressInternet bs sockAddrInternet
r <- PM.unsafeFreezeByteArray bs
pure r
decodeSocketAddressInternet :: SocketAddress -> Maybe SocketAddressInternet
decodeSocketAddressInternet (SocketAddress arr) =
if PM.sizeofByteArray arr == ((16))
{-# LINE 83 "src-linux/Posix/Socket/Platform.hsc" #-}
then if ((\hsc_arr hsc_ix -> indexByteArray hsc_arr (0 + (hsc_ix * 8))) arr 0) == (2 :: CUShort)
{-# LINE 86 "src-linux/Posix/Socket/Platform.hsc" #-}
then Just $ SocketAddressInternet
{ port = (\hsc_arr hsc_ix -> indexByteArray hsc_arr (1 + (hsc_ix * 8))) arr 0
{-# LINE 88 "src-linux/Posix/Socket/Platform.hsc" #-}
, address = (\hsc_arr hsc_ix -> indexByteArray hsc_arr (1 + (hsc_ix * 4))) arr 0
{-# LINE 89 "src-linux/Posix/Socket/Platform.hsc" #-}
}
else Nothing
else Nothing
indexSocketAddressInternet :: Addr -> Int -> IO (Either CInt SocketAddressInternet)
indexSocketAddressInternet addr ix = do
fam <- (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr
{-# LINE 100 "src-linux/Posix/Socket/Platform.hsc" #-}
if fam == (2 :: CUShort)
{-# LINE 101 "src-linux/Posix/Socket/Platform.hsc" #-}
then do
port <- (\hsc_ptr -> peekByteOff hsc_ptr 2) ptr
{-# LINE 103 "src-linux/Posix/Socket/Platform.hsc" #-}
address <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr
{-# LINE 104 "src-linux/Posix/Socket/Platform.hsc" #-}
pure (Right (SocketAddressInternet { port, address }))
else pure (Left (cushortToCInt fam))
where
!(Addr offAddr) = PMA.plusAddr addr (ix * ((16)))
{-# LINE 108 "src-linux/Posix/Socket/Platform.hsc" #-}
ptr = Ptr offAddr
encodeSocketAddressUnix :: SocketAddressUnix -> SocketAddress
encodeSocketAddressUnix (SocketAddressUnix !name) =
SocketAddress $ runByteArrayST $ unboxByteArrayST $ do
let pathSize = 108 :: Int
let familySize = FS.sizeOf (undefined :: CUShort)
bs <- PM.newByteArray (pathSize + familySize)
PM.setByteArray bs familySize pathSize (0 :: Word8)
PM.writeByteArray bs 0 (1 :: CUShort)
{-# LINE 129 "src-linux/Posix/Socket/Platform.hsc" #-}
let sz = PM.sizeofByteArray name
when (sz < pathSize) $ do
PM.copyByteArray bs familySize name 0 sz
PM.unsafeFreezeByteArray bs
cushortToCInt :: CUShort -> CInt
cushortToCInt = fromIntegral
unboxByteArrayST :: ST s ByteArray -> State# s -> (# State# s, ByteArray# #)
unboxByteArrayST (ST f) s = case f s of
(# s', ByteArray b #) -> (# s', b #)
runByteArrayST :: (State# RealWorld -> (# State# RealWorld, ByteArray# #)) -> ByteArray
runByteArrayST st_rep = case runRW# st_rep of (# _, a #) -> ByteArray a