module Fedi.Types where import Data.Aeson qualified as A import Data.Aeson.Types qualified as A import Data.Text qualified as T import Fedi.UserDetails -- | An Object is what everything is here. -- data Object typ = Object { id :: Maybe ObjectId , otype :: typ , content :: Maybe Content , published :: Maybe UTCTime , replies :: Maybe [Link] , attachment :: Maybe [AnyMedia] , attributedTo :: Maybe (LinkOrObject Actor) , -- , audience :: Maybe String tag :: Maybe [Tag] , to :: Maybe [Link] , cc :: Maybe [Link] , inReplyTo :: Maybe (LinkOrObject Actor) , url :: Maybe Url -- revisit , name :: Maybe Name , icon :: Maybe Image , image :: Maybe Image , preview :: Maybe Preview , summary :: Maybe T.Text , updated :: Maybe UTCTime , -- , bto :: Maybe String -- , bcc :: Maybe String mediaType :: Maybe MediaType -- , duration :: Maybe String } deriving (Show) class ToObject a where toObject :: a -> [A.Pair] instance (ToObject a) => A.ToJSON (Object a) where toJSON = A.object . toObject instance (ToObject a) => ToObject (Object a) where toObject object = [ "@context" A..= ("https://www.w3.org/ns/activitystreams" :: String) ] <> toObject object.otype <> [ assignment | Just assignment <- [ fmap ("id" A..=) object.id , fmap ("content" A..=) object.content , fmap ("attachement" A..=) object.attachment , fmap ("attributedTo" A..=) object.attributedTo , fmap ("published" A..=) object.published , fmap ("inReplyTo" A..=) object.inReplyTo , fmap ("url" A..=) object.url , fmap ("name" A..=) object.name , fmap ("icon" A..=) object.icon , fmap ("image" A..=) object.image , -- , fmap ("preview" A..= ) object.preview fmap ("summary" A..=) object.summary , fmap ("updated" A..=) object.updated , fmap ("mediaType" A..=) object.mediaType , fmap ("to" A..=) object.to , fmap ("cc" A..=) object.cc , fmap ("replies" A..=) object.replies ] ] newtype ObjectId = ObjectId {unwrap :: String} deriving (Show, Eq, A.FromJSON, A.ToJSON) via String newtype Link = Link {unwrap :: Url} deriving (Show, A.FromJSON, A.ToJSON) via Url data LinkOrObject a = LLink Link | OObject (Object a) | CCollection [LinkOrObject a] deriving (Show) getAttributedTo :: LinkOrObject a -> Link getAttributedTo = \case LLink link -> link OObject obj -> Link (maybe (ObjectId "") id obj.id).unwrap CCollection list -> maybe (Link "") getAttributedTo (listToMaybe list) instance (ToObject o) => A.ToJSON (LinkOrObject o) where toJSON = \case LLink link -> A.toJSON link OObject ob -> A.toJSON ob CCollection loos -> A.toJSON loos data AnyMedia = ImageMedia Image deriving (Show) instance A.ToJSON AnyMedia where toJSON = \case ImageMedia obj -> A.toJSON obj type Image = Object TypeImage data TypeImage = TypeImage deriving (Show) instance ToObject TypeImage where toObject TypeImage = ["type" A..= ("Image" :: String)] data Name = StringName String | ObjectName (LinkOrObject Actor) deriving (Show) instance A.ToJSON Name where toJSON = \case StringName str -> A.toJSON str ObjectName loo -> A.toJSON loo type Content = T.Text type MediaType = String -- | A Note is an object that has the type 'Note'. type Note = Object TypeNote data TypeNote = TypeNote { likes :: Collection Like , shares :: Collection Share , replies :: Collection Note , sensitive :: Bool } deriving (Show) instance ToObject TypeNote where toObject note = [ "type" A..= ("Note" :: String) , "likes" A..= note.likes , "shares" A..= note.shares , "sensitive" A..= note.sensitive ] type Tag = Object TypeTag data TypeTag = TypeTag { href :: Url } deriving (Show) type Preview = Object TypePreview data TypePreview = TypePreview deriving (Show) type Share = Object TypeShare data TypeShare = TypeShare deriving (Show) instance ToObject TypeShare where toObject TypeShare = [ "type" A..= ("Share" :: String) ] -- * Activities -- | An Activity is a superset of an Object with one of the following types, -- -- and some additional fields. type Activity t = Object (TypeActivity t) data TypeActivity t = TypeActivity { actor :: Link , atype :: t , target :: Maybe AnyActivity , origin :: Maybe AnyActivity -- , result :: Maybe String -- , instrument :: Maybe String } deriving (Show) instance (ToObject t) => ToObject (TypeActivity t) where toObject activity = [ "actor" A..= activity.actor ] <> [ pair | Just pair <- [ fmap ("target" A..=) activity.target , fmap ("origin" A..=) activity.origin ] ] <> toObject activity.atype -- type Announce = Object (TypeActivity TypeAnnounce) -- data TypeAnnounce = TypeAnnounce deriving Show -- instance ToObject TypeAnnounce where -- toObject TypeAnnounce = -- [ "type" A..= ("Announce" :: String) -- ] type Create = Activity TypeCreate data TypeCreate = TypeCreate { object :: Note } deriving (Show) instance ToObject TypeCreate where toObject create = [ "type" A..= ("Create" :: String) , "object" A..= create.object ] type Follow = Object (TypeActivity TypeFollow) data TypeFollow = TypeFollow { object :: Actor } deriving Show instance ToObject TypeFollow where toObject follow = [ "type" A..= ("Follow" :: String) , "object" A..= follow.object ] -- type Like = Object (TypeActivity TypeLike) data TypeLike = TypeLike deriving (Show) instance ToObject TypeLike where toObject TypeLike = [ "type" A..= ("Like" :: String) ] data AnyActivity = -- ActivityAnnounce Announce ActivityCreate Create | ActivityFollow Follow -- | ActivityLike Like | ActivityAccept Accept | ActivityReject Reject deriving (Show) instance A.ToJSON AnyActivity where toJSON = \case -- ActivityAnnounce obj -> A.toJSON obj ActivityCreate obj -> A.toJSON obj ActivityFollow obj -> A.toJSON obj -- ActivityLike obj -> A.toJSON obj ActivityAccept obj -> A.toJSON obj ActivityReject obj -> A.toJSON obj -- * Accept Reject Add Remove type Accept = Object (TypeActivity TypeAccept) data TypeAccept = TypeAccept { object :: AnyActivity } deriving Show instance ToObject TypeAccept where toObject obj = [ "type" A..= ("Accept" :: String) , "object" A..= obj.object ] type Reject = Object (TypeActivity TypeReject) data TypeReject = TypeReject { object :: AnyActivity } deriving Show instance ToObject TypeReject where toObject obj = [ "type" A..= ("Reject" :: String) , "object" A..= obj.object ] -- * Actors -- | An Actor is an object that has one of the following types. -- data Actor = ActorPerson Person deriving (Show) instance A.ToJSON Actor where toJSON = \case ActorPerson obj -> A.toJSON obj instance ToObject Actor where toObject = \case ActorPerson obj -> toObject obj -- | A Person is an object that has the type 'Person'. type Person = Object TypePerson data TypePerson = TypePerson { preferredUsername :: String , publicKey :: PublicKey , inbox :: Link , outbox :: Link , following :: Link , followers :: Link } deriving (Show) instance ToObject TypePerson where toObject person = [ "type" A..= ("Person" :: String) , "preferredUsername" A..= person.preferredUsername , "publicKey" A..= person.publicKey , "inbox" A..= person.inbox , "outbox" A..= person.outbox , "following" A..= person.following , "followers" A..= person.followers ] data PublicKey = PublicKey { pkid :: Url , owner :: Url , publicKeyPem :: Pem } deriving (Show) instance A.ToJSON PublicKey where toJSON pk = A.object [ "id" A..= pk.pkid , "owner" A..= pk.owner , "publicKeyPem" A..= pk.publicKeyPem ] -- * Collections type Collection e = Object (CollectionType (Unordered e)) type OrderedCollection e = Object (CollectionType (Ordered e)) type OrderedCollectionPage e = Object (CollectionType (OrderedPage e)) type Outbox = OrderedCollection AnyActivity type OutboxPage = OrderedCollectionPage AnyActivity data CollectionType t = CollectionType { ctype :: t , first :: Maybe Url , last :: Maybe Url , current :: Maybe Url } deriving (Show) instance (ToObject t) => ToObject (CollectionType t) where toObject collection = toObject collection.ctype <> [ pair | Just pair <- [ fmap ("first" A..=) collection.first , fmap ("last" A..=) collection.last , fmap ("current" A..=) collection.current ] ] data Unordered e = UnorderedCollectionType { items :: [e] } deriving (Show) instance (A.ToJSON e) => ToObject (Unordered e) where toObject collection = [ "type" A..= ("Collection" :: String) , "totalItems" A..= length collection.items , "items" A..= collection.items ] data Ordered e = OrderedCollectionType { orderedItems :: [e] } deriving (Show) instance (A.ToJSON e) => ToObject (Ordered e) where toObject collection = [ "type" A..= ("OrderedCollection" :: String) , "totalItems" A..= length collection.orderedItems , "orderedItems" A..= collection.orderedItems ] data OrderedPage e = OrderedCollectionPageType { partOf :: Url , prev :: Maybe Url , next :: Maybe Url , porderedItems :: [e] } deriving (Show) instance (A.ToJSON e) => ToObject (OrderedPage e) where toObject page = [ "type" A..= ("OrderedCollectionPage" :: String) , "totalItems" A..= length page.porderedItems , "orderedItems" A..= page.porderedItems , "partOf" A..= page.partOf , "prev" A..= page.prev , "next" A..= page.next ]