Scotty and POST params - haskell

I'm having an issue with the Scotty web server right now - rescue isn't working for unfound parameters - I'm still getting a 404 with the following code:
post "/newsletter/create" ( do
(param "subscriber[email]") `rescue` (\msg -> text msg)
formContent <- param "subscriber[email]"
text $ "found! " ++ show formContent )
I can see that when I just use params instead, my data is there, and indexed with "subscriber[email]". Is there something going on with [ escaping? Any help with this would be tremendous.

With some cleanup I got it to work:
{-# LANGUAGE OverloadedStrings #-}
import Web.Scotty
import qualified Data.Text.Lazy as TL
main = scotty 3000 $ do
post "/newsletter/create" $ do
formContent <- (param "subscriber[email]") `rescue` (\msg -> return msg)
text $ "found! " `TL.append` formContent
I made a bunch of modifications, but the key point was that rescue is used as a wrapper around param, not to change any internal state, hence you shouldn't call it twice. The square brackets didn't cause me any trouble.

Related

Haskell Proxy Post request

I have following code working with proxy for a GET Request:
import Control.Applicative ((<$>))
import Data.Maybe (fromJust)
import Network.Browser
import Network.HTTP
import Network.HTTP.Proxy (parseProxy)
main = do
rsp <- browse $ do
setProxy . fromJust $ parseProxy "127.0.0.1:8118"
request $ getRequest "http://www.google.com"
print $ rspBody <$> rsp
And this one for Post, but without proxy:
main = do
r <- post "http://www.geocodeip.com" ["IP" := Data.ByteString.Lazy.Char8.pack "79.212.82.103"]
html <- r ^. responseBody
print html
But how to make a post request with proxy? I dont get it. please help me!
It's pretty simple if you keep track of what you're doing.
We need to use request but feed it a POST request rather than a GET request. To make these we use postRequestWithBody which Hackage tells us has the parameters
postRequestWithBody :: String | URL to POST to
-> String | Content-Type of body
-> String | The body of the request
-> Request_String | The constructed request
So replace request $ getRequest "http://www.google.com" with:
request $ postRequestWithBody "http://www.geocodeip.com/" "application/x-www-form-urlencoded" "IP=79.212.82.103"
...and you'll be good.

How to use warp-tls instead of warp with scotty?

I need to start my scotty application with warp-tls instead of plain warp server but is seems running warp is hardwired in scotty's source code. Am I missing something obvious?
You can use the scottyApp function instead of scotty, to get a WAI Application which you can pass to warp's runTLS:
{-# LANGUAGE OverloadedStrings #-}
import Network.Wai.Handler.WarpTLS (runTLS, tlsSettings)
import Network.Wai.Handler.Warp (defaultSettings, setPort)
import Network.Wai.Middleware.RequestLogger (logStdoutDev)
import Web.Scotty
main :: IO ()
main = do
let tlsConfig = tlsSettings "your.crt" "your.key"
config = setPort 3443 defaultSettings
waiApp <- scottyApp $ do
get "/" (text "hello")
get "/hello" (text "hello again")
runTLS tlsConfig config (logStdoutDev waiApp)

Yesod book example chat and scaffolding

I'm trying to make the chat example from the Yesod book working in the scaffolding site.
I think I've corrected almost all I had to correct, but all of that is completely new to me (it's my first "real" Haskell project) and I'm not very confident in all my modifications; moreover, I'm really stuck at the point 7. Could you comment all the following points if necessary, and helping me for the 7. (in bold some questions/remarks)?
Copy/paste the Chat.hs and Chat/Data.hs in the root of my site,
add import Chat as Import and import Chat.Data as Import to Import.NoFoundation,
add import of IO, Bool, return, Maybe(Nothing), ($) in Data.hs, since the extension NoImplicitPrelude is on Seems very clumsy... Do we have to import all the standard operators on each new file?
in Fundation.hs, add getChat in the App record (after appHttpManager and appLogger)
in Fundation.hs, add YesodChat instance for App: I had to modify the getUserName on the Just uid case (in the original example of Chat, it was just Just uid -> return uid):
Just uid -> do
muser <- runDB $ get uid
case muser of
Nothing -> error "uid not in the DB"
Just user -> return $ userIdent user
This seems very long and nested... Can we do better?
In Fundation.hs, add chatWidget ChatR after the line pc <- widgetToPageContent $ do in the defaultLayout definition.
Now, I have the following warning :
Application.hs:60:36: Warning:
Fields of ‘App’ not initialised: getChat
In the expression: App {..}
I think I have to write something like getChat <- newChan >>=Chat after the appLogger <- newStdoutLoggerSet defaultBufSize >>= makeYesodLogger and appStatic <- ... in the makeFundation definition, but the type doesn't match. I'm a totally lost here, I don't really understand how this function makeFundation works.
You actually got almost the entire way there. I think you just need to change the line to:
getChat <- fmap Chat newChan
Alternatively, if you're not familiar with he fmap function yet, you can use do notation and get:
chan <- newChan
let getChat = Chat chan

How to log the real IP address when behind a proxy using Scotty / wai

This is my scotty app, notice how I am logging requests to the console:
{-# LANGUAGE OverloadedStrings #-}
import Web.Scotty
import Network.Wai.Middleware.RequestLogger
import Data.Monoid (mconcat)
main = scotty 3000 $ do
--log requests to console
middleware logStdoutDev
get "/:word" $ do
beam <- param "word"
html $ mconcat ["<h1>Scotty, ", beam, " me up!</h1>"]
My scotty app runs behind nginx using the proxy mechanism. This causes the scotty app to log like this:
127.0.0.1 - - [27/Aug/2014:15:12:00 +0000] "GET / HTTP/1.0" 200 - ...
I want the REAL IP ADDRESS to be logged.
I had the same issue in my Node.js/Express apps, where I solved it like this:
Express.js: how to get remote client address
How do I solve this problem in Scotty?
There's an IPAddrSource data type in wai-extra which originates in the wai-logger package. So, if you want the IP address to come from a header, it looks like you can do something like:
{-# LANGUAGE OverloadedStrings #-}
import Web.Scotty
import Network.Wai.Middleware.RequestLogger
import Control.Monad.IO.Class
import Data.Monoid (mconcat)
import Data.Default
main = scotty 3000 $ do
--log requests to console
logger <- liftIO $ mkRequestLogger def { outputFormat = Apache FromHeader }
middleware logger
get "/:word" $ do
beam <- param "word"
html $ mconcat ["<h1>Scotty, ", beam, " me up!</h1>"]
From the description, it also looks like Apache FromFallback will check the headers first, and use the socket IP address if no header is found.
Update
You can also just create the logger outside the scotty function:
main = do
logger <- mkRequestLogger def { outputFormat = Apache FromHeader }
scotty 3000 $ do
middleware logger
get "/:word" $ do
beam <- param "word"
html $ mconcat ["<h1>Scotty, ", beam, " me up!</h1>"]

Signing temporary s3 upload URLs w/ Haskell

I'm trying to upload files from a web form directly to to Amazon S3 asynchronously. In order to do this I must authenticate the client request to upload files on the server.
By digitally signing an upload request w/ my AWS Secret key I can create a temporary authenticated URL that the client can use to upload files to a S3 bucket.
The amazon S3 docs specify that the signature must be generated by the following
Signature = URL-Encode( Base64( HMAC-SHA1( YourSecretAccessKeyID,
UTF-8-Encoding-Of( StringToSign ) ) ) );
I'm using Haskell on the server so my implementation looks like:
{-# LANGUAGE OverloadedStrings #-}
import qualified Data.ByteString.Base64.Lazy as B64
import qualified Data.Digest.Pure.SHA as SHA
import qualified Data.ByteString.Lazy.Char8 as BL8
sign :: BL8.ByteString -> BL8.ByteString
sign = B64.encode . SHA.bytestringDigest . SHA.hmacSha1 secret
where secret = "aws-secret-key"
The format of the amazon docs requires that StringToSign look like:
StringToSign = HTTP-VERB + "\n" +
Content-MD5 + "\n" +
Content-Type + "\n" +
Expires + "\n" +
CanonicalizedAmzHeaders +
CanonicalizedResource;
Another example from Amazon:
GET\n
\n
\n
1175139620\n
/johnsmith/photos/puppy.jpg
So my string looks like:
"PUT\n\n\n1384330538\n/bucketname/objname"
I sign the string above (w/ the sign function) and craft a url that looks like:
https://s3.amazonaws.com/bucketname/objname?AWSAccessKeyId=accessskey&Signature=signature=&Expires=1384330979
This is then sent to the client via an AJAX request before an upload. I have updated the CORS policy on the bucket as well to allow for PUT requests.
The problem is that every time I try to upload something with the above signed url I get this message (in an XML doc).
The request signature we calculated does not match the signature you
provided. Check your key and signing method.
So I'm not sure where I went wrong. Note: I can upload if I use the public url (https://s3.amazonaws.com/bucketname/objname) (but this shouldn't be, I only want users to upload blobs, not read nor delete, etc.)
As someone who's done this dance a lot, it's very difficult to build software that correctly signs an HTTP-digest authenticated request like this. In particular, if you rely only on the server response to guide you it will take a long time. For security purposes the servers are deliberately cryptic when rejecting you.
My best tip is to (a) get an alternative implementation that you know works and (b) build your Haskell interface to be pure so that it's easy to make it exactly replicate a request from that other framework and (c) make sure you can get both the exact request text and exact String-To-Sign from both the alternative framework and your own code. In particular, you'll often have to impute exact timestamps and nonces and pay close attention to percent encodings.
With these two tools just create a variety of successful requests from the alternative implementation and see if you can replicate the exact String-To-Sign and exact request text using your own framework.
Most often my own errors involved improper encoding, missing quotes, not including all of the proper parameters (or the wrong ones), or using the hmac function incorrectly.
here is my upload url code, i might have missed a couple of imports since i pulled it out of the deep.
{-# LANGUAGE OverloadedStrings, FlexibleContexts, TypeFamilies, DeriveDataTypeable, TemplateHaskell, QuasiQuotes #-}
import qualified Aws
import qualified Aws.Core as Aws
import qualified Aws.S3 as S3
import qualified Data.Text as T
import qualified Codec.Binary.Base64 as B64
import qualified Data.ByteString as BS
import Text.Shakespeare.Text(st)
import qualified Codec.Binary.Url as Url
import System.Posix.Time(epochTime)
import Crypto.MAC.HMAC(hmac)
import Crypto.Hash.SHA1(hash)
data Cfg = Cfg { baseCfg :: Aws.Configuration
, s3Cfg :: S3.S3Configuration Aws.NormalQuery
, s3Bucket :: S3.Bucket
}
uploadUrl :: Cfg -> T.Text -> T.Text -> IO T.Text
uploadUrl cfg mime filename = do
time <- epochTime
let expires = show $ time + 600
msg = E.encodeUtf8 $ [st|PUT
#{mime}
#{expires}
x-amz-acl:public-read
/#{s3Bucket cfg}/#{filename}|] --the gap is necessary
key = Aws.secretAccessKey $ Aws.credentials $ baseCfg cfg
accessid = T.pack $ Url.encode $ BS.unpack $ Aws.accessKeyID $ Aws.credentials $ baseCfg cfg
signature = encode . T.pack $ B64.encode $ BS.unpack $ hmac hash 64 key msg
encode = T.pack . Url.encode . BS.unpack . E.encodeUtf8
return $ [st|http://#{s3Bucket cfg}.s3.amazonaws.com/#{filename}?AWSAccessKeyId=#{accessid}&Expires=#{expires}&Signature=#{signature}|]

Resources