avers-server 0.0.4 → 0.0.5

raw patch · 2 files changed

+17/−15 lines, 2 files

Files

• avers-server.cabal +1/−1
• src/Avers/Server/Instances.hs +16/−14

@@ -1,5 +1,5 @@ name:                avers-server-version:             0.0.4+version:             0.0.5 synopsis:            Server implementation of the Avers API description:         See README.md homepage:            http://github.com/wereHamster/avers-server

@@ -34,17 +34,18 @@     type ServerT (Credentials :> sublayout) m =         Credentials -> ServerT sublayout m -    route Proxy context subserver = WithRequest $ \request ->-        route (Proxy :: Proxy sublayout) context (addCapture subserver $ do+    route Proxy context subserver =+        route (Proxy :: Proxy sublayout) context (addAuthCheck subserver authCheck)+      where+        authCheck = withRequest $ \request -> do             let mbCookieHeaders = lookup "cookie" (requestHeaders request)                 mbSessionIdText = lookup "session" =<< fmap parseCookiesText mbCookieHeaders -            pure $ case mbSessionIdText of-                Nothing -> FailFatal err401+            case mbSessionIdText of+                Nothing -> delayedFailFatal err401                 Just sessionIdText -> case parseQueryParam sessionIdText of-                    Left _ -> FailFatal err401-                    Right sId -> Route $ (SessionIdCredential $ SessionId sId)-        )+                    Left _ -> delayedFailFatal err401+                    Right sId -> pure $ SessionIdCredential $ SessionId sId   @@ -53,17 +54,18 @@     type ServerT (SessionId :> sublayout) m =         SessionId -> ServerT sublayout m -    route Proxy context subserver = WithRequest $ \request ->-        route (Proxy :: Proxy sublayout) context (addCapture subserver $ do+    route Proxy context subserver =+        route (Proxy :: Proxy sublayout) context (addAuthCheck subserver authCheck)+      where+        authCheck = withRequest $ \request -> do             let mbCookieHeaders = lookup "cookie" (requestHeaders request)                 mbSessionIdText = lookup "session" =<< fmap parseCookiesText mbCookieHeaders -            pure $ case mbSessionIdText of-                Nothing -> FailFatal err401+            case mbSessionIdText of+                Nothing -> delayedFailFatal err401                 Just sessionIdText -> case parseQueryParam sessionIdText of-                    Left _ -> FailFatal err401-                    Right sId -> Route $ SessionId sId-        )+                    Left _ -> delayedFailFatal err401+                    Right sId -> pure $ SessionId sId   instance ToByteString SetCookie where