54 lines
1.9 KiB
Haskell
54 lines
1.9 KiB
Haskell
{-# LANGUAGE RecordWildCards #-}
|
|
|
|
module DataClient
|
|
( fetchLatest
|
|
, getThread
|
|
)
|
|
where
|
|
|
|
import Data.Time.Clock (UTCTime)
|
|
import qualified Data.ByteString.Lazy as LBS
|
|
import qualified Data.ByteString.Lazy.Char8 as LC8
|
|
import qualified Data.Text as Text
|
|
|
|
import Common.Network.CatalogPostType (CatalogPost)
|
|
import Common.Network.ClientTypes (Model (..), FetchCatalogArgs (..))
|
|
import Common.Network.HttpClient
|
|
( post
|
|
, get
|
|
, HttpError (..)
|
|
)
|
|
import Data.Aeson (eitherDecode, encode, FromJSON)
|
|
import qualified Common.FrontEnd.Action as A
|
|
import Common.Server.JSONSettings (JSONSettings)
|
|
import Common.Network.SiteType (Site)
|
|
|
|
fetchLatest :: JSONSettings -> Model -> UTCTime -> IO (Either HttpError [ CatalogPost ])
|
|
fetchLatest settings m t = do
|
|
post settings "/rpc/fetch_catalog" payload False >>= return . eitherDecodeResponse
|
|
|
|
where
|
|
payload = encode FetchCatalogArgs
|
|
{ max_time = t
|
|
, max_row_read = fetchCount m
|
|
}
|
|
|
|
getThread :: JSONSettings -> Model -> A.GetThreadArgs -> IO (Either HttpError [ Site ])
|
|
getThread settings m A.GetThreadArgs {..} =
|
|
get settings path >>= return . eitherDecodeResponse
|
|
|
|
where
|
|
path = "/sites?"
|
|
<> "select=*,boards(*,threads(*,posts(*,attachments(*))))"
|
|
<> "&name=eq." <> Text.unpack website
|
|
<> "&boards.pathpart=eq." <> Text.unpack board_pathpart
|
|
<> "&boards.threads.board_thread_id=eq." <> (show board_thread_id)
|
|
<> "&boards.threads.posts.order=board_post_id.asc"
|
|
|
|
eitherDecodeResponse :: (FromJSON a) => Either HttpError LBS.ByteString -> Either HttpError a
|
|
eitherDecodeResponse (Left err) = Left err
|
|
eitherDecodeResponse (Right bs) =
|
|
case eitherDecode bs of
|
|
Right val -> Right val
|
|
Left err -> Left $ StatusCodeError 500 $ LC8.pack $ "Failed to decode JSON: " ++ err ++ " " ++ (show bs)
|