1

作为 Haskell Servant 项目的一部分，我试图提供一个目录服务器作为端点，即

 type DirServe = Capture "route" Text :> Raw

当我导航到我的页面时，例如

localhost:8081/myRoute

哪个服务

 myDir/
   fileA
   fileB

我看到页面与fileA预期fileB的表格一样并列在表格中。然而，问题是当我点击fileA（例如）我被重定向到

localhost:8081/fileA

和 404 错误。但是，如果我手动输入正确的地址，

localhost:8081/myRoute/fileA

我得到了奖励fileA。那么如何告诉 Servant 或 Network.Wai.Application 为目录服务器中的路径添加前缀呢？

更多信息。当我使用静态路由而不是捕获时，该应用程序也会失败：

type DirServe = "myRoute" :> Raw

但是，如果我使用根路由，则处理程序按预期工作。

type DirServe = Raw

简单目录服务器.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
4

1 回答 1

0

将此文件归档在“用户错误”下。

当我导航到我的页面时，例如

localhost:8081/myRoute

请注意缺少尾部斜杠。服务目录的根位于

localhost:8081/myRoute/

当我在那里导航时，一切都按预期工作。这几乎太尴尬了，但希望我能避免有人像我一样浪费时间。

于 2019-10-07T13:14:59.797 回答