a few more fixes

This commit is contained in:
me 2024-11-07 18:28:42 +02:00
parent c5465b93f1
commit 452477fc11
3 changed files with 12 additions and 12 deletions

View file

@ -29,7 +29,7 @@ data DB
, insertNote :: NoteEntry -> IO (DB.Int64, Note) , insertNote :: NoteEntry -> IO (DB.Int64, Note)
, insertFollower :: , insertFollower ::
forall a. Typeable a => FollowerEntry -> (DB.Int64 -> IO a) -> IO a forall a. Typeable a => FollowerEntry -> (DB.Int64 -> IO a) -> IO a
, deleteFollower :: FollowerEntry -> IO DB.Int64 , deleteFollower :: FollowerEntry -> IO (Maybe DB.Int64)
, getFollowers :: IO [Follower] , getFollowers :: IO [Follower]
} }
@ -156,10 +156,10 @@ insertFollowerToDb follower = do
[n] <- map decodeIntRow <$> uncurry DB.runWith (insertFollowerSQL follower) [n] <- map decodeIntRow <$> uncurry DB.runWith (insertFollowerSQL follower)
pure n pure n
deleteFollowerFromDb :: FollowerEntry -> DB.SQLite DB.Int64 deleteFollowerFromDb :: FollowerEntry -> DB.SQLite (Maybe DB.Int64)
deleteFollowerFromDb follower = do deleteFollowerFromDb follower = do
[n] <- map decodeIntRow <$> uncurry DB.runWith (deleteFollowerSQL follower) ns <- map decodeIntRow <$> uncurry DB.runWith (deleteFollowerSQL follower)
pure n pure $ listToMaybe ns
getFollowersFromDb :: Url -> DB.SQLite [Follower] getFollowersFromDb :: Url -> DB.SQLite [Follower]
getFollowersFromDb url = getFollowersFromDb url =
@ -248,7 +248,7 @@ deleteFollowerSQL follower =
( [r| ( [r|
DELETE FROM follower DELETE FROM follower
WHERE follow_id = ? AND actor = ? WHERE follow_id = ? AND actor = ?
RETURNING follow_id RETURNING id
|] |]
, ,
[ DB.SQLText follower.followId [ DB.SQLText follower.followId
@ -310,7 +310,7 @@ decodeNoteRow = \case
decodeIntRow :: [DB.SQLData] -> DB.Int64 decodeIntRow :: [DB.SQLData] -> DB.Int64
decodeIntRow = \case decodeIntRow = \case
[DB.SQLInteger fid] -> fid [DB.SQLInteger fid] -> fid
row -> error $ "Couldn't decode row as NoteId: " <> show row row -> error $ "Couldn't decode row as id: " <> show row
decodeFollowerRow :: [DB.SQLData] -> Follower decodeFollowerRow :: [DB.SQLData] -> Follower
decodeFollowerRow = \case decodeFollowerRow = \case

View file

@ -146,7 +146,7 @@ handleInbox db detailsFile activity = do
) )
callback = callback =
( \(insertId :: DB.Int64) -> do ( \(insertId :: DB.Int64) -> do
(result :: A.Value) <- Fedi.sendPost result <- Fedi.sendPost
details details
(actor.unwrap <> "/inbox") (actor.unwrap <> "/inbox")
( Fedi.makeAccept ( Fedi.makeAccept
@ -196,5 +196,5 @@ sendFollowers details db message = do
followers <- db.getFollowers followers <- db.getFollowers
Fedi.for_ followers \follower -> do Fedi.for_ followers \follower -> do
Async.async $ do Async.async $ do
result <- Fedi.sendPost @A.Value details (T.unpack follower.actorId <> "/inbox") message bs <- Fedi.sendPost details (T.unpack follower.actorId <> "/inbox") message
print (follower.actorId, A.encode result) print (follower.actorId, bs)

View file

@ -13,11 +13,11 @@ import Text.URI qualified as URI
import Data.Text qualified as T import Data.Text qualified as T
sendPost sendPost
:: (A.FromJSON output, A.ToJSON input) :: A.ToJSON input
=> UserDetails => UserDetails
-> String -> String
-> input -> input
-> IO output -> IO ByteString
sendPost details url payload = do sendPost details url payload = do
uri <- URI.mkURI $ fromString url uri <- URI.mkURI $ fromString url
let encoded = BSL.toStrict $ A.encode payload let encoded = BSL.toStrict $ A.encode payload
@ -29,7 +29,7 @@ sendPost details url payload = do
Req.POST Req.POST
url' url'
(Req.ReqBodyBs encoded) (Req.ReqBodyBs encoded)
Req.jsonResponse Req.bsResponse
( scheme ( scheme
<> sigHeaders httpSignature <> sigHeaders httpSignature
) )