Add http-conduit override

This commit is contained in:
towards-a-new-leftypol 2024-03-22 21:27:12 -04:00
parent 882d56ce66
commit ad6300fa6b
5 changed files with 38 additions and 25 deletions

@ -1 +1 @@
Subproject commit b01e4e269613fc0a69c9728a18a0bcdf1a0562a9
Subproject commit 62a23581e786f8564653406845c4b2a07d73deb6

20
app/DataClient.hs Normal file
View File

@ -0,0 +1,20 @@
module DataClient
( fetchLatest
)
where
import Common.Network.ClientTypes (Model (..))
import Common.Network.HttpClient
( post
, HttpError
)
fetchLatest :: Model -> UTCTime -> IO IO (Either HttpError [ CatalogPost ])
fetchLatest m t iface = do
post settings "/rpc/fetch_catalog" payload False >>= return . eitherDecodeResponse
where
payload = encode FetchCatalogArgs
{ max_time = t
, max_row_read = fetchCount m
}

View File

@ -19,11 +19,11 @@ import qualified Common.FrontEnd.Routes as FE
import qualified Common.FrontEnd.Action as FE
import qualified Common.FrontEnd.Model as FE
newtype HtmlPage a = HtmlPage a
newtype HtmlPage a = HtmlPage (FE.Model, a)
instance (L.ToHtml a) => L.ToHtml (HtmlPage a) where
toHtmlRaw = L.toHtml
toHtml (HtmlPage x) = L.toHtml x
toHtml (HtmlPage (_, x)) = L.toHtml x
-- toHtml (HtmlPage x) = do
-- L.doctype_
-- L.head_ $ do
@ -47,23 +47,7 @@ catalogView :: Handler (HtmlPage (View FE.Action))
catalogView = do
liftIO $ putStrLn "Hello World"
pure $ HtmlPage $ h1_ [] [ text "Hello World" ]
{-
return $ HtmlPage $ do
L.doctype_
L.head_ $ do
L.title_ "Chandlr"
L.meta_ [L.charset_ "utf-8"]
L.with (L.script_ mempty)
[ L.makeAttribute "src" "/static/all.js"
, L.makeAttribute "async" mempty
, L.makeAttribute "defer" mempty
]
L.body_ (L.h1_ "Hello World")
-}
pure $ HtmlPage (undefined, h1_ [] [ text "Hello World" ])
threadView :: Text -> Text -> FE.BoardThreadId -> Handler (HtmlPage (View FE.Action))
threadView = undefined
@ -71,9 +55,6 @@ threadView = undefined
searchView :: Maybe Text -> Handler (HtmlPage (View FE.Action))
searchView = undefined
viewPage :: FE.Model -> View FE.Action
viewPage = undefined
app :: Wai.Application
app = serve (Proxy @FrontEndRoutes) handlers

View File

@ -66,6 +66,7 @@ executable chandlr-server
Common.Component.Search.SearchTypes
Common.FrontEnd.Action
Common.FrontEnd.Routes
Common.FrontEnd.Model
Common.Network.CatalogPostType
Common.Network.ClientTypes
Common.Network.HttpTypes
@ -88,6 +89,8 @@ executable chandlr-server
Common.Parsing.PostPartType
Common.Parsing.QuoteLinkParser
Parsing.BodyParser
DataClient
Common.Server.JSONSettings
-- LANGUAGE extensions used by modules in this package.
-- other-extensions:
@ -106,7 +109,12 @@ executable chandlr-server
containers,
servant,
servant-server,
lucid
lucid,
safe-exceptions,
bytestring,
http-conduit,
http-client,
http-types
-- Directories containing source files.
hs-source-dirs: app

View File

@ -1,7 +1,11 @@
{ nixpkgs ? import <nixpkgs> {} }:
let
drv = nixpkgs.haskell.packages.ghc96.callCabal2nix "chandlr-server" ./. {};
http-conduit = import ./app/Common/nix-support/http-conduit.nix { inherit nixpkgs; };
drv = nixpkgs.haskellPackages.callCabal2nix "chandlr-server" ./. {
http-conduit = http-conduit.http-conduit;
};
env = drv.env.overrideAttrs (oldAttrs: {
buildInputs = oldAttrs.buildInputs ++ [