I'm serving an API using Servant, all managed by Snap. In Servant, it's easy to include an arbitrary data type as part of a POST request, assuming it has a FromJSON instance. For instance, I might have the following endpoint:
ReqBody '[JSON] RequestData :> Post '[JSON] [ResponseData]
How do I do the same for GET requests? From what I understand, I'd need to use the Query Parameters, but my request data consists of complex datatypes (lists, nested dictionaries) that don't seem to be readable easily, e.g. QueryParam "vals" [Int] :> Post '[JSON] [Int] results in the error No instance for (FromHttpApiData [Int])
A workaround would be to use POST requests, which have easily readable request bodies. However, this would clash with my caching scheme in Nginx, since responses to POST requests aren't that easily cachable. Even if I can cache them, I don't want to cache all post requests, so it'd be a messy approach.
Thanks for any help!
A simple solution if you want the same level of automatic derivation as for JSON post bodies is to just send the query params as JSON
import Data.Aeson
import Servant.API
import qualified Data.Text as T
import Data.Text.Encoding
import qualified Data.ByteString.Lazy as LBS
newtype JSONEncoded a = JSONEncoded { unJSONEncoded :: a }
deriving (Eq, Show)
instance (FromJSON a) => FromHttpApiData (JSONEncoded a) where
parseQueryParam x = case eitherDecode $ LBS.fromStrict $ encodeUtf8 x of
Left err -> Left (T.pack err)
Right val -> Right (JSONEncoded val)
instance (ToJSON a) => ToHttpApiData (JSONEncoded a) where
toQueryParam (JSONEncoded x) = decodeUtf8 $ LBS.toStrict $ encode x
Related
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'}
I'm trying to create client bindings to Web API using servant library.
I want to be able to send any JSON objects.
import Control.Monad.Trans.Except (ExceptT, runExceptT)
import Data.Proxy
import Network.HTTP.Client (Manager)
import Servant.API
import Servant.Client
import Data.Aeson
-- | This methods accepts any instance of 'ToJSON'
-- I would like to have only this method exported from the module
send :: ToJSON a => a -> Manager -> IO (Either ServantError Result)
send x manager = runExceptT $ send_ x manager baseUrl
type MyAPI a = "acceptAnyJson"
:> ReqBody '[JSON] a
:> Post '[JSON] Result
api :: ToJSON a => Proxy (MyAPI a)
api = Proxy
send_ :: ToJSON a => a -> Manager -> BaseUrl -> ExceptT ServantError IO Result
send_ = client api
Right now when I try to compile it I have error message:
Couldn't match type ‘a0’ with ‘a’
because type variable ‘a’ would escape its scope
This (rigid, skolem) type variable is bound by
the inferred type for ‘send_’:
...
How can I parameterize my MyAPI, client and Proxy to accept type variable?
You'll need to tie the type of api to the type of the thing you're sending:
{-# LANGUAGE ScopedTypeVariables #-}
send_ :: forall a. (FromJSON a) => a -> Manager -> BaseUrl -> ExceptT ServantError IO Result
send_ = client (api :: Proxy (MyAPI a))
or why even bother with api at that point:
send_ = client (Proxy :: Proxy (MyAPI a))
I am using the Snap information and I was wondering if there was some type of Request function ( such as ::Request -> IO Snap() or ::Request -> Handler App App()) that returns the OS or Browser information of the user visiting the webpage.
I would like to get the OS and Browser information of the person who is visiting the webpage.
You can get the User-Agent HTTP header via getHeader, because Request has a HasHeaders instance.
Example snippet:
import qualified Data.ByteString.Char8 as CS
import qualified Data.CaseInsensitive as CI
import Data.Maybe (listToMaybe)
uaName :: ByteString
uaName = CS.pack "User-Agent"
-- You can avoid CS.pack with OverloadedStrings extension.
uahName :: CI ByteString
uahName = CI.mk uaName
-- OverloadedStrings also gets rid of the CI.mk call.
getUserAgent :: Request -> Snap (Maybe ByteString)
getUserAgent rq = return . coerce $ getHeader uahName rq
where
coerce :: Maybe [ByteString] -> Maybe ByteString
coerce = (>>= listToMaybe)
-- Some HTTP headers can appear multiple times, hence the list.
-- `coerce` ignores all but the first occurrence.
For more detailed / less voluntary information, you could inject JS into an initial request and set cookies that can be extracted with rqCookies in a lter request.
I'm trying to create a JSON REST api using Happstack. It should allow POSTS with a JSON body. How can I do this? All the functions in happstack's API seem to look things up based on parameter name. It thinks the body is always url-encoded.
If it isn't possible with Happstack, which framework should I use?
Alright, here's what I figured out.
{-# LANGUAGE OverloadedStrings, DeriveDataTypeable #-}
import qualified Data.ByteString.Lazy.Char8 as L
import Happstack.Server
import Happstack.Server.Types
import Control.Monad.IO.Class (liftIO)
import Data.Data (Data, Typeable)
-- easiest to serialize/deserialize objects
data Unit = Unit { x :: Int, y :: Int } deriving (Show, Eq, Data, Typeable)
-- put this function in a library somewhere
getBody :: ServerPart L.ByteString
getBody = do
req <- askRq
body <- liftIO $ takeRequestBody req
case body of
Just rqbody -> return . unBody $ rqbody
Nothing -> return ""
myRoute :: ServerPart Response
myRoute = do
body <- getBody -- it's a ByteString
let unit = fromJust $ A.decode body :: Unit -- how to parse json
ok $ toResponse $ A.encode unit -- how to send json back.