servant-rawm 0.3.2.0 → 1.0.0.0

raw patch · 19 files changed

+98/−921 lines, 19 filesdep −Globdep −bytestringdep −doctestdep ~basedep ~servantPVP ok

version bump matches the API change (PVP)

Dependencies removed: Glob, bytestring, doctest, filepath, hspec-wai, http-client, http-media, http-types, lens, resourcet, servant-client, servant-client-core, servant-docs, servant-rawm, servant-server, tasty, tasty-hspec, tasty-hunit, text, transformers, wai, wai-app-static, warp

Dependency ranges changed: base, servant

API changes (from Hackage documentation)

Files

• CHANGELOG.md +11/−0
• LICENSE +1/−1
• README.md +21/−6
• example/Api.hs +0/−20
• example/Client.hs +0/−53
• example/Docs.hs +0/−34
• example/Server.hs +0/−60
• example/files/bar.txt +0/−1
• example/files/foo.txt +0/−3
• servant-rawm.cabal +14/−125
• src/Servant/RawM.hs +51/−16
• src/Servant/RawM/Internal.hs +0/−26
• src/Servant/RawM/Internal/API.hs +0/−42
• src/Servant/RawM/Internal/Client.hs +0/−58
• src/Servant/RawM/Internal/Docs.hs +0/−93
• src/Servant/RawM/Internal/Server.hs +0/−126
• stack.yaml +0/−47
• test/DocTest.hs +0/−40
• test/Spec.hs +0/−170

@@ -1,3 +1,14 @@+## 1.0.0.0++*   The implementations of the `RawM` endpoint are divided into+    `servant-rawm-client`, `servant-rawm-docs`, and `servant-rawm-server` to+    avoid introducing unnecessary dependencies and reduce the compilation+    overhead. You will need to add either of the implementations to your+    dependencies, and import the corresponding implementation+    (`Servant.RawM.Server`, `Servant.RawM.Client`, or `Servant.RawM.Docs`) for+    the `RawM` endpoint to function correctly.+    [#16](https://github.com/cdepillabout/servant-rawm/pull/16)+    Thanks [@Krasjet](https://github.com/Krasjet)!  ## 0.3.2.0 

@@ -1,4 +1,4 @@-Copyright Dennis Gosnell (c) 2017+Copyright Dennis Gosnell (c) 2017-2020  All rights reserved. 

@@ -1,4 +1,3 @@- # Servant.RawM  [![Build Status](https://secure.travis-ci.org/cdepillabout/servant-rawm.svg)](http://travis-ci.org/cdepillabout/servant-rawm)@@ -19,10 +18,20 @@ [`RawM`](https://hackage.haskell.org/package/servant-rawm/docs/Servant-RawM.html#t:RawM) type. +After `servant-rawm` 1.0.0.0, the implementations of the `RawM` endpoint are+divided into `servant-rawm-client`, `servant-rawm-docs`, and+`servant-rawm-server` to avoid introducing unnecessary dependencies and reduce+the compilation overhead.++You will need to add either of the implementations to your dependencies, and+import the corresponding implementation (`Servant.RawM.Server`,+`Servant.RawM.Client`, or `Servant.RawM.Docs`) for the `RawM` endpoint to+function correctly.+ ## Example  There is code for an example server, client, and documentation located-in [`example/`](example/). The following section describes how to run the+in [`servant-rawm-examples-and-tests/example/`](servant-rawm-examples-and-tests/example/). The following section describes how to run the example executables.  ### Building@@ -30,7 +39,7 @@ The example executables can be built with the following command:  ```sh-$ stack build --flag servant-rawm:buildexample+$ stack build servant-rawm-examples-and-tests ```  ### Server@@ -42,7 +51,7 @@ ```  This runs a server on port 8201 serving files-in [`example/files/`](example/files/).+in [`servant-rawm-examples-and-tests/example/files/`](servant-rawm-examples-and-tests/example/files/).  It can be accessed from `curl` like the following: @@ -53,7 +62,7 @@  ### Client -After building, the client can be run like the following:+After building and running the server, the client can be run like the following:  ```sh $ stack exec -- servant-rawm-example-client@@ -65,9 +74,15 @@ ### Documentation  After building, the documentation can be generated like the following. This is-documentation for the API defined in [example/Api.hs](example/Api.hs):+documentation for the API defined in+[servant-rawm-examples-and-tests/example/Api.hs](servant-rawm-examples-and-tests/example/Api.hs):  ```sh $ stack exec -- servant-rawm-example-docs ... ```++## Maintainers++- [@cdepillabout](https://github.com/cdepillabout)+- [@Krasjet](https://github.com/Krasjet)

@@ -1,20 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE TypeOperators #-}--module Api where--import Servant.API (Get, JSON, (:>), (:<|>))--import Servant.RawM (RawM)--type Api = OtherEndpoint1 :<|> RawEndpoint :<|> OtherEndpoint2--type OtherEndpoint1 = "other-endpoint-1" :> Get '[JSON] Int--type RawEndpoint = "serve-directory" :> RawM--type OtherEndpoint2 = "other-endpoint-2" :> Get '[JSON] Int---- | The port to run the server on.-port :: Int-port = 8201

