@@ -28,14 +28,15 @@ data AuthProtected
28instance HasServer rest => HasServer (AuthProtected :> rest) where
28instance HasServer rest => HasServer (AuthProtected :> rest) where
29 type ServerT (AuthProtected :> rest) m = ServerT rest m
29 type ServerT (AuthProtected :> rest) m = ServerT rest m
31− route Proxy a request respond =
31+ route Proxy a = WithRequest $ \ request ->
32+ route (Proxy :: Proxy rest) $ do
32− case lookup "Cookie" (requestHeaders request) of
33+ case lookup "Cookie" (requestHeaders request) of
33− Nothing -> respond . succeedWith $ responseLBS status401 [] "Missing auth header."
34+ Nothing -> return $ failWith $ HttpError status401 (Just "Missing auth header.")
34− Just v -> do
35+ Just v -> do
35− authGranted <- isGoodCookie v
36+ authGranted <- isGoodCookie v
36− if authGranted
37+ if authGranted
37− then route (Proxy :: Proxy rest) a request respond
38+ then a
38− else respond . succeedWith $ responseLBS status403 [] "Invalid cookie."
39+ else return $ failWith $ HttpError status403 (Just "Invalid cookie.")
40type PrivateAPI = Get '[JSON] [PrivateData]
41type PrivateAPI = Get '[JSON] [PrivateData]