HTTP 4000.3.12 → 4000.3.13

raw patch · 6 files changed

+130/−20 lines, 6 filesdep ~Win32dep ~networkPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: Win32, network

API changes (from Hackage documentation)

Files

• HTTP.cabal +10/−10
• Network/HTTP/Base.hs +1/−1
• Network/HTTP/Proxy.hs +10/−2
• Network/HTTP/Utils.hs +96/−0
• Network/StreamSocket.hs +8/−4
• Network/TCP.hs +5/−3

@@ -1,5 +1,5 @@ Name: HTTP-Version: 4000.3.12+Version: 4000.3.13 Cabal-Version: >= 1.8 Build-type: Simple License: BSD3@@ -56,7 +56,7 @@  Extra-Source-Files: CHANGES -tested-with: GHC==8.4.1, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2, GHC==7.2.2, GHC==7.0.4+tested-with: GHC==8.6.3, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2, GHC==7.2.2, GHC==7.0.4  Source-Repository head   type: git@@ -77,7 +77,7 @@  Flag warp-tests   description: Test against warp-  default:     True+  default:     False   manual:      True  flag network-uri@@ -109,7 +109,7 @@    -- note the test harness constraints should be kept in sync with these   -- where dependencies are shared-  Build-depends: base >= 4.3.0.0 && < 4.12, parsec >= 2.0 && < 3.2+  Build-depends: base >= 4.3.0.0 && < 4.13, parsec >= 2.0 && < 3.2   Build-depends: array >= 0.3.0.2 && < 0.6, bytestring >= 0.9.1.5 && < 0.11   Build-depends: time >= 1.1.2.3 && < 1.10 @@ -122,15 +122,15 @@     Build-depends: mtl >= 2.0 && < 2.3    if flag(network-uri)-    Build-depends: network-uri == 2.6.*, network >= 2.6 && < 2.8+    Build-depends: network-uri == 2.6.*, network >= 2.6 && < 3.1   else-    Build-depends: network >= 2.2.1.8 && < 2.6+    Build-depends: network >= 2.4 && < 2.6    if flag(warn-as-error)     ghc-options:      -Werror    if os(windows)-    Build-depends: Win32 >= 2.2.0.0 && < 2.8+    Build-depends: Win32 >= 2.2.0.0 && < 2.9  Test-Suite test   type: exitcode-stdio-1.0@@ -151,15 +151,15 @@                      bytestring >= 0.9.1.5 && < 0.11,                      deepseq >= 1.3.0.0 && < 1.5,                      pureMD5 >= 0.2.4 && < 2.2,-                     base >= 4.3.0.0 && < 4.12,+                     base >= 4.3.0.0 && < 4.13,                      split >= 0.1.3 && < 0.3,                      test-framework >= 0.2.0 && < 0.9,                      test-framework-hunit >= 0.3.0 && <0.4    if flag(network-uri)-    Build-depends: network-uri == 2.6.*, network >= 2.6 && < 2.8+    Build-depends: network-uri == 2.6.*, network >= 2.6 && < 3.1   else-    Build-depends: network >= 2.2.1.5 && < 2.6+    Build-depends: network >= 2.3 && < 2.6    if flag(warp-tests)     CPP-Options: -DWARP_TESTS

