on master help sign in
fix route parsing in `ob run`
commitcaa6b5c8a173d2a7e213fc68fc54cf00664b91fa authorDan Bornside <dan.bornside@obsidian.systems> dateTue 4 Jun 2019, 19:53 (7 years ago) parent38bef16
3 files changed+16−6
lib/backend/src/Obelisk/Backend.hs+1−5 lib/route/src/Obelisk/Route.hs+12 lib/run/src/Obelisk/Run.hs+3−1
lib/backend/src/Obelisk/Backend.hs+1−5
@@ -123,11 +123,7 @@ getPageName :: (MonadSnap m) => m PageName
123123getPageName = do
124124 p <- getsRequest rqPathInfo
125125 q <- getsRequest rqQueryString
126− let pageNameEncoder' :: Encoder Identity Identity PageName (String, String)
127− pageNameEncoder' = bimap
128− (unpackTextEncoder . pathSegmentsTextEncoder . listToNonEmptyEncoder)
129− (unpackTextEncoder . queryParametersTextEncoder . toListMapEncoder)
130− return $ decode pageNameEncoder' (T.unpack (decodeUtf8 p), T.unpack (decodeUtf8 q))
126+ return $ byteStringsToPageName p q
131127
132128getRouteWith :: (MonadSnap m) => Encoder Identity parse route PageName -> m (parse route)
133129getRouteWith e = do
lib/route/src/Obelisk/Route.hs+12
@@ -91,6 +91,7 @@ module Obelisk.Route
9191 , dmapEncoder
9292 , fieldMapEncoder
9393 , jsonEncoder
94+ , byteStringsToPageName
9495 ) where
9596
9697import Prelude hiding ((.), id)
@@ -103,6 +104,7 @@ import Control.Category.Associative
103104import Control.Category.Monoidal
104105import Control.Lens (Identity (..), Prism', makePrisms, itraverse, imap, prism, (^.), re, matching, (^?), _Just, _Nothing, Iso', from, view, Wrapped (..))
105106import Control.Monad.Except
107+import qualified Data.ByteString as BS
106108import qualified Data.ByteString.Lazy as BSL
107109import Data.Dependent.Sum (DSum (..))
108110import Data.Dependent.Map (DMap)
@@ -953,4 +955,14 @@ jsonEncoder = unsafeEncoder $ do
953955 Right x -> return x
954956 }
955957
958+-- Useful for app server integration.
959+-- p must not start with slashes
960+byteStringsToPageName :: BS.ByteString -> BS.ByteString -> PageName
961+byteStringsToPageName p q =
962+ let pageNameEncoder' :: Encoder Identity Identity PageName (String, String)
963+ pageNameEncoder' = bimap
964+ (unpackTextEncoder . pathSegmentsTextEncoder . listToNonEmptyEncoder)
965+ (unpackTextEncoder . queryParametersTextEncoder . toListMapEncoder)
966+ in decode pageNameEncoder' (T.unpack (decodeUtf8 p), T.unpack (decodeUtf8 q))
967+
956968--TODO: decodeURIComponent as appropriate
lib/run/src/Obelisk/Run.hs+3−1
@@ -20,8 +20,10 @@ import Control.Exception
2020import Control.Lens ((%~), (^?), _Just, _Right)
2121import qualified Data.Attoparsec.ByteString.Char8 as A
2222import Data.ByteString (ByteString)
23+import qualified Data.ByteString as BS
2324import qualified Data.ByteString.Char8 as BSC
2425import qualified Data.ByteString.Lazy.Char8 as BSLC
26+import Data.Char (ord)
2527import Data.Dependent.Sum (DSum (..))
2628import Data.Functor.Identity
2729import Data.Functor.Sum
@@ -146,7 +148,7 @@ obeliskApp configs opts frontend validFullEncoder uri backend = do
146148 let jsaddleUri = BSLC.fromStrict $ URI.renderBs $ uri & uriPath %~ (<>[jsaddlePath])
147149 Right (jsaddleWarpRouteValidEncoder :: Encoder Identity (Either Text) (R JSaddleWarpRoute) PageName) <- return $ checkEncoder jsaddleWarpRouteEncoder
148150 jsaddle <- jsaddleWithAppOr opts entryPoint $ \_ sendResponse -> sendResponse $ W.responseLBS H.status500 [("Content-Type", "text/plain")] "obeliskApp: jsaddle got a bad URL"
149− return $ \req sendResponse -> case tryDecode validFullEncoder (W.pathInfo req, mempty) of --TODO: Query strings
151+ return $ \req sendResponse -> case tryDecode validFullEncoder $ byteStringsToPageName (BS.dropWhile (== (fromIntegral $ ord '/')) $ W.rawPathInfo req) (BS.drop 1 $ W.rawQueryString req) of
150152 Identity r -> case r of
151153 InR (ObeliskRoute_Resource ResourceRoute_JSaddleWarp) :=> Identity jsaddleRoute -> case jsaddleRoute of
152154 JSaddleWarpRoute_JavaScript :/ () -> sendResponse $ W.responseLBS H.status200 [("Content-Type", "application/javascript")] $ jsaddleJs' (Just jsaddleUri) False