haskellhaskell-snap-framework

add a header to all responses in snap framework


The title sums it up. I want add a header to all my responses in snap. I can add a modifyRequest handler for each of my routes like :

apiRoutes :: [(ByteString, Handler b Api ())]
apiRoutes = [("status",  addHeader)]


addHeader :: Handler b Api ()
addHeader = do
   modifyResponse (setHeader "Content-Type" "application/json")
   otherHandler

otherHandler :: Handler b Api ()
otherHandler = metod Get doActualStuff <|> metod Get doMoreActualStuff

Now if I have 100 different routes and I want to add the header to them all. I have to write an intercepter function for all those routes. and if I want to change the header I must modify all 100 intercepter functions.

Is there a short simple way ?


Solution

  • With the hint that sjakobi provided I figured it out. This can be done like:

    apiRoutes :: [(ByteString, Handler b Api ())]
    apiRoutes = map (mapSecond (addHeaders >>))
    [("status",  addHeader)]
    
    
    addHeaders :: Handler b Api ()
    addHeaders = do
       modifyResponse (setHeader "Content-Type" "application/json")
       modifyResponse (setHeader "more-header" "more-header")
    
    mapSecond :: (b -> c) -> (a,b) -> (a,c)
    mapSecond f (a,b) = (a,f b)