diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,4 +1,10 @@ -## 0.1.1.0 +#### 0.1.1.1 + +- Fix incorrectly constructed `Host:` header in `uhttpc-bench` executable +- Optimize/improve implementation of `getPOSIXTimeSecs` & `getPOSIXTimeUSecs` +- Add support for `network-3.x` + +### 0.1.1.0 - `uhttpc-bench`: Add support for round-robin POST requests from file - `uhttpc-bench`: Converted to `optparse-applicative` diff --git a/Network/HTTP/MicroClient.hs b/Network/HTTP/MicroClient.hs --- a/Network/HTTP/MicroClient.hs +++ b/Network/HTTP/MicroClient.hs @@ -1,4 +1,7 @@ -{-# LANGUAGE BangPatterns, CPP, OverloadedStrings #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CApiFFI #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} -- |Minimal HTTP client implementation -- @@ -50,25 +53,32 @@ #if !MIN_VERSION_base(4,8,0) import Control.Applicative #endif -import Control.DeepSeq (NFData(rnf),deepseq) +import Control.DeepSeq (NFData (rnf), deepseq) import Control.Exception import Control.Monad -import Data.ByteString (ByteString) -import qualified Data.ByteString as B -import Data.ByteString.Lex.Integral (packDecimal, readDecimal,readHexadecimal) -import qualified Data.ByteString.Unsafe as B +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import Data.ByteString.Lex.Integral (packDecimal, readDecimal, + readHexadecimal) +import qualified Data.ByteString.Unsafe as B import Data.IORef import Data.Maybe +#if !MIN_VERSION_base(4,11,0) import Data.Monoid +#endif import Data.Tuple import Data.Word -import Network -import Network.BSD -import Network.Socket hiding (send, sendTo, recv, recvFrom) +import Network.BSD (getHostByName, getProtocolNumber, + hostAddress) +import Network.Socket (Family (AF_INET), HostName, + PortNumber, ProtocolNumber, + SockAddr (SockAddrInet), Socket, + SocketType (Stream), bind, close, + connect, socket) import Network.Socket.ByteString import Network.URI import System.IO.Error -import System.IO.Unsafe (unsafePerformIO) +import System.IO.Unsafe (unsafePerformIO) -- |Minimal socket input-stream abstraction w/ single pushback & consumed byte-count -- @@ -77,7 +87,7 @@ {-# UNPACK #-} !(IORef ByteString) {-# UNPACK #-} !(IORef Word64) -- note: does contain readbuf's size {-# UNPACK #-} !(IORef Word64) -- data written - {-# UNPACK #-} !Int -- hack: connection-id + {-# UNPACK #-} !Int -- hack: connection-id -- |Internal debug tracing helper ssDebug :: String -> SockStream -> IO a -> IO a @@ -143,7 +153,7 @@ writeIORef bufref B.empty return buf --- |Version of 'ssRead' that throws +-- |Version of 'ssRead' that throws on EOF ssRead' :: SockStream -> IO ByteString ssRead' ss = do buf <- ssRead ss @@ -313,7 +323,7 @@ httpParseHeaderDone :: (ByteString,[ByteString]) -> Bool httpParseHeaderDone (_,l:_) | B.null l = True - httpParseHeaderDone _ = False + httpParseHeaderDone _ = False data HttpResponse = HttpResponse { respCode :: !HttpCode -- ^ status code @@ -490,7 +500,7 @@ -- -- Note: this function returns /NaN/ in case the underlying -- @gettimeofday(2)@ call fails. -foreign import ccall "get_posix_time_secs" getPOSIXTimeSecs :: IO Double +foreign import capi unsafe "hs_uhttpc.h get_posix_time_secs" getPOSIXTimeSecs :: IO Double -- | Return the time as the number of microseconds since the Epoch, -- @1970-01-01 00:00:00 +0000 (UTC)@. @@ -500,4 +510,4 @@ -- @gettimeofday(2)@ call fails. -- -- See also 'getPOSIXTimeSecs' -foreign import ccall "get_posix_time_secs" getPOSIXTimeUSecs :: IO Word64 +foreign import capi unsafe "hs_uhttpc.h get_posix_time_usecs" getPOSIXTimeUSecs :: IO Word64 diff --git a/cbits/get_posix_time.c b/cbits/get_posix_time.c deleted file mode 100644 --- a/cbits/get_posix_time.c +++ /dev/null @@ -1,30 +0,0 @@ -#include -#include -#include -#include - -// get POSIX time as FP value in seconds; returns NaN in case of error -double get_posix_time_secs(void) -{ - struct timeval tval = { 0, 0, }; - - if (gettimeofday(&tval, NULL)) -#ifdef NAN - return (NAN); -#else - return (0.0/0.0); -#endif - - return (((double) tval.tv_sec) + (((double) tval.tv_usec) / 1e6)); -} - -// returns number of microseconds since epoch; returns 0 in case of error -uint64_t get_posix_time_usecs(void) -{ - struct timeval tval = { 0, 0, }; - - if (gettimeofday(&tval, NULL)) - return 0; - - return ((((uint64_t)tval.tv_sec) * 1000000) + ((uint64_t) tval.tv_usec)); -} diff --git a/cbits/hs_uhttpc.h b/cbits/hs_uhttpc.h new file mode 100644 --- /dev/null +++ b/cbits/hs_uhttpc.h @@ -0,0 +1,37 @@ +#ifndef HS_UHTTPC_H +#define HS_UHTTPC_H + +#include +#include +#include +#include + +// get POSIX time as FP value in seconds; returns NaN in case of error +static inline +double get_posix_time_secs(void) +{ + struct timeval tval = { 0, 0, }; + + if (gettimeofday(&tval, NULL)) +#ifdef NAN + return (NAN); +#else + return (0.0/0.0); +#endif + + return (((double) tval.tv_sec) + (((double) tval.tv_usec) / 1e6)); +} + +// returns number of microseconds since epoch; returns 0 in case of error +static inline +uint64_t get_posix_time_usecs(void) +{ + struct timeval tval = { 0, 0, }; + + if (gettimeofday(&tval, NULL)) + return 0; + + return ((((uint64_t)tval.tv_sec) * 1000000) + ((uint64_t) tval.tv_usec)); +} + +#endif diff --git a/src-exe/uhttpc-bench.hs b/src-exe/uhttpc-bench.hs --- a/src-exe/uhttpc-bench.hs +++ b/src-exe/uhttpc-bench.hs @@ -1,32 +1,32 @@ -{-# LANGUAGE Arrows #-} -{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE Arrows #-} +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} module Main (main) where import Control.Concurrent import Control.Concurrent.Async -import Control.DeepSeq (deepseq) +import Control.DeepSeq (deepseq) import Control.Monad -import Data.ByteString (ByteString) -import qualified Data.ByteString as B -import qualified Data.ByteString.Char8 as B8 +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as B8 import Data.Data import Data.IORef import Data.List import Data.Maybe -import Data.Monoid +import Data.Monoid as Mon ((<>)) import Data.Ord import Data.Word -import GHC.Conc.Sync (numCapabilities,getNumProcessors) +import GHC.Conc.Sync (getNumProcessors, numCapabilities) import Network.HTTP.MicroClient -import Network.Socket hiding (send, sendTo, recv, recvFrom) +import Network.Socket (SockAddr) import Options.Applicative import Options.Applicative.Arrows import System.IO -import System.Mem (performGC) +import System.Mem (performGC) import Text.Printf -- |Timestamp in seconds since POSIX epoch @@ -64,7 +64,7 @@ argsParser :: Parser Args argsParser = runA $ proc () -> do - argNumReq <- asA (option auto $ value 1 <> metavar "NUM" <> short 'n' + argNumReq <- asA (option auto $ value 1 <> metavar "NUM" Mon.<> short 'n' <> help "number of requests" <> showDefault) -< () argThrCnt <- asA (option auto $ value numCapabilities <> metavar "NUM" <> short 't' @@ -136,7 +136,7 @@ sa <- getSockAddr hostname portnum lsa <- if null (argLAddr pargs) then return Nothing - else fmap Just $ getSockAddr (argLAddr pargs) aNY_PORT + else fmap Just $ getSockAddr (argLAddr pargs) 0 when verbose $ printf "connecting to %s (using local address %s)\n" (show sa) (maybe "*:*" show lsa) @@ -185,8 +185,7 @@ let rawreqblen = maybe 0 B.length rawreqb msg = mkHttp11Req postOrGet (B8.pack urlpath) - ("Host: " <> B8.pack hostname - <> ":" <> B8.pack (show portnum)) + (B8.pack hostname <> ":" <> B8.pack (show portnum)) (argKeepAlive pargs) hdrs rawreqb diff --git a/uhttpc.cabal b/uhttpc.cabal --- a/uhttpc.cabal +++ b/uhttpc.cabal @@ -1,15 +1,16 @@ +cabal-version: 1.12 name: uhttpc -version: 0.1.1.0 +version: 0.1.1.1 + synopsis: Minimal HTTP client library optimized for benchmarking homepage: https://github.com/hvr/uhttpc license: GPL-3 license-file: LICENSE author: Herbert Valerio Riedel maintainer: hvr@gnu.org -copyright: © 2013-2015 Herbert Valerio Riedel +copyright: © 2013-2019 Herbert Valerio Riedel category: Network build-type: Simple -cabal-version: >=1.10 description: @uhttpc@ contains a simple low-level and lightweight Haskell @@ -32,22 +33,35 @@ instead which aim toward full RFC compliance as well as having good performance. -extra-source-files: README.md CHANGELOG.md +extra-source-files: README.md CHANGELOG.md cbits/hs_uhttpc.h +tested-with: GHC ==8.6.5, GHC ==8.4.4, GHC ==8.2.2, GHC ==8.0.2, GHC==7.10.3, GHC==7.10.2, GHC==7.8.4, GHC==7.6.3 + +flag network--GE-3_0_0 + description: [network](http://hackage.haskell.org/package/network) ≥ 3.0.0 + default: True + manual: False + library default-language: Haskell2010 - other-extensions: BangPatterns, CPP, OverloadedStrings + other-extensions: BangPatterns, CPP, OverloadedStrings, CApiFFI exposed-modules: Network.HTTP.MicroClient ghc-options: -Wall -fwarn-tabs - c-sources: cbits/get_posix_time.c + include-dirs: cbits + build-depends: - base >=4.6 && <4.9, + base >=4.6 && <4.13, bytestring ==0.10.*, - network ==2.6.*, + network ==2.6.* || ==2.8.* || ==3.0.* || ==3.1.*, network-uri ==2.6.*, bytestring-lexing >=0.4 && <0.6, deepseq >=1.1 && <1.5 + if flag(network--GE-3_0_0) + build-depends: + network >= 3.0.0 + , network-bsd >= 2.8.1 && <2.9 + executable uhttpc-bench default-language: Haskell2010 other-extensions: Arrows, BangPatterns, DeriveDataTypeable, OverloadedStrings, RecordWildCards @@ -63,8 +77,8 @@ deepseq, network, -- build-deps which need version bounds - async ==2.0.*, - optparse-applicative ==0.11.* + async ==2.0.* || ==2.1.* || ==2.2.*, + optparse-applicative ==0.11.* || ==0.12.* || ==0.13.* || ==0.14.* Source-Repository head Type: git