@@ -1,53 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Main where--import Data.ByteString.Lazy (ByteString)-import qualified Data.ByteString.Lazy as LBS-import Data.Monoid ((<>))-import Data.Proxy (Proxy(Proxy))-import Data.Text (Text)-import Network.HTTP.Client (defaultManagerSettings, newManager)-import Network.HTTP.Types (methodGet)-import Servant.API ((:<|>)((:<|>)))-import Servant.Client-       (BaseUrl(BaseUrl), ClientM, Response, Scheme(Http),-        client, mkClientEnv, responseBody, runClientM)-import Servant.Client.Core (Request, appendToPath, requestMethod)-import Servant.RawM ()--import Api (Api, port)---------------------------------------------- Clients generated by servant-client ----------------------------------------------otherEndpoint1 :: ClientM Int-getFile' :: (Request -> Request) -> ClientM Response-otherEndpoint2 :: ClientM Int-otherEndpoint1 :<|> getFile' :<|> otherEndpoint2 = client (Proxy :: Proxy Api)--getFile :: Text -> ClientM ByteString-getFile filePath = do-  resp <--    getFile' $ \req -> appendToPath filePath req { requestMethod = methodGet }-  pure $ responseBody resp---------------- Main ---------------main :: IO ()-main = do-  manager <- newManager defaultManagerSettings-  let clientEnv = mkClientEnv manager baseUrl-  eitherRes <- runClientM (getFile "foo.txt") clientEnv-  case eitherRes of-    Left servantErr -> putStrLn $ "Got a ServantErr: " <> show servantErr-    Right fileContents -> do-      putStrLn "Successfully got file ./example/files/foo.txt:\n"-      LBS.putStr fileContents--baseUrl :: BaseUrl-baseUrl = BaseUrl Http "localhost" port ""

@@ -1,34 +0,0 @@-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE EmptyCase #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UndecidableInstances #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--module Main where--import Data.Proxy (Proxy(Proxy))-import Data.Text (Text)-import Servant.Docs (ToSample(toSamples), docs, markdown)--import Servant.RawM ()--import Api (Api)--instance ToSample Int where-  toSamples :: Proxy Int -> [(Text, Int)]-  toSamples Proxy = [("example Int", 3)]---- | Print the documentation rendered as markdown to stdout.-main :: IO ()-main = putStrLn . markdown $ docs (Proxy :: Proxy Api)

