c09c0cf · typeable/servant

servant-client/servant-client.cabal+4−3

compare with master

unifiedsplit

@@ -75,10 +75,8 @@ test-suite spec

75 , Servant.Common.BaseUrlSpec

76 build-depends:

77 base == 4.*

78− , base-compat

79− , transformers

80− , transformers-compat

81 , aeson

78 , aeson

79+ , base-compat

82 , bytestring

80 , bytestring

83 , deepseq

81 , deepseq

84 , hspec == 2.*

82 , hspec == 2.*

@@ -87,11 +85,14 @@ test-suite spec

87 , http-media

85 , http-media

88 , http-types

86 , http-types

89 , HUnit

87 , HUnit

88+ , mtl

90 , network >= 2.6

89 , network >= 2.6

91 , QuickCheck >= 2.7

90 , QuickCheck >= 2.7

92 , servant == 0.9.*

91 , servant == 0.9.*

93 , servant-client

92 , servant-client

94 , servant-server == 0.9.*

93 , servant-server == 0.9.*

95 , text

94 , text

95+ , transformers

96+ , transformers-compat

96 , wai

97 , wai

97 , warp

98 , warp

servant-client/src/Servant/Common/Req.hs−5

@@ -17,14 +17,9 @@ import Control.Monad

17import Control.Monad.Catch (MonadThrow, MonadCatch)

18import Data.Foldable (toList)

19

20−#if MIN_VERSION_mtl(2,2,0)

21−import Control.Monad.Except (MonadError(..))

22−#else

23import Control.Monad.Error.Class (MonadError(..))

20import Control.Monad.Error.Class (MonadError(..))

24−#endif

25import Control.Monad.Trans.Except

21import Control.Monad.Trans.Except

26

22

27−

28import GHC.Generics

23import GHC.Generics

29import Control.Monad.Base (MonadBase (..))

24import Control.Monad.Base (MonadBase (..))

30import Control.Monad.IO.Class ()

25import Control.Monad.IO.Class ()

servant-client/test/Servant/ClientSpec.hs+5−5

@@ -29,7 +29,7 @@ module Servant.ClientSpec where

29import Control.Arrow (left)

30import Control.Concurrent (forkIO, killThread, ThreadId)

31import Control.Exception (bracket)

32−import Control.Monad.Trans.Except (throwE )

32+import Control.Monad.Error.Class (throwError )

33import Data.Aeson

34import qualified Data.ByteString.Lazy as BS

35import Data.Char (chr, isPrint)

@@ -150,8 +150,8 @@ server = serve api (

150 :<|> return

151 :<|> (\ name -> case name of

152 Just "alice" -> return alice

153− Just n -> throwE $ ServantErr 400 (n ++ " not found") "" []

153+ Just n -> throwError $ ServantErr 400 (n ++ " not found") "" []

154− Nothing -> throwE $ ServantErr 400 "missing parameter" "" [])

154+ Nothing -> throwError $ ServantErr 400 "missing parameter" "" [])

155 :<|> (\ names -> return (zipWith Person names [0..]))

156 :<|> return

157 :<|> (\ _request respond -> respond $ responseLBS HTTP.ok200 [] "rawSuccess")

@@ -212,7 +212,7 @@ type instance AuthClientData (AuthProtect "auth-tag") = ()

212genAuthHandler :: AuthHandler Request ()

213genAuthHandler =

214 let handler req = case lookup "AuthHeader" (requestHeaders req) of

215− Nothing -> throwE (err401 { errBody = "Missing auth header" })

215+ Nothing -> throwError (err401 { errBody = "Missing auth header" })

216 Just _ -> return ()

217 in mkAuthHandler handler

218

@@ -298,7 +298,7 @@ sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do

298

299wrappedApiSpec :: Spec

300wrappedApiSpec = describe "error status codes" $ do

301− let serveW api = serve api $ throwE $ ServantErr 500 "error message" "" []

301+ let serveW api = serve api $ throwError $ ServantErr 500 "error message" "" []

302 context "are correctly handled by the client" $

303 let test :: (WrappedApi, String) -> Spec

304 test (WrappedApi api, desc) =

servant-server/CHANGELOG.md+3

@@ -4,6 +4,9 @@

4* Add `err422` Unprocessable Entity

