419 lines
9.9 KiB
Haskell
419 lines
9.9 KiB
Haskell
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.
|
|
-- <https://www.w3.org/TR/activitystreams-vocabulary/#object-types>
|
|
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,
|
|
-- <https://www.w3.org/TR/activitystreams-vocabulary/#activity-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.
|
|
-- <https://www.w3.org/TR/activitystreams-vocabulary/#actor-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
|
|
]
|