network-byte-order 0.0.0.0 → 0.1.0.0
raw patch · 2 files changed
+328/−8 lines, 2 files
Files
- Network/ByteOrder.hs +325/−5
- network-byte-order.cabal +3/−3
Network/ByteOrder.hs view
@@ -1,9 +1,15 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE RecordWildCards #-}+ -- | Peek and poke functions for network byte order. module Network.ByteOrder ( -- *Types Buffer , Offset+ , BufferSize+ , BufferOverrun(..) -- *Poking , poke8 , poke16@@ -16,6 +22,7 @@ , peek24 , peek32 , peek64+ , peekByteString -- *From Word to ByteString , bytestring8 , bytestring16@@ -28,14 +35,43 @@ , word64 -- *Utilities , unsafeWithByteString+ , copy+ , bufferIO+ -- *Class to read a buffer+ , Readable(..)+ -- *Reading from buffer+ , ReadBuffer+ , withReadBuffer+ , read16+ , read24+ , read32+ , extractByteString+ -- *Writing to buffer+ , WriteBuffer(..)+ , newWriteBuffer+ , withWriteBuffer+ , write8+ , write16+ , write24+ , write32+ , copyByteString+ , shiftLastN+ , toByteString+ , currentOffset+ -- *Re-exporting+ , Word8, Word16, Word32, Word64, ByteString ) where +import Control.Exception (bracket, throwIO, Exception) import Data.Bits (shiftR, shiftL, (.&.), (.|.))-import Data.ByteString.Internal (ByteString(..), unsafeCreate)-import Data.Word (Word8, Word16, Word32, Word64)-import Foreign.ForeignPtr (withForeignPtr)-import Foreign.Ptr (Ptr, plusPtr)-import Foreign.Storable (poke, peek)+import Data.ByteString.Internal (ByteString(..), create, memcpy, ByteString(..), unsafeCreate)+import Data.IORef (IORef, newIORef, readIORef, writeIORef)+import Data.Typeable+import Data.Word (Word8, Word8, Word16, Word32, Word64)+import Foreign.ForeignPtr (withForeignPtr, newForeignPtr_)+import Foreign.Marshal.Alloc+import Foreign.Ptr (Ptr, plusPtr, plusPtr, minusPtr)+import Foreign.Storable (peek, poke, poke, peek) import System.IO.Unsafe (unsafeDupablePerformIO) -- $setup@@ -45,8 +81,12 @@ ---------------------------------------------------------------- +-- | A pointer to 'Word8'. type Buffer = Ptr Word8+-- | Offset from the current pointer. type Offset = Int+-- | Size of a buffer.+type BufferSize = Int ---------------------------------------------------------------- @@ -201,6 +241,9 @@ w7 <- fromIntegral <$> peek8 ptr (off + 7) return $ w0 .|. w1 .|. w2 .|. w3 .|. w4 .|. w5 .|. w6 .|. w7 +peekByteString :: Buffer -> Int -> IO ByteString+peekByteString src len = create len $ \dst -> memcpy dst src len+ ---------------------------------------------------------------- -- |@@ -278,3 +321,280 @@ unsafeWithByteString :: ByteString -> (Buffer -> Offset -> IO a) -> IO a unsafeWithByteString (PS fptr off _) io = withForeignPtr fptr $ \ptr -> io ptr off++-- | Copying the bytestring to the buffer.+-- This function returns the point where the next copy should start.+copy :: Buffer -> ByteString -> IO Buffer+copy !ptr (PS fp o l) = withForeignPtr fp $ \p -> do+ memcpy ptr (p `plusPtr` o) (fromIntegral l)+ return $! ptr `plusPtr` l+{-# INLINE copy #-}++bufferIO :: Buffer -> Int -> (ByteString -> IO ()) -> IO ()+bufferIO ptr siz io = do+ fptr <- newForeignPtr_ ptr+ io $ PS fptr 0 siz++----------------------------------------------------------------++-- | Read and write buffer.+data WriteBuffer = WriteBuffer {+ start :: !Buffer+ , limit :: !Buffer+ , offset :: !(IORef Buffer)+ , oldoffset :: !(IORef Buffer)+ }++-- | Creating a write buffer with the given buffer.+newWriteBuffer :: Buffer -> BufferSize -> IO WriteBuffer+newWriteBuffer buf siz =+ WriteBuffer buf (buf `plusPtr` siz) <$> newIORef buf <*> newIORef buf++{-# INLINE write8 #-}+-- | Write one byte and ff one byte.+-- If buffer overrun occurs, 'BufferOverrun' is thrown.+write8 :: WriteBuffer -> Word8 -> IO ()+write8 WriteBuffer{..} w = do+ ptr <- readIORef offset+ if ptr >= limit then+ throwIO BufferOverrun+ else do+ poke ptr w+ let !ptr' = ptr `plusPtr` 1+ writeIORef offset ptr'++{-# INLINE write16 #-}+-- | Write two bytes and ff one byte.+-- If buffer overrun occurs, 'BufferOverrun' is thrown.+write16 :: WriteBuffer -> Word16 -> IO ()+write16 WriteBuffer{..} w = do+ ptr <- readIORef offset+ if ptr `plusPtr` 1 >= limit then+ throwIO BufferOverrun+ else do+ poke16 w ptr 0+ let !ptr' = ptr `plusPtr` 2+ writeIORef offset ptr'++{-# INLINE write24 #-}+-- | Write three bytes and ff one byte.+-- If buffer overrun occurs, 'BufferOverrun' is thrown.+write24 :: WriteBuffer -> Word32 -> IO ()+write24 WriteBuffer{..} w = do+ ptr <- readIORef offset+ if ptr `plusPtr` 2 >= limit then+ throwIO BufferOverrun+ else do+ poke24 w ptr 0+ let !ptr' = ptr `plusPtr` 3+ writeIORef offset ptr'++{-# INLINE write32 #-}+-- | Write four bytes and ff one byte.+-- If buffer overrun occurs, 'BufferOverrun' is thrown.+write32 :: WriteBuffer -> Word32 -> IO ()+write32 WriteBuffer{..} w = do+ ptr <- readIORef offset+ if ptr `plusPtr` 3 >= limit then+ throwIO BufferOverrun+ else do+ poke32 w ptr 0+ let !ptr' = ptr `plusPtr` 4+ writeIORef offset ptr'++{-# INLINE shiftLastN #-}+-- | Shifting the N-bytes area just before the current pointer.+-- 'Offset' is the distance from the offset pointer.+-- If 'Offset' is positive, shift it to right.+-- If 'Offset' is negative, shift it to left.+shiftLastN :: WriteBuffer -> Offset -> Int -> IO ()+shiftLastN WriteBuffer{..} 0 _ = return ()+shiftLastN WriteBuffer{..} i len = do+ ptr <- readIORef offset+ let !ptr' = ptr `plusPtr` i+ if ptr' >= limit then+ throwIO BufferOverrun+ else if i < 0 then do+ let !src = ptr `plusPtr` negate len+ !dst = src `plusPtr` i+ shiftLeft dst src len+ writeIORef offset ptr'+ else do+ let !src = ptr `plusPtr` (-1)+ !dst = ptr' `plusPtr` (-1)+ shiftRight dst src len+ writeIORef offset ptr'+ where+ -- memcpy cannot be used for overlapped areas.+ shiftLeft :: Buffer -> Buffer -> Int -> IO ()+ shiftLeft _ _ 0 = return ()+ shiftLeft !dst !src n = do+ peek src >>= poke dst+ shiftLeft (dst `plusPtr` 1) (src `plusPtr` 1) (n - 1)+ shiftRight :: Buffer -> Buffer -> Int -> IO ()+ shiftRight _ _ 0 = return ()+ shiftRight !dst !src n = do+ peek src >>= poke dst+ shiftRight (dst `plusPtr` (-1)) (src `plusPtr` (-1)) (n - 1)++{-# INLINE copyByteString #-}+-- | Copy the content of 'ByteString' and ff its length.+-- If buffer overrun occurs, 'BufferOverrun' is thrown.+copyByteString :: WriteBuffer -> ByteString -> IO ()+copyByteString WriteBuffer{..} (PS fptr off len) = withForeignPtr fptr $ \ptr -> do+ let src = ptr `plusPtr` off+ dst <- readIORef offset+ let !dst' = dst `plusPtr` len+ if dst' >= limit then+ throwIO BufferOverrun+ else do+ memcpy dst src len+ writeIORef offset dst'++-- | Copy the area from 'start' to the current pointer to 'ByteString'.+toByteString :: WriteBuffer -> IO ByteString+toByteString WriteBuffer{..} = do+ ptr <- readIORef offset+ let !len = ptr `minusPtr` start+ create len $ \p -> memcpy p start len++-- | Allocate a temporary buffer and copy the result to 'ByteString'.+withWriteBuffer :: BufferSize -> (WriteBuffer -> IO ()) -> IO ByteString+withWriteBuffer siz action = bracket (mallocBytes siz) free $ \buf -> do+ wbuf <- newWriteBuffer buf 4096+ action wbuf+ toByteString wbuf++{-# INLINE currentOffset #-}+-- | Getting the offset pointer.+currentOffset :: WriteBuffer -> IO Buffer+currentOffset WriteBuffer{..} = readIORef offset++----------------------------------------------------------------++class Readable a where+ -- | Reading one byte as 'Word8' and ff one byte.+ read8 :: a -> IO Word8+ -- | Reading one byte as 'Int' and ff one byte. If buffer overrun occurs, -1 is returned.+ readInt8 :: a -> IO Int+ -- | Fast forward the offset pointer. The boundary is not checked.+ ff :: a -> Offset -> IO ()+ -- | Returning the length of the remaining+ remainingSize :: a -> IO Int+ -- | Executing an action on the current offset pointer.+ withCurrentOffSet :: a -> (Buffer -> IO b) -> IO b+ -- | Memorizing the current offset pointer.+ save :: a -> IO ()+ -- | Getting how many bytes from the saved offset pinter.+ savingSize :: a -> IO Int++instance Readable WriteBuffer where+ {-# INLINE read8 #-}+ read8 WriteBuffer{..} = do+ ptr <- readIORef offset+ w <- peek ptr+ writeIORef offset $! ptr `plusPtr` 1+ return w+ {-# INLINE readInt8 #-}+ readInt8 WriteBuffer{..} = do+ ptr <- readIORef offset+ if ptr < limit then do+ w <- peek ptr+ writeIORef offset $! ptr `plusPtr` 1+ let !i = fromIntegral w+ return i+ else+ return (-1)+ {-# INLINE ff #-}+ ff WriteBuffer{..} n = do+ ptr <- readIORef offset+ let !ptr' = ptr `plusPtr` n+ writeIORef offset ptr'+ {-# INLINE remainingSize #-}+ remainingSize WriteBuffer{..} = do+ ptr <- readIORef offset+ return $! (limit `minusPtr` ptr)+ {-# INLINE withCurrentOffSet #-}+ withCurrentOffSet WriteBuffer{..} action = readIORef offset >>= action+ {-# INLINE save #-}+ save WriteBuffer{..} = readIORef offset >>= writeIORef oldoffset+ {-# INLINE savingSize #-}+ savingSize WriteBuffer{..} = do+ old <- readIORef oldoffset+ cur <- readIORef offset+ return $ cur `minusPtr` old++instance Readable ReadBuffer where+ {-# INLINE read8 #-}+ read8 (ReadBuffer w) = read8 w+ {-# INLINE readInt8 #-}+ readInt8 (ReadBuffer w) = readInt8 w+ {-# INLINE ff #-}+ ff (ReadBuffer w) = ff w+ {-# INLINE remainingSize #-}+ remainingSize (ReadBuffer w) = remainingSize w+ {-# INLINE withCurrentOffSet #-}+ withCurrentOffSet (ReadBuffer w) = withCurrentOffSet w+ {-# INLINE save #-}+ save (ReadBuffer w) = save w+ {-# INLINE savingSize #-}+ savingSize (ReadBuffer w) = savingSize w++----------------------------------------------------------------++-- | Read only buffer. To ensure that the internal is not modified,+-- this is an abstract data type.+newtype ReadBuffer = ReadBuffer WriteBuffer++-- | Converting 'ByteString' to 'ReadBuffer' and run the action+-- with it.+withReadBuffer :: ByteString -> (ReadBuffer -> IO a) -> IO a+withReadBuffer (PS fp off siz) action = withForeignPtr fp $ \ptr -> do+ let !buf = ptr `plusPtr` off+ nsrc <- ReadBuffer <$> newWriteBuffer buf siz+ action nsrc++-- | Extracting 'ByteString' from the current offset.+-- The contents is copied, not shared.+-- Its length is specified by the 2nd argument.+-- If the length is positive, the area after the current pointer is extracted and FF the length finally.+-- If the length is negative, the area before the current pointer is extracted and does not FF.+extractByteString :: Readable a => a -> Int -> IO ByteString+extractByteString wbuf len+ | len == 0 = return mempty+ | len > 0 = do+ bs <- withCurrentOffSet wbuf $ \src ->+ create len $ \dst -> memcpy dst src len+ ff wbuf len+ return bs+ | otherwise = do+ withCurrentOffSet wbuf $ \src0 -> do+ let src = src0 `plusPtr` len+ let len' = negate len+ create len' $ \dst -> memcpy dst src len'++-- | Reading two bytes as 'Word16' and ff two bytes.+read16 :: Readable a => a -> IO Word16+read16 rbuf = do+ w16 <- withCurrentOffSet rbuf (\buf -> peek16 buf 0)+ ff rbuf 2+ return w16++-- | Reading three bytes as 'Word32' and ff three bytes.+read24 :: Readable a => a -> IO Word32+read24 rbuf = do+ w24 <- withCurrentOffSet rbuf (\buf -> peek24 buf 0)+ ff rbuf 3+ return w24++-- | Reading four bytes as 'Word32' and ff four bytes.+read32 :: Readable a => a -> IO Word32+read32 rbuf = do+ w32 <- withCurrentOffSet rbuf (\buf -> peek32 buf 0)+ ff rbuf 4+ return w32++data BufferOverrun = BufferOverrun -- ^ The buffer size is not enough+ deriving (Eq,Show,Typeable)++instance Exception BufferOverrun
network-byte-order.cabal view
@@ -2,13 +2,13 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: network-byte-order-version: 0.0.0.0+version: 0.1.0.0 synopsis: Network byte order utilities description: Peek and poke functions for network byte order. license: BSD3 license-file: LICENSE-author: Kazu Yamamoto <kazu@iij.ad.jp>-maintainer: Kazu Yamamoto <kazu@iij.ad.jp>+author: Kazu Yamamoto+maintainer: kazu@iij.ad.jp -- copyright: category: Network build-type: Simple