e7b7256 · typeable/servant

git.iko.soy/typeable/servant

on master help sign in

Merge pull request #35 from alpmestan/static_files_shahn

e7b7256Alp Mestanogullari12 years ago

servant.cabal+6

compare with master

unifiedsplit

@@ -33,6 +33,7 @@ library

33 Servant.Server

34 Servant.Utils.ApiQuasiQuoting

35 Servant.Utils.Links

36+ Servant.Utils.StaticFiles

36 build-depends:

37 build-depends:

37 base >=4.7 && <5

38 base >=4.7 && <5

38 , either

39 , either

@@ -46,15 +47,18 @@ library

46 , http-types

47 , http-types

47 , network-uri >= 2.6

48 , network-uri >= 2.6

48 , wai

49 , wai

50+ , wai-app-static

49 , warp

51 , warp

50 , parsec

52 , parsec

51 , safe

53 , safe

52 , transformers

54 , transformers

53 , template-haskell

55 , template-haskell

54 , text

56 , text

57+ , system-filepath

55 , lens

58 , lens

56 , unordered-containers

59 , unordered-containers

57 , hashable

60 , hashable

61+ , system-filepath

58 hs-source-dirs: src

62 hs-source-dirs: src

59 default-language: Haskell2010

63 default-language: Haskell2010

60 ghc-options: -O0 -Wall

64 ghc-options: -O0 -Wall

@@ -85,6 +89,7 @@ test-suite spec

85 , aeson

89 , aeson

86 , bytestring

90 , bytestring

87 , deepseq

91 , deepseq

92+ , directory

88 , either

93 , either

89 , exceptions

94 , exceptions

90 , hspec == 2.*

95 , hspec == 2.*

@@ -96,6 +101,7 @@ test-suite spec

96 , parsec

101 , parsec

97 , servant

102 , servant

98 , string-conversions

103 , string-conversions

104+ , temporary

99 , text

105 , text

100 , transformers

106 , transformers

101 , wai

107 , wai

src/Servant.hs+7

@@ -12,6 +12,10 @@ module Servant (

12 module Servant.Docs,

13 -- | Helper module

14 module Servant.Common.Text,

15+ -- | Utilities on top of the servant core

16+ module Servant.Utils.ApiQuasiQuoting,

17+ module Servant.Utils.Links,

18+ module Servant.Utils.StaticFiles,

15 -- | Useful re-exports

19 -- | Useful re-exports

16 Proxy(..),

20 Proxy(..),

17 ) where

21 ) where

@@ -23,3 +27,6 @@ import Servant.Common.BaseUrl

23import Servant.Common.Text

27import Servant.Common.Text

24import Servant.Docs

28import Servant.Docs

25import Servant.Server

29import Servant.Server

30+import Servant.Utils.ApiQuasiQuoting

31+import Servant.Utils.Links

32+import Servant.Utils.StaticFiles

src/Servant/API/Raw.hs+5

@@ -4,6 +4,7 @@ module Servant.API.Raw where

5import Data.Proxy

6import Network.Wai

7+import Servant.Docs

7import Servant.Server

8import Servant.Server

9-- | Endpoint for plugging in your own Wai 'Application's.

10-- | Endpoint for plugging in your own Wai 'Application's.

@@ -16,3 +17,7 @@ instance HasServer Raw where

16 type Server Raw = Application

17 type Server Raw = Application

17 route Proxy rawApplication request respond =

18 route Proxy rawApplication request respond =

18 rawApplication request (respond . succeedWith)

19 rawApplication request (respond . succeedWith)

20+

21+instance HasDocs Raw where

22+ docsFor _proxy (endpoint, action) =

23+ single endpoint action

src/Servant/Docs.hs+69−59

@@ -85,7 +85,7 @@

85-- > main = printMarkdown greetDocs

86module Servant.Docs