5 ([#646](https://github.com/haskell-servant/servant/pull/646))

6

7+* `Handler` is not abstract datatype. Migration hint: change `throwE` to `throwError`.

8+ ([#641](https://github.com/haskell-servant/servant/issues/641))

9+

70.7.1

100.7.1

8------

11------

9

12

servant-server/servant-server.cabal+4

@@ -43,6 +43,7 @@ library

43 Servant.Server.Internal

44 Servant.Server.Internal.BasicAuth

45 Servant.Server.Internal.Context

46+ Servant.Server.Internal.Handler

46 Servant.Server.Internal.Router

47 Servant.Server.Internal.Router

47 Servant.Server.Internal.RoutingApplication

48 Servant.Server.Internal.RoutingApplication

48 Servant.Server.Internal.ServantErr

49 Servant.Server.Internal.ServantErr

@@ -55,9 +56,11 @@ library

55 , base64-bytestring >= 1.0 && < 1.1

56 , base64-bytestring >= 1.0 && < 1.1

56 , bytestring >= 0.10 && < 0.11

57 , bytestring >= 0.10 && < 0.11

57 , containers >= 0.5 && < 0.6

58 , containers >= 0.5 && < 0.6

59+ , exceptions >= 0.8 && < 0.9

58 , http-api-data >= 0.3 && < 0.4

60 , http-api-data >= 0.3 && < 0.4

59 , http-types >= 0.8 && < 0.10

61 , http-types >= 0.8 && < 0.10

60 , network-uri >= 2.6 && < 2.7

62 , network-uri >= 2.6 && < 2.7

63+ , monad-control >= 1.0.0.4 && < 1.1

61 , mtl >= 2 && < 2.3

64 , mtl >= 2 && < 2.3

62 , network >= 2.6 && < 2.7

65 , network >= 2.6 && < 2.7

63 , safe >= 0.3 && < 0.4

66 , safe >= 0.3 && < 0.4

@@ -68,6 +71,7 @@ library

68 , filepath >= 1 && < 1.5

71 , filepath >= 1 && < 1.5

69 , text >= 1.2 && < 1.3

72 , text >= 1.2 && < 1.3

70 , transformers >= 0.3 && < 0.6

73 , transformers >= 0.3 && < 0.6

74+ , transformers-base >= 0.4.4 && < 0.5

71 , transformers-compat>= 0.4 && < 0.6

75 , transformers-compat>= 0.4 && < 0.6

72 , wai >= 3.0 && < 3.3

76 , wai >= 3.0 && < 3.3

73 , wai-app-static >= 3.1 && < 3.2

77 , wai-app-static >= 3.1 && < 3.2

servant-server/src/Servant/Server.hs+2−1

@@ -17,7 +17,8 @@ module Servant.Server

17 , -- * Handlers for all standard combinators

18 HasServer(..)

19 , Server

20− , Handler

20+ , Handler (..)

21+ , runHandler

21

22

22 -- * Debugging the server layout

23 -- * Debugging the server layout

23 , layout

24 , layout

servant-server/src/Servant/Server/Experimental/Auth.hs+2−3

@@ -13,7 +13,6 @@

13module Servant.Server.Experimental.Auth where

14

15import Control.Monad.Trans (liftIO)

16−import Control.Monad.Trans.Except (runExceptT)

17import Data.Proxy (Proxy (Proxy))

16import Data.Proxy (Proxy (Proxy))

18import Data.Typeable (Typeable)

17import Data.Typeable (Typeable)

19import GHC.Generics (Generic)

18import GHC.Generics (Generic)

@@ -29,7 +28,7 @@ import Servant.Server.Internal.RoutingApplication (addAuthCheck,

29 delayedFailFatal,

28 delayedFailFatal,

30 DelayedIO,

29 DelayedIO,

31 withRequest)

30 withRequest)

32−import Servant.Server.Internal.ServantErr (Handler)

31+import Servant.Server.Internal.Handler (Handler, runHandler)

33

32

34-- * General Auth

33-- * General Auth

35

34

@@ -65,4 +64,4 @@ instance ( HasServer api context

65 authHandler :: Request -> Handler (AuthServerData (AuthProtect tag))

64 authHandler :: Request -> Handler (AuthServerData (AuthProtect tag))

66 authHandler = unAuthHandler (getContextEntry context)

65 authHandler = unAuthHandler (getContextEntry context)

67 authCheck :: Request -> DelayedIO (AuthServerData (AuthProtect tag))

66 authCheck :: Request -> DelayedIO (AuthServerData (AuthProtect tag))

68− authCheck = (>>= either delayedFailFatal return) . liftIO . runExceptT . authHandler

67+ authCheck = (>>= either delayedFailFatal return) . liftIO . runHandler . authHandler

servant-server/src/Servant/Server/Internal.hs+2

@@ -17,6 +17,7 @@ module Servant.Server.Internal

17 ( module Servant.Server.Internal

18 , module Servant.Server.Internal.Context

19 , module Servant.Server.Internal.BasicAuth

20+ , module Servant.Server.Internal.Handler

20 , module Servant.Server.Internal.Router

21 , module Servant.Server.Internal.Router

21 , module Servant.Server.Internal.RoutingApplication

22 , module Servant.Server.Internal.RoutingApplication

22 , module Servant.Server.Internal.ServantErr

23 , module Servant.Server.Internal.ServantErr

@@ -63,6 +64,7 @@ import Servant.API.ResponseHeaders (GetHeaders, Headers, getHeaders,

63

64

64import Servant.Server.Internal.Context

65import Servant.Server.Internal.Context

65import Servant.Server.Internal.BasicAuth

66import Servant.Server.Internal.BasicAuth

67+import Servant.Server.Internal.Handler

66import Servant.Server.Internal.Router

68import Servant.Server.Internal.Router

67import Servant.Server.Internal.RoutingApplication

69import Servant.Server.Internal.RoutingApplication

68import Servant.Server.Internal.ServantErr

70import Servant.Server.Internal.ServantErr

servant-server/src/Servant/Server/Internal/Handler.hsnew file+41

@@ -0,0 +1,41 @@

1+{-# LANGUAGE CPP #-}

2+{-# LANGUAGE DeriveDataTypeable #-}

3+{-# LANGUAGE DeriveGeneric #-}

4+{-# LANGUAGE GeneralizedNewtypeDeriving #-}

5+{-# LANGUAGE MultiParamTypeClasses #-}

6+{-# LANGUAGE TypeFamilies #-}

7+module Servant.Server.Internal.Handler where

8+

9+import Prelude ()

10+import Prelude.Compat

11+

12+import Control.Monad.Base (MonadBase (..))

13+import Control.Monad.Catch (MonadCatch, MonadThrow)

14+import Control.Monad.Error.Class (MonadError)

15+import Control.Monad.IO.Class (MonadIO)

16+import Control.Monad.Trans.Control (MonadBaseControl (..))

17+import Control.Monad.Trans.Except (ExceptT, runExceptT)

18+import GHC.Generics (Generic)

19+import Servant.Server.Internal.ServantErr (ServantErr)

20+

21+newtype Handler a = Handler { runHandler' :: ExceptT ServantErr IO a }

22+ deriving

23+ ( Functor, Applicative, Monad, MonadIO, Generic

24+ , MonadError ServantErr

25+ , MonadThrow, MonadCatch

26+ )

27+

28+instance MonadBase IO Handler where

29+ liftBase = Handler . liftBase

30+

31+instance MonadBaseControl IO Handler where

32+ type StM Handler a = Either ServantErr a

33+

34+ -- liftBaseWith :: (RunInBase Handler IO -> IO a) -> Handler a

35+ liftBaseWith f = Handler (liftBaseWith (\g -> f (g . runHandler')))

36+

37+ -- restoreM :: StM Handler a -> Handler a

38+ restoreM st = Handler (restoreM st)

39+

40+runHandler :: Handler a -> IO (Either ServantErr a)

41+runHandler = runExceptT . runHandler'

servant-server/src/Servant/Server/Internal/RoutingApplication.hs+2−2

@@ -10,12 +10,12 @@ module Servant.Server.Internal.RoutingApplication where

10

11import Control.Monad (ap, liftM)

12import Control.Monad.Trans (MonadIO(..))

13−import Control.Monad.Trans.Except (runExceptT)

14import Network.Wai (Application, Request,

13import Network.Wai (Application, Request,

15 Response, ResponseReceived)

14 Response, ResponseReceived)

16import Prelude ()

15import Prelude ()

17import Prelude.Compat

16import Prelude.Compat

18import Servant.Server.Internal.ServantErr

17import Servant.Server.Internal.ServantErr

18+import Servant.Server.Internal.Handler

19

20type RoutingApplication =

21 Request -- ^ the request, the field 'pathInfo' may be modified by url routing

@@ -264,7 +264,7 @@ runAction action env req respond k =

264 go (Fail e) = return $ Fail e

265 go (FailFatal e) = return $ FailFatal e

266 go (Route a) = do

267− e <- runExceptT a

267+ e <- runHandler a

268 case e of

269 Left err -> return . Route $ responseServantErr err

270 Right x -> return $! k x

servant-server/src/Servant/Server/Internal/ServantErr.hs−3

@@ -4,7 +4,6 @@

4module Servant.Server.Internal.ServantErr where

5

6import Control.Exception (Exception)

7−import Control.Monad.Trans.Except (ExceptT)

8import qualified Data.ByteString.Char8 as BS

7import qualified Data.ByteString.Char8 as BS

9import qualified Data.ByteString.Lazy as LBS

8import qualified Data.ByteString.Lazy as LBS

10import Data.Typeable (Typeable)

9import Data.Typeable (Typeable)

@@ -19,8 +18,6 @@ data ServantErr = ServantErr { errHTTPCode :: Int

19

18

20instance Exception ServantErr

19instance Exception ServantErr

21

20

22−type Handler = ExceptT ServantErr IO

23−

24responseServantErr :: ServantErr -> Response

21responseServantErr :: ServantErr -> Response

25responseServantErr ServantErr{..} = responseLBS status errHeaders errBody

22responseServantErr ServantErr{..} = responseLBS status errHeaders errBody

26 where

23 where

servant-server/test/Servant/Server/ErrorSpec.hs+2−3

@@ -6,7 +6,6 @@

6{-# OPTIONS_GHC -fno-warn-orphans #-}

7module Servant.Server.ErrorSpec (spec) where

8

9−import Control.Monad.Trans.Except (throwE)

10import Data.Aeson (encode)

9import Data.Aeson (encode)

11import qualified Data.ByteString.Char8 as BC

10import qualified Data.ByteString.Char8 as BC

12import qualified Data.ByteString.Lazy.Char8 as BCL

11import qualified Data.ByteString.Lazy.Char8 as BCL

@@ -51,7 +50,7 @@ errorOrderApi :: Proxy ErrorOrderApi

51errorOrderApi = Proxy

50errorOrderApi = Proxy

52

51

53errorOrderServer :: Server ErrorOrderApi

52errorOrderServer :: Server ErrorOrderApi

54−errorOrderServer = \_ _ _ -> throwE err402

53+errorOrderServer = \_ _ _ -> throwError err402

55

54

56-- On error priorities:

55-- On error priorities:

57--

56--

@@ -187,7 +186,7 @@ errorRetryApi = Proxy

187

186

188errorRetryServer :: Server ErrorRetryApi

187errorRetryServer :: Server ErrorRetryApi

189errorRetryServer

188errorRetryServer

190− = (\_ -> throwE err402)

189+ = (\_ -> throwError err402)

191 :<|> (\_ -> return 1)

190 :<|> (\_ -> return 1)

192 :<|> (\_ -> return 2)

191 :<|> (\_ -> return 2)

193 :<|> (\_ -> return 3)

192 :<|> (\_ -> return 3)

servant-server/test/Servant/ServerSpec.hs+5−5

@@ -14,7 +14,7 @@

14module Servant.ServerSpec where

15

16import Control.Monad (forM_, when, unless)

17−import Control.Monad.Trans.Except (throwE)

17+import Control.Monad.Error.Class (MonadError (..))

18import Data.Aeson (FromJSON, ToJSON, decode', encode)

19import qualified Data.ByteString.Base64 as Base64

20import Data.Char (toUpper)

@@ -194,7 +194,7 @@ captureServer :: Integer -> Handler Animal

194captureServer legs = case legs of

195 4 -> return jerry

196 2 -> return tweety

197− _ -> throwE err404

197+ _ -> throwError err404

198

199captureSpec :: Spec

200captureSpec = do

@@ -228,7 +228,7 @@ captureAllServer legs = case sum legs of

228 4 -> return jerry

229 2 -> return tweety

230 0 -> return beholder

231− _ -> throwE err404

231+ _ -> throwError err404

232

233captureAllSpec :: Spec

234captureAllSpec = do

@@ -642,8 +642,8 @@ genAuthContext :: Context '[AuthHandler Request ()]

642genAuthContext =

643 let authHandler = \req -> case lookup "Auth" (requestHeaders req) of

644 Just "secret" -> return ()

645− Just _ -> throwE err403

645+ Just _ -> throwError err403

646− Nothing -> throwE err401

646+ Nothing -> throwError err401

647 in mkAuthHandler authHandler :. EmptyContext

648

649genAuthSpec :: Spec