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!
Related
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.
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 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.
I'm trying to set up Yesod, while running Fay for the frontend of my site. It's mostly working as I'd expect, as in any Fay I write runs. The problem is I'm getting an Uncaught ReferenceError in the generated JS.
Here is a short version of the JS in question:
(function(){
var Data = {};Data.Data = {};var Fay = {}; ... lots of code ... Home.main = new Fay$$$(function(){return Fay$$_(Home.alert)(Fay$$list("test"));});
;
Fay$$_(Home.main);
})();
Fay$$_(Home.main); /* Uncaught ReferenceError: Home is not defined */
And the Fay code that generates it:
module Home where
import Prelude
import Fay.FFI
import Language.Fay.Yesod
import SharedTypes
alert :: String -> Fay ()
alert = ffi "window.alert(%1)"
main :: Fay ()
main = alert "test"
I suspect that the extra call is being added by the yesod-fay package, but I'm not sure how to avoid this happening. https://github.com/fpco/yesod-fay/blob/master/Yesod/Fay.hs#L124 is the function I think might be involved.
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.