Неправильное построение маршрута с Servant и Raw WAI directoryServer - PullRequest
Новая
       30

Неправильное построение маршрута с Servant и Raw WAI directoryServer

1 голос
/ 25 сентября 2019

В рамках проекта 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

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
...