In postInboxR, use the Activity type, so we only accept Create Note for now

This commit is contained in:
fr33domlover 2019-02-14 22:29:59 +00:00
parent fb396bb984
commit 128f1297ec

View file

@ -125,7 +125,7 @@ postInboxR = do
Left _ -> notAuthenticated
where
liftE = ExceptT . pure
getActivity :: UTCTime -> ExceptT String Handler (ContentType, HashMap Text Value)
getActivity :: UTCTime -> ExceptT String Handler (ContentType, Activity)
getActivity now = do
contentType <- do
ctypes <- lookupHeaders "Content-Type"
@ -138,34 +138,15 @@ postInboxR = do
_ -> Left "More than one Content-Type given"
HttpSigVerResult result <- ExceptT . fmap (first displayException) $ verifyRequestSignature now
uActor <- liftE result
o <- requireJsonBody
activityActor <-
liftE $
case M.lookup "actor" o of
Nothing -> Left "Activity has no actor member"
Just v -> case v of
String t -> case parseFedURI t of
Left e -> Left $ "Activity actor URI parsing failed: " ++ e
Right uri -> Right uri
_ -> Left "Activity actor isn't a JSON string"
liftE $ if activityActor == uActor
then Right ()
else Left "Activity's actor != Signature key's actor"
liftE $ case M.lookup "object" o of
Nothing -> Right ()
Just v -> case v of
Object obj -> case M.lookup "actor" obj <|> M.lookup "attributedTo" obj of
Nothing -> Right ()
Just v' -> case v' of
String t -> case parseFedURI t of
Left e -> Left $ "Activity actor URI parsing failed: " ++ e
Right uri ->
if uri == uActor
then Right ()
else Left "Activity object's actor doesn't match activity's actor"
_ -> Left "Activity actor isn't a JSON string"
_ -> Left "Activity's object isn't a JSON object"
return (contentType, o)
a@(CreateActivity c) <- requireJsonBody
liftE $ do
if createActor c == uActor
then Right ()
else Left "Activity's actor != Signature key's actor"
if noteAttrib (createObject c) == uActor
then Right ()
else Left "Activity object's actor doesn't match activity's actor"
return (contentType, a)
{-
jsonField :: (FromJSON a, ToJSON a) => Field Handler a