diff --git a/BufferedSocket.cabal b/BufferedSocket.cabal new file mode 100644 --- /dev/null +++ b/BufferedSocket.cabal @@ -0,0 +1,67 @@ +-- Initial BufferedSocket.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +-- The name of the package. +name: BufferedSocket + +-- The package version. See the Haskell package versioning policy (PVP) +-- for standards guiding when and how versions should be incremented. +-- http://www.haskell.org/haskellwiki/Package_versioning_policy +-- PVP summary: +-+------- breaking API changes +-- | | +----- non-breaking API additions +-- | | | +--- code changes with no API change +version: 0.1.0.0 + +-- A short (one-line) description of the package. +synopsis: A socker wrapper that makes the IO of sockets much cleaner + +-- A longer description of the package. +description: The idea of a "BufferedSocket" is that reading from a network socket should be really easy and handy. BufferedSockets is an attempt to do just that whilst beeing space-time efficient. Having "in app" buffers also makes it easy for the buffered socket to read data without taking the data out of the buffer thus giving us the ability to look for patterns and read exess data without having to "take out of the reading queue". + +-- The license under which the package is released. +license: MIT + +-- The file containing the license text. +license-file: LICENSE + +-- The package author(s). +author: Tomas Möre + +-- An email address to which users can send suggestions, bug reports, and +-- patches. +maintainer: tomas.o.more@gmail.com + +-- A copyright notice. +-- copyright: + +category: Network + +build-type: Simple + +-- Extra files to be distributed with the package, such as examples or a +-- README. +extra-source-files: README + +-- Constraint on the version of Cabal needed to build this package. +cabal-version: >=1.10 + + +library + -- Modules exported by the library. + exposed-modules: BufferedSocket, Core, Reader, Writer + + -- Modules included in this library but not exported. + -- other-modules: test + + -- LANGUAGE extensions used by modules in this package. + other-extensions: OverloadedStrings, FlexibleInstances + + -- Other library packages from which modules are imported. + build-depends: base >=4.7 && <4.8, bytestring >=0.10 && <0.11, text >=1.1 && <1.2, network >=2.4 && <2.5 + + -- Directories containing source files. + -- hs-source-dirs: + + -- Base language which the package is written in. + default-language: Haskell2010 + diff --git a/BufferedSocket.hs b/BufferedSocket.hs new file mode 100644 --- /dev/null +++ b/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 BufferedSocket (module X) where + +import Core as X +import Reader as X +import Writer as X diff --git a/Core.hs b/Core.hs new file mode 100644 --- /dev/null +++ b/Core.hs @@ -0,0 +1,464 @@ +{----------------------------------------------------------------------------------------- +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 +, sendByteString +, 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/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,10 @@ + +The MIT License (MIT) + +Copyright (c) 2015 Tomas Möre + +Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,1 @@ +This Package contains the source for a "BufferedSocket" These sockets are used as wrappers for normal network sockets but brings functions to easily manage the input and output of different kinds of data diff --git a/Reader.hs b/Reader.hs new file mode 100644 --- /dev/null +++ b/Reader.hs @@ -0,0 +1,162 @@ +{----------------------------------------------------------------------------------------- +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 0 + +convertToShiftedList:: (Bits a, Num a, Integral a, Bits b, Num b) => [a] -> Int -> [b] +convertToShiftedList byteList byteSize = + [shift (fromIntegral x) (byteSize * 8 * n) | x <- byteList, n <- [0..(length byteList)]] + +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 2 + let result = convertToShiftedList bytes 2:: [Word16] + return $ listToValue result + +readWord32:: BS.BufferedSocket -> IO Word32 +readWord32 bSocket = do + bytes <- B.unpack <$> BS.readRaw bSocket 4 + let result = convertToShiftedList bytes 4:: [Word32] + return $ listToValue result + +readWord64:: BS.BufferedSocket -> IO Word64 +readWord64 bSocket = do + bytes <- B.unpack <$> BS.readRaw bSocket 8 + let result = convertToShiftedList bytes 8:: [Word64] + return $ listToValue result + +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/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/Writer.hs b/Writer.hs new file mode 100644 --- /dev/null +++ b/Writer.hs @@ -0,0 +1,151 @@ +{----------------------------------------------------------------------------------------- +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 - 1)) + 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 = BS.sendByteString bSocket $ bitsToByteString word16 + +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 +--}