I am following this tutorial http://www.parsonsmatt.org/programming/2015/06/07/servant-persistent.html to create APIs through servant. I want to customize the server to serve static files as well but couldn't find a way to do it.
I am using the stack build tool.
I modified the Main.hs file's run to include static (run port $ static $ logger $ app cfg) and I imported Network.Wai.Middleware.Static (static). I also added wai-middleware-static >=0.7.0 && < 0.71 to my cabal file.
When I run stack build I get: (Update: This part is totally my error. I added the the package to the wrong cabal file.. lame. Importing Network.Wai.Middleware.Static works and serves static files. Leaving the error below in case anyone searches for it and finds it useful.)
Could not find module ‘Network.Wai.Middleware.Static’
Perhaps you meant
Network.Wai.Middleware.Gzip (from wai-extra-3.0.7.1#waiex_GpotceEdscHD6hq9p0wPOJ)
Network.Wai.Middleware.Jsonp (from wai-extra-3.0.7.1#waiex_GpotceEdscHD6hq9p0wPOJ)
Network.Wai.Middleware.Local (from wai-extra-3.0.7.1#waiex_GpotceEdscHD6hq9p0wPOJ)
Next I tried using servant's serveDirectory as follows (simplified):
type API = "users" :> Get '[JSON] [Person]
:<|> "static" :> Raw
server = createPerson :<|> serveDirectory "/static"
I get this error:
Couldn't match type ‘IO’ with ‘EitherT ServantErr IO’
arising from a functional dependency between:
constraint ‘Servant.Server.Internal.Enter.Enter
(IO Network.Wai.Internal.ResponseReceived)
(AppM :~> EitherT ServantErr IO)
(IO Network.Wai.Internal.ResponseReceived)’
arising from a use of ‘enter’
instance ‘Servant.Server.Internal.Enter.Enter
(m a) (m :~> n) (n a)’
at <no location info>
In the expression: enter (readerToEither cfg) server
In an equation for ‘readerServer’:
readerServer cfg = enter (readerToEither cfg) server
I am a Haskell beginner and I am not familiar with Wai so unsure where to even begin. What changes do I need to make the example code in the Blog post to serve static files?
Edit: Since the comments get hidden from the default view, I am pasting my last comment here:
Here is toned down version of Matt's code from his blog. I consolidated all his modules into a single file, removed all the database stuff but did not clean up the extensions/imports. When I run this code I get the above type mismatch error. Please note that this code does not use Network.Wai.Middleware.Static and I am using qualified import of Servant StaticFiles.
As described in the relevant section of servant's tutorial, the whole deal with enter is to have your request handlers use some monad m (in your case some ReaderT monad) and to provide a way to convert a computation in m to a computation in servant's standard EitherT ServantErr IO monad.
The problem here though is that you define a bunch of request handlers in ReaderT and an additional one to serve static files, and call enter on all of these. The ReaderT handlers are converted to EitherT ... handlers just fine, but enter tries to convert the serveDirectory call from ReaderT ... to EitherT .... This is of course not going to happen anytime soon, since serveDirectory isn't a computation in ReaderT ... to begin with!
servant could arguably just leave serveDirectory alone -- at this point I don't have a definite opinion on whether we should do that or not, or if it's better to just have the file-serving handler be glued separately, to the result of calling enter on all the other endpoints. Here's how this would look like (look for -- NEW to see the changes):
type PersonAPI =
"users" :> Capture "name" String :> Get '[JSON] Person
-- NEW: removed Raw from here
-- NEW
type WholeAPI = PersonAPI :<|> Raw
type AppM = ReaderT Config (EitherT ServantErr IO)
userAPI :: Proxy PersonAPI
userAPI = Proxy
-- NEW
wholeAPI :: Proxy WholeAPI
wholeAPI = Proxy
-- NEW: changed 'userAPI' to 'wholeAPI'
app :: Config -> Application
app cfg = serve wholeAPI (readerServer cfg)
readerServer :: Config -> Server WholeAPI
readerServer cfg = enter (readerToEither cfg) server
:<|> S.serveDirectory "/static" -- NEW
readerToEither :: Config -> AppM :~> EitherT ServantErr IO
readerToEither cfg = Nat $ \x -> runReaderT x cfg
server :: ServerT PersonAPI AppM
server = singlePerson
singlePerson :: String -> AppM Person
singlePerson str = do
let person = Person { name = "Joe", email = "joe#example.com" }
return person
I have brought this topic to the attention of the other servant developers anyway, thanks! We hadn't really thought about the interaction between enter and serveDirectory so far (well, I did not).
Related
In my attempt to write an authenticated Servant API where handlers use the RIO monad instead of Servant's own Handler monad, I am stuck on authenticated routes that return no content; i.e., Servant's NoContent type. When I try to hoist the RIO server into the Handler using hoistServerWithContext, I get a type error that I don't grok.
Here is the simplified API and server setup:
import qualified Servant as SV
import qualified Servant.Auth.Server as AS
-- A login endpoint that sets authentication and XSRF cookies upon success.
-- Login is a credentials record.
type LoginEndpoint
= "login" :> SV.ReqBody '[SV.JSON] Login :> SV.Verb 'SV.POST 204 '[SV.JSON] CookieHeader
loginServer
:: AS.CookieSettings -> AS.JWTSettings -> SV.ServerT LoginEndpoint (RIO m)
loginServer = ... -- Perform credential check here.
-- A protected endpoint that requires cookie authentication
-- The no-content handler is causing the problem described below.
type ProtectedEndpoint = "api" :> SV.Get '[SV.JSON] Text :<|> SV.DeleteNoContent
protectedServer (AS.Authenticated _) =
return "Authenticated" :<|> return SV.NoContent
protectedServer _ = throwIO SV.err401 :<|> throwIO SV.err401
-- The overall API, with cookie authentication on the protected endpoint
type Api
= LoginEndpoint :<|> (AS.Auth '[AS.Cookie] User :> ProtectedEndpoint)
-- | The overall server for all endpoints.
server :: AS.CookieSettings -> AS.JWTSettings -> SV.ServerT Api (RIO m)
server cs jwt = loginServer cs jwt :<|> protectedServer
Where User is a record type that can be serialized as JWT as part of a cookie. To hoist the server, I follow the example here:
apiProxy :: Proxy Api
apiProxy = Proxy
contextProxy :: Proxy '[AS.CookieSettings, AS.JWTSettings]
contextProxy = Proxy
newtype Env = Env
{ config :: Text }
-- Helper function to hoist our RIO handler into a Servant Handler.
hoistAppServer :: AS.CookieSettings -> AS.JWTSettings -> Env -> SV.Server Api
hoistAppServer cookieSettings jwtSettings env = SV.hoistServerWithContext
apiProxy
contextProxy
(nt env)
(server cookieSettings jwtSettings)
where
-- Natural transformation to map the RIO monad stack to Servant's Handler.
nt :: Env -> RIO Env a -> SV.Handler a
nt e m = SV.Handler $ ExceptT $ try $ runRIO e m
main :: IO ()
main = do
myKey <- AS.generateKey -- Key for encrypting the JWT.
let jwtCfg = AS.defaultJWTSettings myKey
cfg = cookieConf :. jwtCfg :. SV.EmptyContext -- cookieConf sets XSRF handling
env = Env { config = "Some configuration string" }
Warp.run 8081 $ SV.serveWithContext apiProxy cfg $ hoistAppServer cookieConf jwtCfg env
The above hoisting works fine for endpoints that return some content. However, when :<|> SV.DeleteNoContent is present in the ProtectedEndpoint (and the corresponding parts in the server), I get the following type error:
No instance for (HasServer
(Servant.Auth.Server.Internal.AddSetCookie.AddSetCookieApi
(Servant.Auth.Server.Internal.AddSetCookie.AddSetCookieApi
(NoContentVerb 'DELETE)))
'[CookieSettings, JWTSettings])
arising from a use of ‘hoistServerWithContext’
The problem does not arise on an endpoint without authentication; e.g., UnprotectedEndpoint instead of (AS.Auth '[AS.Cookie] User :> ProtectedEndpoint) in the API type definition.
hoistServerWithContext is a function of the HasServer type class, but I'm not sure which instance is of concern here. If I let GHC infer the type, I get
hoistServerWithContext :: forall k (api :: k) (context :: [*]) (m :: * -> *) (n :: * -> *).
HasServer api context =>
Proxy api
-> Proxy context
-> (forall x. m x -> n x)
-> ServerT api m
-> ServerT api n
To me, the type error (plus my experiments adding and removing the no-content handler) indicate that the protectedServer derived by Servant's type machinery is not a member of the HasServer type class. But my Haskell type-level programming skills are not up to the task, it seems. Where exactly is the problem? Am I missing a type annotation? A language extension?
The type error seems to result because servant currently does not allow adding headers to a NoContentVerb because the corresponding type instance is missing. See the Servant-Auth issue here.
Even though I don't fully understand the details, the following workaround from the above issue comment avoids the type error:
type instance ASC.AddSetCookieApi (SV.NoContentVerb 'SV.DELETE)
= SV.Verb 'SV.DELETE 204 '[SV.JSON] (ASC.AddSetCookieApiVerb SV.NoContent)
I am building a web API with Servant and Persistent. I plan to define some API endpoints (about 15) that use a connection pool to access the DB.
For example, one of the endpoint definitions (Handlers) is:
getUser :: ConnectionPool -> Int -> Handler User
getUser pool uid = do
user <- inPool pool $ get (toId #User uid)
user & orErr err404 {errBody = "This user does not exist."}
where inPool is just a lifted withResource function, and orErr is a lifted fromMaybe.
Then, a higher level API definition (Servers) looks like this:
type Point (s :: Symbol) (a :: *) =
s :> Capture "id" Int :>
( Get '[JSON] a
:<|> ReqBody '[JSON] a :> Post '[JSON] NoContent
)
type UserPoint = Point "users" User
userServer :: ConnectionPool -> Server UserPoint
userServer pool uid =
getUser pool uid :<|>
postUser pool uid
And I defined the main to be:
main = runStdoutLoggingT . withPostgresqlPool connectionString numConnections $ \pool -> do
withResource pool (runSqlConn $ runMigration migrateAll)
liftIO $ run appPort (userServer pool)
But I soon noticed that I would have to pass the pool down layer by layer (In the example above there are 2 layers, and in my real project there are 3), to every function (that is over 20). My intuition tells me this is bad smell, but I am not quite sure.
Then I thought of ReaderT, because I think that may abstract the pool out. But my concern is that the introduction of ReaderT may lead to unnecessary complexity:
I need to lift many things manually;
The mental model of types will become more complicated thus harder to think about;
It means I'll have to give up the Handler type, which makes using Servant harder too.
I am not sure whether I should use ReaderT in this case. Please offer some suggestions (I'll be grateful if you could also provide some guidelines about when to use ReaderT or even other monad transformers).
UPDATE: I found that I can use where-clauses to simplify this a lot, and this basically solves my problem. but I'm not sure if this is best practice, so I'm still looking forwand to an answer.
userServer :: Pooled (Server UserPoint)
userServer pool auth = c :<|> rud where
c :: UserCreation -> Handler NoContent
c = undefined
rud uid = r :<|> u :<|> d where
r :: Handler User
r = do
checkAuth pool auth
user <- inPool pool $ get (toId #User uid)
user & orErr err404 {errBody = "This user does not exist."}
u :: User -> Handler NoContent
u = undefined
d :: Handler NoContent
d = undefined
While defining your handlers along with your server will avoid you the parameter-passing, as the server grows in complexity you might want to define some handlers separately:
Perhaps some handler provides some generic functionality and could be useful in other servers.
Defining everything together means everything is aware of everything else.
Moving handlers to the top level, or even to another module, will
help make explicit which parts of the whole they really need to know.
And this can make the handler easier to understand.
Once we separate a handler, supplying it with the environment will become necessary. This can be done with plain parameters to functions, or with a ReaderT. As the number of parameters grows, the ReaderT (often in combination with auxiliary HasX typeclasses) becomes more attractive because it frees you from having to care about parameter order.
I would have to pass the pool down layer by layer (In the example
above there are 2 layers, and in my real project there are 3), to
every function
Besides the extra (possibly inevitable) burden of having to pass parameters, I think there's a potentially worse problem lurking: you are threading a low-level detail (the connection pool) through several layers of functions. This can be bad because:
You are committing your whole application to using an actual database. What happens if, during testing, you want switch it with some kind of in-memory repository?
If you need to change the way you do persistence, the refactor will reverberate through all the layers of your application, instead of remaining localized.
One possible solution for these problems: the functions at layer N+1 should not receive as parameter the connection pool, but rather the functions they use from layer N. And those functions from layer N will already have been partially applied with the connection pool.
A trivial example: if you have some high level logic transferUser :: Conn -> Handle -> IO () that includes hardwired calls to functions readUserFromDb :: Conn -> IO User and writeUserToFile :: Handle -> User -> IO (), change it into a transferUser :: IO User -> (User -> IO) -> IO ().
Notice that the auxiliary functions from level N could be stored in the ReaderT context; the functions from level N+1 could get them from there.
It means I'll have to give up the Handler type, which makes using
Servant harder too.
You can define your server using a ReaderT transformer over Handler, and then pass it to the hoistServer function which will "whittle it down" to a runnable server:
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
import Servant
import Servant.API
import Control.Monad.Trans.Reader
type UserAPI1 = "users" :> Capture "foo" Int :> Get '[JSON] Int
data Env = Env
-- also valid type
-- server1 :: Int -> ReaderT Env Handler Int
server1 :: ServerT UserAPI1 (ReaderT Env Handler)
server1 =
\ param ->
do _ <- ask
return param
-- also valid types:
-- server2 :: ServerT UserAPI1 Handler
-- server2 :: Int -> Handler Int
server2 :: Server UserAPI1
server2 = hoistServer (Proxy :: Proxy UserAPI1) (flip runReaderT Env) server1
These days it's not uncommon to need to return a file (say, index.html) from the backend if the requested route doesn't match an existing API endpoint or another static asset. This is especially handy when using react-router and browserHistory.
I'm a bit stumped as to how I might approach this with Servant. I did wonder if intercepting 404's might be the way to go, but then of course sometimes the API will need to legitimately issue 404. Here's the kind of thing I've been using to experiment:
data Wombat = Wombat
{ id :: Int
, name :: String
} deriving (Eq, Show, Generic)
instance ToJSON Wombat
wombatStore :: [Wombat]
wombatStore =
[ Wombat 0 "Gertrude"
, Wombat 1 "Horace"
, Wombat 2 "Maisie"
, Wombat 3 "Julius"
]
wombats :: Handler [Wombat]
wombats = return wombatStore
wombat :: Int -> Handler Wombat
wombat wid = do
case find (\w -> Main.id w == wid) wombatStore of
Just x -> return x
Nothing -> throwE err404
type API =
"api" :> "wombats" :> Get '[JSON] [Wombat] :<|>
"api" :> "wombats" :> Capture "id" Int :> Get '[JSON] Wombat :<|>
Raw
api :: Proxy API
api = Proxy
server :: Server API
server = wombats
:<|> wombat
:<|> serveDirectory "static"
app :: Application
app = serve api server
main :: IO ()
main = run 3000 app
I'd love to see an example of how I could go about adding a 'default route' that sends an HTML response if the request doesn't match an API endpoint or anything in the static directory. Toy repo here.
You got it, basically. serveDirectory "static" can be replaced by any wai Application, so for instance, we could have:
...
{-# LANGUAGE OverloadedStrings #-}
...
import Network.Wai (responseLBS)
import Network.HTTP.Types (status200)
...
server :: Server API
server = wombats
:<|> wombat
:<|> hello
hello :: Application
hello req respond = respond $
responseLBS
status200 --
[("Content-Type", "text/plain")] -- headers
"Hello, World!" -- content
...
To a first approximation, wai applications are simply Request -> Response, but the docs tell a fuller story:
Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived
So since you've got access to IO, you can check if the file exists and if so serve it, otherwise do whatever you like. In fact, wai defines type Middleware = Application -> Application, so you might think up a handy Middleware that wraps up hello (or any other Application!) in a file existence-checker-and-server.
Here is another route:
serveDirectory is defined as
serveDirectory = staticApp . defaultFileServerSettings . addTrailingPathSeparator
defaultFileServerSettings contains a field ssLookupFile which you can change to serve what you want if the file was not found. Perhaps:
import WaiAppStatic.Types
import WaiAppStatic.Storage.Filesystem
import Network.Wai.Application.Static
import System.FilePath
fileOrIndex root pieces = do
res <- ssLookupFile (defaultFileServerSettings root) pieces
case res of
LRNotFound -> undefined -- index.html here
_ -> return res
serveStatic root =
let root' = addTrailingPathSeparator root in
staticApp $ (defaultFileServerSettings root') {ssLookupFile = fileOrIndex root'}
This is a follow-up to my previous post. MaybeT and Transactions in runDb
I thought this will be a simple thing to do but I have been trying to figure this out for over a day and still haven't made much progress. So thought I will give up and ask!
I just added a try function (from Control.Exception.Lifted) to my previous code and I couldn't get the code to type check. Variants like catch and handle had similar issues.
eauth <- LiftIO (
try( runDb $ do
ma <- runMaybeT $ do
valid <- ...
case ma of
Just a -> return a
Nothing -> liftIO $ throwIO MyException
) :: IO (Either MyException Auth)
)
case eauth of
Right auth -> return auth
Left _ -> lift $ left err400 { errBody = "Could not create user"}
My runDb looks like this (I also tried a variant where I removed liftIO):
runDb query = do
pool <- asks getPool
liftIO $ runSqlPool query pool
I get this error:
No instance for (Control.Monad.Reader.Class.MonadReader Config IO)
arising from a use of ‘runDb’
In the expression: runDb
In the first argument of ‘try’, namely
‘(runDb
$ do { ma <- runMaybeT ...
I am running inside servant handler and my return type is AppM Auth where
type AppM = ReaderT Config (EitherT ServantErr IO)
I have tried many combinations of lifting but doesn't seem to be helping. I thought I will take this opportunity to figure out things from scratch and I hit a wall as well. If someone could suggest how you arrived at the answer, it will be super instructive for me.
This has been my thought process:
I see runSqlConn :: MonadBaseControl IO m => SqlPersistT m a -> Connection -> m a
So that seems to imply it will be in the IO monad, which means try should work
I think check the definition of MonadBaseControl which has class MonadBase b m => MonadBaseControl b m | m -> b. At this point I am confused. This functional dependency logic seems to be suggest type m dictates what b will be but in the previous one b was specified as IO.
I check MonadBase and that did not give me any clue either.
I check SqlPersistT and got no clues either.
I reduced the problem to something very simple like result <- liftIO (try (evaluate (5 `div` 0)) :: IO (Either SomeException Int)) and that worked. So I was even more confused at this time. Doesn't runDb work in IO so shouldn't the same thing work for my original code?
I thought I can figure this out by backtracking but it seems like my level of Haskell knowledge is just not sufficient to get at the root of the problem. Appreciate if people can provide step by step pointers as to arrive at the right solution.
Thanks!
General type signature for try:
(MonadBaseControl IO m, Exception e) => m a -> m (Either e a)
Specialized type signature for try (as it appears in your code):
IO Auth -> IO (Either MyException Auth)
So, the monadic value that is the argument to try has type:
IO Auth
Everything listed above, you probably already understood. If we look at the type signature for your runDb, we get this:
runDb :: (MonadReader Config m, MonadIO m) => SqlPersistT m a -> m a
I sort of had to guess because you didn't provide a type signature, but that is probably what it is. So now, the problem should be a little clearer. You are trying to use runDb to create a monadic value for something that's supposed to be in IO. But IO doesn't satisfy the MonadReader Config instance that you need.
To make the mistake more clear, let's make runDb more monomorphic. You could give it this type signature instead:
type AppM = ReaderT Config (EitherT ServantErr IO)
runDb :: SqlPersistT AppM a -> AppM a
And now if you tried to compile your code, you would get an even better error. Instead of telling you
No instance for (Control.Monad.Reader.Class.MonadReader Config IO)
It would tell you that IO doesn't match AppM (although it would probably expand the type synonym). Practically, what this means is that you can't get the shared pool of database connections magically out of IO. You need the ReaderT Config that was passing it around everywhere.
The easiest fix I can think of would be to stop using exceptions where they aren't necessary:
mauth <- runDb $ runMaybeT $ do
... -- Same stuff you were doing earlier
case mauth of
Just auth -> return auth
Nothing -> lift $ left err400 { errBody = "Could not create user"}
This is the first time I'm playing with Monad Transformers. This is a simple happstack app.
{-# LANGUAGE OverloadedStrings #-}
import Happstack.Lite
import qualified Data.ByteString.Lazy.Char8 as L
main :: IO ()
main = do
serve Nothing hello
hello :: ServerPart Response
hello = do
ok $ toResponse ("Hello" :: L.ByteString)
I would like to be able to change hello so it can read some global config data using ReaderT. Let's just say the config is a string to keep it simple
type NewMonad = ReaderT L.ByteString (ServerPartT IO)
runNewMonad :: NewMonad a -> L.ByteString -> ServerPart a
runNewMonad k c = runReaderT k c
How do I change hello so it can use ask? I'm not sure what the type would be. NewMonad Response isn't quite right, because ok returns a ServerPart Response.
How do I change main so that serve works? It expects a ServerPart Response.
In fact, NewMonad Response is the correct type for hello; you just need to use lift to transform an action in the underlying monad to one in the transformer. For example:
hello :: NewMonad Response
hello = do
foo <- ask
lift . ok $ toResponse foo
In general,
lift :: (MonadTrans t, Monad m) => m a -> t m a
i.e., if you have a monadic action, then you turn it into an action in any monad transformer over that monad. This is the definition of a monad transformer: it can transform over any monad, and embed actions of that monad.
It seems that restricting all the monadic actions to one specific monad — rather than using typeclasses to work in any appropriate monad — is one of the simplifications happstack-lite uses compared to the full Happstack, which has this type for ok:
ok :: (FilterMonad Response m) => a -> m a
With this type, assuming appropriate instances are declared for the standard transformers, you could just use ok directly in MyMonad.
As for main, you need to eliminate the ReaderT layer, leading a a ServerPart Response that you can pass to serve:
main :: IO ()
main = do
serve Nothing $ runNewMonad hello ("Hello" :: L.ByteString)
(This would cause problems if you were using a monad carrying state that you wanted to change over the course of many requests, since serve's type is too restrictive to support such state threading (without manually encoding it with IORefs or similar); possibly the unrestricted Happstack has the ability to do this, but it'd likely be very brittle anyway, as you shouldn't really be relying on the order requests are processed in like that.)