I am using the Snap information and I was wondering if there was some type of Request function ( such as ::Request -> IO Snap() or ::Request -> Handler App App()) that returns the OS or Browser information of the user visiting the webpage.
I would like to get the OS and Browser information of the person who is visiting the webpage.
You can get the User-Agent HTTP header via getHeader, because Request has a HasHeaders instance.
Example snippet:
import qualified Data.ByteString.Char8 as CS
import qualified Data.CaseInsensitive as CI
import Data.Maybe (listToMaybe)
uaName :: ByteString
uaName = CS.pack "User-Agent"
-- You can avoid CS.pack with OverloadedStrings extension.
uahName :: CI ByteString
uahName = CI.mk uaName
-- OverloadedStrings also gets rid of the CI.mk call.
getUserAgent :: Request -> Snap (Maybe ByteString)
getUserAgent rq = return . coerce $ getHeader uahName rq
where
coerce :: Maybe [ByteString] -> Maybe ByteString
coerce = (>>= listToMaybe)
-- Some HTTP headers can appear multiple times, hence the list.
-- `coerce` ignores all but the first occurrence.
For more detailed / less voluntary information, you could inject JS into an initial request and set cookies that can be extracted with rqCookies in a lter request.
Related
I'm serving an API using Servant, all managed by Snap. In Servant, it's easy to include an arbitrary data type as part of a POST request, assuming it has a FromJSON instance. For instance, I might have the following endpoint:
ReqBody '[JSON] RequestData :> Post '[JSON] [ResponseData]
How do I do the same for GET requests? From what I understand, I'd need to use the Query Parameters, but my request data consists of complex datatypes (lists, nested dictionaries) that don't seem to be readable easily, e.g. QueryParam "vals" [Int] :> Post '[JSON] [Int] results in the error No instance for (FromHttpApiData [Int])
A workaround would be to use POST requests, which have easily readable request bodies. However, this would clash with my caching scheme in Nginx, since responses to POST requests aren't that easily cachable. Even if I can cache them, I don't want to cache all post requests, so it'd be a messy approach.
Thanks for any help!
A simple solution if you want the same level of automatic derivation as for JSON post bodies is to just send the query params as JSON
import Data.Aeson
import Servant.API
import qualified Data.Text as T
import Data.Text.Encoding
import qualified Data.ByteString.Lazy as LBS
newtype JSONEncoded a = JSONEncoded { unJSONEncoded :: a }
deriving (Eq, Show)
instance (FromJSON a) => FromHttpApiData (JSONEncoded a) where
parseQueryParam x = case eitherDecode $ LBS.fromStrict $ encodeUtf8 x of
Left err -> Left (T.pack err)
Right val -> Right (JSONEncoded val)
instance (ToJSON a) => ToHttpApiData (JSONEncoded a) where
toQueryParam (JSONEncoded x) = decodeUtf8 $ LBS.toStrict $ encode 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!
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.
I want to download the content of the URL
http://example.com/foobar?key1=value1&key2=value2
using http-conduit (GET request).
How can I do that:
a) Assuming I already know the full (i.e. encoded URL)
b) If some parameters are dynamic and therefore not URL-encoded?
Note: This question was answered Q&A-style and therefore intentionally does not show any research effort.
Regarding a):
You can use simpleHttp with an URL containing query parameters just like the example in the docs:
{-# LANGUAGE OverloadedStrings #-}
import Network.HTTP.Conduit
import qualified Data.ByteString.Lazy as LB
main :: IO ()
main =
simpleHttp "http://example.com/foobar?key1=value1&key2=value2" >>= LB.putStr
Regarding b):
You need a list of key/value tuples of type [(ByteString, Maybe ByteString)] that contains your query parameters.
{-# LANGUAGE OverloadedStrings #-}
import Network.HTTP.Conduit
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy.Char8 as LB
queryParams :: [(ByteString, Maybe ByteString)]
queryParams = [
("key1", Just "value1"),
("key2", Just "value2")]
main :: IO ()
main = do
request <- parseUrl "http://example.com/foobar"
let request' = setQueryString queryParams request
response <- withManager $ httpLbs request'
LB.putStrLn $ responseBody response
Note: This requires at least http-conduit 2.1.
Also note that it is recommended to reuse Manager instances where applicable.
I'm trying to understand how to write a web service using warp that has a long lived resource that I want access to from all my requests (i.e. I want the resource to exist for the life time of server, not per request). I'm assuming this is a use for ResourceT, but I'm unsure how I actually do this.
My particular use is that I want to expose a file handle, that I currently have wrapped up in the state monad. I'm happy to change this approach, if this doesn't make sense when using warp and ResourceT. An early version of this code can be seen on code review: https://codereview.stackexchange.com/questions/9177/my-simple-haskell-key-value-file-store
Thanks in advance,
Matt
The most obvious way is to pass the file handle in as a parameter to the Application.
import Control.Monad.Trans (liftIO)
import Data.ByteString.Lazy as Bl
import Network.HTTP.Types
import Network.Wai
import Network.Wai.Handler.Warp as Warp
import System.IO
doSomethingWithAFileHandle :: Handle -> IO ()
doSomethingWithAFileHandle =
undefined -- insert your logic here
app :: Handle -> Application
app h req = do
let headers = []
body = Bl.empty
liftIO $ doSomethingWithAFileHandle h
return $! responseLBS ok200 headers body
main :: IO ()
main =
-- get some file handle
withBinaryFile "/dev/random" ReadMode $ \ h ->
-- and then partially apply it to get an Application
Warp.run 3000 (app h)