a few more fixes
This commit is contained in:
parent
c5465b93f1
commit
452477fc11
3 changed files with 12 additions and 12 deletions
12
app/DB.hs
12
app/DB.hs
|
@ -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
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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
|
||||||
)
|
)
|
||||||
|
|
Loading…
Add table
Reference in a new issue