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.
Related
I'm using an openapi-based library within a handler; unfortunately it throws a lot of network or http exceptions, so I'm attempting to use Control.Monad.CatchIO with it, but banging my head against the types.
This is where I'm at:
{-# LANGUAGE ScopedTypeVariables #-}
import qualified Control.Exception as E
import qualified Control.Monad.CatchIO as CI (try,MonadCatchIO)
import Control.Monad.State
import Snap
import Application
import Services
import qualified Helper.Heist as H
import Snap.AzureAdAuth
-- this is the function that throws the exceptions
runQuery :: (Produces req accept, MimeUnrender accept b1, Show b1, MimeType contentType) => ServicesRequest req contentType b1 accept -> Handler App (AuthManager App) (Either MimeError b1)
runQuery r = ...
runQuery' :: forall req accept contentType b1. (Produces req accept, MimeUnrender accept b1, Show b1, MimeType contentType)
=> ServicesRequest req contentType b1 accept
-> Handler App (AuthManager App) (Either E.SomeException (Either MimeError b1))
runQuery' req =
CI.try $ runQuery req :: Handler App (AuthManager App) (Either E.SomeException (Either MimeError b1))
Compiling gives this error message:
* Could not deduce (CI.MonadCatchIO
(Handler App (AuthManager App)))
arising from a use of `CI.try'
from the context: (Produces req accept, MimeUnrender accept b1,
Show b1, MimeType contentType)
bound by the type signature for:
runQuery' :: forall req accept contentType b1.
(Produces req accept, MimeUnrender accept b1, Show b1,
MimeType contentType) =>
ServicesRequest req contentType b1 accept
-> Handler
App
(AuthManager App)
(Either E.SomeException (Either MimeError b1))
at src/Helper/API.hs:(96,1)-(99,102)
* In the expression: CI.try $ runQuery req
In an equation for runQuery':
runQuery' req = CI.try $ runQuery req
Any thoughts on how to line up the types?
I can't reproduce your example exactly, because there are still many types for which I don't know where they're coming from.
The Snap framework's Handler monad uses MonadBaseControl to embed the IO monad, rather than the more traditional mtl-style MonadIO and MonadCatchIO that MonadCatchIO-mtl uses.
Instead, the lifted-base package provides primitives such as try (in Control.Exception.Lifted) for these embeddings.
The following code compiles for me:
import Snap.Snaplet
import Control.Exception.Lifted hiding (Handler)
runQuery :: Handler a b c
runQuery = undefined
runQuery' :: (Exception e) => Handler a b (Either e a1)
runQuery' = try runQuery
Happy Haskelling!
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
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).
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")
...
I used the servant-0.4.4.7. Below is my model code:
type API = ServletAPI :<|> Raw
type AppM = ReaderT Config (EitherT ServantErr IO)
runApplication :: IO ()
runApplication = do
configApp <- initializationConfig
case configApp of
ConfigNull -> return ()
otherwise -> run (opt_portServer . cfg_optionsArg $ configApp) $ app configApp
app :: Config -> Application
app configApp = serve api (readerServer configApp)
readerServer :: Config -> Server API
readerServer configApp = enter (readerToEither configApp) server
:<|> serveDirectory (opt_pathFolderStatic . cfg_optionsArg $ configApp)
readerToEither :: Config -> AppM :~> EitherT ServantErr IO
readerToEither configApp = Nat $ \x -> runReaderT x configApp
api :: Proxy API
api = Proxy
This code worked.But when I use servant-0.7.1, I get the error:
Couldn't match type ‘Control.Monad.Trans.Except.ExceptT
ServantErr IO’
with ‘EitherT ServantErr IO’
arising from a functional dependency between:
constraint ‘Servant.Utils.Enter.Enter
(ReaderT Config (EitherT ServantErr IO) Data.Text.Internal.Text)
(AppM :~> EitherT ServantErr IO)
(Control.Monad.Trans.Except.ExceptT
ServantErr IO Data.Text.Internal.Text)’
I understand that there is a type mismatch, but how to fix it, I can not understand.
Thanks!
Changing all EitherTs to ExceptTs (from Control.Monad.Trans.Except in transformers) should do the trick. EitherT came from the either package, which has been folded into transformers (under the name ExceptT), so servant, along with more and more packages, migrated to ExceptT.