@@ -1,60 +0,0 @@-{-# LANGUAGE TypeOperators #-}--module Main where--import Control.Monad.IO.Class (liftIO)-import Control.Monad.Trans.Reader (ReaderT, ask, runReaderT)-import Data.Monoid ((<>))-import Data.Proxy (Proxy(Proxy))-import Network.Wai (Application)-import Network.Wai.Handler.Warp (run)-import Servant (Handler, (:<|>)((:<|>)), Server, ServerT, hoistServer, serve)--import Servant.RawM (serveDirectoryWebApp)--import Api (Api, port)--data Config = Config-  { configInt1 :: Int-  , configInt2 :: Int-  , configDir :: FilePath-  } deriving Show--config :: Config-config = Config {configInt1 = 3, configInt2 = 4, configDir = "./example/files"}--serverRoot :: ServerT Api (ReaderT Config IO)-serverRoot = getOtherEndpoint1 :<|> rawEndpoint :<|> getOtherEndpoint2--getOtherEndpoint1 :: ReaderT Config IO Int-getOtherEndpoint1 = do-  (Config int1 _ _) <- ask-  pure int1--rawEndpoint :: ReaderT Config IO Application-rawEndpoint = do-  (Config _ _ dir) <- ask-  serveDirectoryWebApp dir--getOtherEndpoint2 :: ReaderT Config IO Int-getOtherEndpoint2 = do-  (Config _ int2 _) <- ask-  pure int2--apiProxy :: Proxy Api-apiProxy = Proxy--app :: Config -> Application-app conf = serve apiProxy apiServer-  where-    apiServer :: Server Api-    apiServer = hoistServer apiProxy transformation serverRoot--    transformation :: ReaderT Config IO a -> Handler a-    transformation readerT = liftIO $ runReaderT readerT conf---- | Run the WAI 'Application' using 'run' on the port defined by 'port'.-main :: IO ()-main = do-  putStrLn $ "example RawM server running on port " <> show port-  run port $ app config

@@ -1,1 +0,0 @@-This is bar.txt.

@@ -1,3 +0,0 @@-This is an example text file.--The example API will serve any file in the ./example/files directory.

@@ -1,147 +1,36 @@ name:                servant-rawm-version:             0.3.2.0+version:             1.0.0.0 synopsis:            Embed a raw 'Application' in a Servant API-description:         Please see <https://github.com/cdepillabout/servant-rawm#readme README.md>.+description:+  Please see <https://github.com/cdepillabout/servant-rawm#readme README.md>.+  .+  After @servant-rawm@ 1.0.0.0, the implementation are divided into+  three packages: @servant-rawm-server@, @servant-rawm-client@,+  and @servant-rawm-docs@.+  .+  You need to use either of the three implementations for the 'RawM' endpoint+  to function correctly. homepage:            https://github.com/cdepillabout/servant-rawm license:             BSD3 license-file:        LICENSE author:              Dennis Gosnell maintainer:          cdep.illabout@gmail.com+                   , nil.krjst@gmail.com copyright:           2017 Dennis Gosnell-category:            Text+category:            Servant+                   , Web build-type:          Simple extra-source-files:  CHANGELOG.md                    , README.md-                   , example/files/bar.txt-                   , example/files/foo.txt-                   , stack.yaml cabal-version:       >=1.10 -flag buildexample-  description: Build a small example program-  default: False- library   hs-source-dirs:      src   exposed-modules:     Servant.RawM-                     , Servant.RawM.Internal-                     , Servant.RawM.Internal.API-                     , Servant.RawM.Internal.Client-                     , Servant.RawM.Internal.Docs-                     , Servant.RawM.Internal.Server   build-depends:       base >= 4.8 && < 5-                     , bytestring >= 0.10-                     , filepath >= 1.4-                     , http-client >= 0.5-                     , http-media >= 0.6-                     , http-types >= 0.9-                     , lens >= 4.0-                     , resourcet >= 1.0-                     , servant-client >= 0.16-                     , servant-client-core >= 0.16-                     , servant-docs >= 0.11.3-                     , servant-server >= 0.16-                     , wai >= 3.2-                     , wai-app-static >= 3.1+                     , servant >= 0.16   default-language:    Haskell2010   ghc-options:         -Wall -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -fwarn-monomorphism-restriction -Wmissing-import-lists--  other-extensions:    QuasiQuotes-                     , TemplateHaskell--executable servant-rawm-example-client-  main-is:             Client.hs-  other-modules:       Api-  hs-source-dirs:      example-  build-depends:       base-                     , bytestring-                     , http-client-                     , http-media-                     , http-types-                     , servant-                     , servant-rawm-                     , servant-client-                     , servant-client-core-                     , text-  default-language:    Haskell2010-  ghc-options:         -Wall -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -fwarn-monomorphism-restriction -Wmissing-import-lists -threaded -rtsopts -with-rtsopts=-N--  if flag(buildexample)-    buildable:         True-  else-    buildable:         False--executable servant-rawm-example-docs-  main-is:             Docs.hs-  other-modules:       Api-  hs-source-dirs:      example-  build-depends:       base-                     , servant-                     , servant-rawm-                     , servant-docs-                     , text-  default-language:    Haskell2010-  ghc-options:         -Wall -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -fwarn-monomorphism-restriction -Wmissing-import-lists -threaded -rtsopts -with-rtsopts=-N--  if flag(buildexample)-    buildable:         True-  else-    buildable:         False--executable servant-rawm-example-server-  main-is:             Server.hs-  other-modules:       Api-  hs-source-dirs:      example-  build-depends:       base-                     , servant-                     , servant-rawm-                     , servant-server-                     , transformers-                     , wai-                     , warp-  default-language:    Haskell2010-  ghc-options:         -Wall -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -fwarn-monomorphism-restriction -Wmissing-import-lists -threaded -rtsopts -with-rtsopts=-N--  if flag(buildexample)-    buildable:         True-  else-    buildable:         False--test-suite servant-rawm-doctest-  type:                exitcode-stdio-1.0-  main-is:             DocTest.hs-  hs-source-dirs:      test-  build-depends:       base-                     , doctest-                     , Glob-  default-language:    Haskell2010-  ghc-options:         -Wall -threaded -rtsopts -with-rtsopts=-N--test-suite servant-rawm-test-  type:                exitcode-stdio-1.0-  main-is:             Spec.hs-  other-modules:-  hs-source-dirs:      test-  build-depends:       base-                     , bytestring-                     , hspec-wai-                     , http-client-                     , http-media-                     , http-types-                     , servant-                     , servant-client-                     , servant-client-core-                     , servant-rawm-                     , servant-server-                     , tasty-                     , tasty-hspec >= 0.2-                     , tasty-hunit-                     , text-                     , transformers-                     , wai-                     , warp-  default-language:    Haskell2010-  ghc-options:         -Wall -threaded -rtsopts -with-rtsopts=-N -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -fwarn-monomorphism-restriction -Wmissing-import-lists  source-repository head   type:     git

@@ -1,4 +1,4 @@-{-# OPTIONS_GHC -fno-warn-missing-import-lists #-}+{-# LANGUAGE TypeFamilies #-}  {- | Module      :  Servant.RawM@@ -7,8 +7,9 @@ License     :  BSD3  Maintainer  :  Dennis Gosnell (cdep.illabout@gmail.com)+               Krasjet (nil.krjst@gmail.com) -This module exposes a 'RawM' type that allows you to embed a WAI+This module defines the 'RawM' type that allows you to embed a WAI 'Network.Wai.Application' in your Servant API.  It is similar to 'Servant.API.Raw.Raw' provided by Servant, but there is one big@@ -19,6 +20,8 @@ 'RawM':  @+  import "Servant.RawM.Server"+   type Api = \"serve-directory-example\" :> 'RawM'    serverRoot :: 'Servant.Server.ServerT' Api ('Control.Monad.Reader.ReaderT' 'FilePath' 'IO')@@ -27,7 +30,7 @@   rawEndpoint :: 'Control.Monad.Reader.ReaderT' 'FilePath' 'IO' 'Network.Wai.Application'   rawEndpoint = do     filePath <- 'Control.Monad.Reader.ask'-    'serveDirectoryWebApp' filePath+    'Servant.RawM.Server.serveDirectoryWebApp' filePath    apiProxy :: 'Data.Proxy.Proxy' Api   apiProxy = 'Data.Proxy.Proxy'@@ -49,7 +52,7 @@ following:  @-  type Api\' = \"serve-directory-example\" :> 'Raw'+  type Api\' = \"serve-directory-example\" :> 'Servant.API.Raw.Raw'    serverRoot\' :: 'Server.ServerT' Api\' ('Control.Monad.Reader.ReaderT' 'FilePath' 'IO')   serverRoot\' = rawEndpoint\'@@ -65,23 +68,55 @@ produced monadically.  There is an-<https://github.com/cdepillabout/servant-rawm/tree/master/example example> in-the source code repository that shows a more in-depth server, client, and+<https://github.com/cdepillabout/servant-rawm/tree/master/servant-rawm-examples-and-tests/example example>+in the source code repository that shows a more in-depth server, client, and documentation.++After @servant-rawm@ 1.0.0.0, the implementations for 'RawM' server, client,+and documentation generator are divided into three packages:+<https://hackage.haskell.org/package/servant-rawm-server servant-rawm-server>,+<https://hackage.haskell.org/package/servant-rawm-client servant-rawm-client>,+and+<https://hackage.haskell.org/package/servant-rawm-client servant-rawm-docs>+to avoid pulling in unnecessary dependencies. This module is re-exported in+"Servant.RawM.Server", "Servant.RawM.Client", and "Servant.RawM.Docs", so you+don't need to import this module explicitly. Import the corresponding+implementation instead. -} -module Servant.RawM-  (+module Servant.RawM (   -- * 'RawM' API parameter     RawM   , RawM'   , FileServer-  -- * Helper functions for writing simple file servers-  , serveDirectoryWebApp-  , serveDirectoryFileServer-  , serveDirectoryWebAppLookup-  , serveDirectoryEmbedded-  , serveDirectoryWith-  ) where+)+  where -import Servant.RawM.Internal+import Data.Typeable (Typeable)+import Servant.Links (HasLink, MkLink, toLink)++-- | Specialization of 'RawM'' to 'FileServer'. This can be used if you are+-- using 'Servant.RawM.Server.serveDirectoryWebApp',+-- 'Servant.RawM.Server.serveDirectoryFileServer', etc.+type RawM = RawM' FileServer++-- | This is a type to use to define a Servant API. It signifies a route that+-- allows embedding of a WAI 'Network.Wai.Application'. It is similar to+-- 'Servant.API.Raw.Raw', but it has a 'Servant.Server.HasServer' instance that+-- allows embedding of monadic effects. This should be more convenient than+-- 'Servant.API.Raw.Raw'.+--+-- The phantom type @serverType@ is used for defining the 'Servant.Docs.HasDocs'+-- instance. There are instances for 'Servant.Client.HasClient' and+-- 'Servant.Server.HasServer' for 'RawM'' with a polymorphic phantom type, but+-- there is only a 'Servant.Docs.HasDocs' instance specified for @'RawM''+-- 'FileServer'@. This allows the end-user to easily create a+-- 'Servant.Docs.HasDocs' instance for a custom 'Network.Wai.Application'.+data RawM' serverType deriving Typeable++instance HasLink (RawM' st) where+  type MkLink (RawM' st) a = a+  toLink toA _ = toA++-- | Used by 'RawM' as a phantom type.+data FileServer deriving Typeable

@@ -1,26 +0,0 @@-{-# OPTIONS_GHC -fno-warn-missing-import-lists #-}--{- |-Module      :  Servant.RawM.Internal--Copyright   :  Dennis Gosnell 2017-License     :  BSD3--Maintainer  :  Dennis Gosnell (cdep.illabout@gmail.com)-Stability   :  experimental-Portability :  unknown--Export all of the instances for the Client, Docs, and Server.--}--module Servant.RawM.Internal-  ( module Servant.RawM.Internal.API-  -- , module Servant.RawM.Internal.Client-  -- , module Servant.RawM.Internal.Docs-  , module Servant.RawM.Internal.Server-  ) where--import Servant.RawM.Internal.API-import Servant.RawM.Internal.Client ()-import Servant.RawM.Internal.Docs ()-import Servant.RawM.Internal.Server

@@ -1,42 +0,0 @@-{-# LANGUAGE TypeFamilies #-}--{- |-Module      :  Servant.RawM.Internal.API--Copyright   :  Dennis Gosnell 2017-License     :  BSD3--Maintainer  :  Dennis Gosnell (cdep.illabout@gmail.com)---}--module Servant.RawM.Internal.API where--import Data.Typeable (Typeable)-import Servant (HasLink, MkLink, toLink)---- | Specialization of 'RawM'' to 'FileServer'. This can be used if you are--- using 'Servant.RawM.serveDirectoryWebApp',--- 'Servant.RawM.serveDirectoryFileServer', etc.-type RawM = RawM' FileServer---- | This is a type to use to define a Servant API. It signifies a route that--- allows embedding of a WAI 'Network.Wai.Application'. It is similar to--- 'Servant.API.Raw.Raw', but it has a 'Servant.Server.HasServer' instance that--- allows embedding of monadic effects. This should be more convenient than--- 'Servant.API.Raw.Raw'.------ The phantom type @serverType@ is used for defining the 'Servant.Docs.HasDocs'--- instance. There are instances for 'Servant.Client.HasClient' and--- 'Servant.Server.HasServer' for 'RawM'' with a polymorphic phantom type, but--- there is only a 'Servant.Docs.HasDocs' instance specified for @'RawM''--- 'FileServer'@. This allows the end-user to easily create a--- 'Servant.Docs.HasDocs' instance for a custom 'Network.Wai.Application'.-data RawM' serverType deriving Typeable--instance HasLink (RawM' st) where-  type MkLink (RawM' st) a = a-  toLink toA _ = toA---- | Used by 'RawM' as a phantom type.-data FileServer deriving Typeable

@@ -1,58 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE TypeFamilies #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--{- |-Module      :  Servant.RawM.Internal.Client--Copyright   :  Dennis Gosnell 2017-License     :  BSD3--Maintainer  :  Dennis Gosnell (cdep.illabout@gmail.com)-Stability   :  experimental-Portability :  unknown--This module only exports a 'HasClient' instance for 'RawM'.--}--module Servant.RawM.Internal.Client where--import Data.Proxy (Proxy(Proxy))-import Servant.Client (Client, HasClient(clientWithRoute, hoistClientMonad))-import Servant.Client.Core (runRequest, RunClient, Request, Response)-import Servant.RawM.Internal.API (RawM')---- | Creates a client route like the following:------ >>> :set -XTypeOperators--- >>> import Data.Type.Equality ((:~:)(Refl))--- >>> Refl :: Client m (RawM' a) :~: ((Request -> Request) -> m Response)--- Refl------ This allows modification of the underlying 'Request' to work for any sort of--- 'Network.Wai.Application'.------ Check out the--- <https://github.com/cdepillabout/servant-rawm/tree/master/example example> in--- the source code repository that shows a more in-depth server, client, and--- documentation.-instance RunClient m => HasClient m (RawM' serverType) where-  type Client m (RawM' serverType) = (Request -> Request) -> m Response--  clientWithRoute-    :: Proxy m-    -> Proxy (RawM' serverType)-    -> Request-    -> Client m (RawM' serverType)-  clientWithRoute Proxy Proxy req reqFunc = runRequest $ reqFunc req--  hoistClientMonad-    :: Proxy m-    -> Proxy (RawM' serverType)-    -> (forall x. mon x -> mon' x)-    -> Client mon (RawM' serverType)-    -> Client mon' (RawM' serverType)-  hoistClientMonad Proxy Proxy f cl = \meth -> f (cl meth)

@@ -1,93 +0,0 @@-{-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE NoMonomorphismRestriction #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--{- |-Module      :  Servant.RawM.Internal.Docs--Copyright   :  Dennis Gosnell 2017-License     :  BSD3--Maintainer  :  Dennis Gosnell (cdep.illabout@gmail.com)-Stability   :  experimental-Portability :  unknown--This module exports a 'HasDocs' instance for 'RawM'.--}--module Servant.RawM.Internal.Docs where--import Control.Lens ((.~), (<>~))-import Data.Function ((&))-import Data.Proxy (Proxy(Proxy))-import Data.Semigroup ((<>))-import Network.HTTP.Media ((//))-import Network.HTTP.Types (methodGet)-import Servant.Docs-       (Action, API, DocCapture(DocCapture), DocNote(DocNote), DocOptions,-        Endpoint, HasDocs(docsFor), captures, defResponse, method, notes,-        path, respBody, respStatus, respTypes, response, single)--import Servant.RawM.Internal.API (FileServer, RawM')---- | This just defers to the 'HasDocs' instance for the @serverType@ phantom--- type.-instance (HasDocs serverType) => HasDocs (RawM' serverType) where-  docsFor :: Proxy (RawM' serverType) -> (Endpoint, Action) -> DocOptions -> API-  docsFor Proxy (endpoint, action) docOpts =-    docsFor (Proxy :: Proxy serverType) (endpoint, action) docOpts---- | This is a 'HasDocs' instance compatible with the file servers defined in--- "Servant.RawM.Internal.Server".-instance HasDocs FileServer where-  docsFor :: Proxy FileServer -> (Endpoint, Action) -> DocOptions -> API-  docsFor Proxy (endpoint, action) _ =-    let captureSymbol = ":filename"-        captureDesc = "the name of the file to GET"-        capture = DocCapture captureSymbol captureDesc-        htmlMediaType = "text" // "html"-        jsMediaType = "application" // "javascript"-        possibleRespMediaTypes =-          [ jsMediaType-          , "application" // "xml"-          , "application" // "zip"-          , "application" // "pdf"-          , "audio" // "mpeg"-          , "text" // "css"-          , htmlMediaType-          , "text" // "csv"-          , "text" // "plain"-          , "image" // "png"-          , "image" // "jpeg"-          , "image" // "gif"-          ]-        sampleHtml = "<html><body><p>Hello World</p></body></html>"-        sampleHtmlResp = ("example HTML response", htmlMediaType, sampleHtml)-        sampleJs = "alert(\"Hello World\");"-        sampleJsResp = ("example JS response", jsMediaType, sampleJs)-        noteBody1 =-          "This route is a file server.  If you specify the filename, it " <>-          "will serve up the file with the appropriate content type.  If " <>-          "the file doesn't exist, it will return a 404."-        noteBody2 =-          "The supported content types below are just examples.  A full " <>-          "list of recognized MIME types can be found " <>-          "[here](https://hackage.haskell.org/package/mime-types-0.1.0.7/docs/src/Network.Mime.html#defaultMimeMap)."-        note = DocNote "File Server" [noteBody1, noteBody2]-        resp =-          defResponse-            & respStatus .~ 200-            & respTypes .~ possibleRespMediaTypes-            & respBody .~ [sampleHtmlResp, sampleJsResp]-        newEndpoint =-          endpoint-            & method .~ methodGet-            & path <>~ [captureSymbol]-        newAction =-          action-            & captures <>~ [capture]-            & notes <>~ [note]-            & response .~ resp-    in single newEndpoint newAction

@@ -1,126 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--{- |-Module      :  Servant.RawM.Internal.Server--Copyright   :  Dennis Gosnell 2017-License     :  BSD3--Maintainer  :  Dennis Gosnell (cdep.illabout@gmail.com)-Stability   :  experimental-Portability :  unknown--This module exports 'HasServer' instances for 'RawM'', as well as some helper-functions for serving directories of files.--}--module Servant.RawM.Internal.Server where--import Control.Monad.IO.Class (liftIO)-import Control.Monad.Trans.Resource (runResourceT)-import Data.ByteString (ByteString)-import Data.Proxy (Proxy(Proxy))-import Network.Wai-       (Application, Request, Response, ResponseReceived)-import Network.Wai.Application.Static-       (StaticSettings, defaultFileServerSettings, defaultWebAppSettings,-        embeddedSettings, staticApp, webAppSettingsWithLookup)-import Servant (Context, HasServer(route, hoistServerWithContext), Handler, ServerT, runHandler)-import Servant.Server.Internal-       (Delayed, Router'(RawRouter), RouteResult(Fail, FailFatal, Route), responseServerError, runDelayed)-import System.FilePath (addTrailingPathSeparator)-import WaiAppStatic.Storage.Filesystem (ETagLookup)--import Servant.RawM.Internal.API (RawM')---- | Creates a server instance like the following:--------- >>> :set -XTypeOperators--- >>> import Data.Type.Equality ((:~:)(Refl))--- >>> Refl :: ServerT (RawM' a) m :~: m Application--- Refl-instance HasServer (RawM' serverType) context where-  type ServerT (RawM' serverType) m = m Application-  route-    :: forall env.-       Proxy (RawM' serverType)-    -> Context context-    -> Delayed env (Handler Application)-    -> Router' env (Request -> (RouteResult Response -> IO ResponseReceived) -> IO ResponseReceived)-  route Proxy _ rawApplication = RawRouter go-    where-      go-        :: env-        -> Request-        -> (RouteResult Response -> IO ResponseReceived)-        -> IO ResponseReceived-      go env request respond =-        runResourceT $ do-          routeRes <- runDelayed rawApplication env request-          liftIO $-            case routeRes of-              (Fail e) -> respond $ Fail e-              (FailFatal e) -> respond $ FailFatal e-              (Route handlerApp) -> do-                eitherApp <- runHandler handlerApp-                case eitherApp of-                  Left err -> respond . Route $ responseServerError err-                  Right app -> app request (respond . Route)-  hoistServerWithContext-    :: Proxy (RawM' serverType)-      -> Proxy context-      -> (forall x. m x -> n x)-      -> m Application-      -> n Application-  hoistServerWithContext Proxy Proxy f m = f m---- | Serve anything under the specified directory as a 'RawM'' endpoint.------ @--- type MyApi = "static" :> RawM'------ server :: ServerT MyApi m--- server = serveDirectoryWebApp "\/var\/www"--- @------ would capture any request to @\/static\/\<something>@ and look for--- @\<something>@ under @\/var\/www@.------ It will do its best to guess the MIME type for that file, based on the extension,--- and send an appropriate /Content-Type/ header if possible.------ If your goal is to serve HTML, CSS and Javascript files that use the rest of the API--- as a webapp backend, you will most likely not want the static files to be hidden--- behind a /\/static\// prefix. In that case, remember to put the 'serveDirectoryWebApp'--- handler in the last position, because /servant/ will try to match the handlers--- in order.------ Corresponds to the `defaultWebAppSettings` `StaticSettings` value.-serveDirectoryWebApp :: Applicative m => FilePath -> ServerT (RawM' serverType) m-serveDirectoryWebApp = serveDirectoryWith . defaultWebAppSettings . addTrailingPathSeparator---- | Same as 'serveDirectoryWebApp', but uses `defaultFileServerSettings`.-serveDirectoryFileServer :: Applicative m => FilePath -> ServerT (RawM' serverType) m-serveDirectoryFileServer = serveDirectoryWith . defaultFileServerSettings . addTrailingPathSeparator---- | Same as 'serveDirectoryWebApp', but uses 'webAppSettingsWithLookup'.-serveDirectoryWebAppLookup :: Applicative m => ETagLookup -> FilePath -> ServerT (RawM' serverType) m-serveDirectoryWebAppLookup etag =-  serveDirectoryWith . flip webAppSettingsWithLookup etag . addTrailingPathSeparator---- | Uses 'embeddedSettings'.-serveDirectoryEmbedded :: Applicative m => [(FilePath, ByteString)] -> ServerT (RawM' serverType) m-serveDirectoryEmbedded files = serveDirectoryWith (embeddedSettings files)---- | Alias for 'staticApp'. Lets you serve a directory with arbitrary--- 'StaticSettings'. Useful when you want particular settings not covered by--- the four other variants. This is the most flexible method.-serveDirectoryWith :: Applicative m => StaticSettings -> ServerT (RawM' serverType) m-serveDirectoryWith = pure . staticApp

@@ -1,47 +0,0 @@-# For more information, see: http://docs.haskellstack.org/en/stable/yaml_configuration.html--# Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2)-# nightly is used for the servant-0.16 dependencies.  When lts-14 is released, this can be updated to-# use that.-resolver: lts-14.3--# Local packages, usually specified by relative directory name-packages:-- '.'--# Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3)-extra-deps: []--# Override default flag values for local packages and extra-deps-flags: {}--# Extra package databases containing global packages-extra-package-dbs: []--# Control whether we use the GHC we find on the path-# system-ghc: true--# Require a specific version of stack, using version ranges-# require-stack-version: -any # Default-# require-stack-version: >= 1.0.0--# Override the architecture used by stack, especially useful on Windows-# arch: i386-# arch: x86_64--# Extra directories used by stack for building-# extra-include-dirs: [/path/to/dir]-# extra-lib-dirs: [/path/to/dir]--# Allow a newer minor version of GHC than the snapshot specifies-# compiler-check: newer-minor--# Enable Hackage-friendly mode, for more details see-#  https://docs.haskellstack.org/en/stable/yaml_configuration/#pvp-bounds-# This has been disabled because of the following exchange:-# https://github.com/cdepillabout/pretty-simple/pull/1#issuecomment-272706215-#pvp-bounds: both--nix:-  packages:-    - zlib

@@ -1,40 +0,0 @@--module Main (main) where--import Prelude--import Data.Monoid ((<>))-import System.FilePath.Glob (glob)-import Test.DocTest (doctest)--main :: IO ()-main = glob "src/**/*.hs" >>= doDocTest--doDocTest :: [String] -> IO ()-doDocTest options = doctest $ options <> ghcExtensions--ghcExtensions :: [String]-ghcExtensions =-    [-    --   "-XConstraintKinds"-    -- , "-XDataKinds"-      "-XDeriveDataTypeable"-    , "-XDeriveGeneric"-    -- , "-XEmptyDataDecls"-    , "-XFlexibleContexts"-    -- , "-XFlexibleInstances"-    -- , "-XGADTs"-    -- , "-XGeneralizedNewtypeDeriving"-    -- , "-XInstanceSigs"-    -- , "-XMultiParamTypeClasses"-    -- , "-XNoImplicitPrelude"-    , "-XOverloadedStrings"-    -- , "-XPolyKinds"-    -- , "-XRankNTypes"-    -- , "-XRecordWildCards"-    , "-XScopedTypeVariables"-    -- , "-XStandaloneDeriving"-    -- , "-XTupleSections"-    -- , "-XTypeFamilies"-    -- , "-XTypeOperators"-    ]

@@ -1,170 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeOperators #-}--module Main where--import Control.Concurrent-       (ThreadId, forkIO, killThread, threadDelay)-import Control.Exception (Exception, SomeException, catch)-import Control.Monad.IO.Class (liftIO)-import Control.Monad.Trans.Reader (ReaderT, ask, runReaderT)-import Data.ByteString.Lazy (ByteString)-import Data.Either (isLeft)-import Data.Monoid ((<>))-import Data.Proxy (Proxy(Proxy))-import Data.Text (Text)-import Data.Type.Equality ((:~:)(Refl))-import Data.Typeable (Typeable)-import Network.HTTP.Client (defaultManagerSettings, newManager)-import Network.HTTP.Types (methodGet)-import Network.Wai (Application)-import Network.Wai.Handler.Warp (run)-import Servant ((:>), Handler, ServerT, hoistServer, serve)-import Servant.Client-       (Client, ClientM, Response, client, mkClientEnv, parseBaseUrl, responseBody, runClientM)-import Servant.Client.Core (Request, appendToPath, requestMethod)-import Test.Hspec.Wai (get, shouldRespondWith, with)-import Test.Tasty (TestTree, defaultMain, testGroup)-import Test.Tasty.Hspec (afterAll, beforeAll, it, shouldBe, testSpec)-import Test.Tasty.HUnit ((@?=), assertFailure, testCase)--import Servant.RawM (RawM, serveDirectoryWebApp)--main :: IO ()-main = do-  tests <- testsIO-  defaultMain tests--testsIO :: IO TestTree-testsIO = do-  clientTests <- clientTestsIO-  serverTests <- serverTestsIO-  pure $-    testGroup-      "tests"-      [ instanceTests-      , clientTests-      , serverTests-      ]------------------ Helpers ------------------type Selector e = e -> Bool--anyException :: Selector SomeException-anyException _ = True---- | Extra HUnit assertion to make sure an expression throws an exception.-assertThrows-  :: forall e a.-     (Exception e, Typeable e)-  => IO a -> Selector e -> IO ()-assertThrows ioAction selector = do-  didCatch <- catch (ioAction *> pure False) (pure . selector)-  case didCatch of-    False ->-      assertFailure "expecting an exception, but no exception occurred"-    True -> pure ()---- | Infix version of 'assertThrows'.-(@!)-  :: (Exception e, Typeable e)-  => IO a -> Selector e -> IO ()-(@!) = assertThrows--infix 1 @!----------------------------------- HasServer instance tests -----------------------------------checkRawMServer :: ServerT RawM m :~: m Application-checkRawMServer = Refl--checkRawMClient-  :: Client m RawM :~: ((Request -> Request) -> m Response)-checkRawMClient = Refl--instanceTests :: TestTree-instanceTests =-  testGroup-    "instances"-    [ testCase "HasServer" $ checkRawMServer @?= Refl-    , testCase "HasClient" $ checkRawMClient @?= Refl-    ]------------------------------------- Real Server Tests (Server) -------------------------------------type Api = "test" :> RawM--server :: ServerT Api (ReaderT FilePath IO)-server = fileServer--fileServer :: ReaderT FilePath IO Application-fileServer = do-  path <- ask-  serveDirectoryWebApp path--app :: Application-app =-  let proxy = Proxy :: Proxy Api-  in-  serve proxy $ hoistServer proxy trans server-  where-    trans :: forall a. ReaderT FilePath IO a -> Handler a-    trans readerT = liftIO $ runReaderT readerT "example/files"--serverTestsIO :: IO TestTree-serverTestsIO =-  testSpec "server" $-    with (pure app) $ do-      it "correctly serves files" $-        get "/test/bar.txt" `shouldRespondWith` "This is bar.txt.\n"-      it "returns 404 for non-existent files" $-        get "/test/non-existent-file.txt" `shouldRespondWith` 404------------------------------------- Real Server Tests (Client) -------------------------------------getFile'-  :: (Request -> Request)-  -> ClientM Response-getFile' = client (Proxy :: Proxy Api)--getFile :: Text -> ClientM ByteString-getFile filePath = do-  resp <--    getFile' $ \req -> appendToPath filePath req { requestMethod = methodGet }-  pure $ responseBody resp--clientTestsIO :: IO TestTree-clientTestsIO = do-  manager <- newManager defaultManagerSettings-  baseUrl <- parseBaseUrl $ "http://localhost:" <> show port <> "/"-  let clientEnv = mkClientEnv manager baseUrl-  testSpec "client" . beforeAll runServer . afterAll killServer $ do-    it "correctly gets files" $ \_ -> do-      eitherRes <- runClientM (getFile "bar.txt") clientEnv-      eitherRes `shouldBe` Right "This is bar.txt.\n"-    it "returns ServantErr for non-existent files" $ \_ -> do-      eitherRes <- runClientM (getFile "non-existent-file.txt") clientEnv-      isLeft eitherRes `shouldBe` True--runServer :: IO ThreadId-runServer = do-  threadId <- forkIO (run port app)-  threadDelay $ 250 * 1000-  pure threadId--killServer :: ThreadId -> IO ()-killServer = killThread--port :: Int-port = 51135