87 ( -- * 'HasDocs' class and key functions

88− HasDocs(..), docs, printMarkdown

88+ HasDocs(..), docs, markdown, printMarkdown

90 , -- * Classes you need to implement for your types

91 ToSample(..), ToParam(..), ToCapture(..)

@@ -106,7 +106,6 @@ module Servant.Docs

106 ) where

107

108import Control.Lens hiding (Action)

109−import Control.Monad (when)

110import Data.Aeson

109import Data.Aeson

111import Data.ByteString.Lazy.Char8 (ByteString)

110import Data.ByteString.Lazy.Char8 (ByteString)

112import Data.Hashable

111import Data.Hashable

@@ -114,9 +113,9 @@ import Data.HashMap.Strict (HashMap)

114import Data.List

113import Data.List

115import Data.Monoid

114import Data.Monoid

116import Data.Proxy

115import Data.Proxy

116+import Data.String.Conversions

117import GHC.Generics

118

119−import qualified Data.ByteString.Lazy.Char8 as LB

120import qualified Data.HashMap.Strict as HM

119import qualified Data.HashMap.Strict as HM

121

120

122-- | Supported HTTP request methods

121-- | Supported HTTP request methods

@@ -349,69 +348,80 @@ class ToCapture c where

349-- | Print documentation in Markdown format for

348-- | Print documentation in Markdown format for

350-- the given 'API', on standard output.

349-- the given 'API', on standard output.

351printMarkdown :: API -> IO ()

350printMarkdown :: API -> IO ()

352−printMarkdown = imapM_ printEndpoint

351+printMarkdown = print . markdown

353−

352+

353+markdown :: API -> String

354+markdown = unlines . concat . map (uncurry printEndpoint) . HM.toList

355+

354− where printEndpoint endpoint action = do

356+ where printEndpoint :: Endpoint -> Action -> [String]

357+ printEndpoint endpoint action =

355− putStrLn $ str

358+ str :

356− putStrLn $ replicate len '-'

359+ replicate len '-' :

357− putStrLn ""

360+ "" :

358− capturesStr (action ^. captures)

361+ capturesStr (action ^. captures) ++

359− paramsStr (action ^. params)

362+ paramsStr (action ^. params) ++

360− rqbodyStr (action ^. rqbody)

363+ rqbodyStr (action ^. rqbody) ++

361− responseStr (action ^. response)

364+ responseStr (action ^. response) ++

365+ []

362

366

363 where str = show (endpoint^.method) ++ " " ++ endpoint^.path

367 where str = show (endpoint^.method) ++ " " ++ endpoint^.path

364 len = length str

368 len = length str

365

369

366− capturesStr :: [DocCapture] -> IO ()

370+ capturesStr :: [DocCapture] -> [String]

367− capturesStr [] = return ()

371+ capturesStr [] = []

368− capturesStr l = do

372+ capturesStr l =

369− putStrLn "**Captures**: "

373+ "**Captures**: " :

370− putStrLn ""

374+ "" :

371− mapM_ captureStr l

375+ map captureStr l ++

372− putStrLn ""

376+ "" :

377+ []

373 captureStr cap =

378 captureStr cap =

374− putStrLn $ "- *" ++ (cap ^. capSymbol) ++ "*: " ++ (cap ^. capDesc)

379+ "- *" ++ (cap ^. capSymbol) ++ "*: " ++ (cap ^. capDesc)

375−

380+

376− paramsStr :: [DocQueryParam] -> IO ()

381+ paramsStr :: [DocQueryParam] -> [String]

377− paramsStr [] = return ()

382+ paramsStr [] = []

378− paramsStr l = do

383+ paramsStr l =

379− putStrLn "**GET Parameters**: "

384+ "**GET Parameters**: " :

380− putStrLn ""

385+ "" :

381− mapM_ paramStr l

386+ map paramStr l ++

382− putStrLn ""

387+ "" :

388+ []

383− paramStr param = do

389+ paramStr param = unlines $

