trasa-client 0.1.0.0 → 0.2
raw patch · 3 files changed
+26/−20 lines, 3 filesdep +http-mediadep ~trasa
Dependencies added: http-media
Dependency ranges changed: trasa
Files
- src/Trasa/Client.hs +13/−11
- test/Main.hs +10/−7
- trasa-client.cabal +3/−2
src/Trasa/Client.hs view
@@ -10,10 +10,11 @@ , Config(..) -- * Requests , clientWith- )where+ ) where -import Data.Semigroup ((<>)) import Data.Word (Word16)+import Data.Semigroup ((<>))+import qualified Data.List.NonEmpty as NE import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import qualified Data.Binary.Builder as LBS@@ -25,6 +26,7 @@ import qualified Network.HTTP.Types.URI as N import qualified Network.HTTP.Types.Header as N import qualified Network.HTTP.Types.Status as N+import qualified Network.HTTP.Media as N import qualified Network.HTTP.Client as N import Trasa.Core hiding (status,body)@@ -63,8 +65,8 @@ N.renderQueryBuilder True . encodeQuery -encodeAcceptBS :: [T.Text] -> BS.ByteString-encodeAcceptBS = TE.encodeUtf8 . T.intercalate ", "+encodeAcceptBS :: NE.NonEmpty N.MediaType -> BS.ByteString+encodeAcceptBS = BS.intercalate "; " . fmap N.renderHeader . NE.toList data Config = Config { configAuthority :: Authority@@ -72,7 +74,7 @@ } clientWith :: forall route response.- (forall caps qrys req resp. route caps qrys req resp -> T.Text)+ (forall caps qrys req resp. route caps qrys req resp -> Method) -- ^ Get the method out of the route -> (forall caps qrys req resp. route caps qrys req resp -> Path CaptureEncoding caps) -- ^ Get a way to encode paths from a route@@ -89,7 +91,7 @@ clientWith toMethod toCapEnc toQuerys toReqBody toRespBody config = requestWith toMethod toCapEnc toQuerys toReqBody toRespBody run where- run :: T.Text -> Url -> Maybe Content -> [T.Text] -> IO (Either TrasaErr Content)+ run :: Method -> Url -> Maybe Content -> NE.NonEmpty N.MediaType -> IO (Either TrasaErr Content) run method (Url path query) mcontent accepts = do response <- N.httpLbs req manager let status = N.responseStatus response@@ -97,14 +99,14 @@ return $ case status < N.status400 of True -> case lookup N.hContentType (N.responseHeaders response) of Nothing -> Left (TrasaErr N.status415 "No content type found")- Just bs -> case TE.decodeUtf8' bs of- Left _ -> Left (TrasaErr N.status415 "Could note utf8 decode content type")- Right typ -> Right (Content typ body)+ Just bs -> case N.parseAccept bs of+ Nothing -> Left (TrasaErr N.status415 "Could not decode content type")+ Just typ -> Right (Content typ body) False -> Left (TrasaErr status body) where Config (Authority scheme host port) manager = config req = N.defaultRequest- { N.method = TE.encodeUtf8 method+ { N.method = TE.encodeUtf8 $ encodeMethod method , N.secure = schemeToSecure scheme , N.host = encodeAuthority host port , N.port = maybe (schemeToPort scheme) fromIntegral port@@ -112,7 +114,7 @@ , N.queryString = encodeQueryBS query , N.requestHeaders = [(N.hAccept,encodeAcceptBS accepts)] ++ case mcontent of Nothing -> []- Just (Content typ _) -> [(N.hContentType,TE.encodeUtf8 typ)]+ Just (Content typ _) -> [(N.hContentType,N.renderHeader typ)] , N.requestBody = case mcontent of Nothing -> N.RequestBodyLBS "" Just (Content _ reqBody) -> N.RequestBodyLBS reqBody
test/Main.hs view
@@ -24,6 +24,7 @@ import qualified Network.HTTP.Types.Status as N import qualified Network.HTTP.Client as N import Trasa.Core+import qualified Trasa.Method as M import Trasa.Client data Ip = Ip@@ -50,7 +51,7 @@ int = showReadCaptureCodec bodyUnit :: BodyCodec ()-bodyUnit = BodyCodec (pure "text/html; charset=utf-8") (const "") (const (Right ()))+bodyUnit = BodyCodec (pure "text/html") (const "") (const (Right ())) data Route :: [Type] -> [Param] -> Bodiedness -> Type -> Type where RouteHome :: Route '[] '[] Bodyless ()@@ -63,14 +64,14 @@ , metaQuery :: Rec (Query CaptureCodec) qrys , metaRequestBody :: RequestBody BodyCodec req , metaResponseBody :: ResponseBody BodyCodec resp- , metaMethod :: T.Text }+ , metaMethod :: Method } meta :: Route caps qrys req resp -> Meta caps qrys req resp meta = \case- RouteHome -> Meta end qend bodyless (resp bodyUnit) "GET"- RouteIp -> Meta (match "ip" ./ end) qend bodyless (resp bodyAeson) "GET"- RouteStatus -> Meta (match "status" ./ capture int ./ end) qend bodyless (resp bodyUnit) "GET"- RouteQuery -> Meta (match "anything" ./ end) (optional "int" int .& qend) bodyless (resp bodyAeson) "GET"+ RouteHome -> Meta end qend bodyless (resp bodyUnit) M.get+ RouteIp -> Meta (match "ip" ./ end) qend bodyless (resp bodyAeson) M.get+ RouteStatus -> Meta (match "status" ./ capture int ./ end) qend bodyless (resp bodyUnit) M.get+ RouteQuery -> Meta (match "anything" ./ end) (optional "int" int .& qend) bodyless (resp bodyAeson) M.get prepare :: Route caps qrys req resp -> Arguments caps qrys req (Prepared Route resp) prepare = prepareWith (metaPath . meta) (metaQuery . meta) (metaRequestBody . meta)@@ -103,7 +104,9 @@ let conf = Config (Authority Http "httpbin.org" Nothing) manager res <- catch (client conf (prepare RouteHome)) $ \(_ :: SomeException) -> return (Left (status N.status400)) case res of- Left _ -> putStrLn "Could not connect to httpbin.org, not running test suite"+ Left err -> do+ putStrLn "Could not connect to httpbin.org, not running test suite"+ putStrLn ("Could not connect because: " ++ show err) Right _ -> do putStrLn "Connected to httpbin.org, actually testing routes now..." shouldRight conf (prepare RouteIp)
trasa-client.cabal view
@@ -1,5 +1,5 @@ name: trasa-client-version: 0.1.0.0+version: 0.2 synopsis: Type safe http requests license: MIT license-file: LICENSE@@ -18,8 +18,9 @@ , binary == 0.8.* , text == 1.2.* , http-types == 0.9.*+ , http-media == 0.6.* , http-client == 0.5.*- , trasa == 0.1.*+ , trasa == 0.2.* hs-source-dirs: src default-language: Haskell2010