diff --git a/BufferedSocket.cabal b/BufferedSocket.cabal --- a/BufferedSocket.cabal +++ b/BufferedSocket.cabal @@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.1.1.0 +version: 0.2.0.0 -- A short (one-line) description of the package. synopsis: A socker wrapper that makes the IO of sockets much cleaner @@ -48,10 +48,10 @@ library -- Modules exported by the library. - exposed-modules: BufferedSocket, Core, Reader, Writer - + exposed-modules: Network.BufferedSocket, Network.BufferedSocket.Core, Network.BufferedSocket.Reader, Network.BufferedSocket.Writer + -- Modules included in this library but not exported. - -- other-modules: test + -- other-modules: Network.BufferedSocket.test -- LANGUAGE extensions used by modules in this package. other-extensions: OverloadedStrings, FlexibleInstances diff --git a/BufferedSocket.hs b/BufferedSocket.hs deleted file mode 100644 --- a/BufferedSocket.hs +++ /dev/null @@ -1,36 +0,0 @@ -{----------------------------------------------------------------------------------------- -Module name: BufferedSocket -Made by: Tomas Möre 2015 - - -Usage: - This module is mean to be imported qualified - - ex: import Headers qualified BS - -Notes: - Buffered sockets are a data type that is a kind of overlay on normal sockets. - - - All the exported read / write operations are build such that they ALLWAYS read / write the ammount of bytes requested - - - This package allows some cases of lazy IO. Some people see Lazy io as the devil incarné. However it is excpected that anyone using this module - is cabale of understanding any possible side effects. - - -WARNINGS: - This module uses a ton of IO and non functional ways of solving problems. - This is because we want to be as spacetime efficient as possible. - - This module does NOT contain "beatiful" haskell code -------------------------------------------------------------------------------------------} - - -{-# LANGUAGE OverloadedStrings #-} - -module BufferedSocket (module X) where - -import Core as X -import Reader as X -import Writer as X diff --git a/Core.hs b/Core.hs deleted file mode 100644 --- a/Core.hs +++ /dev/null @@ -1,466 +0,0 @@ -{----------------------------------------------------------------------------------------- -Module name: BufferedSocket -Made by: Tomas Möre 2015 - - -Usage: - This module is mean to be imported qualified - - ex: import Headers qualified BS - -Notes: - Buffered sockets are a data type that is a kind of overlay on normal sockets. - - - All the exported read / write operations are build such that they ALLWAYS read / write the ammount of bytes requested - - - This package allows some cases of lazy IO. Some people see Lazy io as the devil incarné. However it is excpected that anyone using this module - is cabale of understanding any possible side effects. - - -WARNINGS: - This module uses a ton of IO and non functional ways of solving problems. - This is because we want to be as spacetime efficient as possible. - - This module does NOT contain "beatiful" haskell code -------------------------------------------------------------------------------------------} - - -{-# LANGUAGE OverloadedStrings #-} - -module Core -( - readRaw -, readLazy -, readByte -, readToByte -, readToByteMax -, sendByteString -, readToByteStringMax -, flush -, BufferedSocket -, makeBufferedSocket -, MaxLength -, ReadSize - -, inBuffer -, waitForRead -, isReadable -, isWriteable -, closeRead -, closeWrite -, nativeSocket - ) -where - -import Prelude hiding (getLine, read) - - - -import Control.Monad -import Control.Applicative -import qualified Data.ByteString as B -import qualified Data.ByteString.Internal as BI -import qualified Data.ByteString.Lazy as BL -import qualified Data.ByteString.Builder as BB -import qualified Data.ByteString.Char8 as BC8 -import qualified Data.Text as T -import qualified Data.Text.Lazy as TL - -import Data.List -import Data.IORef -import Data.Functor -import Data.Maybe (isJust) - -import qualified Network.Socket as NS -- ns for native socket -import Foreign.Storable -import Foreign.Ptr -import Foreign.C.Types -import System.IO.Unsafe -- I'm so sorry for this -import System.Posix.Types -import System.Timeout - -import Foreign.ForeignPtr -import Data.Monoid -import Data.Word -import Data.String -import qualified Data.Text.Encoding as ENCSTRICT -import qualified Data.Text.Lazy.Encoding as ENCLAZY - -import GHC.Conc.IO - -type MaxLength = Int - -type BufferSize = Int - -type InputBufferSize = BufferSize -type OutputBufferSize = BufferSize - -type BytesInBuffer = IORef Int -type ByteOffset = IORef Int - -type RemainingBytes = Int - -type ReadSize = Int - -type Read = Int - -type Timeout = Int - -type SocketData = (NS.Socket,NS.SockAddr,Fd) - -type ByteString = B.ByteString --- Since newtype is disregarded at compile time we make these newtypes to make sure no errors occur - --- The output buffer is simply a buffer that attemps to store a certain ammount of data before we send the package. --- This is to make minimalize the TCP overhead. Some operating systems might attemp to do the same. -type OutputBuffer = (ForeignPtr Word8, BytesInBuffer,BufferSize) -type InputBuffer = (ForeignPtr Word8, ByteOffset,BytesInBuffer,BufferSize) - -newtype BufferedSocket = BufferedSocket (SocketData, InputBuffer, OutputBuffer) - -{- -UTIL --} - - -nativeSocket:: BufferedSocket -> NS.Socket -nativeSocket (BufferedSocket ((socket,_,_),_,_)) = socket - -isReadable:: BufferedSocket -> IO Bool -isReadable (BufferedSocket ((socket,_,_),_,_)) = NS.sIsReadable socket - -isWriteable:: BufferedSocket -> IO Bool -isWriteable (BufferedSocket ((socket,_,_),_,_)) = NS.isWritable socket - -closeRead :: BufferedSocket -> IO () -closeRead (BufferedSocket ((socket,_,_),_,_)) = NS.shutdown socket NS.ShutdownReceive - -closeWrite :: BufferedSocket -> IO () -closeWrite (BufferedSocket ((socket,_,_),_,_)) = NS.shutdown socket NS.ShutdownSend --- INPUT BUFFER -inBuffer :: BufferedSocket -> InputBuffer -inBuffer (BufferedSocket (_,inBuf,_)) = inBuf - -inBufferClear :: InputBuffer -> IO () -inBufferClear (_, offsetRef, bytesRef, _) = writeIORef offsetRef 0 >> writeIORef bytesRef 0 - -inBufferReadAll :: InputBuffer -> IO ByteString -inBufferReadAll inBuf@(buf, offsetRef, bytesRef, _) = - do - offset <- readIORef offsetRef - bytesN <- readIORef bytesRef - let unreadBytes = bytesN - offset - if bytesN == 0 - then return "" - else (inBufferClear inBuf) >> (return $ BI.fromForeignPtr buf offset unreadBytes) - - --- moves the bytes in the buffer to the start -inBufferRealign :: InputBuffer -> IO () -inBufferRealign (buf, offsetRef, bytesRef, _) = - withForeignPtr buf $ \ptr -> - do putStrLn "realigned" - offset <- readIORef offsetRef - when (offset > 0) $ - do bytesN <- readIORef bytesRef - let unreadBytes = bytesN - offset - offsetPtr = plusPtr  ptr offset - BI.memcpy  ptr offsetPtr unreadBytes - writeIORef offsetRef 0 - -inBufferFindByteReal :: Ptr Word8 -> Int -> Word8 -> IO (Maybe Int) -inBufferFindByteReal _ 0 _ = return Nothing -inBufferFindByteReal ptr bytesLeft matchByte = - do currentChar <- peek ptr - if isMatch currentChar - then return $ Just bytesLeft - else inBufferFindByteReal (plusPtr ptr 1) (bytesLeft - 1) matchByte - where - isMatch = (==matchByte) - - -inBufferFindByte :: InputBuffer -> Word8 -> IO (Maybe Int) -inBufferFindByte (buf, offsetRef, bytesRef, _) byte = - do offset <- readIORef offsetRef - bytesN <- readIORef bytesRef - let unreadBytes = bytesN - offset - - withForeignPtr buf $  - \ ptr -> do let startPtr = plusPtr ptr offset - maybeBytesLeft <- inBufferFindByteReal startPtr unreadBytes byte - case maybeBytesLeft of - Just n -> return $ Just (unreadBytes - n) - Nothing -> return Nothing - - --- OUTPUT BUFFER -outBuffer :: BufferedSocket -> OutputBuffer -outBuffer (BufferedSocket (_,_,outBuf)) = outBuf - - --- SOCKET DATA -socketData :: BufferedSocket -> SocketData -socketData (BufferedSocket (sockData,_,_)) = sockData - - --- Reads up to max the available bytes of data -bSocketRecv :: BufferedSocket -> IO Int -bSocketRecv (BufferedSocket ((sock,_,_),(buf,offsetRef,bytesNRef,bufSize),_)) = - withForeignPtr buf $ \ptr -> - do bytesN <- readIORef bytesNRef - let offsetBuf = plusPtr ptr bytesN - maxRead = bufSize - bytesN - if maxRead > 0 - then - do - (recievedBytes, _) <- NS.recvBufFrom sock offsetBuf maxRead - writeIORef bytesNRef (bytesN + recievedBytes) - return recievedBytes - else - return 0 - --- Unsafe. Do not use if you don't know what you're doing -bSocketRecvMin :: BufferedSocket -> Int -> IO () -bSocketRecvMin bSocket n = - do bytesRead <- bSocketRecv bSocket - when (bytesRead < n) $ bSocketRecvMin bSocket (n - bytesRead) - -waitForRead :: BufferedSocket -> Timeout -> IO Bool -waitForRead (BufferedSocket ((sock,_,fideDesc),_,_)) timeoutDuration = - do maybeSucess <- timeout timeoutDuration (threadWaitRead fideDesc) - if isJust maybeSucess - then return True - else return False - -{- -CREATING A SOCKET - -This puts together a new "BufferedSocket". or commonly refered as "bSock" -A buffered socket is a socket which is acommodated by a Ptr. Because of the need to split headers etc up at certain points but still -safet he rest of the data to be whatever the server requires it to be. - -A buffered socket should be called with freeBSocket before disregarded. -The server thunk function does so automaticly. - --} ---BufferedSocket ((sock, sockAddr, socketFileDesc), inputBuffer, outPutBuffer) -makeBufferedSocket :: (NS.Socket, NS.SockAddr) -> InputBufferSize -> OutputBufferSize -> IO BufferedSocket -makeBufferedSocket (sock, sockAddr) inBufferSize outBufferSize = - do - inputBuffer <- makeInputBuffer inBufferSize - outPutBuffer <- makeOutputBuffer outBufferSize - let socketFileDesc = NS.fdSocket sock - return $ BufferedSocket ((sock, sockAddr, Fd socketFileDesc), inputBuffer, outPutBuffer) - -makeInputBuffer :: InputBufferSize -> IO InputBuffer -makeInputBuffer bufferSize = - do offset <- newIORef 0 - bytesCount <- newIORef 0 - buffer <- BI.mallocByteString bufferSize - return (buffer, offset, bytesCount, bufferSize) - -makeOutputBuffer :: OutputBufferSize -> IO OutputBuffer -makeOutputBuffer bufferSize = - do bytesCount <- newIORef 0 - buffer <- BI.mallocByteString bufferSize - return (buffer, bytesCount, bufferSize) - -{- -USING THE BUFFERED SOCKETS: --} - -{- Strict reading -If the buffer contains the required ammount of bytes it will simply read it. -If not it will read all the bytes. Clear the buffer and attempt to read more - --} -readRaw :: BufferedSocket -> Int -> IO ByteString -readRaw _ 0 = return "" -readRaw bSock@(BufferedSocket ((sock,_,_),inBuf@(buf,offsetRef,bytesNRef,bufSize),_)) readSize = - do bytesN <- readIORef bytesNRef - offset <- readIORef offsetRef - - let unreadBytes = bytesN - offset - availableBytesAfterBytesN = bufSize - bytesN - availableBytesTotal = availableBytesAfterBytesN + offset - - missingBytes = readSize - unreadBytes - - if missingBytes <= 0 - then writeIORef offsetRef (offset + readSize) >> (return $ BI.fromForeignPtr buf offset readSize) - else if missingBytes <= availableBytesAfterBytesN - then bSocketRecvMin bSock missingBytes >> - loop - else if missingBytes <= availableBytesTotal - then inBufferRealign inBuf >> - fillBuffer availableBytesTotal >> - loop - else do - let strFragment =  if unreadBytes > 0 - then BI.fromForeignPtr buf offset unreadBytes - else "" - inBufferClear inBuf - (strFragment<>) <$> readRaw bSock (readSize - B.length strFragment) - where - fillBuffer = bSocketRecvMin bSock - loop = readRaw bSock readSize - --- -lazyReader :: BufferedSocket -> [Int] -> IO [ByteString] -lazyReader _ [] = return [] -lazyReader bSock ~(chunkSize:rest) = - do chunk <- unsafeInterleaveIO $ readRaw bSock chunkSize - next <- unsafeInterleaveIO $ lazyReader bSock rest - return (chunk:next) - --- readLazy will read will read in chunks of the same size of the buffered socket -readLazy :: BufferedSocket -> Int -> IO BL.ByteString -readLazy _ 0 = return "" -readLazy bSock@(BufferedSocket ((sock,_,_),inBuf@(buf,offsetRef,bytesNRef,bufSize),_)) readSize = - let chunkSizes = unfoldr (\b -> if b == 0 - then Nothing - else if b > bufSize - then Just (bufSize, b - bufSize) - else Just (b,0)) readSize - in BL.fromChunks <$> lazyReader bSock chunkSizes - - -readByte :: BufferedSocket -> IO Word8 -readByte bSock@(BufferedSocket ((sock,_,_),inBuf@(buf,offsetRef,bytesNRef,bufSize),_)) = - do bytesN <- readIORef bytesNRef - offset <- readIORef offsetRef - let unreadBytes = bytesN - offset - - if unreadBytes > 0 - then do - writeIORef offsetRef (offset + 1) - withForeignPtr buf (`peekByteOff` offset) - else do - inBufferClear inBuf - bSocketRecvMin bSock 1 - readByte bSock - -readToByte :: BufferedSocket -> Word8 -> IO ByteString -readToByte bSock@(BufferedSocket ((sock,_,_),inBuf@(buf,offsetRef,bytesNRef,bufSize),_)) byte = - do maybeByteIndex <- inBufferFindByte inBuf byte - case maybeByteIndex of - Nothing -> (<>) <$> inBufferReadAll inBuf <*> readToByte bSock byte -- >>= (<>) fmap (<>(readToByte bSock byte)) $ inBufferReadAll inBuf - Just n -> do - offset <- readIORef offsetRef - writeIORef offsetRef (offset + n + 1) - return $ BI.fromForeignPtr buf offset n - -readToByteMax :: BufferedSocket -> Word8 -> MaxLength -> IO (Maybe ByteString) -readToByteMax bSock@(BufferedSocket ((sock,_,_),inBuf@(buf,offsetRef,bytesNRef,bufSize),_)) byte maxLen - | hasNoMaxLen = return Nothing - | otherwise = - do maybeByteIndex <- inBufferFindByte inBuf byte - bytesN <- readIORef bytesNRef - offset <- readIORef offsetRef - - let unreadBytes = bytesN - offset - - case maybeByteIndex of - Nothing -> if unreadBytes >= maxLen - then return Nothing - else do let maxBytesLeft = maxLen - unreadBytes - thisBufData <- inBufferReadAll inBuf -- empties the current buffer data - bSocketRecv bSock -- attempts to rebuffer the socket - maybeData <- readToByteMax bSock byte maxBytesLeft -- repeat - case maybeData of - Nothing -> return Nothing - Just a -> return $ Just (thisBufData <> a) - Just n -> do writeIORef offsetRef (offset + n + 1) - return $ Just $ BI.fromForeignPtr buf offset n - where - hasNoMaxLen = maxLen <= 0 - --- Dangerous will read forever if nothing is found --- You will most probably want to use the readToByteStringMax -readToByteString :: BufferedSocket -> ByteString -> IO ByteString -readToByteString _ "" = error "readToByteString can not take an empty bytestring" -readToByteString bSock searchString = - do dataString <- readToByte bSock firstByte - trail <- readRaw bSock $ B.length restSearchString - if trail == restSearchString - then return dataString - else ((dataString<>trail)<>) <$> readToByteString bSock searchString - where - firstByte = B.head searchString - restSearchString = B.tail searchString - --- Same as above but Will read to a max length. If this is reached It returns "Nothing" -readToByteStringMax :: BufferedSocket -> ByteString -> MaxLength -> IO (Maybe ByteString) -readToByteStringMax _ _ 0 = return Nothing -readToByteStringMax _ "" _ = error "readToByteString max got an empty string" -readToByteStringMax bSock searchString maxLength = - do maybeDataString <- readToByteMax bSock firstByte maxLength - case maybeDataString of - Nothing -> return Nothing - Just dataString -> do trail <- readRaw bSock $ B.length restSearchString - if trail == restSearchString - then return $ Just dataString - else do maybeMoreString <- readToByteStringMax bSock searchString (maxLength - B.length dataString - B.length trail) - case maybeMoreString of - Nothing -> return Nothing - Just a -> return $ Just $ dataString <> trail <> a - where - firstByte = B.head searchString - restSearchString = B.tail searchString - - --- Simple and clean. force pushed the data to the actual socket. Afther this -flush :: BufferedSocket -> IO() -flush (BufferedSocket ((socket,sockAddr,_),_,(outBuf, bytesNRef, bufferSize))) = - do bytesInBuffer <- readIORef bytesNRef - when (bytesInBuffer > 0) $ - do let sender ptr bytes = - do sent <- NS.sendBufTo socket ptr bytes sockAddr - when (sent < bytes) $ sender (plusPtr ptr sent) (bytes - sent) - - str = BI.fromForeignPtr outBuf 0 bytesInBuffer - withForeignPtr outBuf (`sender` bytesInBuffer) - writeIORef bytesNRef 0 - - --- if the string sent to this function is less or equal to the ammount of bytes left in the buffer --- we will simply fill the buffer --- (if equal) we will also flush this buffer. --- If the string is greater then the ammount of bytes left --- we will attempt to fill the last bytes in the buffer then -sendByteString:: BufferedSocket -> ByteString -> IO () -sendByteString _ "" = return () -sendByteString bSock@(BufferedSocket ((sock,sockAddr,_),_,(outBuf, bytesNRef, bufferSize))) outputStr = - do bytesInBuffer <- readIORef bytesNRef - let bytesLeftInBuffer = bufferSize - bytesInBuffer - - if srcLength <= bytesLeftInBuffer - then do - withForeignPtr outBuf $ \bufPtr -> - withForeignPtr sourceFrgnPtr $ \srcPtr -> - BI.memcpy (plusPtr bufPtr bytesInBuffer) (plusPtr srcPtr srcOffet) srcLength - - writeIORef bytesNRef (bytesInBuffer + srcLength) - when (srcLength + bytesInBuffer == bufferSize) $ flush bSock - else do - - let (current,rest) = B.splitAt bytesLeftInBuffer outputStr - overflowRest = div (B.length rest) bufferSize - directSendChunk = B.take overflowRest rest - directSendLen = B.length directSendChunk - (directSend,_,_)= BI.toForeignPtr directSendChunk - - toBufferPart = B.drop overflowRest rest - - sendByteString bSock current - when (directSendChunk /= "") $ withForeignPtr sourceFrgnPtr $ \ptr -> void $ NS.sendBufTo sock (plusPtr ptr srcOffet) directSendLen sockAddr - sendByteString bSock toBufferPart - - where - (sourceFrgnPtr, srcOffet, srcLength) = BI.toForeignPtr outputStr - - - - diff --git a/Network/BufferedSocket.hs b/Network/BufferedSocket.hs new file mode 100644 --- /dev/null +++ b/Network/BufferedSocket.hs @@ -0,0 +1,36 @@ +{----------------------------------------------------------------------------------------- +Module name: BufferedSocket +Made by: Tomas Möre 2015 + + +Usage: + This module is mean to be imported qualified + + ex: import Headers qualified BS + +Notes: + Buffered sockets are a data type that is a kind of overlay on normal sockets. + + + All the exported read / write operations are build such that they ALLWAYS read / write the ammount of bytes requested + + + This package allows some cases of lazy IO. Some people see Lazy io as the devil incarné. However it is excpected that anyone using this module + is cabale of understanding any possible side effects. + + +WARNINGS: + This module uses a ton of IO and non functional ways of solving problems. + This is because we want to be as spacetime efficient as possible. + + This module does NOT contain "beatiful" haskell code +------------------------------------------------------------------------------------------} + + +{-# LANGUAGE OverloadedStrings #-} + +module Network.BufferedSocket (module Network.BufferedSocket.Core , module Network.BufferedSocket.Reader, module Network.BufferedSocket.Writer) where + +import Network.BufferedSocket.Core +import Network.BufferedSocket.Reader +import Network.BufferedSocket.Writer diff --git a/Network/BufferedSocket/Core.hs b/Network/BufferedSocket/Core.hs new file mode 100644 --- /dev/null +++ b/Network/BufferedSocket/Core.hs @@ -0,0 +1,466 @@ +{----------------------------------------------------------------------------------------- +Module name: BufferedSocket +Made by: Tomas Möre 2015 + + +Usage: + This module is mean to be imported qualified + + ex: import Headers qualified BS + +Notes: + Buffered sockets are a data type that is a kind of overlay on normal sockets. + + + All the exported read / write operations are build such that they ALLWAYS read / write the ammount of bytes requested + + + This package allows some cases of lazy IO. Some people see Lazy io as the devil incarné. However it is excpected that anyone using this module + is cabale of understanding any possible side effects. + + +WARNINGS: + This module uses a ton of IO and non functional ways of solving problems. + This is because we want to be as spacetime efficient as possible. + + This module does NOT contain "beatiful" haskell code +------------------------------------------------------------------------------------------} + + +{-# LANGUAGE OverloadedStrings #-} + +module Network.BufferedSocket.Core +( + readRaw +, readLazy +, readByte +, readToByte +, readToByteMax +, sendByteString +, readToByteStringMax +, flush +, BufferedSocket +, makeBufferedSocket +, MaxLength +, ReadSize + +, inBuffer +, waitForRead +, isReadable +, isWriteable +, closeRead +, closeWrite +, nativeSocket + ) +where + +import Prelude hiding (getLine, read) + + + +import Control.Monad +import Control.Applicative +import qualified Data.ByteString as B +import qualified Data.ByteString.Internal as BI +import qualified Data.ByteString.Lazy as BL +import qualified Data.ByteString.Builder as BB +import qualified Data.ByteString.Char8 as BC8 +import qualified Data.Text as T +import qualified Data.Text.Lazy as TL + +import Data.List +import Data.IORef +import Data.Functor +import Data.Maybe (isJust) + +import qualified Network.Socket as NS -- ns for native socket +import Foreign.Storable +import Foreign.Ptr +import Foreign.C.Types +import System.IO.Unsafe -- I'm so sorry for this +import System.Posix.Types +import System.Timeout + +import Foreign.ForeignPtr +import Data.Monoid +import Data.Word +import Data.String +import qualified Data.Text.Encoding as ENCSTRICT +import qualified Data.Text.Lazy.Encoding as ENCLAZY + +import GHC.Conc.IO + +type MaxLength = Int + +type BufferSize = Int + +type InputBufferSize = BufferSize +type OutputBufferSize = BufferSize + +type BytesInBuffer = IORef Int +type ByteOffset = IORef Int + +type RemainingBytes = Int + +type ReadSize = Int + +type Read = Int + +type Timeout = Int + +type SocketData = (NS.Socket,NS.SockAddr,Fd) + +type ByteString = B.ByteString +-- Since newtype is disregarded at compile time we make these newtypes to make sure no errors occur + +-- The output buffer is simply a buffer that attemps to store a certain ammount of data before we send the package. +-- This is to make minimalize the TCP overhead. Some operating systems might attemp to do the same. +type OutputBuffer = (ForeignPtr Word8, BytesInBuffer,BufferSize) +type InputBuffer = (ForeignPtr Word8, ByteOffset,BytesInBuffer,BufferSize) + +newtype BufferedSocket = BufferedSocket (SocketData, InputBuffer, OutputBuffer) + +{- +UTIL +-} + + +nativeSocket:: BufferedSocket -> NS.Socket +nativeSocket (BufferedSocket ((socket,_,_),_,_)) = socket + +isReadable:: BufferedSocket -> IO Bool +isReadable (BufferedSocket ((socket,_,_),_,_)) = NS.sIsReadable socket + +isWriteable:: BufferedSocket -> IO Bool +isWriteable (BufferedSocket ((socket,_,_),_,_)) = NS.isWritable socket + +closeRead :: BufferedSocket -> IO () +closeRead (BufferedSocket ((socket,_,_),_,_)) = NS.shutdown socket NS.ShutdownReceive + +closeWrite :: BufferedSocket -> IO () +closeWrite (BufferedSocket ((socket,_,_),_,_)) = NS.shutdown socket NS.ShutdownSend +-- INPUT BUFFER +inBuffer :: BufferedSocket -> InputBuffer +inBuffer (BufferedSocket (_,inBuf,_)) = inBuf + +inBufferClear :: InputBuffer -> IO () +inBufferClear (_, offsetRef, bytesRef, _) = writeIORef offsetRef 0 >> writeIORef bytesRef 0 + +inBufferReadAll :: InputBuffer -> IO ByteString +inBufferReadAll inBuf@(buf, offsetRef, bytesRef, _) = + do + offset <- readIORef offsetRef + bytesN <- readIORef bytesRef + let unreadBytes = bytesN - offset + if bytesN == 0 + then return "" + else (inBufferClear inBuf) >> (return $ BI.fromForeignPtr buf offset unreadBytes) + + +-- moves the bytes in the buffer to the start +inBufferRealign :: InputBuffer -> IO () +inBufferRealign (buf, offsetRef, bytesRef, _) = + withForeignPtr buf $ \ptr -> + do putStrLn "realigned" + offset <- readIORef offsetRef + when (offset > 0) $ + do bytesN <- readIORef bytesRef + let unreadBytes = bytesN - offset + offsetPtr = plusPtr  ptr offset + BI.memcpy  ptr offsetPtr unreadBytes + writeIORef offsetRef 0 + +inBufferFindByteReal :: Ptr Word8 -> Int -> Word8 -> IO (Maybe Int) +inBufferFindByteReal _ 0 _ = return Nothing +inBufferFindByteReal ptr bytesLeft matchByte = + do currentChar <- peek ptr + if isMatch currentChar + then return $ Just bytesLeft + else inBufferFindByteReal (plusPtr ptr 1) (bytesLeft - 1) matchByte + where + isMatch = (==matchByte) + + +inBufferFindByte :: InputBuffer -> Word8 -> IO (Maybe Int) +inBufferFindByte (buf, offsetRef, bytesRef, _) byte = + do offset <- readIORef offsetRef + bytesN <- readIORef bytesRef + let unreadBytes = bytesN - offset + + withForeignPtr buf $  + \ ptr -> do let startPtr = plusPtr ptr offset + maybeBytesLeft <- inBufferFindByteReal startPtr unreadBytes byte + case maybeBytesLeft of + Just n -> return $ Just (unreadBytes - n) + Nothing -> return Nothing + + +-- OUTPUT BUFFER +outBuffer :: BufferedSocket -> OutputBuffer +outBuffer (BufferedSocket (_,_,outBuf)) = outBuf + + +-- SOCKET DATA +socketData :: BufferedSocket -> SocketData +socketData (BufferedSocket (sockData,_,_)) = sockData + + +-- Reads up to max the available bytes of data +bSocketRecv :: BufferedSocket -> IO Int +bSocketRecv (BufferedSocket ((sock,_,_),(buf,offsetRef,bytesNRef,bufSize),_)) = + withForeignPtr buf $ \ptr -> + do bytesN <- readIORef bytesNRef + let offsetBuf = plusPtr ptr bytesN + maxRead = bufSize - bytesN + if maxRead > 0 + then + do + (recievedBytes, _) <- NS.recvBufFrom sock offsetBuf maxRead + writeIORef bytesNRef (bytesN + recievedBytes) + return recievedBytes + else + return 0 + +-- Unsafe. Do not use if you don't know what you're doing +bSocketRecvMin :: BufferedSocket -> Int -> IO () +bSocketRecvMin bSocket n = + do bytesRead <- bSocketRecv bSocket + when (bytesRead < n) $ bSocketRecvMin bSocket (n - bytesRead) + +waitForRead :: BufferedSocket -> Timeout -> IO Bool +waitForRead (BufferedSocket ((sock,_,fideDesc),_,_)) timeoutDuration = + do maybeSucess <- timeout timeoutDuration (threadWaitRead fideDesc) + if isJust maybeSucess + then return True + else return False + +{- +CREATING A SOCKET + +This puts together a new "BufferedSocket". or commonly refered as "bSock" +A buffered socket is a socket which is acommodated by a Ptr. Because of the need to split headers etc up at certain points but still +safet he rest of the data to be whatever the server requires it to be. + +A buffered socket should be called with freeBSocket before disregarded. +The server thunk function does so automaticly. + +-} +--BufferedSocket ((sock, sockAddr, socketFileDesc), inputBuffer, outPutBuffer) +makeBufferedSocket :: (NS.Socket, NS.SockAddr) -> InputBufferSize -> OutputBufferSize -> IO BufferedSocket +makeBufferedSocket (sock, sockAddr) inBufferSize outBufferSize = + do + inputBuffer <- makeInputBuffer inBufferSize + outPutBuffer <- makeOutputBuffer outBufferSize + let socketFileDesc = NS.fdSocket sock + return $ BufferedSocket ((sock, sockAddr, Fd socketFileDesc), inputBuffer, outPutBuffer) + +makeInputBuffer :: InputBufferSize -> IO InputBuffer +makeInputBuffer bufferSize = + do offset <- newIORef 0 + bytesCount <- newIORef 0 + buffer <- BI.mallocByteString bufferSize + return (buffer, offset, bytesCount, bufferSize) + +makeOutputBuffer :: OutputBufferSize -> IO OutputBuffer +makeOutputBuffer bufferSize = + do bytesCount <- newIORef 0 + buffer <- BI.mallocByteString bufferSize + return (buffer, bytesCount, bufferSize) + +{- +USING THE BUFFERED SOCKETS: +-} + +{- Strict reading +If the buffer contains the required ammount of bytes it will simply read it. +If not it will read all the bytes. Clear the buffer and attempt to read more + +-} +readRaw :: BufferedSocket -> Int -> IO ByteString +readRaw _ 0 = return "" +readRaw bSock@(BufferedSocket ((sock,_,_),inBuf@(buf,offsetRef,bytesNRef,bufSize),_)) readSize = + do bytesN <- readIORef bytesNRef + offset <- readIORef offsetRef + + let unreadBytes = bytesN - offset + availableBytesAfterBytesN = bufSize - bytesN + availableBytesTotal = availableBytesAfterBytesN + offset + + missingBytes = readSize - unreadBytes + + if missingBytes <= 0 + then writeIORef offsetRef (offset + readSize) >> (return $ BI.fromForeignPtr buf offset readSize) + else if missingBytes <= availableBytesAfterBytesN + then bSocketRecvMin bSock missingBytes >> + loop + else if missingBytes <= availableBytesTotal + then inBufferRealign inBuf >> + fillBuffer availableBytesTotal >> + loop + else do + let strFragment =  if unreadBytes > 0 + then BI.fromForeignPtr buf offset unreadBytes + else "" + inBufferClear inBuf + (strFragment<>) <$> readRaw bSock (readSize - B.length strFragment) + where + fillBuffer = bSocketRecvMin bSock + loop = readRaw bSock readSize + +-- +lazyReader :: BufferedSocket -> [Int] -> IO [ByteString] +lazyReader _ [] = return [] +lazyReader bSock ~(chunkSize:rest) = + do chunk <- unsafeInterleaveIO $ readRaw bSock chunkSize + next <- unsafeInterleaveIO $ lazyReader bSock rest + return (chunk:next) + +-- readLazy will read will read in chunks of the same size of the buffered socket +readLazy :: BufferedSocket -> Int -> IO BL.ByteString +readLazy _ 0 = return "" +readLazy bSock@(BufferedSocket ((sock,_,_),inBuf@(buf,offsetRef,bytesNRef,bufSize),_)) readSize = + let chunkSizes = unfoldr (\b -> if b == 0 + then Nothing + else if b > bufSize + then Just (bufSize, b - bufSize) + else Just (b,0)) readSize + in BL.fromChunks <$> lazyReader bSock chunkSizes + + +readByte :: BufferedSocket -> IO Word8 +readByte bSock@(BufferedSocket ((sock,_,_),inBuf@(buf,offsetRef,bytesNRef,bufSize),_)) = + do bytesN <- readIORef bytesNRef + offset <- readIORef offsetRef + let unreadBytes = bytesN - offset + + if unreadBytes > 0 + then do + writeIORef offsetRef (offset + 1) + withForeignPtr buf (`peekByteOff` offset) + else do + inBufferClear inBuf + bSocketRecvMin bSock 1 + readByte bSock + +readToByte :: BufferedSocket -> Word8 -> IO ByteString +readToByte bSock@(BufferedSocket ((sock,_,_),inBuf@(buf,offsetRef,bytesNRef,bufSize),_)) byte = + do maybeByteIndex <- inBufferFindByte inBuf byte + case maybeByteIndex of + Nothing -> (<>) <$> inBufferReadAll inBuf <*> readToByte bSock byte -- >>= (<>) fmap (<>(readToByte bSock byte)) $ inBufferReadAll inBuf + Just n -> do + offset <- readIORef offsetRef + writeIORef offsetRef (offset + n + 1) + return $ BI.fromForeignPtr buf offset n + +readToByteMax :: BufferedSocket -> Word8 -> MaxLength -> IO (Maybe ByteString) +readToByteMax bSock@(BufferedSocket ((sock,_,_),inBuf@(buf,offsetRef,bytesNRef,bufSize),_)) byte maxLen + | hasNoMaxLen = return Nothing + | otherwise = + do maybeByteIndex <- inBufferFindByte inBuf byte + bytesN <- readIORef bytesNRef + offset <- readIORef offsetRef + + let unreadBytes = bytesN - offset + + case maybeByteIndex of + Nothing -> if unreadBytes >= maxLen + then return Nothing + else do let maxBytesLeft = maxLen - unreadBytes + thisBufData <- inBufferReadAll inBuf -- empties the current buffer data + bSocketRecv bSock -- attempts to rebuffer the socket + maybeData <- readToByteMax bSock byte maxBytesLeft -- repeat + case maybeData of + Nothing -> return Nothing + Just a -> return $ Just (thisBufData <> a) + Just n -> do writeIORef offsetRef (offset + n + 1) + return $ Just $ BI.fromForeignPtr buf offset n + where + hasNoMaxLen = maxLen <= 0 + +-- Dangerous will read forever if nothing is found +-- You will most probably want to use the readToByteStringMax +readToByteString :: BufferedSocket -> ByteString -> IO ByteString +readToByteString _ "" = error "readToByteString can not take an empty bytestring" +readToByteString bSock searchString = + do dataString <- readToByte bSock firstByte + trail <- readRaw bSock $ B.length restSearchString + if trail == restSearchString + then return dataString + else ((dataString<>trail)<>) <$> readToByteString bSock searchString + where + firstByte = B.head searchString + restSearchString = B.tail searchString + +-- Same as above but Will read to a max length. If this is reached It returns "Nothing" +readToByteStringMax :: BufferedSocket -> ByteString -> MaxLength -> IO (Maybe ByteString) +readToByteStringMax _ _ 0 = return Nothing +readToByteStringMax _ "" _ = error "readToByteString max got an empty string" +readToByteStringMax bSock searchString maxLength = + do maybeDataString <- readToByteMax bSock firstByte maxLength + case maybeDataString of + Nothing -> return Nothing + Just dataString -> do trail <- readRaw bSock $ B.length restSearchString + if trail == restSearchString + then return $ Just dataString + else do maybeMoreString <- readToByteStringMax bSock searchString (maxLength - B.length dataString - B.length trail) + case maybeMoreString of + Nothing -> return Nothing + Just a -> return $ Just $ dataString <> trail <> a + where + firstByte = B.head searchString + restSearchString = B.tail searchString + + +-- Simple and clean. force pushed the data to the actual socket. Afther this +flush :: BufferedSocket -> IO() +flush (BufferedSocket ((socket,sockAddr,_),_,(outBuf, bytesNRef, bufferSize))) = + do bytesInBuffer <- readIORef bytesNRef + when (bytesInBuffer > 0) $ + do let sender ptr bytes = + do sent <- NS.sendBufTo socket ptr bytes sockAddr + when (sent < bytes) $ sender (plusPtr ptr sent) (bytes - sent) + + str = BI.fromForeignPtr outBuf 0 bytesInBuffer + withForeignPtr outBuf (`sender` bytesInBuffer) + writeIORef bytesNRef 0 + + +-- if the string sent to this function is less or equal to the ammount of bytes left in the buffer +-- we will simply fill the buffer +-- (if equal) we will also flush this buffer. +-- If the string is greater then the ammount of bytes left +-- we will attempt to fill the last bytes in the buffer then +sendByteString:: BufferedSocket -> ByteString -> IO () +sendByteString _ "" = return () +sendByteString bSock@(BufferedSocket ((sock,sockAddr,_),_,(outBuf, bytesNRef, bufferSize))) outputStr = + do bytesInBuffer <- readIORef bytesNRef + let bytesLeftInBuffer = bufferSize - bytesInBuffer + + if srcLength <= bytesLeftInBuffer + then do + withForeignPtr outBuf $ \bufPtr -> + withForeignPtr sourceFrgnPtr $ \srcPtr -> + BI.memcpy (plusPtr bufPtr bytesInBuffer) (plusPtr srcPtr srcOffet) srcLength + + writeIORef bytesNRef (bytesInBuffer + srcLength) + when (srcLength + bytesInBuffer == bufferSize) $ flush bSock + else do + + let (current,rest) = B.splitAt bytesLeftInBuffer outputStr + overflowRest = div (B.length rest) bufferSize + directSendChunk = B.take overflowRest rest + directSendLen = B.length directSendChunk + (directSend,_,_)= BI.toForeignPtr directSendChunk + + toBufferPart = B.drop overflowRest rest + + sendByteString bSock current + when (directSendChunk /= "") $ withForeignPtr sourceFrgnPtr $ \ptr -> void $ NS.sendBufTo sock (plusPtr ptr srcOffet) directSendLen sockAddr + sendByteString bSock toBufferPart + + where + (sourceFrgnPtr, srcOffet, srcLength) = BI.toForeignPtr outputStr + + + + diff --git a/Network/BufferedSocket/Reader.hs b/Network/BufferedSocket/Reader.hs new file mode 100644 --- /dev/null +++ b/Network/BufferedSocket/Reader.hs @@ -0,0 +1,176 @@ +{----------------------------------------------------------------------------------------- +Module name: BufferedSocketReader +Made by: Tomas Möre 2015 + + +Usage: + This module is mean to be imported qualified + This is an addition to BufferedSocket + ex: import Headers qualified BS + +Notes: + This reader modules purpose is to make it easto to read diffrent kinds of data types. This is of course only if the socket isn't encrypted. + +WARNINGS: + Nah Nothing +------------------------------------------------------------------------------------------} + + +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE FlexibleInstances #-} + +module Network.BufferedSocket.Reader +( readText +, readTextLazy +, readNativeString +, readWord8 +, readWord16 +, readWord32 +, readWord64 +, readInt8 +, readInt16 +, readInt32 +, readInt64 +, read +, Readable +, readString +, ReadableString + ) +where + +import Prelude hiding (getLine, read) + + + + +import qualified Data.ByteString as B +import qualified Data.ByteString.Internal as BI +import qualified Data.ByteString.Lazy as BL +import qualified Data.ByteString.Builder as BB +import qualified Data.ByteString.Char8 as BC8 +import qualified Data.Text as T +import qualified Data.Text.Lazy as TL + +import qualified Data.Text.Encoding as ENC +import qualified Data.Text.Lazy.Encoding as ENCL + +import qualified Data.Text.Encoding.Error as ENCERROR +import Data.Maybe (isJust) + +import Control.Monad + +import Data.Functor + +import Data.Monoid +import Data.Word +import Data.String +import Data.Int + +import qualified Network.BufferedSocket.Core as BS + +import Data.Bits + +listToValue :: (Bits a, Num a) => [a] -> a +listToValue = foldl xor zeroBits + + +convertToShiftedList:: (Bits b, Num b) => [Word8] -> Int -> [b] +convertToShiftedList [] _ = [] +convertToShiftedList (x:xs) byteIndex = + let n = byteIndex - 1 -- Since we want the size of the result data the actual index -||- is (-1) + in (shift (fromIntegral x) (8 * n): convertToShiftedList xs n) + + +readText:: BS.BufferedSocket -> BS.ReadSize -> IO T.Text +readText bSocket readSize = do + byteData <- BS.readRaw bSocket readSize + return $ ENC.decodeUtf8With (ENCERROR.replace '\xfffd') byteData + +readTextLazy:: BS.BufferedSocket -> BS.ReadSize -> IO TL.Text +readTextLazy bSocket readSize = do + byteData <- BS.readLazy bSocket readSize + return $ ENCL.decodeUtf8With (ENCERROR.replace '\xfffd') byteData + +readNativeString:: BS.BufferedSocket -> BS.ReadSize -> IO String +readNativeString bSock readSize = do + byteString <- readText bSock readSize + return $ T.unpack byteString + +readWord8:: BS.BufferedSocket -> IO Word8 +readWord8 = BS.readByte + +readWord16:: BS.BufferedSocket -> IO Word16 +readWord16 bSocket = do + bytes <- B.unpack <$> BS.readRaw bSocket byteSize + let result = convertToShiftedList bytes byteSize:: [Word16] + return $ listToValue result + + where + byteSize = 2 + +readWord32:: BS.BufferedSocket -> IO Word32 +readWord32 bSocket = do + bytes <- B.unpack <$> BS.readRaw bSocket byteSize + let result = convertToShiftedList bytes byteSize:: [Word32] + return $ listToValue result + + where + byteSize = 4 + +readWord64:: BS.BufferedSocket -> IO Word64 +readWord64 bSocket = do + bytes <- B.unpack <$> BS.readRaw bSocket byteSize + let result = convertToShiftedList bytes byteSize:: [Word64] + return $ listToValue result + + where + byteSize = 8 +readInt8:: BS.BufferedSocket -> IO Int8 +readInt8 = (fromIntegral <$>) . readWord8 + +readInt16:: BS.BufferedSocket -> IO Int16 +readInt16 = (fromIntegral <$>) . readWord16 + +readInt32:: BS.BufferedSocket -> IO Int32 +readInt32 = (fromIntegral <$>) . readWord32 + +readInt64:: BS.BufferedSocket -> IO Int64 +readInt64 = (fromIntegral <$>) . readWord64 + + +class Readable r where + read :: (BS.BufferedSocket -> IO r) + +instance Readable Word8 where + read = readWord8 +instance Readable Word16 where + read = readWord16 +instance Readable Word32 where + read = readWord32 +instance Readable Word64 where + read = readWord64 + +instance Readable Int8 where + read = readInt8 +instance Readable Int16 where + read = readInt16 +instance Readable Int32 where + read = readInt32 +instance Readable Int64 where + read = readInt64 + +class ReadableString s where + readString :: (BS.BufferedSocket -> Int -> IO s) + +instance ReadableString B.ByteString where + readString = BS.readRaw +instance ReadableString BL.ByteString where + readString = BS.readLazy +{-- +instance ReadableString T.Text where + readString = readText +instance ReadableString TL.Text where + readString = readTextLazy +instance ReadableString String where + readString = readNativeString +--} diff --git a/Network/BufferedSocket/Writer.hs b/Network/BufferedSocket/Writer.hs new file mode 100644 --- /dev/null +++ b/Network/BufferedSocket/Writer.hs @@ -0,0 +1,153 @@ +{----------------------------------------------------------------------------------------- +Module name: BufferedSocketReader +Made by: Tomas Möre 2015 + + +Usage: + This module is mean to be imported qualified + This is an addition to BufferedSocket + ex: import Headers qualified BS + +Notes: + This reader modules purpose is to make it easto to read diffrent kinds of data types. This is of course only if the socket isn't encrypted. + +WARNINGS: +------------------------------------------------------------------------------------------} + + +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE FlexibleInstances #-} +module Network.BufferedSocket.Writer +( sendText +, sendTextLazy +, sendString +, sendWord8 +, sendWord16 +, sendWord32 +, sendWord64 +, sendInt8 +, sendInt16 +, sendInt32 +, sendInt64 +, Sendable +, send + ) +where + +import Prelude hiding (getLine, read) + + + +import qualified Data.ByteString as B +import qualified Data.ByteString.Internal as BI +import qualified Data.ByteString.Lazy as BL +import qualified Data.ByteString.Builder as BB +import qualified Data.ByteString.Char8 as BC8 +import qualified Data.Text as T +import qualified Data.Text.Lazy as TL + +import qualified Data.Text.Encoding as ENC +import qualified Data.Text.Lazy.Encoding as ENCL + + +import Control.Monad +import Data.Functor +import Data.Monoid +import Data.Word +import Data.String +import Data.Int +import Data.Bits + +import Foreign.Storable + +import qualified Network.BufferedSocket.Core as BS + +bitsToByteStringReal:: (Bits a, Integral a) => a -> Int -> [Word8] +bitsToByteStringReal a 0 = [fromIntegral a] +bitsToByteStringReal inData size = + let thisByte = shift inData (- (size * 8 )) + in (fromIntegral thisByte : bitsToByteStringReal inData (size - 1)) + +bitsToByteString:: (Bits a, Integral a, Storable a) => a -> B.ByteString +bitsToByteString inData = B.pack $ bitsToByteStringReal inData $ sizeOf inData - 1 + + +sendWord8:: BS.BufferedSocket -> Word8 -> IO () +sendWord8 bSocket byte = BS.sendByteString bSocket $ B.pack [byte] + +sendByte :: BS.BufferedSocket -> Word8 -> IO () +sendByte = sendWord8 + +sendWord16:: BS.BufferedSocket -> Word16 -> IO () +sendWord16 bSocket word16 = let sendData = bitsToByteString word16 + in do + putStrLn $ "sent bytes: " ++ (show $ B.unpack sendData) + BS.sendByteString bSocket $ sendData + + +sendWord32:: BS.BufferedSocket -> Word32 -> IO () +sendWord32 bSocket word32 = BS.sendByteString bSocket $ bitsToByteString word32 + +sendWord64:: BS.BufferedSocket -> Word64 -> IO () +sendWord64 bSocket word64 = BS.sendByteString bSocket $ bitsToByteString word64 +sendInt8:: BS.BufferedSocket -> Int8 -> IO () +sendInt8 bSocket int8 = sendWord8 bSocket $ fromIntegral int8 +sendInt16:: BS.BufferedSocket -> Int16 -> IO () +sendInt16 bSocket int16 = sendWord16 bSocket $ (fromIntegral int16 :: Word16) +sendInt32:: BS.BufferedSocket -> Int32 -> IO () +sendInt32 bSocket int32 = sendWord32 bSocket $ fromIntegral int32 +sendInt64:: BS.BufferedSocket -> Int64 -> IO () +sendInt64 bSocket int64 = sendWord64 bSocket $ fromIntegral int64 + +sendLazyReal :: BS.BufferedSocket -> [B.ByteString] -> IO () +sendLazyReal _ [] = return () +sendLazyReal bSocket (x:xs) = BS.sendByteString bSocket x >> sendLazyReal bSocket xs + +sendLazy :: BS.BufferedSocket -> BL.ByteString -> IO () +sendLazy bSocket lazyBytestring = sendLazyReal bSocket $ BL.toChunks lazyBytestring + + +sendText:: BS.BufferedSocket -> T.Text -> IO () +sendText bSocket textData = BS.sendByteString bSocket $ ENC.encodeUtf8 textData + +sendTextLazy:: BS.BufferedSocket -> TL.Text -> IO () +sendTextLazy bSocket lazyText = sendLazy bSocket $ ENCL.encodeUtf8 lazyText + +sendString:: BS.BufferedSocket -> String -> IO () +sendString bSocket string = sendLazy bSocket $ fromString string + + + +class Sendable s where + send :: (BS.BufferedSocket -> s -> IO ()) + +instance Sendable Word8 where + send = sendWord8 +instance Sendable Word16 where + send = sendWord16 +instance Sendable Word32 where + send = sendWord32 +instance Sendable Word64 where + send = sendWord64 + +instance Sendable Int8 where + send = sendInt8 +instance Sendable Int16 where + send = sendInt16 +instance Sendable Int32 where + send = sendInt32 +instance Sendable Int64 where + send = sendInt64 + +instance Sendable B.ByteString where + send = BS.sendByteString +instance Sendable BL.ByteString where + send = sendLazy +{-- +instance Sendable T.Text where + send = sendText +instance Sendable TL.Text where + send = sendTextLazy +instance Sendable String where + send = sendString +--} diff --git a/Reader.hs b/Reader.hs deleted file mode 100644 --- a/Reader.hs +++ /dev/null @@ -1,176 +0,0 @@ -{----------------------------------------------------------------------------------------- -Module name: BufferedSocketReader -Made by: Tomas Möre 2015 - - -Usage: - This module is mean to be imported qualified - This is an addition to BufferedSocket - ex: import Headers qualified BS - -Notes: - This reader modules purpose is to make it easto to read diffrent kinds of data types. This is of course only if the socket isn't encrypted. - -WARNINGS: - Nah Nothing -------------------------------------------------------------------------------------------} - - -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE FlexibleInstances #-} - -module Reader -( readText -, readTextLazy -, readNativeString -, readWord8 -, readWord16 -, readWord32 -, readWord64 -, readInt8 -, readInt16 -, readInt32 -, readInt64 -, read -, Readable -, readString -, ReadableString - ) -where - -import Prelude hiding (getLine, read) - - - - -import qualified Data.ByteString as B -import qualified Data.ByteString.Internal as BI -import qualified Data.ByteString.Lazy as BL -import qualified Data.ByteString.Builder as BB -import qualified Data.ByteString.Char8 as BC8 -import qualified Data.Text as T -import qualified Data.Text.Lazy as TL - -import qualified Data.Text.Encoding as ENC -import qualified Data.Text.Lazy.Encoding as ENCL - -import qualified Data.Text.Encoding.Error as ENCERROR -import Data.Maybe (isJust) - -import Control.Monad - -import Data.Functor - -import Data.Monoid -import Data.Word -import Data.String -import Data.Int - -import qualified Core as BS - -import Data.Bits - -listToValue :: (Bits a, Num a) => [a] -> a -listToValue = foldl xor zeroBits - - -convertToShiftedList:: (Bits b, Num b) => [Word8] -> Int -> [b] -convertToShiftedList [] _ = [] -convertToShiftedList (x:xs) byteIndex = - let n = byteIndex - 1 -- Since we want the size of the result data the actual index -||- is (-1) - in (shift (fromIntegral x) (8 * n): convertToShiftedList xs n) - - -readText:: BS.BufferedSocket -> BS.ReadSize -> IO T.Text -readText bSocket readSize = do - byteData <- BS.readRaw bSocket readSize - return $ ENC.decodeUtf8With (ENCERROR.replace '\xfffd') byteData - -readTextLazy:: BS.BufferedSocket -> BS.ReadSize -> IO TL.Text -readTextLazy bSocket readSize = do - byteData <- BS.readLazy bSocket readSize - return $ ENCL.decodeUtf8With (ENCERROR.replace '\xfffd') byteData - -readNativeString:: BS.BufferedSocket -> BS.ReadSize -> IO String -readNativeString bSock readSize = do - byteString <- readText bSock readSize - return $ T.unpack byteString - -readWord8:: BS.BufferedSocket -> IO Word8 -readWord8 = BS.readByte - -readWord16:: BS.BufferedSocket -> IO Word16 -readWord16 bSocket = do - bytes <- B.unpack <$> BS.readRaw bSocket byteSize - let result = convertToShiftedList bytes byteSize:: [Word16] - return $ listToValue result - - where - byteSize = 2 - -readWord32:: BS.BufferedSocket -> IO Word32 -readWord32 bSocket = do - bytes <- B.unpack <$> BS.readRaw bSocket byteSize - let result = convertToShiftedList bytes byteSize:: [Word32] - return $ listToValue result - - where - byteSize = 4 - -readWord64:: BS.BufferedSocket -> IO Word64 -readWord64 bSocket = do - bytes <- B.unpack <$> BS.readRaw bSocket byteSize - let result = convertToShiftedList bytes byteSize:: [Word64] - return $ listToValue result - - where - byteSize = 8 -readInt8:: BS.BufferedSocket -> IO Int8 -readInt8 = (fromIntegral <$>) . readWord8 - -readInt16:: BS.BufferedSocket -> IO Int16 -readInt16 = (fromIntegral <$>) . readWord16 - -readInt32:: BS.BufferedSocket -> IO Int32 -readInt32 = (fromIntegral <$>) . readWord32 - -readInt64:: BS.BufferedSocket -> IO Int64 -readInt64 = (fromIntegral <$>) . readWord64 - - -class Readable r where - read :: (BS.BufferedSocket -> IO r) - -instance Readable Word8 where - read = readWord8 -instance Readable Word16 where - read = readWord16 -instance Readable Word32 where - read = readWord32 -instance Readable Word64 where - read = readWord64 - -instance Readable Int8 where - read = readInt8 -instance Readable Int16 where - read = readInt16 -instance Readable Int32 where - read = readInt32 -instance Readable Int64 where - read = readInt64 - -class ReadableString s where - readString :: (BS.BufferedSocket -> Int -> IO s) - -instance ReadableString B.ByteString where - readString = BS.readRaw -instance ReadableString BL.ByteString where - readString = BS.readLazy -{-- -instance ReadableString T.Text where - readString = readText -instance ReadableString TL.Text where - readString = readTextLazy -instance ReadableString String where - readString = readNativeString ---} diff --git a/Writer.hs b/Writer.hs deleted file mode 100644 --- a/Writer.hs +++ /dev/null @@ -1,153 +0,0 @@ -{----------------------------------------------------------------------------------------- -Module name: BufferedSocketReader -Made by: Tomas Möre 2015 - - -Usage: - This module is mean to be imported qualified - This is an addition to BufferedSocket - ex: import Headers qualified BS - -Notes: - This reader modules purpose is to make it easto to read diffrent kinds of data types. This is of course only if the socket isn't encrypted. - -WARNINGS: -------------------------------------------------------------------------------------------} - - -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE FlexibleInstances #-} -module Writer -( sendText -, sendTextLazy -, sendString -, sendWord8 -, sendWord16 -, sendWord32 -, sendWord64 -, sendInt8 -, sendInt16 -, sendInt32 -, sendInt64 -, Sendable -, send - ) -where - -import Prelude hiding (getLine, read) - - - -import qualified Data.ByteString as B -import qualified Data.ByteString.Internal as BI -import qualified Data.ByteString.Lazy as BL -import qualified Data.ByteString.Builder as BB -import qualified Data.ByteString.Char8 as BC8 -import qualified Data.Text as T -import qualified Data.Text.Lazy as TL - -import qualified Data.Text.Encoding as ENC -import qualified Data.Text.Lazy.Encoding as ENCL - - -import Control.Monad -import Data.Functor -import Data.Monoid -import Data.Word -import Data.String -import Data.Int -import Data.Bits - -import Foreign.Storable - -import qualified Core as BS - -bitsToByteStringReal:: (Bits a, Integral a) => a -> Int -> [Word8] -bitsToByteStringReal a 0 = [fromIntegral a] -bitsToByteStringReal inData size = - let thisByte = shift inData (- (size * 8 )) - in (fromIntegral thisByte : bitsToByteStringReal inData (size - 1)) - -bitsToByteString:: (Bits a, Integral a, Storable a) => a -> B.ByteString -bitsToByteString inData = B.pack $ bitsToByteStringReal inData $ sizeOf inData - 1 - - -sendWord8:: BS.BufferedSocket -> Word8 -> IO () -sendWord8 bSocket byte = BS.sendByteString bSocket $ B.pack [byte] - -sendByte :: BS.BufferedSocket -> Word8 -> IO () -sendByte = sendWord8 - -sendWord16:: BS.BufferedSocket -> Word16 -> IO () -sendWord16 bSocket word16 = let sendData = bitsToByteString word16 - in do - putStrLn $ "sent bytes: " ++ (show $ B.unpack sendData) - BS.sendByteString bSocket $ sendData - - -sendWord32:: BS.BufferedSocket -> Word32 -> IO () -sendWord32 bSocket word32 = BS.sendByteString bSocket $ bitsToByteString word32 - -sendWord64:: BS.BufferedSocket -> Word64 -> IO () -sendWord64 bSocket word64 = BS.sendByteString bSocket $ bitsToByteString word64 -sendInt8:: BS.BufferedSocket -> Int8 -> IO () -sendInt8 bSocket int8 = sendWord8 bSocket $ fromIntegral int8 -sendInt16:: BS.BufferedSocket -> Int16 -> IO () -sendInt16 bSocket int16 = sendWord16 bSocket $ (fromIntegral int16 :: Word16) -sendInt32:: BS.BufferedSocket -> Int32 -> IO () -sendInt32 bSocket int32 = sendWord32 bSocket $ fromIntegral int32 -sendInt64:: BS.BufferedSocket -> Int64 -> IO () -sendInt64 bSocket int64 = sendWord64 bSocket $ fromIntegral int64 - -sendLazyReal :: BS.BufferedSocket -> [B.ByteString] -> IO () -sendLazyReal _ [] = return () -sendLazyReal bSocket (x:xs) = BS.sendByteString bSocket x >> sendLazyReal bSocket xs - -sendLazy :: BS.BufferedSocket -> BL.ByteString -> IO () -sendLazy bSocket lazyBytestring = sendLazyReal bSocket $ BL.toChunks lazyBytestring - - -sendText:: BS.BufferedSocket -> T.Text -> IO () -sendText bSocket textData = BS.sendByteString bSocket $ ENC.encodeUtf8 textData - -sendTextLazy:: BS.BufferedSocket -> TL.Text -> IO () -sendTextLazy bSocket lazyText = sendLazy bSocket $ ENCL.encodeUtf8 lazyText - -sendString:: BS.BufferedSocket -> String -> IO () -sendString bSocket string = sendLazy bSocket $ fromString string - - - -class Sendable s where - send :: (BS.BufferedSocket -> s -> IO ()) - -instance Sendable Word8 where - send = sendWord8 -instance Sendable Word16 where - send = sendWord16 -instance Sendable Word32 where - send = sendWord32 -instance Sendable Word64 where - send = sendWord64 - -instance Sendable Int8 where - send = sendInt8 -instance Sendable Int16 where - send = sendInt16 -instance Sendable Int32 where - send = sendInt32 -instance Sendable Int64 where - send = sendInt64 - -instance Sendable B.ByteString where - send = BS.sendByteString -instance Sendable BL.ByteString where - send = sendLazy -{-- -instance Sendable T.Text where - send = sendText -instance Sendable TL.Text where - send = sendTextLazy -instance Sendable String where - send = sendString ---}