vervis/src/Yesod/ActivityPub.hs

{- This file is part of Vervis.
 -
 - Written in 2019 by fr33domlover <fr33domlover@riseup.net>.
 -
 - ♡ Copying is an act of love. Please copy, reuse and share.
 -
 - The author(s) have dedicated all copyright and related and neighboring
 - rights to this software to the public domain worldwide. This software is
 - distributed without any warranty.
 -
 - You should have received a copy of the CC0 Public Domain Dedication along
 - with this software. If not, see
 - <http://creativecommons.org/publicdomain/zero/1.0/>.
 -}

module Yesod.ActivityPub
    ( YesodActivityPub (..)
    , postActivity
    )
where

import Prelude

import Data.ByteString (ByteString)
import Data.List.NonEmpty (NonEmpty)
import Data.Text (Text)
import Yesod.Core

import Network.HTTP.Client
import Network.HTTP.Signature
import Network.HTTP.Types.Header

import Network.FedURI
import Web.ActivityPub
import Yesod.MonadSite

class Yesod site => YesodActivityPub site where
    sitePostSignedHeaders :: site -> NonEmpty HeaderName
    siteGetHttpSign       :: (MonadSite m, SiteEnv m ~ site)
                          => m (KeyId, ByteString -> Signature)

postActivity
    :: ( MonadSite m
       , SiteEnv m ~ site
       , HasHttpManager site
       , YesodActivityPub site
       )
    => FedURI
    -> Maybe (Either FedURI (KeyId, ByteString))
    -> Doc Activity
    -> m (Either APPostError (Response ()))
postActivity inbox mrecip doc@(Doc hAct activity) = do
    manager <- asksSite getHttpManager
    headers <- asksSite sitePostSignedHeaders
    (keyid, sign) <- siteGetHttpSign
    let sender = renderFedURI $ l2f hAct (activityActor activity)
    httpPostAP manager inbox headers keyid sign sender mrecip doc