Improper route construction with Servant and Raw WAI directoryServer

Question

As part of a Haskell Servant project, I'm trying to provide a directory server as an endpoint, i.e.

 type DirServe = Capture "route" Text :> Raw

When I navigate to my page, e.g.

localhost:8081/myRoute

Which is serving

 myDir/
   fileA
   fileB

I see the page with fileA and fileB listed in a table like expected. The problem, however, is when I click on fileA (for example) I am redirected to

localhost:8081/fileA

and a 404 error. If however I manually enter the correct address,

localhost:8081/myRoute/fileA

I am rewarded with fileA. So how do I tell Servant or Network.Wai.Application to prefix the paths in the directory server?

Further information. The app also fails when I use a static route instead of a capture:

type DirServe = "myRoute" :> Raw

If I use the root route, however, the handler works as expected.

type DirServe = Raw

SimpleDirServer.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
-- {-# LANGUAGE FlexibleContexts #-}

module Main (main) where

import Servant
import Network.Wai.Handler.Warp
import Network.Wai.Application.Static
-- import WaiAppStatic.Storage.Filesystem
-- import WaiAppStatic.Types
import Data.Text

import Options.Applicative
import Data.Semigroup ((<>))

data Env = Env
 { channelPort :: Int
 , channelFilePath :: FilePath
 , routeRoot :: Text
 } deriving Show

type DirServe = Capture "route" Text :> Raw

main :: IO ()
main = do
  env@Env { channelPort, channelFilePath, routeRoot } <- getEnv
  print env
  run channelPort . serve (Proxy @DirServe)
                  $ serveAtRoute channelFilePath routeRoot
  where
    serveAtRoute :: FilePath -> Text -> Text -> Tagged Handler Application
    serveAtRoute fp root rt | rt == root =
        serveDirectoryWith (mySettings fp $ rt)
                   | otherwise  = error "not found"
    mySettings fp rt = defaultFileServerSettings fp
      -- Previous attempt to manually prefix route...
      -- let ss = defaultFileServerSettings fp
      --     rd = ssMkRedirect ss
      -- in ss{ssMkRedirect = \ps -> maybe (rd ps) (\p -> rd (p:ps)) $ toPiece rt}

    -- Just Options parsing
    getEnv = execParser $ info (doOpts <**> helper) thisDesc
    thisDesc = fullDesc
            <> progDesc "Simple Directory Server"
            <> header "pkgs"
    doOpts = Env <$> doPort <*> doFilePath <*> doRouteRoot
    doPort = option auto $
      long "port" <> short 'p' <> metavar "INT" <>
      help "Port."  <>
      value 8081 <> showDefault
    doFilePath = strOption $
      long "dir" <> short 'd' <> metavar "PATH" <>
      help "Directory to serve." <>
      value "/var/lib/serve"
    doRouteRoot = strOption $
      long "route" <> short 'r' <> metavar "ROUTE" <>
      help "The URL \"Path\" component." <>
      value ""

simpleDirServer.cabal

cabal-version:       2.0
name:                simpleDirServer
version:             0.1.0.1
synopsis:            Serves a directory
-- description:
-- bug-reports:
license:             BSD3
category:            Distribution
build-type:          Simple
extra-source-files:  CHANGELOG.md

executable simpleDirServer
  main-is:            SimpleDirServer.hs
  ghc-options:
    -O2
    -threaded
    -rtsopts
    "-with-rtsopts=-N"
  -- exposed-modules:
  -- other-modules:
  -- other-extensions:
  build-depends:       base ^>=4.12.0.0,
                       servant-server,
                       warp,
                       bytestring,
                       text,
                       optparse-applicative,
                       wai-app-static
                       -- mtl
  hs-source-dirs:      src
  default-language:    Haskell2010

trevor cook trevor cook · Accepted Answer · 2019-10-07T13:14:59

File this one under "user error".

When I navigate to my page, e.g.
localhost:8081/myRoute

Note the lack of trailing slash. The root of the served directory is at

localhost:8081/myRoute/

When I navigate there, it all works as expected. This is almost too embarrassing to post, but hopefully I can save someone from wasting as much time as I did on this.

Improper route construction with Servant and Raw WAI directoryServer

1 Answers