diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,13 @@ +## 0.8.0.7 (2018-04-03) + +Changes: + + - Bump several package upper bounds. + + - Requires servant 0.13. + + - Drop support for Stackage LTS < 11. + ## 0.8.0.6 (2018-02-04) Fixes: diff --git a/examples/ScheduleUnlock.hs b/examples/ScheduleUnlock.hs --- a/examples/ScheduleUnlock.hs +++ b/examples/ScheduleUnlock.hs @@ -31,8 +31,14 @@ import Network.HTTP.Types (Status(..)) import Options.Applicative import Servant.Client - (BaseUrl, ClientEnv(..), ServantError(..), parseBaseUrl, - runClientM) + ( BaseUrl + , ClientEnv + , ServantError(..) + , mkClientEnv + , parseBaseUrl + , runClientM + ) +import Servant.Client.Core (GenResponse(responseBody, responseStatusCode)) import System.Exit (ExitCode(..), exitWith) data GlobalOptions = @@ -103,7 +109,7 @@ then Unlocked end else Locked in do manager <- newManager tlsManagerSettings - let clientEnv = ClientEnv manager url + let clientEnv = mkClientEnv manager url runClientM (putState state) clientEnv >>= \case Right status -> do putStrLn $ ((show status) :: String) @@ -112,16 +118,16 @@ do putStrLn $ "Mellon service error: " ++ prettyServantError e exitWith $ ExitFailure 1 prettyServantError :: ServantError -> String - prettyServantError (FailureResponse _ status _ _) = - show (statusCode status) ++ " " ++ (toS $ statusMessage status) - prettyServantError (DecodeFailure _ _ _) = + prettyServantError (FailureResponse response) = + show (responseStatusCode response) ++ " " ++ (toS $ responseBody response) + prettyServantError (DecodeFailure _ _) = "decode failure" prettyServantError (UnsupportedContentType _ _) = "unsupported content type" - prettyServantError (InvalidContentTypeHeader _ _) = + prettyServantError (InvalidContentTypeHeader _) = "invalid content type header" prettyServantError (ConnectionError _) = - "connection refused" + "connection error" main :: IO () main = execParser opts >>= run diff --git a/mellon-web.cabal b/mellon-web.cabal --- a/mellon-web.cabal +++ b/mellon-web.cabal @@ -1,11 +1,11 @@ --- This file has been generated from package.yaml by hpack version 0.21.2. +-- This file has been generated from package.yaml by hpack version 0.27.0. -- -- see: https://github.com/sol/hpack -- --- hash: 1f6be6c884c3ebe5ad3e9cc23e01642a2104485a9d38263856e26947381a37b0 +-- hash: 37fd9457219bddae1b0efb878b9f204202aaf16601dc4e139c38f8f16087cf2a name: mellon-web -version: 0.8.0.6 +version: 0.8.0.7 synopsis: A REST web service for Mellon controllers description: The @mellon-web@ package wraps a @mellon-core@ controller in a REST web service, making it possible to control physical access devices @@ -41,7 +41,7 @@ copyright: Copyright (c) 2018, Quixoftic, LLC license: BSD3 license-file: LICENSE -tested-with: GHC==8.0.2 GHC==8.2.2 +tested-with: GHC==8.0.2 GHC==8.2.2 GHC==8.4.1 build-type: Simple cabal-version: >= 1.10 @@ -98,16 +98,17 @@ , base >=4.8 && <5 , bytestring ==0.10.* , http-client >=0.4 && <0.6 - , http-types ==0.9.* + , http-types >=0.9 && <0.13 , lens >=4 && <5 , lucid ==2.9.* , mellon-core , protolude ==0.2.* - , servant ==0.11.* - , servant-client ==0.11.* + , servant ==0.13.* + , servant-client ==0.13.* + , servant-client-core ==0.13.* , servant-docs >=0.10 && <0.12 - , servant-lucid ==0.7.* - , servant-server ==0.11.* + , servant-lucid >=0.7 && <0.9 + , servant-server ==0.13.* , servant-swagger ==1.1.* , servant-swagger-ui ==0.2.* , swagger2 >=2.1 && <2.3 @@ -197,6 +198,7 @@ , optparse-applicative , protolude , servant-client + , servant-client-core , time , transformers default-language: Haskell2010 @@ -241,7 +243,7 @@ else build-depends: base - , doctest >=0.11 && <0.14 + , doctest >=0.11 && <0.16 , protolude default-language: Haskell2010 @@ -261,7 +263,7 @@ else build-depends: base - , hlint ==2.0.* + , hlint >=2.0 && <2.2 , protolude default-language: Haskell2010 @@ -279,7 +281,7 @@ , aeson-pretty , base , bytestring - , hspec >=2.2 && <2.5 + , hspec >=2.2 && <2.6 , hspec-wai >=0.6.6 && <0.10 , http-client , http-types @@ -292,6 +294,7 @@ , quickcheck-instances ==0.3.* , servant , servant-client + , servant-client-core , servant-docs , servant-lucid , servant-server diff --git a/package.yaml b/package.yaml --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: mellon-web -version: 0.8.0.6 +version: 0.8.0.7 synopsis: A REST web service for Mellon controllers category: Web stability: experimental @@ -53,7 +53,7 @@ server such as Nginx.' -tested-with: GHC==8.0.2 GHC==8.2.2 +tested-with: GHC==8.0.2 GHC==8.2.2 GHC==8.4.1 flags: test-hlint: @@ -121,29 +121,30 @@ - ScopedTypeVariables - TypeOperators dependencies: - - base >=4.8 && <5 - - aeson >=0.11 && <1.3 - - aeson-pretty ==0.8.* - - bytestring ==0.10.* - - http-client >=0.4 && <0.6 - - http-types ==0.9.* - - lens >=4 && <5 - - lucid ==2.9.* + - base >=4.8 && <5 + - aeson >=0.11 && <1.3 + - aeson-pretty ==0.8.* + - bytestring ==0.10.* + - http-client >=0.4 && <0.6 + - http-types >=0.9 && <0.13 + - lens >=4 && <5 + - lucid ==2.9.* - mellon-core - - protolude ==0.2.* - - servant ==0.11.* - - servant-client ==0.11.* - - servant-docs >=0.10 && <0.12 - - servant-lucid ==0.7.* - - servant-server ==0.11.* - - servant-swagger ==1.1.* - - servant-swagger-ui ==0.2.* - - swagger2 >=2.1 && <2.3 - - text ==1.2.* - - time >=1.5 && <2 - - transformers >=0.4.2 && <0.6 - - wai ==3.2.* - - warp ==3.2.* + - protolude ==0.2.* + - servant ==0.13.* + - servant-client ==0.13.* + - servant-client-core ==0.13.* + - servant-docs >=0.10 && <0.12 + - servant-lucid >=0.7 && <0.9 + - servant-server ==0.13.* + - servant-swagger ==1.1.* + - servant-swagger-ui ==0.2.* + - swagger2 >=2.1 && <2.3 + - text ==1.2.* + - time >=1.5 && <2 + - transformers >=0.4.2 && <0.6 + - wai ==3.2.* + - warp ==3.2.* tests: hlint: @@ -162,7 +163,7 @@ else: dependencies: - base - - hlint ==2.0.* + - hlint >=2.0 && <2.2 - protolude doctest: main: doctest.hs @@ -177,7 +178,7 @@ else: dependencies: - base - - doctest >=0.11 && <0.14 + - doctest >=0.11 && <0.16 - protolude spec: main: Main.hs @@ -202,7 +203,7 @@ - aeson - aeson-pretty - bytestring - - hspec >=2.2 && <2.5 + - hspec >=2.2 && <2.6 - hspec-wai >=0.6.6 && <0.10 - http-client - http-types @@ -214,6 +215,7 @@ - protolude - servant - servant-client + - servant-client-core - servant-docs - servant-lucid - servant-server @@ -294,6 +296,7 @@ - optparse-applicative - protolude - servant-client + - servant-client-core - time - transformers mock-mellon-server: diff --git a/src/Mellon/Web/Server/API.hs b/src/Mellon/Web/Server/API.hs --- a/src/Mellon/Web/Server/API.hs +++ b/src/Mellon/Web/Server/API.hs @@ -64,10 +64,11 @@ import qualified Mellon.Controller as Controller (State(..)) import Network.Wai (Application) import Servant - ((:<|>)(..), (:>), (:~>)(..), Get, Handler, JSON, Proxy(..), Put, - ReqBody, Server, ServerT, enter, serve) + ((:<|>)(..), (:>), Get, Handler, JSON, Proxy(..), Put, + ReqBody, Server, ServerT, serve) import Servant.Docs (ToSample(..)) import Servant.HTML.Lucid (HTML) +import Servant.Server (hoistServer) -- $setup -- >>> :set -XOverloadedStrings @@ -279,16 +280,13 @@ mellonAPI :: Proxy MellonAPI mellonAPI = Proxy -appToHandler :: Controller d -> AppM d :~> Handler -appToHandler cc = NT $ \m -> runReaderT m cc - -- | A Servant 'Server' which serves the 'MellonAPI' on the given -- 'Controller'. -- -- Normally you will just use 'app', but this function is exported so -- that you can extend/wrap 'MellonAPI'. server :: Controller d -> Server MellonAPI -server cc = enter (appToHandler cc) serverT +server cc = hoistServer mellonAPI (`runReaderT` cc) serverT -- | A WAI 'Network.Wai.Application' which runs the service, using the -- given 'Controller'. diff --git a/test/Mellon/Web/ClientSpec.hs b/test/Mellon/Web/ClientSpec.hs --- a/test/Mellon/Web/ClientSpec.hs +++ b/test/Mellon/Web/ClientSpec.hs @@ -33,8 +33,8 @@ (port, sock) <- openTestSocket let settings = setPort port $ defaultSettings threadId <- forkIO $ runSettingsSocket settings sock (app cc) - manager <- newManager defaultManagerSettings - let clientEnv = ClientEnv manager $ BaseUrl Http "localhost" port "" + mgr <- newManager defaultManagerSettings + let clientEnv = mkClientEnv mgr $ BaseUrl Http "localhost" port "" return (threadId, clientEnv) killApp :: (ThreadId, ClientEnv) -> IO ()