384− putStrLn $ " - " ++ param ^. paramName

390+ (" - " ++ param ^. paramName) :

385− when (not (null values) || param ^. paramKind /= Flag) $

391+ (if (not (null values) || param ^. paramKind /= Flag)

386− putStrLn $ " - **Values**: *" ++ intercalate ", " values ++ "*"

392+ then [" - **Values**: *" ++ intercalate ", " values ++ "*"]

393+ else []) ++

387− putStrLn $ " - **Description**: " ++ param ^. paramDesc

394+ (" - **Description**: " ++ param ^. paramDesc) :

388− when (param ^. paramKind == List) $

395+ (if (param ^. paramKind == List)

389− putStrLn $ " - This parameter is a **list**. All GET parameters with the name "

396+ then [" - This parameter is a **list**. All GET parameters with the name "

390− ++ param ^. paramName ++ "[] will forward their values in a list to the handler."

397+ ++ param ^. paramName ++ "[] will forward their values in a list to the handler."]

398+ else []) ++

391− when (param ^. paramKind == Flag) $

399+ (if (param ^. paramKind == Flag)

392− putStrLn $ " - This parameter is a **flag**. This means no value is expected to be associated to this parameter."

400+ then [" - This parameter is a **flag**. This means no value is expected to be associated to this parameter."]

401+ else []) ++

402+ []

393

403

394 where values = param ^. paramValues

404 where values = param ^. paramValues

395

405

396− rqbodyStr :: Maybe ByteString -> IO ()

406+ rqbodyStr :: Maybe ByteString -> [String]

397− rqbodyStr Nothing = return ()

407+ rqbodyStr Nothing = []

398− rqbodyStr (Just b) = do

408+ rqbodyStr (Just b) =

399− putStrLn "**Request Body**: "

409+ "**Request Body**: " :

400 jsonStr b

410 jsonStr b

401

411

402− jsonStr b = do

412+ jsonStr b =

403− putStrLn ""

413+ "" :

404− putStrLn "``` javascript"

414+ "``` javascript" :

405− LB.putStrLn b

415+ cs b :

406− putStrLn "```"

416+ "```" :

407− putStrLn ""

417+ "" :

408−

418+ []

419+

409− responseStr :: Response -> IO ()

420+ responseStr :: Response -> [String]

410− responseStr resp = do

421+ responseStr resp =

411− putStrLn $ "**Response**: "

422+ "**Response**: " :

412− putStrLn $ ""

423+ "" :

413− putStrLn $ " - Status code " ++ show (resp ^. respStatus)

424+ (" - Status code " ++ show (resp ^. respStatus)) :

414− resp ^. respBody &

425+ (resp ^. respBody &

415− maybe (putStrLn " - No response body\n")

426+ maybe [" - No response body\n"]

416− (\b -> putStrLn " - Response body as below." >> jsonStr b)

427+ (\b -> " - Response body as below." : jsonStr b))

417−

src/Servant/Utils/StaticFiles.hsnew file+33

@@ -0,0 +1,33 @@

1+module Servant.Utils.StaticFiles (

2+ serveDirectory,

3+ serveDocumentation,

4+ ) where

6+import Data.Proxy

7+import Data.String.Conversions

8+import Filesystem.Path.CurrentOS (decodeString)

9+import Network.HTTP.Types

10+import Network.Wai

11+import Network.Wai.Application.Static

12+

13+import Servant.API

14+import Servant.Docs

15+import Servant.Server

16+

17+serveDirectory :: FilePath -> Server Raw

18+serveDirectory documentRoot =

19+ staticApp (defaultFileServerSettings (decodeString (documentRoot ++ "/")))

20+

21+serveDocumentation :: HasDocs api => Proxy api -> Server Raw

22+serveDocumentation proxy _request respond =

23+ respond $ responseLBS ok200 [] $ cs $ toHtml $ markdown $ docs proxy

24+

25+toHtml :: String -> String

26+toHtml markdown =

