caa6b5c · obelisk · git.iko.soy

git.iko.soy/obelisk

on master help sign in

fix route parsing in `ob run`

caa6b5cDan Bornside7 years ago

lib/backend/src/Obelisk/Backend.hs+1−5

compare with master

unifiedsplit

@@ -123,11 +123,7 @@ getPageName :: (MonadSnap m) => m PageName

123getPageName = do

124 p <- getsRequest rqPathInfo

125 q <- getsRequest rqQueryString

126− let pageNameEncoder' :: Encoder Identity Identity PageName (String, String)

126+ return $ byteStringsToPageName p q

127− pageNameEncoder' = bimap

128− (unpackTextEncoder . pathSegmentsTextEncoder . listToNonEmptyEncoder)

129− (unpackTextEncoder . queryParametersTextEncoder . toListMapEncoder)

130− return $ decode pageNameEncoder' (T.unpack (decodeUtf8 p), T.unpack (decodeUtf8 q))

131

127

132getRouteWith :: (MonadSnap m) => Encoder Identity parse route PageName -> m (parse route)

128getRouteWith :: (MonadSnap m) => Encoder Identity parse route PageName -> m (parse route)

133getRouteWith e = do

129getRouteWith e = do

lib/route/src/Obelisk/Route.hs+12

@@ -91,6 +91,7 @@ module Obelisk.Route

91 , dmapEncoder

92 , fieldMapEncoder

93 , jsonEncoder

94+ , byteStringsToPageName

94 ) where

95 ) where

96import Prelude hiding ((.), id)

97import Prelude hiding ((.), id)

@@ -103,6 +104,7 @@ import Control.Category.Associative

103import Control.Category.Monoidal

104import Control.Category.Monoidal

104import Control.Lens (Identity (..), Prism', makePrisms, itraverse, imap, prism, (^.), re, matching, (^?), _Just, _Nothing, Iso', from, view, Wrapped (..))

105import Control.Lens (Identity (..), Prism', makePrisms, itraverse, imap, prism, (^.), re, matching, (^?), _Just, _Nothing, Iso', from, view, Wrapped (..))

105import Control.Monad.Except

106import Control.Monad.Except

107+import qualified Data.ByteString as BS

106import qualified Data.ByteString.Lazy as BSL

108import qualified Data.ByteString.Lazy as BSL

107import Data.Dependent.Sum (DSum (..))

109import Data.Dependent.Sum (DSum (..))

108import Data.Dependent.Map (DMap)

110import Data.Dependent.Map (DMap)

@@ -953,4 +955,14 @@ jsonEncoder = unsafeEncoder $ do

953 Right x -> return x

955 Right x -> return x

954 }

956 }

955

957

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+

956--TODO: decodeURIComponent as appropriate

968--TODO: decodeURIComponent as appropriate

lib/run/src/Obelisk/Run.hs+3−1

@@ -20,8 +20,10 @@ import Control.Exception

20import Control.Lens ((%~), (^?), _Just, _Right)

21import qualified Data.Attoparsec.ByteString.Char8 as A

22import Data.ByteString (ByteString)

23+import qualified Data.ByteString as BS

23import qualified Data.ByteString.Char8 as BSC

24import qualified Data.ByteString.Char8 as BSC

24import qualified Data.ByteString.Lazy.Char8 as BSLC

25import qualified Data.ByteString.Lazy.Char8 as BSLC

26+import Data.Char (ord)

25import Data.Dependent.Sum (DSum (..))

27import Data.Dependent.Sum (DSum (..))

26import Data.Functor.Identity

28import Data.Functor.Identity

27import Data.Functor.Sum

29import Data.Functor.Sum

@@ -146,7 +148,7 @@ obeliskApp configs opts frontend validFullEncoder uri backend = do

146 let jsaddleUri = BSLC.fromStrict $ URI.renderBs $ uri & uriPath %~ (<>[jsaddlePath])

148 let jsaddleUri = BSLC.fromStrict $ URI.renderBs $ uri & uriPath %~ (<>[jsaddlePath])

147 Right (jsaddleWarpRouteValidEncoder :: Encoder Identity (Either Text) (R JSaddleWarpRoute) PageName) <- return $ checkEncoder jsaddleWarpRouteEncoder

149 Right (jsaddleWarpRouteValidEncoder :: Encoder Identity (Either Text) (R JSaddleWarpRoute) PageName) <- return $ checkEncoder jsaddleWarpRouteEncoder

148 jsaddle <- jsaddleWithAppOr opts entryPoint $ \_ sendResponse -> sendResponse $ W.responseLBS H.status500 [("Content-Type", "text/plain")] "obeliskApp: jsaddle got a bad URL"

150 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

150 Identity r -> case r of

152 Identity r -> case r of

151 InR (ObeliskRoute_Resource ResourceRoute_JSaddleWarp) :=> Identity jsaddleRoute -> case jsaddleRoute of

153 InR (ObeliskRoute_Resource ResourceRoute_JSaddleWarp) :=> Identity jsaddleRoute -> case jsaddleRoute of

152 JSaddleWarpRoute_JavaScript :/ () -> sendResponse $ W.responseLBS H.status200 [("Content-Type", "application/javascript")] $ jsaddleJs' (Just jsaddleUri) False

154 JSaddleWarpRoute_JavaScript :/ () -> sendResponse $ W.responseLBS H.status200 [("Content-Type", "application/javascript")] $ jsaddleJs' (Just jsaddleUri) False