Merge pull request #966 from Vlix/use-Data-Word8-when-possible

Use `Data.Word8` when possible

.github/workflows/tests.yml

@@ -16,7 +16,8 @@ jobs:
         os: [ubuntu-latest, macos-latest, windows-latest]
         args:
         - "--resolver nightly --stack-yaml stack-nightly.yaml"
-        - "--resolver lts-21"
+        - "--resolver lts-22"
+        - "--resolver lts-21 --stack-yaml stack-lts-21.yaml"
         - "--resolver lts-20 --stack-yaml stack-lts-20.yaml"
         - "--resolver lts-19 --stack-yaml stack-lts-19.yaml"
         - "--resolver lts-18 --stack-yaml stack-lts-18.yaml"

stack-lts-21.yaml

@@ -0,0 +1,38 @@
+resolver: lts-21.21
+packages:
+- ./auto-update
+- ./mime-types
+- ./recv
+- ./time-manager
+- ./wai
+- ./wai-app-static
+- ./wai-conduit
+- ./wai-extra
+- ./wai-frontend-monadcgi
+- ./wai-http2-extra
+- ./wai-websockets
+- ./warp
+- ./warp-quic
+- ./warp-tls
+flags:
+  wai-extra:
+    build-example: true
+nix:
+  enable: false
+  packages:
+  - fcgi
+  - zlib
+extra-deps:
+  - crypto-token-0.0.2
+  - crypton-0.34
+  - crypton-x509-1.7.6
+  - crypton-x509-store-1.6.9
+  - crypton-x509-system-1.6.7
+  - crypton-x509-validation-1.6.12
+  - http2-5.0.0
+  - http3-0.0.7
+  - network-control-0.0.2
+  - network-udp-0.0.0
+  - quic-0.1.12
+  - sockaddr-0.0.1
+  - tls-1.9.0

stack-nightly.yaml

@@ -1,32 +1,26 @@
 resolver: nightly
 packages:
-- ./auto-update
-- ./mime-types
-- ./recv
-- ./time-manager
-- ./wai
-- ./wai-extra
-- ./wai-app-static
-- ./wai-frontend-monadcgi
-- ./wai-http2-extra
-- ./wai-websockets
-- ./wai-conduit
-- ./warp
-- ./warp-quic
-- ./warp-tls
+  - ./auto-update
+  - ./mime-types
+  - ./recv
+  - ./time-manager
+  - ./wai
+  - ./wai-app-static
+  - ./wai-conduit
+  - ./wai-extra
+  # Commented out packages until they are supported on nightly
+  # - ./wai-frontend-monadcgi
+  - ./wai-http2-extra
+  # - ./wai-websockets
+  - ./warp
+  # - ./warp-quic
+  - ./warp-tls
 flags:
   wai-extra:
     build-example: true
 nix:
   enable: false
   packages:
-  - fcgi
-  - zlib
-extra-deps:
-  - crypto-token-0.0.2
-  - crypton-0.34
-  - http3-0.0.7
-  - network-udp-0.0.0
-  - quic-0.1.12
-  - sockaddr-0.0.1
-  - tls-1.9.0
+    - fcgi
+    - zlib
+extra-deps: []

stack.yaml

@@ -1,4 +1,4 @@
-resolver: lts-21.21
+resolver: lts-22.3
 packages:
 - ./auto-update
 - ./mime-types
@@ -23,16 +23,9 @@ nix:
   - fcgi
   - zlib
 extra-deps:
-  - crypto-token-0.0.2
-  - crypton-0.34
-  - crypton-x509-1.7.6
-  - crypton-x509-store-1.6.9
-  - crypton-x509-system-1.6.7
-  - crypton-x509-validation-1.6.12
-  - http2-5.0.0
+  - crypto-token-0.1.0
   - http3-0.0.7
-  - network-control-0.0.2
   - network-udp-0.0.0
-  - quic-0.1.12
+  - quic-0.1.14
   - sockaddr-0.0.1
   - tls-1.9.0

wai-extra/Network/Wai/EventSource/EventStream.hs

@@ -13,6 +13,7 @@ import Data.ByteString.Builder
 #if __GLASGOW_HASKELL__ < 710
 import Data.Monoid
 #endif
+import Data.Word8 (_colon, _lf)
 
 {-|
     Type representing a communication over an event stream.  This can be an
@@ -38,7 +39,7 @@ data ServerEvent
     Newline as a Builder.
 -}
 nl :: Builder
