module HTTPResponseDecoder
(
run,
Response,
headAndBody,
Head,
statusCode,
httpVersion,
headers,
Headers,
header,
contentType,
Body,
bodyStream,
bodyBytes,
bodyLazyBytes,
Matcher.Matcher,
Matcher.equals,
Matcher.satisfies,
Matcher.converts,
)
where
import HTTPResponseDecoder.Prelude
import qualified Network.HTTP.Client
import qualified Network.HTTP.Types
import qualified Data.ByteString.Lazy
import qualified Data.HashMap.Strict
import qualified Data.CaseInsensitive
import qualified HTTPResponseDecoder.BodyReaders
import qualified Matcher
run :: Response a -> Network.HTTP.Client.Response Network.HTTP.Client.BodyReader -> IO (Either Text a)
run (Response impl) =
impl
newtype Response a =
Response (Network.HTTP.Client.Response Network.HTTP.Client.BodyReader -> IO (Either Text a))
deriving (Functor)
headAndBody :: Head a -> Body b -> Response (a, b)
headAndBody (Head headMatcher) (Body bodyToIOEither) =
Response $
(liftA2 . liftA2 . liftA2) (,) (pure . responseToEither) (bodyToIOEither . responseToBody)
where
responseToBody =
Network.HTTP.Client.responseBody
responseToEither =
Matcher.run headMatcher
newtype Head a =
Head (forall body. Matcher.Matcher (Network.HTTP.Client.Response body) a)
deriving (Functor)
instance Applicative Head where
pure a =
Head (pure a)
(<*>) (Head decoder1) (Head decoder2) =
Head (decoder1 <*> decoder2)
instance Alternative Head where
empty =
Head empty
(<|>) (Head decoder1) (Head decoder2) =
Head (decoder1 <|> decoder2)
statusCode :: Matcher.Matcher Int a -> Head a
statusCode decoder =
Head $
lmap mapping decoder
where
mapping =
Network.HTTP.Types.statusCode .
Network.HTTP.Client.responseStatus
httpVersion :: Matcher.Matcher (Int, Int) a -> Head a
httpVersion decoder =
Head $
lmap mapping decoder
where
mapping =
httpVersionToTuple .
Network.HTTP.Client.responseVersion
where
httpVersionToTuple (Network.HTTP.Types.HttpVersion major minor) =
(major, minor)
headers :: Headers a -> Head a
headers (Headers decoder) =
Head $
lmap mapping decoder
where
mapping =
Data.HashMap.Strict.fromList .
map foldKeyCase .
Network.HTTP.Client.responseHeaders
where
foldKeyCase (k, v) =
(Data.CaseInsensitive.foldedCase k, v)
newtype Headers a =
Headers (Matcher.Matcher (HashMap ByteString ByteString) a)
deriving (Functor, Applicative, Alternative)
header :: ByteString -> Matcher.Matcher ByteString a -> Headers a
header name headerMatcher =
Headers $
decoder
where
decoder =
headerMatcher . lookup
where
lookup =
Matcher.converts $
\hashMap ->
Data.HashMap.Strict.lookup foldedName hashMap &
maybe (Left ("Header " <> fromString (show foldedName) <> " not found")) Right
where
foldedName =
Data.CaseInsensitive.foldCase name
contentType :: Matcher.Matcher ByteString a -> Headers a
contentType =
header "content-type"
newtype Body a =
Body (IO ByteString -> IO (Either Text a))
deriving (Functor)
bodyStream :: (IO ByteString -> IO (Either Text a)) -> Body a
bodyStream reader =
Body $
reader
bodyBytes :: Matcher.Matcher ByteString a -> Body a
bodyBytes matcher =
Body $
fmap (Matcher.run matcher) .
HTTPResponseDecoder.BodyReaders.bytes
bodyLazyBytes :: Matcher.Matcher Data.ByteString.Lazy.ByteString a -> Body a
bodyLazyBytes matcher =
Body $
fmap (Matcher.run matcher) .
HTTPResponseDecoder.BodyReaders.lazyBytes