Redirect to https with Snap - haskell

i have this code to start a snap app over https:
main :: IO ()
main = do
-- get the port from the ENV , it should be in /etc/profile as any other ENV variable or $ export BIND_PORT=8000
a <- lookupEnv "BIND_PORT"
let port = displayResult a
liftIO $ createDirectoryIfMissing True "img"
httpServe (setPort (read port) config) Main.skite
where
config =
setSSLPort 443 $
setSSLCert "/etc/letsencrypt/../cert.pem" $
setSSLKey "/etc/letsencrypt/../privkey.pem" $
setSSLBind "0.0.0.0" $
setSSLChainCert False $
defaultConfig
skite :: Snap ()
skite = do
req <- fmap rqHostName getRequest
reqPath <- fmap rqPathInfo getRequest
routes req reqPath
where
routes req reqPath =
Rain.skite
Now, when i am browsing with example.com is not forwarded to https://example.com. Is there any builtin functionality to do this?

I'm not too familiar with Snap, I'm guessing you could probably achieve this by adding an additional httpServe for port 80, and then doing a redirect if executed (to the https:// version).

Related

Is there a reason why warp doesn't call toWaiApp?

Just for the sake of it, I'm interested in why warp doesn't call toWaiApp as stated in the comment:
toWaiApp :: YesodDispatch site => site -> IO W.Application
toWaiApp site = do
logger <- makeLogger site
toWaiAppLogger logger site
-- | [...] Automatically calls 'toWaiApp'. [...]
warp :: YesodDispatch site => Int -> site -> IO ()
warp port site = do
logger <- makeLogger site
toWaiAppLogger logger site >>= Network.Wai.Handler.Warp.runSettings (...)
Why not calling toWaiApp:
-- | [...] Automatically calls 'toWaiApp'. [...]
warp :: YesodDispatch site => Int -> site -> IO ()
warp port site = toWaiApp site >>= Network.Wai.Handler.Warp.runSettings (...)
Update: I'm on yesod-core-1.6.14.

How can I use log-warper with Servant?

I have an application built on top of Servant, and now I want to add logging to the application. I skimmed through Haskell log packages, and I assume this one provides what I need: https://github.com/serokell/log-warper/blob/master/log-warper/examples/HowTo.md
One of the 'design patterns' often used for building apps with Servant is to use Reader monad, so I use this approach for the app: I have AppEnv which contains AppConfig. Usually, I could add something like a 'logger' entity to the AppEnv and so use it in handlers. Although, log-warper doesn't provide 'a logger', but it uses different approach instead (seems to be another monad, I assume; please, see the example on the link above). And so I can't figure out how to use this logger with Servant.
Here is my Servant-based app (using recent version of Servant, basing on examples from the doc: http://haskell-servant.readthedocs.io/en/stable/tutorial/Server.html#welcome-hoistserver):
data AppEnv = AppEnv { config :: Config }
type MyHandler = ReaderT AppEnv (ExceptT ServantErr IO)
startApp :: AppEnv -> IO ()
startApp env = do
run 16384 (app env)
app :: AppEnv -> Application
app env = serve readerAPI (readerServer env)
readerAPI :: Proxy ReaderAPI
readerAPI = Proxy
readerToHandler :: AppEnv -> Reader AppEnv a -> Handler a
readerToHandler env r = return (runReader r env)
readerServer :: AppEnv -> Server ReaderAPI
readerServer env = hoistServer readerAPI (readerToHandler env) readerServerT
b :: Reader AppEnv Bool
b = do
c <- config <$> ask
let
s = getServerConfig c
p = getServerPort s
return (p == 1)
getServerConfig :: Config -> ServerConfig
getServerConfig (Config s _) = s
getServerPort :: ServerConfig -> Int
getServerPort (ServerConfig _ p) = p
readerServerT :: ServerT ReaderAPI (Reader AppEnv)
readerServerT = a :<|> b where
a :: Reader AppEnv Int
a = return 1797
And here is the main function:
main :: IO ()
main = do
config <- loadYamlSettings ["etc/config.yaml"] [] useEnv
print (config :: Config)
let
env = AppEnv config
startApp env
Now, how can I add log-warper to the application so I could initialize the logger (with launchFromFile I assume), and then use logging (logInfo, logError, etc.) in the app (in particular, in handlers, but possibly in other functions as well)?
Thanks
General logging
If you want a generic logging tool with some sophisticated options katip looks like a good choice. There is even a small discussion about how to use it with servant. You just need to add a couple of parameters for katip to your Config type, initialize them, then you can log in your handlers.
Request logging
servant-server is built on top of wai and warp so you can reuse a lot of there tools. If you are just interested in logging data about requests to servant, you can use wai-logger without changing any of your types.
startApp would look something like this.
startApp :: AppEnv -> IO ()
startApp env = do
withStdoutLogger $ \logger ->
runSettings (setPort 16384 $ setLogger logger $ defaultSettings) $ app env

Websockets with Snap won't bind in production

please help me with something:
I want to implement websockets-snap in production but they seem that won't take the address. I have the following code:
the js inside index.html file
function createChatSocket() {
if(window.location.host == '') {
/* Running on localhost */
return new WebSocket('ws://35.197.208.147/ws/console/');
} else {
/* Running in "production" */
return new WebSocket('wss://jaspervdj.be/websockets/example/chat/');
}
}
the window.location.host is not empty, it is the ip
the server.hs file
app :: Snap ()
app = Snap.route
[ ("", Snap.ifTop $ Snap.serveFile "./shorts/index.html")
, ("console", console)
]
....
....
....
--------------------------------------------------------------------------------
console :: Snap ()
console = do
state <- liftIO $ newMVar newServerState
WS.runWebSocketsSnap $ application state
No matter what i do, it will always return the websockets found on wss://jaspervdj.be/websockets/example/chat/ and not my server. What can i do?
Thanks
That's a JavaScript issue, not a Haskell one. The window.location.host will never be empty. Therefore, you always end up with the websocket to jaspervdj.be.

Creating a route for static assets or images in Hasekll Spock

I have this basic Spock application taken from its website:
main :: IO ()
main =
do ref <- newIORef 0
spockCfg <- defaultSpockCfg EmptySession PCNoDatabase (DummyAppState ref)
runSpock 8080 (spock spockCfg app)
app :: SpockM () MySession MyAppState ()
app =
do get root $
text "Hello World!"
get -- ??? route for "/img/"???
I have an html page which I can return like this:
However, an html page contains a some "img" tags. How do I need to create a route so that the images resolves? Say, the images are location in the folder "img".
Something I like to do is to use the wai-middleware-static middleware to serve a static directory :
app :: SpockM () MySession MyAppState ()
app = do
middleware $ staticPolicy (addBase "static")
...

How to do subdomain routing using Haskell

Using Hakyll that uses snap i started working on a routing server. Given the following code from their tutorials i can see the routing but i would like to have some different applications on their own subdomains like oneapp.mysite.com. Is this possible using snap or any other Haskell server?
site :: Snap ()
site =
ifTop (writeBS "hello world") <|>
route [ ("foo", writeBS "bar")
, ("echo/:echoparam", echoHandler)
] <|>
dir "static" (serveDirectory ".")
I haven't done this before, but this is what I would try:
Use the wrapSite function to conditionally use the routes for your subdomain and you can test which subdomain was requested with fmap rqServerName getRequest
http://hackage.haskell.org/packages/archive/snap/0.11.0/doc/html/Snap-Snaplet.html#g:7
http://hackage.haskell.org/packages/archive/snap-core/0.9.2.2/doc/html/Snap-Core.html#g:5
http://hackage.haskell.org/packages/archive/snap-core/0.9.2.2/doc/html/Snap-Core.html#g:10
Thank you both for suggestions, i made it. I didn't used snaplets but i did use fmap rqServerName getRequest and the if-then-else statements. This is a piece of code.
skite :: Snap ()
skite = do
req <- fmap rqServerName getRequest
routes req
where
routes req =
if (req == "www.site1.ro") then (site1) else pass <|>
if (req == "site1.ro") then (site1) else pass <|>
if (req == "www.site2.ro") then (writeBS req) else pass <|>
if (req == "site2.ro") then (writeBS "Nowhere to be found") else pass <|>
ifTop (writeBS req)
I also created a gist with the full code here
For further suggestions you are welcome.

Resources