27+ "<html>" ++

28+ "<body>" ++

29+ "<verbatim>" ++

30+ markdown ++

31+ "</verbatim>" ++

32+ "</body>" ++

33+ "</html>"

test/Servant/ServerSpec.hs+3

@@ -29,6 +29,7 @@ import Servant.API.QueryParam

29import Servant.API.Raw

30import Servant.API.Sub

31import Servant.API.Alternative

32+import Servant.Docs

32import Servant.Server

33import Servant.Server

@@ -42,6 +43,8 @@ data Person = Person {

43instance ToJSON Person

44instance ToJSON Person

44instance FromJSON Person

45instance FromJSON Person

46+instance ToSample Person where

47+ toSample _proxy = Just $ encode alice

46alice :: Person

49alice :: Person

47alice = Person "Alice" 42

50alice = Person "Alice" 42

test/Servant/Utils/StaticFilesSpec.hsnew file+80

@@ -0,0 +1,80 @@

1+{-# LANGUAGE DataKinds #-}

2+{-# LANGUAGE FlexibleInstances #-}

3+{-# LANGUAGE OverloadedStrings #-}

4+{-# LANGUAGE TypeOperators #-}

5+{-# OPTIONS_GHC -fno-warn-orphans #-}

6+module Servant.Utils.StaticFilesSpec where

8+import Control.Exception

9+import Data.Foldable

10+import Data.List

11+import Data.Proxy

12+import Data.String.Conversions

13+import Network.Wai

14+import Network.Wai.Test

15+import System.Directory

16+import System.IO.Temp

17+import Test.Hspec hiding (pending)

18+import Test.Hspec.Wai

19+

20+import Servant.API.Alternative

21+import Servant.API.Capture

22+import Servant.API.Get

23+import Servant.API.Raw

24+import Servant.API.Sub

25+import Servant.Docs

26+import Servant.Server

27+import Servant.ServerSpec

28+import Servant.Utils.StaticFiles

29+

30+type Api =

31+ "dummy_api" :> Capture "person_name" String :> Get Person

32+ :<|> "static" :> Raw

33+ :<|> "documentation" :> Raw

34+

35+instance ToCapture (Capture "person_name" String) where

36+ toCapture _proxy = DocCapture "person_name" "person_name_doc"

37+

38+api :: Proxy Api

39+api = Proxy

40+

41+app :: Application

42+app = serve api server

43+

44+server :: Server Api

45+server =

46+ (\ name -> return (Person name 42))

47+ :<|> serveDirectory "static"

48+ :<|> serveDocumentation api

49+

50+withStaticFiles :: IO () -> IO ()

51+withStaticFiles action = withSystemTempDirectory "servant-test" $ \ tmpDir ->

52+ bracket (setup tmpDir) teardown (const action)

53+ where

54+ setup tmpDir = do

55+ outer <- getCurrentDirectory

56+ setCurrentDirectory tmpDir

57+ createDirectory "static"

58+ writeFile "static/foo.txt" "bar"

59+ writeFile "static/index.html" "index"

60+ return outer

61+

62+ teardown outer = do

63+ setCurrentDirectory outer

64+

65+spec :: Spec

66+spec = do

67+ around_ withStaticFiles $ with (return app) $ do

68+ describe "serveDirectory" $ do

69+ it "successfully serves files" $ do

70+ get "/static/foo.txt" `shouldRespondWith` "bar"

71+

72+ it "serves the contents of index.html when requesting the root of a directory" $ do

73+ get "/static" `shouldRespondWith` "index"

74+

75+ describe "serveDocumentation" $ do

76+ it "serves documentation about the expose API" $ do

77+ response <- get "/documentation"

78+ liftIO $ forM_ ["person_name" :: String, "static", "dummy_api", "person_name_doc"] $

79+ \ snippet ->

80+ (snippet, cs (simpleBody response)) `shouldSatisfy` uncurry isInfixOf