-nl = char7 '\n'
+nl = word8 _lf
 
 
 {-|
@@ -49,7 +50,7 @@ nameField = string7 "event:"
 idField = string7 "id:"
 dataField = string7 "data:"
 retryField = string7 "retry:"
-commentField = char7 ':'
+commentField = word8 _colon
 
 
 {-|

wai-extra/Network/Wai/Handler/CGI.hs

@@ -14,7 +14,7 @@ import Data.Monoid (mconcat, mempty, mappend)
 #endif
 import Control.Arrow ((***))
 import Control.Monad (unless, void)
-import Data.ByteString.Builder (byteString, char7, string8, toLazyByteString)
+import Data.ByteString.Builder (byteString, string8, toLazyByteString, word8)
 import Data.ByteString.Builder.Extra (flush)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy as L
@@ -26,6 +26,7 @@ import Data.IORef (newIORef, readIORef, writeIORef)
 import Data.Maybe (fromMaybe)
 import qualified Data.Streaming.ByteString.Builder as Builder
 import qualified Data.String as String
+import Data.Word8 (_lf, _space)
 import Network.HTTP.Types (Status (..), hContentLength, hContentType, hRange)
 import qualified Network.HTTP.Types as H
 import Network.Socket (addrAddress, getAddrInfo)
@@ -137,28 +138,28 @@ runGeneric vars inputH outputH xsendfile app = do
                                 unless (B.null bs) $ do
                                     outputH bs
                                     loop
-                    sendBuilder $ headers s hs `mappend` char7 '\n'
+                    sendBuilder $ headers s hs `mappend` word8 _lf
                     b sendBuilder (sendBuilder flush)
                 blazeFinish >>= maybe (return ()) outputH
                 return ResponseReceived
   where
     headers s hs = mconcat (map header $ status s : map header' (fixHeaders hs))
     status (Status i m) = (byteString "Status", mconcat
         [ string8 $ show i
-        , char7 ' '
+        , word8 _space
         , byteString m
         ])
     header' (x, y) = (byteString $ CI.original x, byteString y)
     header (x, y) = mconcat
         [ x
         , byteString ": "
         , y
-        , char7 '\n'
+        , word8 _lf
         ]
     sfBuilder s hs sf fp = mconcat
         [ headers s hs
         , header (byteString sf, string8 fp)
-        , char7 '\n'
+        , word8 _lf
         , byteString sf
         , byteString " not supported"
         ]

wai-extra/Network/Wai/Header.hs

@@ -22,8 +22,8 @@ contentLength hdrs = lookup H.hContentLength hdrs >>= readInt
 readInt :: S8.ByteString -> Maybe Integer
 readInt bs =
     case S8.readInteger bs of
-        -- 'S8.all' is also 'True' for an empty string
-        Just (i, rest) | S8.all (== ' ') rest -> Just i
+        -- 'S.all' is also 'True' for an empty string
+        Just (i, rest) | S.all (== _space) rest -> Just i
         _ -> Nothing
 
 replaceHeader :: H.HeaderName -> S.ByteString -> [H.Header] -> [H.Header]

wai-extra/Network/Wai/Parse.hs

@@ -67,7 +67,7 @@ import Data.IORef
 import Data.Int (Int64)
 import Data.List (sortBy)
 import Data.Maybe (catMaybes, fromMaybe)
-import Data.Word (Word8)
+import Data.Word8
 import Network.HTTP.Types (hContentType)
 import qualified Network.HTTP.Types as H
 import Network.Wai
@@ -86,20 +86,20 @@ parseHttpAccept :: S.ByteString -> [S.ByteString]
 parseHttpAccept = map fst
                 . sortBy (rcompare `on` snd)
                 . map (addSpecificity . grabQ)
-                . S.split 44 -- comma
+                . S.split _comma
   where
     rcompare :: (Double,Int) -> (Double,Int) -> Ordering
     rcompare = flip compare
     addSpecificity (s, q) =
         -- Prefer higher-specificity types
-        let semicolons = S.count 0x3B s
-            stars = S.count 0x2A s
+        let semicolons = S.count _semicolon s
+            stars = S.count _asterisk s
         in (s, (q, semicolons - stars))
     grabQ s =
         -- Stripping all spaces may be too harsh.
         -- Maybe just strip either side of semicolon?
-        let (s', q) = S.breakSubstring ";q=" (S.filter (/=0x20) s) -- 0x20 is space
-            q' = S.takeWhile (/=0x3B) (S.drop 3 q) -- 0x3B is semicolon
+        let (s', q) = S.breakSubstring ";q=" (S.filter (/= _space) s)
+            q' = S.takeWhile (/= _semicolon) (S.drop 3 q)
          in (s', readQ q')
     readQ s = case reads $ S8.unpack s of
                 (x, _):_ -> x
@@ -333,26 +333,23 @@ getRequestBodyType req = do
 -- @since 1.3.2
 parseContentType :: S.ByteString -> (S.ByteString, [(S.ByteString, S.ByteString)])
 parseContentType a = do
-    let (ctype, b) = S.break (== semicolon) a
+    let (ctype, b) = S.break (== _semicolon) a
         attrs = goAttrs id $ S.drop 1 b
      in (ctype, attrs)
   where
-    semicolon = 59
-    equals = 61
-    space = 32
-    dq s = if S.length s > 2 && S.head s == 34 && S.last s == 34 -- quote
+    dq s = if S.length s > 2 && S.head s == _quotedbl && S.last s == _quotedbl
                 then S.tail $ S.init s
                 else s
     goAttrs front bs
         | S.null bs = front []
         | otherwise =
-            let (x, rest) = S.break (== semicolon) bs
+            let (x, rest) = S.break (== _semicolon) bs
              in goAttrs (front . (goAttr x:)) $ S.drop 1 rest
     goAttr bs =
-        let (k, v') = S.break (== equals) bs
+        let (k, v') = S.break (== _equal) bs
             v = S.drop 1 v'
          in (strip k, dq $ strip v)
-    strip = S.dropWhile (== space) . fst . S.breakEnd (/= space)
+    strip = S.dropWhile (== _space) . fst . S.breakEnd (/= _space)
 
 -- | Parse the body of an HTTP request.
 -- See parseRequestBodyEx for details.
@@ -449,7 +446,7 @@ takeLine maxlen src =
 
     close front = leftover src front >> return Nothing
     push front bs = do
-        let (x, y) = S.break (== 10) bs -- LF
+        let (x, y) = S.break (== _lf) bs
          in if S.null y
                 then go $ front `S.append` x
                 else do
@@ -574,8 +571,8 @@ parsePiecesEx o sink bound rbody add =
         contDisp = mk $ S8.pack "Content-Disposition"
         contType = mk $ S8.pack "Content-Type"
         parsePair s =
-            let (x, y) = breakDiscard 58 s -- colon
-             in (mk x, S.dropWhile (== 32) y) -- space
+            let (x, y) = breakDiscard _colon s
+             in (mk x, S.dropWhile (== _space) y)
 
 
 data Bound = FoundBound S.ByteString S.ByteString
@@ -695,22 +692,22 @@ sinkTillBound bound iter seed0 src max' = do
     return (b, seed)
 
 parseAttrs :: S.ByteString -> [(S.ByteString, S.ByteString)]
-parseAttrs = map go . S.split 59 -- semicolon
+parseAttrs = map go . S.split _semicolon
   where
-    tw = S.dropWhile (== 32) -- space
-    dq s = if S.length s > 2 && S.head s == 34 && S.last s == 34 -- quote
+    tw = S.dropWhile (== _space)
+    dq s = if S.length s > 2 && S.head s == _quotedbl && S.last s == _quotedbl
                 then S.tail $ S.init s
                 else s
     go s =
-        let (x, y) = breakDiscard 61 s -- equals sign
+        let (x, y) = breakDiscard _equal s
          in (tw x, dq $ tw y)
 
 killCRLF :: S.ByteString -> S.ByteString
 killCRLF bs
-    | S.null bs || S.last bs /= 10 = bs -- line feed
+    | S.null bs || S.last bs /= _lf = bs
     | otherwise = killCR $ S.init bs
 
 killCR :: S.ByteString -> S.ByteString
 killCR bs
-    | S.null bs || S.last bs /= 13 = bs -- carriage return
+    | S.null bs || S.last bs /= _cr = bs
     | otherwise = S.init bs

wai-extra/test/Network/Wai/Middleware/StripHeadersSpec.hs

@@ -36,7 +36,7 @@ spec = describe "stripHeader" $ do
 
         simpleHeaders resp1 `shouldBe` ciTestHeaders
         simpleHeaders resp2 `shouldBe` ciTestHeaders
-        simpleHeaders resp3 `shouldBe` tail ciTestHeaders
+        simpleHeaders resp3 `shouldBe` drop 1 ciTestHeaders
 
     it "strips specific set of headers" $ do
         resp1 <- runApp host (addHeaders testHeaders) defaultRequest

wai-extra/test/Network/Wai/ParseSpec.hs

@@ -12,6 +12,7 @@ import qualified Data.ByteString.Lazy as L
 import qualified Data.IORef as I
 import qualified Data.Text as TS
 import qualified Data.Text.Encoding as TE
+import Data.Word8 (_e)
 import Network.Wai (Request (requestHeaders), defaultRequest, setRequestBodyChunks)
 import Network.Wai.Handler.Warp (InvalidRequest(..))
 import System.IO (IOMode (ReadMode), withFile)
@@ -190,7 +191,7 @@ caseParseRequestBody = do
       <> "Photo blog using Hack.\r\n\r\n"
       <> "------WebKitFormBoundaryB1pWXPZ6lNr8RiLh\r\n"
       <> "Content-Disposition: form-data; name=\"bla\"; filename=\"riedmi"
-      <> S8.replicate 8190 'e' <> "\"\r\n"
+      <> S.replicate 8190 _e <> "\"\r\n"
       <> "Content-Type: application/octet-stream\r\n\r\n"
       <> "Photo blog using Hack.\r\n\r\n"
       <> "------WebKitFormBoundaryB1pWXPZ6lNr8RiLh--\r\n"

wai-extra/wai-extra.cabal

@@ -229,6 +229,7 @@ test-suite spec
                    , wai-extra
                    , wai
                    , warp
+                   , word8
                    , zlib
     ghc-options:     -Wall
     default-language:          Haskell2010