diff --git a/src/Web/ActivityPub.hs b/src/Web/ActivityPub.hs index 3f1cee6..21f9c43 100644 --- a/src/Web/ActivityPub.hs +++ b/src/Web/ActivityPub.hs @@ -15,6 +15,8 @@ -} {-# LANGUAGE StrictData #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} module Web.ActivityPub ( -- * Type-safe manipulation tools @@ -142,6 +144,103 @@ module Web.ActivityPub , fetchKnownSharedKey , Obj (..) + + , Property (..) + + {- + , Id_ + , Type_ + + , Subject_ + , Relationship_ + , Actor_ + , AttributedTo_ + , Attachment_ + , Bcc_ + , Bto_ + , Cc_ + , Context_ + , Current_ + , First_ + , Generator_ + , Icon_ + , Image_ + , InReplyTo_ + , Items_ + , Instrument_ + , OrderedItems_ + , Last_ + , Location_ + , Next_ + , Object_ + , OneOf_ + , AnyOf_ + , Closed_ + , Origin_ + , Accuracy_ + , Prev_ + , Preview_ + , Provider_ + , Replies_ + , Result_ + , Audience_ + , PartOf_ + , Tag_ + , Tags_ + , Target_ + , To_ + , Url_ + , Altitude_ + , Content_ + , ContentMap_ + , Name_ + , NameMap_ + , Duration_ + , EndTime_ + , Height_ + , Href_ + , Hreflang_ + , Latitude_ + , Longitude_ + , MediaType_ + , Published_ + , Radius_ + , Rating_ + , Rel_ + , StartIndex_ + , StartTime_ + , Summary_ + , SummaryMap_ + , TotalItems_ + , Units_ + , Updated_ + , Width_ + , Describes_ + , FormerType_ + , Deleted_ + + , Endpoints_ + , Following_ + , Followers_ + , Inbox_ + , Liked_ + , Shares_ + , Likes_ + , OauthAuthorizationEndpoint_ + , OauthTokenEndpoint_ + , Outbox_ + , PreferredUsername_ + , ProvideClientKey_ + , ProxyUrl_ + , SharedInbox_ + , SignClientKey_ + , Source_ + , Streams_ + , UploadMedia_ + -} + + , req + , opt ) where @@ -161,6 +260,7 @@ import Data.Bitraversable import Data.ByteString (ByteString) import Data.Char import Data.Foldable (for_) +import Data.Kind import Data.List import Data.List.NonEmpty (NonEmpty (..)) import Data.Proxy @@ -169,6 +269,7 @@ import Data.Text (Text) import Data.Text.Encoding (encodeUtf8, decodeUtf8, decodeUtf8') import Data.Time.Clock import Data.Traversable +import GHC.TypeLits import Network.HTTP.Client hiding (Proxy, proxy) import Network.HTTP.Client.Conduit.ActivityPub (httpAPEither) import Network.HTTP.Simple (JSONException) @@ -179,6 +280,7 @@ import Yesod.Core.Content (ContentType) import Yesod.Core.Handler (ProvidedRep, provideRepType) import Network.HTTP.Client.Signature +import Web.ActivityPub.Internal import qualified Data.Attoparsec.ByteString as A import qualified Data.ByteArray as BA diff --git a/src/Web/ActivityPub/Internal.hs b/src/Web/ActivityPub/Internal.hs new file mode 100644 index 0000000..d452155 --- /dev/null +++ b/src/Web/ActivityPub/Internal.hs @@ -0,0 +1,405 @@ +{- This file is part of Vervis. + - + - Written in 2024 by fr33domlover . + - + - ♡ 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 + - . + -} + +{-# LANGUAGE StrictData #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneKindSignatures #-} +{-# LANGUAGE AllowAmbiguousTypes #-} + +-- I created this module for the type-level properties, because they +-- require the AllowAmbiguousTypes extension. +module Web.ActivityPub.Internal + ( Property (..) + + {- + , Id_ + , Type_ + + , Subject_ + , Relationship_ + , Actor_ + , AttributedTo_ + , Attachment_ + , Bcc_ + , Bto_ + , Cc_ + , Context_ + , Current_ + , First_ + , Generator_ + , Icon_ + , Image_ + , InReplyTo_ + , Items_ + , Instrument_ + , OrderedItems_ + , Last_ + , Location_ + , Next_ + , Object_ + , OneOf_ + , AnyOf_ + , Closed_ + , Origin_ + , Accuracy_ + , Prev_ + , Preview_ + , Provider_ + , Replies_ + , Result_ + , Audience_ + , PartOf_ + , Tag_ + , Tags_ + , Target_ + , To_ + , Url_ + , Altitude_ + , Content_ + , ContentMap_ + , Name_ + , NameMap_ + , Duration_ + , EndTime_ + , Height_ + , Href_ + , Hreflang_ + , Latitude_ + , Longitude_ + , MediaType_ + , Published_ + , Radius_ + , Rating_ + , Rel_ + , StartIndex_ + , StartTime_ + , Summary_ + , SummaryMap_ + , TotalItems_ + , Units_ + , Updated_ + , Width_ + , Describes_ + , FormerType_ + , Deleted_ + + , Endpoints_ + , Following_ + , Followers_ + , Inbox_ + , Liked_ + , Shares_ + , Likes_ + , OauthAuthorizationEndpoint_ + , OauthTokenEndpoint_ + , Outbox_ + , PreferredUsername_ + , ProvideClientKey_ + , ProxyUrl_ + , SharedInbox_ + , SignClientKey_ + , Source_ + , Streams_ + , UploadMedia_ + -} + + , req + , opt + ) +where + +import Control.Applicative ((<|>), optional) +import Control.Exception (Exception, displayException, try) +import Control.Monad +import Control.Monad.IO.Class +import Control.Monad.Trans.Class +import Control.Monad.Trans.Except +import Control.Monad.Trans.Writer (Writer) +import Crypto.Hash hiding (Context) +import Data.Aeson +import Data.Aeson.Encoding (pair) +import Data.Aeson.Types (Parser, typeMismatch, listEncoding) +import Data.Bifunctor +import Data.Bitraversable +import Data.ByteString (ByteString) +import Data.Char +import Data.Foldable (for_) +import Data.Kind +import Data.List +import Data.List.NonEmpty (NonEmpty (..)) +import Data.Proxy +import Data.Semigroup (Endo, First (..)) +import Data.Text (Text) +import Data.Text.Encoding (encodeUtf8, decodeUtf8, decodeUtf8') +import Data.Time.Clock +import Data.Traversable +import GHC.TypeLits +import Network.HTTP.Client hiding (Proxy, proxy) +import Network.HTTP.Client.Conduit.ActivityPub (httpAPEither) +import Network.HTTP.Simple (JSONException) +import Network.HTTP.Types.Header (HeaderName, hContentType) +import Text.Email.Parser (EmailAddress) +import Text.Read (readMaybe) +import Yesod.Core.Content (ContentType) +import Yesod.Core.Handler (ProvidedRep, provideRepType) + +import Network.HTTP.Client.Signature + +import qualified Data.Attoparsec.ByteString as A +import qualified Data.ByteArray as BA +import qualified Data.ByteString as B +import qualified Data.ByteString.Base58 as B58 +import qualified Data.ByteString.Base64 as B64 +import qualified Data.ByteString.Char8 as BC +import qualified Data.ByteString.Lazy as BL +import qualified Data.HashMap.Strict as M +import qualified Data.List.NonEmpty as NE +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import qualified Data.Vector as V +import qualified Network.HTTP.Signature as S +import qualified Text.Email.Parser as E + +import Crypto.PublicVerifKey +import Development.PatchMediaType +import Development.PatchMediaType.JSON +import Network.FedURI +import Network.HTTP.Digest +import Web.Text + +import Data.Aeson.Local + +data Property + + -- Keywords + + = Id_ + | Type_ + + -- ActivityStreams2 + + | Subject_ + | Relationship_ + | Actor_ + | AttributedTo_ + | Attachment_ + | Bcc_ + | Bto_ + | Cc_ + | Context_ + | Current_ + | First_ + | Generator_ + | Icon_ + | Image_ + | InReplyTo_ + | Items_ + | Instrument_ + | OrderedItems_ + | Last_ + | Location_ + | Next_ + | Object_ + | OneOf_ + | AnyOf_ + | Closed_ + | Origin_ + | Accuracy_ + | Prev_ + | Preview_ + | Provider_ + | Replies_ + | Result_ + | Audience_ + | PartOf_ + | Tag_ + | Tags_ + | Target_ + | To_ + | Url_ + | Altitude_ + | Content_ + | ContentMap_ + | Name_ + | NameMap_ + | Duration_ + | EndTime_ + | Height_ + | Href_ + | Hreflang_ + | Latitude_ + | Longitude_ + | MediaType_ + | Published_ + | Radius_ + | Rating_ + | Rel_ + | StartIndex_ + | StartTime_ + | Summary_ + | SummaryMap_ + | TotalItems_ + | Units_ + | Updated_ + | Width_ + | Describes_ + | FormerType_ + | Deleted_ + + -- ActivityPub + + | Endpoints_ + | Following_ + | Followers_ + | Inbox_ + | Liked_ + | Shares_ + | Likes_ + | OauthAuthorizationEndpoint_ + | OauthTokenEndpoint_ + | Outbox_ + | PreferredUsername_ + | ProvideClientKey_ + | ProxyUrl_ + | SharedInbox_ + | SignClientKey_ + | Source_ + | Streams_ + | UploadMedia_ + +type PropertySymbol :: Property -> Symbol +type family PropertySymbol p where + + -- Keywords + + PropertySymbol 'Id_ = "id" + PropertySymbol 'Type_ = "type" + + -- ActivityStreams2 + + PropertySymbol 'Subject_ = "subject" + PropertySymbol 'Relationship_ = "relationship" + PropertySymbol 'Actor_ = "actor" + PropertySymbol 'AttributedTo_ = "attributedTo" + PropertySymbol 'Attachment_ = "attachment" + PropertySymbol 'Bcc_ = "bcc" + PropertySymbol 'Bto_ = "bto" + PropertySymbol 'Cc_ = "cc" + PropertySymbol 'Context_ = "context" + PropertySymbol 'Current_ = "current" + PropertySymbol 'First_ = "first" + PropertySymbol 'Generator_ = "generator" + PropertySymbol 'Icon_ = "icon" + PropertySymbol 'Image_ = "image" + PropertySymbol 'InReplyTo_ = "inReplyTo" + PropertySymbol 'Items_ = "items" + PropertySymbol 'Instrument_ = "instrument" + PropertySymbol 'OrderedItems_ = "orderedItems" + PropertySymbol 'Last_ = "last" + PropertySymbol 'Location_ = "location" + PropertySymbol 'Next_ = "next" + PropertySymbol 'Object_ = "object" + PropertySymbol 'OneOf_ = "oneOf" + PropertySymbol 'AnyOf_ = "anyOf" + PropertySymbol 'Closed_ = "closed" + PropertySymbol 'Origin_ = "origin" + PropertySymbol 'Accuracy_ = "accuracy" + PropertySymbol 'Prev_ = "prev" + PropertySymbol 'Preview_ = "preview" + PropertySymbol 'Provider_ = "provider" + PropertySymbol 'Replies_ = "replies" + PropertySymbol 'Result_ = "result" + PropertySymbol 'Audience_ = "audience" + PropertySymbol 'PartOf_ = "partOf" + PropertySymbol 'Tag_ = "tag" + PropertySymbol 'Tags_ = "tags" + PropertySymbol 'Target_ = "target" + PropertySymbol 'To_ = "to" + PropertySymbol 'Url_ = "url" + PropertySymbol 'Altitude_ = "altitude" + PropertySymbol 'Content_ = "content" + PropertySymbol 'ContentMap_ = "contentMap" + PropertySymbol 'Name_ = "name" + PropertySymbol 'NameMap_ = "nameMap" + PropertySymbol 'Duration_ = "duration" + PropertySymbol 'EndTime_ = "endTime" + PropertySymbol 'Height_ = "height" + PropertySymbol 'Href_ = "href" + PropertySymbol 'Hreflang_ = "hreflang" + PropertySymbol 'Latitude_ = "latitude" + PropertySymbol 'Longitude_ = "longitude" + PropertySymbol 'MediaType_ = "mediaType" + PropertySymbol 'Published_ = "published" + PropertySymbol 'Radius_ = "radius" + PropertySymbol 'Rating_ = "rating" + PropertySymbol 'Rel_ = "rel" + PropertySymbol 'StartIndex_ = "startIndex" + PropertySymbol 'StartTime_ = "startTime" + PropertySymbol 'Summary_ = "summary" + PropertySymbol 'SummaryMap_ = "summaryMap" + PropertySymbol 'TotalItems_ = "totalItems" + PropertySymbol 'Units_ = "units" + PropertySymbol 'Updated_ = "updated" + PropertySymbol 'Width_ = "width" + PropertySymbol 'Describes_ = "describes" + PropertySymbol 'FormerType_ = "formerType" + PropertySymbol 'Deleted_ = "deleted" + + -- ActivityPub + + PropertySymbol 'Endpoints_ = "endpoints" + PropertySymbol 'Following_ = "following" + PropertySymbol 'Followers_ = "followers" + PropertySymbol 'Inbox_ = "inbox" + PropertySymbol 'Liked_ = "liked" + PropertySymbol 'Shares_ = "shares" + PropertySymbol 'Likes_ = "likes" + PropertySymbol 'OauthAuthorizationEndpoint_ = "oauthAuthorizationEndpoint" + PropertySymbol 'OauthTokenEndpoint_ = "oauthTokenEndpoint" + PropertySymbol 'Outbox_ = "outbox" + PropertySymbol 'PreferredUsername_ = "preferredUsername" + PropertySymbol 'ProvideClientKey_ = "provideClientKey" + PropertySymbol 'ProxyUrl_ = "proxyUrl" + PropertySymbol 'SharedInbox_ = "sharedInbox" + PropertySymbol 'SignClientKey_ = "signClientKey" + PropertySymbol 'Source_ = "source" + PropertySymbol 'Streams_ = "streams" + PropertySymbol 'UploadMedia_ = "uploadMedia" + +req :: forall (p::Property) (a::Type) . + ( FromJSON a + , KnownSymbol (PropertySymbol p) + ) + => Object + -> Parser a +req obj = obj .: prop + where + prop = T.pack $ symbolVal @(PropertySymbol p) Proxy + +opt :: forall (p::Property) (a::Type) . + ( FromJSON a + , KnownSymbol (PropertySymbol p) + ) + => Object + -> Parser (Maybe a) +opt obj = obj .:? prop + where + prop = T.pack $ symbolVal @(PropertySymbol p) Proxy + +--instance ToJSONKey Property where +-- toJSONKey = toJSONKeyText diff --git a/vervis.cabal b/vervis.cabal index 8a06389..b23da6d 100644 --- a/vervis.cabal +++ b/vervis.cabal @@ -129,6 +129,7 @@ library Text.Jasmine.Local Web.ActivityAccess Web.ActivityPub + Web.ActivityPub.Internal Web.Actor Web.Actor.Deliver Web.Actor.Persist