38 lines
1.2 KiB
Haskell
38 lines
1.2 KiB
Haskell
{-# LANGUAGE DeriveFunctor #-}
|
|
{-# LANGUAGE LambdaCase #-}
|
|
module Control.Monad.HTTP where
|
|
import Data.ByteString.Lazy (ByteString)
|
|
import Data.URL (URL (URL))
|
|
import Control.Monad.Free.Church (F, liftF, foldF)
|
|
import Network.HTTP.Client (Manager, httpLbs, parseRequest, responseBody)
|
|
import System.IO.Unsafe (unsafeInterleaveIO)
|
|
|
|
data OpsF f = Fetch URL (ByteString -> f)
|
|
deriving Functor
|
|
|
|
-- | A restricted HTTP monad
|
|
--
|
|
-- While the "regular" code could access http whenever and it would be
|
|
-- fine, the middleware functions shouldn't probably have full IO
|
|
-- access. So restricting the access and providing manager and user
|
|
-- agents should prove useful
|
|
type FetchM = F OpsF
|
|
|
|
-- | Execute a http request and return the bytestring
|
|
--
|
|
-- Possible HTTP exceptions are thrown (how?)
|
|
fetch :: URL -> FetchM ByteString
|
|
fetch u = liftF (Fetch u id)
|
|
|
|
-- Run the http monad
|
|
--
|
|
-- The requests are executed lazily, both as an atomic request and as
|
|
-- a lazy bytestring. Be careful.
|
|
execute :: Manager -> FetchM a -> IO a
|
|
execute manager = foldF $ \case
|
|
Fetch (URL u) k -> k <$> unsafeInterleaveIO (fetchR u)
|
|
where
|
|
fetchR u = do
|
|
req <- parseRequest u
|
|
responseBody <$> httpLbs req manager
|