Add some server stuff.

pkg/arvo

@@ -1 +1 @@
-Subproject commit 587b4d26df6396a21478a110fc0736df319298a0
+Subproject commit 23507c12fbe8ff42cb165e1ec5456b895bf6de5b

pkg/hair/lib/Data/Noun/Jam/Fast.hs

@@ -244,10 +244,11 @@ peekWord :: Get Word
 peekWord = do
   off <- peekUsedBits
   cur <- peekCurWord
-  if off == 0 then pure cur else do
-  nex <- peekNextWord
-  advance 64
-  pure (dropLowBits off cur .|. dropHighBits off nex)
+  if off == 0 then pure cur else
+    do
+      nex <- peekNextWord
+      advance 64
+      pure (dropLowBits off cur .|. dropHighBits off nex)
 
 dropLowBits :: Word -> Word -> Word
 dropLowBits bits wor = shiftR wor (fromIntegral bits :: Int)

pkg/hair/lib/Vere/Http.hs

@@ -5,10 +5,13 @@ module Vere.Http where
 import ClassyPrelude
 import Data.Noun
 
+import qualified Data.CaseInsensitive as CI
+import qualified Network.HTTP.Types as HT
+import qualified Network.HTTP.Types.Method as H
+
 data Header = Header Text Text
 
-data Method = CONNECT | DELETE | GET | HEAD | OPTIONS | POST | PUT | TRACE
-  deriving (Eq,Ord,Show)
+type Method = H.StdMethod
 
 data Request = Request
   { method :: Method
@@ -27,3 +30,8 @@ data Event = Started ResponseHeader -- [%start hdr (unit octs) ?]
            | Done                   -- [%continue ~ %.y]
            | Canceled               -- %cancel
            | Failed Text            -- %cancel
+
+convertHeaders :: [HT.Header] -> [Header]
+convertHeaders = fmap f
+  where
+    f (k, v) = Header (decodeUtf8 (CI.original k)) (decodeUtf8 v)

pkg/hair/lib/Vere/Http/Client.hs

@@ -47,8 +47,7 @@ cvtRespHeaders :: H.Response a -> ResponseHeader
 cvtRespHeaders resp =
   ResponseHeader (HT.statusCode (H.responseStatus resp)) heads
   where
-    heads = H.responseHeaders resp <&> \(k, v) ->
-      Header (decodeUtf8 (CI.original k)) (decodeUtf8 v)
+    heads = convertHeaders (H.responseHeaders resp)
 
 
 --------------------------------------------------------------------------------

pkg/hair/lib/Vere/Http/Server.hs

@@ -5,6 +5,11 @@ module Vere.Http.Server where
 import ClassyPrelude
 import Vere.Http
 
+import Data.Noun.Atom
+import Data.Noun.Pill (packAtom)
+import qualified Network.HTTP.Types.Method as H
+import qualified Network.Wai as H
+
 type ServerId = Word
 type ConnectionId = Word
 type RequestId = Word
@@ -37,3 +42,29 @@ data ClientResponse
   | Cancel
 
 data MimeData = MimeData Text ByteString
+
+--
+
+cookMeth :: H.Request -> Maybe Method
+cookMeth re =
+  case H.parseMethod (H.requestMethod re) of
+    Left _ -> Nothing
+    Right m -> Just m
+
+data Octs = Octs Atom Atom
+
+bsToOcts :: ByteString -> Octs
+bsToOcts bs = Octs (fromIntegral (length bs)) (packAtom bs)
+
+readEvents :: H.Request -> IO Request
+readEvents request = do
+  let Just method = cookMeth request
+      url = decodeUtf8 (H.rawPathInfo request)
+      headers = convertHeaders (H.requestHeaders request)
+  bodyLbs <- H.strictRequestBody request
+  let body = if length bodyLbs == 0 then Nothing
+        else Just (toStrict bodyLbs)
+
+  -- TODO: Check if wai just deletes the 'host': header like h2o does?
+
+  pure (Request method url headers body)

pkg/hair/package.yaml

@@ -42,6 +42,7 @@ dependencies:
   - extra
   - flat
   - ghc-prim
+  - hashtables
   - http-client
   - http-types
   - integer-gmp
@@ -67,7 +68,7 @@ dependencies:
   - transformers
   - unordered-containers
   - vector
-  - hashtables
+  - wai
 
 default-extensions:
   - ApplicativeDo