@@ -107,7 +107,7 @@    )  import Control.Monad ( guard )-import Control.Monad.Error ()+import Control.Monad.Error.Class () import Data.Bits     ( (.&.), (.|.), shiftL, shiftR ) import Data.Word     ( Word8 ) import Data.Char     ( digitToInt, intToDigit, toLower, isDigit,

@@ -47,10 +47,16 @@  #if defined(WIN32) import System.Win32.Types   ( DWORD, HKEY )-import System.Win32.Registry( hKEY_CURRENT_USER, regOpenKey, regCloseKey, regQueryValue, regQueryValueEx )+import System.Win32.Registry( hKEY_CURRENT_USER, regOpenKey, regCloseKey, regQueryValueEx ) import Control.Exception    ( bracket ) import Foreign              ( toBool, Storable(peek, sizeOf), castPtr, alloca )++#if MIN_VERSION_Win32(2,8,0)+import System.Win32.Registry( regQueryDefaultValue )+#else+import System.Win32.Registry( regQueryValue ) #endif+#endif  -- | HTTP proxies (or not) are represented via 'Proxy', specifying if a -- proxy should be used for the request (see 'Network.Browser.setProxy')@@ -103,7 +109,9 @@   (bracket (uncurry regOpenKey registryProxyLoc) regCloseKey $ \hkey -> do     enable <- fmap toBool $ regQueryValueDWORD hkey "ProxyEnable"     if enable-#if MIN_VERSION_Win32(2,6,0)+#if MIN_VERSION_Win32(2,8,0)+        then fmap Just $ regQueryDefaultValue hkey "ProxyServer"+#elif MIN_VERSION_Win32(2,6,0)         then fmap Just $ regQueryValue hkey "ProxyServer" #else         then fmap Just $ regQueryValue hkey (Just "ProxyServer")

@@ -27,12 +27,18 @@        , dropWhileTail -- :: (a -> Bool) -> [a] -> [a]        , chopAtDelim   -- :: Eq a => a -> [a] -> ([a],[a])        +       , toUTF8BS+       , fromUTF8BS        ) where        +import Data.Bits import Data.Char import Data.List ( elemIndex ) import Data.Maybe ( fromMaybe )+import Data.Word ( Word8 ) +import qualified Data.ByteString as BS+ -- | @crlf@ is our beloved two-char line terminator. crlf :: String crlf = "\r\n"@@ -109,3 +115,93 @@   case break (==elt) xs of     (_,[])    -> (xs,[])     (as,_:bs) -> (as,bs)++toUTF8BS :: String -> BS.ByteString+toUTF8BS = BS.pack . encodeStringUtf8++fromUTF8BS :: BS.ByteString -> String+fromUTF8BS = decodeStringUtf8 . BS.unpack++-- | Encode 'String' to a list of UTF8-encoded octets+--+-- Code-points in the @U+D800@-@U+DFFF@ range will be encoded+-- as the replacement character (i.e. @U+FFFD@).+--+-- The code is extracted from Cabal library, written originally+-- Herbert Valerio Riedel under BSD-3-Clause license+encodeStringUtf8 :: String -> [Word8]+encodeStringUtf8 []        = []+encodeStringUtf8 (c:cs)+  | c <= '\x07F' = w8+                 : encodeStringUtf8 cs+  | c <= '\x7FF' = (0xC0 .|.  w8ShiftR  6          )+                 : (0x80 .|. (w8          .&. 0x3F))+                 : encodeStringUtf8 cs+  | c <= '\xD7FF'= (0xE0 .|.  w8ShiftR 12          )+                 : (0x80 .|. (w8ShiftR  6 .&. 0x3F))+                 : (0x80 .|. (w8          .&. 0x3F))+                 : encodeStringUtf8 cs+  | c <= '\xDFFF'= 0xEF : 0xBF : 0xBD -- U+FFFD+                 : encodeStringUtf8 cs+  | c <= '\xFFFF'= (0xE0 .|.  w8ShiftR 12          )+                 : (0x80 .|. (w8ShiftR  6 .&. 0x3F))+                 : (0x80 .|. (w8          .&. 0x3F))+                 : encodeStringUtf8 cs+  | otherwise    = (0xf0 .|.  w8ShiftR 18          )+                 : (0x80 .|. (w8ShiftR 12 .&. 0x3F))+                 : (0x80 .|. (w8ShiftR  6 .&. 0x3F))+                 : (0x80 .|. (w8          .&. 0x3F))+                 : encodeStringUtf8 cs+  where+    w8 = fromIntegral (ord c) :: Word8+    w8ShiftR :: Int -> Word8+    w8ShiftR = fromIntegral . shiftR (ord c)++-- | Decode 'String' from UTF8-encoded octets.+--+-- Invalid data in the UTF8 stream (this includes code-points @U+D800@+-- through @U+DFFF@) will be decoded as the replacement character (@U+FFFD@).+--+-- See also 'encodeStringUtf8'+decodeStringUtf8 :: [Word8] -> String+decodeStringUtf8 = go+  where+    go :: [Word8] -> String+    go []       = []+    go (c : cs)+      | c <= 0x7F = chr (fromIntegral c) : go cs+      | c <= 0xBF = replacementChar : go cs+      | c <= 0xDF = twoBytes c cs+      | c <= 0xEF = moreBytes 3 0x800     cs (fromIntegral $ c .&. 0xF)+      | c <= 0xF7 = moreBytes 4 0x10000   cs (fromIntegral $ c .&. 0x7)+      | c <= 0xFB = moreBytes 5 0x200000  cs (fromIntegral $ c .&. 0x3)+      | c <= 0xFD = moreBytes 6 0x4000000 cs (fromIntegral $ c .&. 0x1)+      | otherwise   = replacementChar : go cs++    twoBytes :: Word8 -> [Word8] -> String+    twoBytes c0 (c1:cs')+      | c1 .&. 0xC0 == 0x80+      = let d = (fromIntegral (c0 .&. 0x1F) `shiftL` 6)+             .|. fromIntegral (c1 .&. 0x3F)+         in if d >= 0x80+               then  chr d                : go cs'+               else  replacementChar      : go cs'+    twoBytes _ cs' = replacementChar      : go cs'++    moreBytes :: Int -> Int -> [Word8] -> Int -> [Char]+    moreBytes 1 overlong cs' acc+      | overlong <= acc && acc <= 0x10FFFF && (acc < 0xD800 || 0xDFFF < acc)+      = chr acc : go cs'++      | otherwise+      = replacementChar : go cs'++    moreBytes byteCount overlong (cn:cs') acc+      | cn .&. 0xC0 == 0x80+      = moreBytes (byteCount-1) overlong cs'+          ((acc `shiftL` 6) .|. fromIntegral cn .&. 0x3F)++    moreBytes _ _ cs' _+      = replacementChar : go cs'++    replacementChar = '\xfffd'

@@ -29,11 +29,15 @@    ( Stream(..), ConnError(ErrorReset, ErrorMisc), Result    ) import Network.Socket-   ( Socket, getSocketOption, shutdown, send, recv, sClose+   ( Socket, getSocketOption, shutdown    , ShutdownCmd(ShutdownBoth), SocketOption(SoError)    )+import Network.Socket.ByteString (send, recv)+import qualified Network.Socket+   ( close )  import Network.HTTP.Base ( catchIO )+import Network.HTTP.Utils ( fromUTF8BS, toUTF8BS ) import Control.Monad (liftM) import Control.Exception as Exception (IOException) import System.IO.Error (isEOFError)@@ -50,7 +54,7 @@ myrecv :: Socket -> Int -> IO String myrecv sock len =     let handler e = if isEOFError e then return [] else ioError e-        in catchIO (recv sock len) handler+        in catchIO (fmap fromUTF8BS (recv sock len)) handler  instance Stream Socket where     readBlock sk n    = readBlockSocket sk n@@ -59,7 +63,7 @@     close sk          = do         -- This slams closed the connection (which is considered rude for TCP\/IP)          shutdown sk ShutdownBoth-         sClose sk+         Network.Socket.close sk     closeOnEnd _sk _  = return () -- can't really deal with this, so do run the risk of leaking sockets here.  readBlockSocket :: Socket -> Int -> IO (Result String)@@ -89,5 +93,5 @@ writeBlockSocket sk str = (liftM Right $ fn str) `catchIO` (handleSocketError sk)   where    fn [] = return ()-   fn x  = send sk x >>= \i -> fn (drop i x)+   fn x  = send sk (toUTF8BS x) >>= \i -> fn (drop i x) 

@@ -38,11 +38,13 @@    ( Socket, SocketOption(KeepAlive)    , SocketType(Stream), connect    , shutdown, ShutdownCmd(..)-   , sClose, setSocketOption, getPeerName+   , setSocketOption, getPeerName    , socket, Family(AF_UNSPEC), defaultProtocol, getAddrInfo    , defaultHints, addrFamily, withSocketsDo    , addrSocketType, addrAddress    )+import qualified Network.Socket+   ( close ) import qualified Network.Stream as Stream    ( Stream(readBlock, readLine, writeBlock, close, closeOnEnd) ) import Network.Stream@@ -242,7 +244,7 @@                             setSocketOption s KeepAlive 1                             connect s (addrAddress a)                             socketConnection_ fixedUri port s stashInput-                            ) (sClose s)+                            ) (Network.Socket.close s)  -- | @socketConnection@, like @openConnection@ but using a pre-existing 'Socket'. socketConnection :: BufferType ty@@ -295,7 +297,7 @@     suck readL     hClose (connHandle conn)     shutdown sk ShutdownReceive-    sClose sk+    Network.Socket.close sk    suck :: IO Bool -> IO ()   suck rd = do