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

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)

Related

Warp / Scotty not terminating thread / resources at end of request

I'm running into an issue where my Scotty app does not seem to terminate old HTTP request threads. And eventually, after a large number (10-20) of concurrent requests, I run into an error with too many DB connections libpq: failed (FATAL: sorry, too many clients already).
{-# LANGUAGE OverloadedStrings #-}
import Web.Scotty
import Database.PostgreSQL.Simple
import Control.Monad.IO.Class
connection :: IO Connection
connection = connect defaultConnectInfo
{ connectHost = "localhost", connectUser="postgres", connectPassword="mysecretpassword" }
main :: IO ()
main = scotty 8000 $ do
get "/" $ do
c <- liftIO $ connection
text "test"
This also happens with a Warp application (which Scotty):
{-# LANGUAGE OverloadedStrings #-}
import Network.Wai
import Network.Wai.Handler.Warp (run)
import Network.HTTP.Types (status200)
import Network.HTTP.Types.Header (hContentType)
import Database.PostgreSQL.Simple
import Control.Monad.IO.Class
connection :: IO Connection
connection = connect defaultConnectInfo
{ connectHost = "localhost", connectUser="postgres", connectPassword="mysecretpassword" }
main = run 8000 app
app :: Application
app req respond = do
respond $ responseStream status200 [] $ \write flush -> do
print "test"
con <- connection
flush
write $ "World\n"
Why is this happening? Is there an simple way to "finalize" the request at the end?
I can manually close the connection, but ideally I think killing the thread with any other related resources would be ideal.
I've verified that it keeps the connection open by running the following in postgres:
SELECT sum(numbackends) FROM pg_stat_database;
Scotty seems to take a few seconds until it closes it automatically (after the request is completed).
postgresql-simple provides the close :: Connection -> IO () function which closes the connection and free associated resources. You need to close the connection after you are done with it.
But a common problem is the following: what happens if the code between opening and closing the connection throws an exception? How to ensure that the connection is closed even in that case, so that we don't leak connections?
In Haskell, this is solved using the bracket :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c function. You pass it an IO action that allocates some resource (in this case, a connection) a function that frees the allocated resource once we are we are done with it (in our case, the close function) and a function that says what we actually want to do with the allocated resource (in this case, perform a query).
bracket is somewhat similar to try-with-resources in Java or the "using" statement in C#.
Instead of opening and closing a connection on each request, a better approach would be so use some kind of connection pool shared between request threads. persistent-postgresql uses resource-pool for example.

Haskell websockets library not working

I was able to successfully use the websockets library with https://www.websocket.org/echo.html. I can also connect to api2.poloniex.com via https://www.websocket.org and successfully query the websocket.
However when I try to connect to api2.poloniex.com with websockets I get the following error:
Exception: MalformedResponse (ResponseHead {responseCode = 403, responseMessage = "Forbidden", responseHeaders = [("Date","Wed, 15 Aug 2018 00:27:10 GMT"),("Content-Type","text/html; charset=UTF-8"),("Transfer-Encoding","chunked"),("Connection","close"),("CF-Chl-Bypass","1"),("Set-Cookie","__cfduid=de2aa54a27d656c35f2c3b90f60cc72461534292830; expires=Thu, 15-Aug-19 00:27:10 GMT; path=/; domain=.poloniex.com; HttpOnly"),("Cache-Control","max-age=2"),("Expires","Wed, 15 Aug 2018 00:27:12 GMT"),("X-Frame-Options","SAMEORIGIN"),("Server","cloudflare"),("CF-RAY","44a788b174052eb7-MIA")]}) "Wrong response status or message."
My code is as follows:
{-# LANGUAGE OverloadedStrings #-}
module Main
( main
) where
import Control.Concurrent (forkIO)
import Control.Monad (forever, unless)
import Control.Monad.Trans (liftIO)
import Data.Aeson
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Network.Socket (withSocketsDo)
import qualified Network.WebSockets as WS
--------------------------------------------------------------------------------
app :: WS.ClientApp ()
app conn = do
putStrLn "Connected!"
-- Fork a thread that writes WS data to stdout
_ <- forkIO $ forever $ do
msg <- WS.receiveData conn
liftIO $ T.putStrLn msg
-- Read from stdin and write to WS
let loop = do
line <- T.getLine
unless (T.null line) $ WS.sendTextData conn line >> loop
loop
WS.sendClose conn ("Bye!" :: Text)
--------------------------------------------------------------------------------
main :: IO ()
main = withSocketsDo $ WS.runClient "api2.poloniex.com" 80 "" app
It seems like that the Poloniex WebSocket API requires a secure connection, see: https://poloniex.com/support/api/ (I know this from the WS endpoint URL, it uses wss:// instead of ws://). WS.runClient uses the unsecure ws:// protocol instead of the secure wss:// one and thus it won't be able to connect. Try using the wuss library: http://hackage.haskell.org/package/wuss
and rewrite your main function to:
import qualified Wuss as WSS (runSecureClient)
-- ...
main :: IO ()
main = withSocketsDo $ WSS.runSecureClient "api2.poloniex.com" 443 "/" app
Hope this helps!
The issue was for whatever reason my public IP was being blocked. I got around this by using a VPN.

Scotty and POST params

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.

Accepting specific certificate with http-client-tls or tls?

I'm probably just overlooking something basic in the documentation of http-client-tls and tls, but: how can I establish an HTTPS connection to a server and only accept one particular certificate, specified by me, that is potentially not in the system certificate store?
I see that this is an old question, but I just spent some time writing code to do this and figured I'd post it here for posterity... and in the hopes of getting some code review from the community. Snoyman's comment is helpful, but there are so many code interdependencies here, and X.509 and TLS are so boil the ocean, that it's hard to debug and to know for sure that you're not screwing something up without digging pretty deep into the various libraries. I figured a more complete explanation with working code was in order.
Anyways, here's what I've come up with (this is a stack script so you can run it easily yourself) --
#!/usr/bin/env stack
{- stack --resolver lts-7.16 runghc -}
import qualified Data.ByteString as B
import Data.ByteString.Lazy (ByteString)
import Data.Default.Class (def)
import Data.String (fromString)
import Data.X509.CertificateStore (CertificateStore, readCertificateStore)
import Network.HTTP.Client (httpLbs, newManager, ManagerSettings)
import Network.HTTP.Client.TLS (mkManagerSettings)
import Network.Connection (TLSSettings(TLSSettings))
import qualified Network.TLS as TLS
import qualified Network.TLS.Extra.Cipher as TLS
import System.Environment (getArgs, getProgName)
managerSettings :: CertificateStore -> ManagerSettings
managerSettings store = mkManagerSettings settings Nothing
where settings = TLSSettings params
params = (TLS.defaultParamsClient "" B.empty) {
TLS.clientUseServerNameIndication = True
, TLS.clientShared = def {
TLS.sharedCAStore = store
}
, TLS.clientSupported = def {
TLS.supportedCiphers = TLS.ciphersuite_default
}
}
get :: FilePath -> String -> IO ()
get ca url = do
mstore <- readCertificateStore ca
case mstore of
Just store -> do
manager <- newManager $ managerSettings store
response <- httpLbs (fromString url) manager
putStrLn (show response)
Nothing -> do
putStrLn $ "error: invalid certificate store " ++ ca
main :: IO ()
main = do
args <- getArgs
case args of
ca:url:[] -> get ca url
_ -> do
name <- getProgName
putStrLn $ "usage: " ++ name ++ " ca url"
A couple notes:
The TLS.sharedCAStore settings is where the magic happens. If you want to add your CA to the system store (vs. using only your CA) you can load the system store using getSystemCertificateStore from System.X509, then use Data.X509.CertificateStore to convert back and forth between CertificateStore and [SignedCertificate] to create a store with the system certificates along with your own.
TLS.defaultParamsClient takes a hostname and server id, used for TLS server name indication (SNI), a TLS extension that allows a server to host multiple sites on a single IP (similar to how HTTP/1.1 host headers work). We don't necessarily know what to set this to when we're creating a manager. Fortunately, Network.Connection (used by http-client-tls) appears to override whatever settings we use, so it doesn't matter.
The default for TLS.supportedCiphers is an empty list, so this setting is required (unless you turn off validation or something). Network.Connection defaults to ciphersuite_all but that includes some "not recommended last resource cipher suites" so I opted to use ciphersuite_default instead.
I think you're looking for ClientHooks. You can create a TLSSettings value with that by using the TLSSettings constructor, and then create a ManagerSettings using mkManagerSettings.

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>"]

Resources