eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

make error messages for the GET client more general

Browse source
This commit is contained in:
Alp Mestanogullari 2014-10-23 14:36:40 +02:00
parent c1a5a3a09f
commit 8c260f5127
1 changed files with 3 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
src/Soenke.hs
View file

@ -63,7 +63,7 @@ class HasServer layout where
route :: Proxy layout -> Server layout -> RoutingApplication route :: Proxy layout -> Server layout -> RoutingApplication
instance ToJSON result => HasServer (Get result) where instance ToJSON result => HasServer (Get result) where
type Server (Get result) = (EitherT (Int, String) IO result) type Server (Get result) = EitherT (Int, String) IO result
route Proxy action request route Proxy action request
| null (pathInfo request) && requestMethod request == methodGet = do | null (pathInfo request) && requestMethod request == methodGet = do
e <- runEitherT action e <- runEitherT action
@ -120,8 +120,8 @@ instance FromJSON result => HasClient (Get result) where
innerResponse <- liftIO $ __withGlobalManager $ \ manager -> innerResponse <- liftIO $ __withGlobalManager $ \ manager ->
Http.Client.httpLbs innerRequest manager Http.Client.httpLbs innerRequest manager
when (Http.Client.responseStatus innerResponse /= ok200) $ when (Http.Client.responseStatus innerResponse /= ok200) $
left ("kraken daemon returned: " ++ show (Http.Client.responseStatus innerResponse)) left ("HTTP GET request failed with status: " ++ show (Http.Client.responseStatus innerResponse))
maybe (left "kraken daemon returned invalid json") return $ maybe (left "HTTP GET request returned invalid json") return $
decode' (Http.Client.responseBody innerResponse) decode' (Http.Client.responseBody innerResponse)
instance (KnownSymbol path, HasClient sublayout) => HasClient (path :> sublayout) where instance (KnownSymbol path, HasClient sublayout) => HasClient (path :> sublayout) where