What I'm trying to do is to create a somewhat smart reverse proxy server that should process some requests on its own and forward the others to the backend of choice. To make it challenging I'm trying hard to do it in Haskell, which I am a total newbie in.
Here's the code I've come up so far:
{-# LANGUAGE OverloadedStrings #-}
import Control.Applicative
import Data.ByteString
import Network.HTTP.ReverseProxy
import Network.HTTP.Types
import Network.Wai
import Network.Wai.Handler.Warp
import Network.Wai.Middleware.RequestLogger
import qualified Network.HTTP.Client as HC
helloApp :: Application
helloApp req respond =
respond $ responseLBS status200 [("Content-Type", "text/plain")] "Hello"
proxyStubApp :: Application
proxyStubApp req respond =
respond $ responseLBS status200 [("Content-Type", "text/plain")] "You've hit the stub"
proxyApp :: IO Application
proxyApp = do
manager <- HC.newManager HC.defaultManagerSettings
return $ waiProxyTo (const $ return $ WPRProxyDest ProxyDest { pdHost = "localhost", pdPort = 9393 }) defaultOnExc manager
app :: Application
app req respond =
serve req respond
where serve = lookupServeFunction req
lookupServeFunction :: Request -> Application
lookupServeFunction req
| isInfixOf "sample_path" (rawPathInfo req) = proxyStubApp
| otherwise = helloApp
main = run 3011 =<< (logStdoutDev <$> return app)
It works fine, but when I exchange proxyStubApp for actual proxyApp I am forced to add IO all over the place. Particularly it gets added to app, consequently leaving me with the following compilation error message:
Couldn't match expected type ‘Request -> t5 -> t4’
with actual type ‘IO Application’
The equation(s) for ‘app’ have two arguments,
but its type ‘IO Application’ has none
I feel like I understand why it is happening, but I'm out of ideas of how to cope with it :( Or am I doing something totally wrong?
Thank you!
P.S. Here are the dependencies should you want to compile the thing on your own: wai warp http-types text bytestring wai-extra time http-reverse-proxy http-client
The IO in IO Application is kind-of redundant. Note that
type Application = Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived
so, expanding proxyApp's arguments (what you already do in proxyStubApp), you get
proxyApp :: Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived
proxyApp req continuation = do
manager <- HC.newManager HC.defaultManagerSettings
waiProxyTo (...) req respond
That works, because in either case
proxyApp :: IO Application
proxyApp = do
manager <- HC.newManager ...
...
and
proxyApp :: Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived
proxyApp req continuation = do
manager <- HC.newManager ...
...
the IO action HC.newManager ... is "run within IO".
You may find it conceptually clearer to construct an Application in IO and hand it to some other place, and I won't argue with you. I want to note though, that you choose the Application based on the Request, so in a way you are in the hypothetical HTTP monad when choosing, so lookupServeFunction's signature Request -> Application makes more sense to me.
If you want to keep that type signature for proxyApp,
lookupServeFunction and app will have to be in IO as well and main will have to change accordingly, e.g.
myApp <- app
...
As haoformayor said, It is generally easier to work without the outer IO layer.
You might also like to simplify main.
fmap logStdoutDev (return app)
is the same as
return (logStdoutDev app)
and
run 3011 =<< return (logStdoutDev app)
is the same as
run 3011 (logStdoutDev app)
You might want to install hlint, which will help you spot these.
Related
Visualize a bytestring body on a webserver run on Spock (localhost for instance)
My goal : create website and view a bytestring (converted to text)
Framework: Http Simple for performing request to restAPI
Spock for my server
I don't want for instance to create a JSON as I need to manipulate/inspect my response before creating a JSON structure. General idea is that I want to use the response body to construct a JSON query structure (the user will be able to compose his question) that will be sent to the restAPI website.
I manage to build a request like this:
connect = do
request' <- (parseRequest "http://localhost")
let request = setRequestMethod "POST"
$ setRequestHost (S8.pack ("xx.xxx.xxx.xxx"))
$ setRequestPath "/api/Integration/Login"
$ setRequestBodyJSON me
$ setRequestPort 1000
$ request'
response <- httpJSON request
return (getResponseBody response :: Auth)
then I used it to query the API page
getRequest :: RequestPath -> HtmlT IO L.ByteString
getRequest rpath = do
atoken <- liftIO connect
request' <- liftIO (parseRequest "http://localhost")
let request = setRequestMethod "POST"
$ setRequestHost (S8.pack ("xx.xxx.xxx.xxx"))
$ setRequestPort 1000
$ setRequestPath (S8.pack ("/api/Integration/" ++ rpath))
$ addRequestHeader hAuthorization (S8.pack (unpack (token_type (atoken)) ++ " " ++ unpack (access_token (atoken))))
$ setRequestBodyJSON r1
$ request'
response <- httpLBS request
return (getResponseBody (response))
then I follow with a short SpockM monad:
app1 = do get root $ text "root"
fct
with fct equal to
fct = do get "/further" $ lucidIO ( fmap TL.decodeUtf8 (getRequest "GetProperties"))
Everything compile fine I am even able to see the result in GHCI with invocation like : connect >>= (\ x -> print x) (same with getRequest "GetProperties" )
What I don't understand is that lucidIO should give me a ActionCtxtT ctx m b type, which perfectly fit the type of a handler (for example like the text function in the do get ... $ text -> ActionCtxT ctx m a) and should be processed by the spock function in main() ie runSpock 8080 (spock spockCfg app1)
I tried to get rid of the ByteString 'ending' type replacing it with a () in order to mimic as close as possible the Html () type which shows up and work in lot of examples I studied.
All parsing and request building is done with the HTTP.Simple (it's not very elegant I know for instance it just have to work) which pulls me from start in a monad (due to the first function 'parseRequest' -> m Request) from which I cannot escape until lucidIO - may be I am choosing the wrong Monad (ie IO : but with IO I am able to check everything in ghci). Could you give me some hints on how to get this ByteString printed in my browser?
So finally I achieve what I was looking for - woua I am really proud of me ...
Okay for those who will look for the same thing, what I've manage to do, to recap my main problem was to escape the IO monad (my choice may be not clever but still) in which I was stuck due to the use of request parsers from HTTP.simple library.
My code change a little bit but the general idea stays the same:
building a Response query:
getResponseMethod :: RequestPath -> RequestBody -> IO (Maybe Value)
from which thanks to the decode function (aeson package) a Maybe Value is obtained (wrapped in IO but that's okay)
then my little spock server:
main :: IO ()
main = do
spockCfg <- defaultSpockCfg () PCNoDatabase ()
runSpock 8080 (spock spockCfg app)
I work a lot to have the right app -> SpockM () () () ()
I started with the simplest app we could imagine:
app = do get root $ text "Hello!"
noticing that the text function is producing a MonadIO m => ActionCtxT cxt m a monad so my thought was that if I 'sprinkle' some clever LiftIO thing it should do the job.
I create a helper function:
extrct :: MonadIO m => ActionCtxT ctx m Text
extrct = liftIO $ do
a <- getResponseMethod "GetProperties" r1
return (pack $ show a)
and with a twist of hand adjust my app
app :: SpockM () () () ()
app = do get root $ do
a <- extrct
text a
and finally I was able to see the string representation of the Maybe Value :: JSON on my spock local webserver. That's what I was looking for. Now I can work on cleaning my code. From what I understand using liftIO will place the IO monad in the rigth place in the Monad Stack that's because IO is always at the bottom?
I'm writing a wrapper around a Warp server where users can specify routes and handlers to make a web server. I decided to try using Continuation Monads to allow handlers to exit using a continuation when a route matches.
Here are the types and definitions I'm starting with:
import Control.Monad.Cont
import Control.Monad.Reader
import qualified Network.Wai as W
import qualified Data.Text as T
type App r a = ContT r (ReaderT W.Request IO) a
type Handler a = ReaderT W.Request IO a
type Respond = ((Status, T.Text) -> App (Status, T.Text) ())
route :: T.Text -> Handler (Status, T.Text) -> Respond -> App (Status, T.Text) ()
route routePath handler respond = do
liftIO $ print $ "Checking" `T.append` routePath
pth <- path
when (routePath == pth) $ do
req <- ask
response <- liftIO $ runReaderT handler req
respond response
An app is a collection of routes, each route reads the current continuation from the Reader environment; I originally wrote it like this:
hello :: Handler (Status, T.Text)
hello = return (ok200, "Hello World!")
goodbye :: Handler (Status, T.Text)
goodbye = return (ok200, "Goodbye World!")
app :: Respond -> App (Status, T.Text) ()
app = do
route "/hello" hello
route "/goodbye" goodbye
Strangely this doesn't seem to work, it only prints "Checking /goodbye"; however if we instead write the reader in the next form it works properly, as far as I was aware these two definitions should be equivalent; but apparently I'm missing something:
app :: Respond -> App (Status, T.Text) ()
app resp = do
route "/hello" hello resp
route "/goodbye" goodbye resp
Is there any way I can get the proper behaviour using the original app definition? Is there some way that the Reader Monad is messing up the continuations somehow?
I suspect that somehow the monad definition for reader is interrupting the order of computation; but it's not clear to me how:
instance Monad ((->) r) where
f >>= k = \ r -> k (f r) r
Thanks!
I try to return a uuid within a route definition for a web app (Spock Webserver).
A route is pretty simple to define
get("PATH") $ do
text "Hello World"
Now I try to return a uuid via nextRandom from the Data.UUID.V1 module.
The function returns a IO(Maybe UUID) value.
So I thought, since I am in IO and work with another IO I have to do bind the value simply with <-, like so:
get ("id") $ do
uuid<-nextUUID
json . pack $ show $ uuid
But the compiler says no:
Couldn't match type ‘ActionCtxT ctx0 m0’ with ‘IO’
Expected type: IO b0
Actual type: ActionCtxT ctx0 m0 b0
• In a stmt of a 'do' block: json . pack $ show $ uuid
In the second argument of ‘($)’, namely
‘do { uuid <- nextUUID;
json . pack $ show $ uuid }’
Why is it throwing that error?
I could easily create the uuid with a simple print example, but within Spock I don't understand what the ActionCtxT does and why I can't do the uuid IO in it.
So I thought, since I am in IO and work with another IO
That's the trouble here, when you're routing in Spock, you're not in IO. The error message tells you what context you're really in: ActionCtxT ctx0 m0. According to the docs, that's a monad transformer stack that bundles effects and state.
You can "lift" an IO computation into the right type using liftIO.
get ("id") $ do
uuid <- liftIO nextUUID
json . pack $ show $ uuid
Based on Libbys helpful answer I just added the catch for the Nothing of the Maybe UUID. Here the full programm:
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Web.Spock hiding (head)
import Web.Spock.Config
import Data.UUID.V1
import Data.Pool
import Control.Monad.IO.Class
import Database.PostgreSQL.Simple
import Data.Aeson (Value(Null))
import qualified Network.HTTP.Types.Status as Http
type AppAction a = SpockActionCtx () Connection AppSession AppState a
data AppState = EmptyState
data AppSession = EmptySession
main :: IO ()
main =
do pool<-createPool (connect (ConnectInfo "localhost" 5432 "" "" "envelopes") ) close 1 10 10
spockCfg <- defaultSpockCfg EmptySession (PCPool pool) EmptyState
runSpock 8080 (spock spockCfg app)
app :: SpockM Connection AppSession AppState ()
app = do
get ("json/id") $ do
uuid<-liftIO nextUUID
case uuid of
Nothing -> do
setStatus Http.status500
json Null
Just x -> json $ show x
I am following the basic dispatching section of wai application.
I am able to catch the url parameter. How can I perform IO operation using these params.
I would like to use runCommand of System.Process to execute a system command using these parameters.
:t runCommand give
runCommand :: String -> IO ProcessHandle
my Main.hs
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Control.Monad
import Network.Wai
import Network.HTTP.Types
import Network.Wai.Handler.Warp (run)
import Data.ByteString
import Control.Monad
import System.Process
import qualified Data.ByteString.Lazy.Char8 as L8
main :: IO ()
main = do
run 8080 app
app :: Application
app request respond = respond $ case rawPathInfo request of
"/" -> indexHtml
"/wake" -> wakeMeUP request
_ -> fourNotFour
indexHtml :: Response
indexHtml = responseFile
status200
[("Content-Type","text/html")]
"index.html"
Nothing
wakeMeUP :: Request -> Response
wakeMeUP request =
let query = queryString request
hour = join $ lookup "hour" query
min = join $ lookup "min" query
--I would like to use runCommand "using hour and min variables"
in responseLBS
status200
[("Content-Type","text/plain")]
"Alarm set at...to be coded later"
fourNotFour :: Response
fourNotFour = responseLBS
status404
[("Content-Type","text/plain")]
"404 not found"
Your design prevents it, because of how you have written app,
app request respond = respond $ case rawPathInfo request of
which says that you immediately respond. Note the type of Application:
type Application = Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived
Since the result type has an IO, you have the opportunity to do I/O before yielding a value. So you could:
app request respond = do
whateverResult <- runCommand "whatever"
respond $ ...
(You could also do it afterward, at least according to the types:
app request respond = do
rcvd <- respond $ ...
runCommand "whatever"
return rcvd
Though that's a bit odd to do for the continuation-passing idiom being used here (the (a -> b) -> b pattern in the Application type). It means that the command will be run after everything else, for some definition of "everything else" that we can't know without reading the wai source.)
Anyway, you probably don't want the command to be run inside app, but rather in wakeMeUp, which means you need to change some types around. In particular,
wakeMeUp :: Request -> IO Response
-- ^^
and suitably monadify the function. Then your app needs to not call respond immediately, so you can say
app request respond =
response <- case rawPathInfo request of
"/" -> return indexHtml
-- ^^^^^^
"/wake" -> wakeMeUp request
-- no change, because wakeMeUp now has an IO return type
...
respond response
If this is gibberish to you, it's time to do some monad tutorials. Or if you just want to get the damn thing working, I recommend Dan Piponi's The IO Monad For People who Simply Don't Care. Happy hacking!
In the question Web, Scotty: connection pool as monad reader it is shown how to use ScottyT to embed a Reader monad in the stack to access a static configuration (in that case, a connection pool).
I have a similar question, but simpler – or at least I thought so…
I want to add a Reader to a single handler (i.e. a ActionT), not the whole app.
I started modifying the program from the question above, but I cannot figure out how to turn an ActionT Text (ReaderT String IO) into the ActionT Text IO the handler needs to be. After fumbling around and trying to use typed holes hoping to see how to construct this I have to give up for now and ask for help. I really feel this should be simple, but cannot figure out how to do this.
Here's the program, with the lines where I'm stuck highlighted:
{-# LANGUAGE OverloadedStrings #-}
import qualified Data.Text.Lazy as T
import Data.Text.Lazy (Text)
import Control.Monad.Reader
import Web.Scotty.Trans
type ActionD = ActionT Text (ReaderT String IO)
main :: IO ()
main = do
scottyT 3000 id id app
-- Application
app :: ScottyT Text IO ()
app = do
get "/foo" $ do
h <- handler -- ?
runReaderT h "foo" -- ?
--get "/bar" $ do
-- h <- handler
-- runReaderT h "bar"
-- Route action handler
handler :: ActionD ()
handler = do
config <- lift ask
html $ T.pack $ show config
If you want to run each action in a separate reader, you don't need the more complex Scotty.Trans interface at all. You can just build you monad stack the other way around, with ReaderT on top.
import qualified Data.Text.Lazy as T
import Control.Monad.Reader
import Web.Scotty
type ActionD = ReaderT String ActionM
main :: IO ()
main = do
scotty 3000 app
-- Application
app :: ScottyM ()
app = do
get "/foo" $ do
runReaderT handler "foo"
-- Route action handler
handler :: ActionD ()
handler = do
config <- ask
lift $ html $ T.pack $ show config