{-# 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 :: CInt
sizeofSocketAddressInternet = (CInt
16)
{-# LINE 46 "src-linux/Posix/Socket/Platform.hsc" #-}
internalWriteSocketAddressInternet ::
MutableByteArray s
-> SocketAddressInternet
-> ST s ()
internalWriteSocketAddressInternet :: forall s. MutableByteArray s -> SocketAddressInternet -> ST s ()
internalWriteSocketAddressInternet MutableByteArray s
bs (SocketAddressInternet {Word16
$sel:port:SocketAddressInternet :: SocketAddressInternet -> Word16
port :: Word16
port, Word32
$sel:address:SocketAddressInternet :: SocketAddressInternet -> Word32
address :: Word32
address}) = do
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> Int -> a -> m ()
PM.setByteArray MutableByteArray s
bs Int
0 (Int
16) (Word8
0 :: Word8)
{-# LINE 55 "src-linux/Posix/Socket/Platform.hsc" #-}
(\MutableByteArray s
hsc_arr Int
hsc_ix -> forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray s
hsc_arr (Int
0 forall a. Num a => a -> a -> a
+ (Int
hsc_ix forall a. Num a => a -> a -> a
* Int
8))) MutableByteArray s
bs Int
0 (CUShort
2 :: CUShort)
{-# LINE 62 "src-linux/Posix/Socket/Platform.hsc" #-}
(\MutableByteArray s
hsc_arr Int
hsc_ix -> forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray s
hsc_arr (Int
1 forall a. Num a => a -> a -> a
+ (Int
hsc_ix forall a. Num a => a -> a -> a
* Int
8))) MutableByteArray s
bs Int
0 Word16
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 :: SocketAddressInternet -> SocketAddress
encodeSocketAddressInternet SocketAddressInternet
sockAddrInternet =
ByteArray -> SocketAddress
SocketAddress forall a b. (a -> b) -> a -> b
$ (State# RealWorld -> (# State# RealWorld, ByteArray# #))
-> ByteArray
runByteArrayST forall a b. (a -> b) -> a -> b
$ forall s. ST s ByteArray -> State# s -> (# State# s, ByteArray# #)
unboxByteArrayST forall a b. (a -> b) -> a -> b
$ do
MutableByteArray RealWorld
bs <- forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newByteArray (Int
16)
{-# LINE 73 "src-linux/Posix/Socket/Platform.hsc" #-}
internalWriteSocketAddressInternet bs sockAddrInternet
ByteArray
r <- forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
PM.unsafeFreezeByteArray MutableByteArray RealWorld
bs
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteArray
r
decodeSocketAddressInternet :: SocketAddress -> Maybe SocketAddressInternet
decodeSocketAddressInternet :: SocketAddress -> Maybe SocketAddressInternet
decodeSocketAddressInternet (SocketAddress ByteArray
arr) =
if ByteArray -> Int
PM.sizeofByteArray ByteArray
arr forall a. Eq a => a -> a -> Bool
== ((Int
16))
{-# LINE 83 "src-linux/Posix/Socket/Platform.hsc" #-}
then if ((\ByteArray
hsc_arr Int
hsc_ix -> forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
hsc_arr (Int
0 forall a. Num a => a -> a -> a
+ (Int
hsc_ix forall a. Num a => a -> a -> a
* Int
8))) ByteArray
arr Int
0) forall a. Eq a => a -> a -> Bool
== (CUShort
2 :: CUShort)
{-# LINE 86 "src-linux/Posix/Socket/Platform.hsc" #-}
then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ SocketAddressInternet
{ $sel:port:SocketAddressInternet :: Word16
port = (\ByteArray
hsc_arr Int
hsc_ix -> forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
hsc_arr (Int
1 forall a. Num a => a -> a -> a
+ (Int
hsc_ix forall a. Num a => a -> a -> a
* Int
8))) ByteArray
arr Int
0
{-# LINE 88 "src-linux/Posix/Socket/Platform.hsc" #-}
, $sel:address:SocketAddressInternet :: Word32
address = (\ByteArray
hsc_arr Int
hsc_ix -> forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
hsc_arr (Int
1 forall a. Num a => a -> a -> a
+ (Int
hsc_ix forall a. Num a => a -> a -> a
* Int
4))) ByteArray
arr Int
0
{-# LINE 89 "src-linux/Posix/Socket/Platform.hsc" #-}
}
else forall a. Maybe a
Nothing
else forall a. Maybe a
Nothing
indexSocketAddressInternet :: Addr -> Int -> IO (Either CInt SocketAddressInternet)
indexSocketAddressInternet :: Addr -> Int -> IO (Either CInt SocketAddressInternet)
indexSocketAddressInternet Addr
addr Int
ix = do
CUShort
fam <- (\Ptr Any
hsc_ptr -> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Any
hsc_ptr Int
0) forall {a}. Ptr a
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 Addr#
offAddr) = Addr -> Int -> Addr
PMA.plusAddr Addr
addr (Int
ix forall a. Num a => a -> a -> a
* ((Int
16)))
{-# LINE 108 "src-linux/Posix/Socket/Platform.hsc" #-}
ptr = Ptr offAddr
encodeSocketAddressUnix :: SocketAddressUnix -> SocketAddress
encodeSocketAddressUnix :: SocketAddressUnix -> SocketAddress
encodeSocketAddressUnix (SocketAddressUnix !ByteArray
name) =
ByteArray -> SocketAddress
SocketAddress forall a b. (a -> b) -> a -> b
$ (State# RealWorld -> (# State# RealWorld, ByteArray# #))
-> ByteArray
runByteArrayST forall a b. (a -> b) -> a -> b
$ forall s. ST s ByteArray -> State# s -> (# State# s, ByteArray# #)
unboxByteArrayST forall a b. (a -> b) -> a -> b
$ do
let pathSize :: Int
pathSize = Int
108 :: Int
let familySize :: Int
familySize = forall a. Storable a => a -> Int
FS.sizeOf (forall a. HasCallStack => a
undefined :: CUShort)
MutableByteArray RealWorld
bs <- forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newByteArray (Int
pathSize forall a. Num a => a -> a -> a
+ Int
familySize)
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> Int -> a -> m ()
PM.setByteArray MutableByteArray RealWorld
bs Int
familySize Int
pathSize (Word8
0 :: Word8)
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PM.writeByteArray MutableByteArray RealWorld
bs Int
0 (CUShort
1 :: CUShort)
{-# LINE 129 "src-linux/Posix/Socket/Platform.hsc" #-}
let sz = PM.sizeofByteArray name
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
sz forall a. Ord a => a -> a -> Bool
< Int
pathSize) forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> ByteArray -> Int -> Int -> m ()
PM.copyByteArray MutableByteArray RealWorld
bs Int
familySize ByteArray
name Int
0 Int
sz
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
PM.unsafeFreezeByteArray MutableByteArray RealWorld
bs
cushortToCInt :: CUShort -> CInt
cushortToCInt :: CUShort -> CInt
cushortToCInt = forall a b. (Integral a, Num b) => a -> b
fromIntegral
unboxByteArrayST :: ST s ByteArray -> State# s -> (# State# s, ByteArray# #)
unboxByteArrayST :: forall s. ST s ByteArray -> State# s -> (# State# s, ByteArray# #)
unboxByteArrayST (ST STRep s ByteArray
f) State# s
s = case STRep s ByteArray
f State# s
s of
(# State# s
s', ByteArray ByteArray#
b #) -> (# State# s
s', ByteArray#
b #)
runByteArrayST :: (State# RealWorld -> (# State# RealWorld, ByteArray# #)) -> ByteArray
runByteArrayST :: (State# RealWorld -> (# State# RealWorld, ByteArray# #))
-> ByteArray
runByteArrayST State# RealWorld -> (# State# RealWorld, ByteArray# #)
st_rep = case forall o. (State# RealWorld -> o) -> o
runRW# State# RealWorld -> (# State# RealWorld, ByteArray# #)
st_rep of (# State# RealWorld
_, ByteArray#
a #) -> ByteArray# -> ByteArray
ByteArray ByteArray#
a