#{show time} $case result $of Left e
#{e} $of Right (ct, o)
#{BC.unpack ct}
                      #{decodeUtf8 o}
        |]

postInboxR :: Handler ()
postInboxR = do
    now <- liftIO getCurrentTime
    r <- runExceptT $ getActivity now
    let item = (now, second (second encodePretty) r)
    acts <- getsYesod appActivities
    liftIO $ atomically $ modifyTVar' acts $ \ vec ->
        let vec' = item `V.cons` vec
        in  if V.length vec' > 10
                then V.init vec'
                else vec'
    case r of
        Right _ -> return ()
        Left _ -> notAuthenticated
    where
    liftE = ExceptT . pure
    getActivity :: UTCTime -> ExceptT String Handler (ContentType, HashMap Text Value)
    getActivity now = do
        contentType <- do
            ctypes <- lookupHeaders "Content-Type"
            liftE $ case ctypes of
                [] -> Left "Content-Type not specified"
                [x] -> case x of
                    "application/activity+json" -> Right x
                    "application/ld+json; profile=\"https://www.w3.org/ns/activitystreams\"" -> Right x
                    _ -> Left "Unknown Content-Type"
                _ -> 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 parseURI $ T.unpack t of
                        Nothing -> Left "Activity actor URI parsing failed"
                        Just 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 parseURI $ T.unpack t of
                            Nothing -> Left "Activity actor URI parsing failed"
                            Just 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)

jsonField :: (FromJSON a, ToJSON a) => Field Handler a
jsonField = checkMMap fromTextarea toTextarea textareaField
    where
    toTextarea = Textarea . TL.toStrict . encodePrettyToLazyText
    fromTextarea = return . first T.pack . eitherDecodeStrict' . encodeUtf8 . unTextarea

activityForm :: Form Activity
activityForm = renderDivs $ areq jsonField "" $ Just defval
    where
    defval = Activity
        { activityTo =
            URI "https:"
                (Just $ URIAuth "" "forge.angeley.es" "")
                "/p/aviva"
                ""
                ""
        , activityJSON = M.fromList
            [ "@context" .= ("https://www.w3.org/ns/activitystreams" :: Text)
            , "type"     .= ("Create" :: Text)
            , "object"   .= object
                [ "type"    .= ("Note" :: Text)
                , "content" .= ("Hi! Nice to meet you :)" :: Text)
                , "to"      .= ("https://forge.angeley.es/p/luke" :: Text)
                ]
            ]
        }

activityWidget :: Widget -> Enctype -> Widget
activityWidget widget enctype =
    [whamlet|
        Enter an activity JSON document and click "Submit" to send it.
        
NOTES:
        

          
            This is a test page for implementing federation in Vervis. The
            activities just reach a test page, nothing really gets published or
            changed otherwise.
          

            The activity itself just needs to be valid JSON and pass some sanity
            checks. It isn't verified to look like an ActivityPub activity with
            ActivityStreams2 properties. So, you can probably post weird things
            and they will pass.
          

            The generated HTTP Signature uses Ed25519, while AFAIK the
            Fediverse generally uses RSA, specifically RSA-PKCS1.5 (i.e. not
            PSS) with SHA-256. In other words, send the activities to another
            Vervis instance, not to Mastodon etc., because the latter won't
            accept them.
          

            Addressing is determined by the "to" field, which has to be a
            single actor URL. The fields "cc" and "bcc" are ignored at the
            moment.

        
          ^{widget}
          
    |]

getOutboxR :: Handler Html
getOutboxR = do
    ((_result, widget), enctype) <- runFormPost activityForm
    defaultLayout $ activityWidget widget enctype

postOutboxR :: Handler Html
postOutboxR = do
    ((result, widget), enctype) <- runFormPost activityForm
    defaultLayout $ activityWidget widget enctype
    case result of
        FormMissing -> setMessage "Field(s) missing"
        FormFailure _l -> setMessage "Invalid input, see below"
        FormSuccess (Activity to act) -> do
            Entity _pid person <- requireAuth
            let sid = personIdent person
            sharer <- runDB $ get404 sid
            let shr = sharerIdent sharer
            renderUrl <- getUrlRender
            let actorID = renderUrl $ PersonR shr
                actID = actorID <> "/fake/1"
                objID = actorID <> "/fake/2"
                keyID = actorID <> "#key"
                updateObj (Object obj) = Object $ M.insert "attributedTo" (String actorID) $ M.insert "id" (String objID) obj
                updateObj v            = v
                updateAct = M.adjust updateObj "object" . M.insert "actor" (String actorID) . M.insert "id" (String actID)
            manager <- getsYesod appHttpManager
            eres <- httpGetAP manager to
            case eres of
                Left (APGetErrorHTTP e) -> setMessage $ toHtml $ "Failed to GET the recipient actor: " <> T.pack (displayException e)
                Left (APGetErrorJSON e) -> setMessage $ toHtml $ "Failed to parse recipient actor JSON: " <> T.pack (displayException e)
                Left (APGetErrorContentType e) -> setMessage $ toHtml $ "Got unexpected Content-Type for actor JSON: " <> T.pack e
                Right response -> do
                    let actor = getResponseBody response
                    if actorId actor /= to
                        then setMessage "Fetched actor JSON but its id doesn't match the URL we fetched"
                        else do
                            akey <- liftIO . readTVarIO =<< getsYesod appActorKey
                            let sign b = (KeyId $ encodeUtf8 keyID, actorKeySign akey b)
                            eres' <- httpPostAP manager (actorInbox actor) (hRequestTarget :| [hHost, hDate]) sign (updateAct act)
                            case eres of
                                Left e -> setMessage $ toHtml $ "Failed to POST to recipient's inbox: " <> T.pack (displayException e)
                                Right _ -> setMessage "Activity posted! You can go to the target server's /inbox to see the result."
    defaultLayout $ activityWidget widget enctype