use duplicate record fields

This commit is contained in:
me 2024-12-17 10:46:59 +02:00
parent 3034f194c7
commit a36f3a2bed
5 changed files with 78 additions and 93 deletions

View file

@ -52,6 +52,7 @@ library
GeneralizedNewtypeDeriving
DeriveAnyClass
DerivingStrategies
DuplicateRecordFields
executable fedi
import: warnings

View file

@ -8,7 +8,7 @@ import Data.Time (UTCTime)
data Activity
= Create
{ createId :: ActivityUrl
{ id :: ActivityUrl
, actor :: ActorId
, object :: Object
}
@ -20,13 +20,13 @@ data Object
data Note
= Note
{ noteId :: NoteId
, notePublished :: UTCTime
, noteActor :: ActorId
, noteContent :: T.Text
, noteName :: Maybe String
, noteUrl :: Maybe Url
, noteReplies :: Collection Unordered Note
{ id :: NoteId
, published :: UTCTime
, actor :: ActorId
, content :: T.Text
, name :: Maybe String
, url :: Maybe Url
, replies :: Collection Unordered Note
}
type NoteId = Url
@ -35,29 +35,30 @@ type Following = [Actor]
type Inbox = Collection Ordered Activity
type Outbox = Collection Unordered Activity
type OutboxPage = Collection Unordered Activity
data Ordered
data Unordered
data Collection order a
= Collection
{ collectionSummary :: String
, collectionItems :: [a]
{ summary :: String
, items :: [a]
}
instance A.ToJSON Note where
toJSON note =
A.object $
[ "type" A..= ("Note" :: String)
, "id" A..= note.noteId
, "published" A..= note.notePublished
, "attributedTo" A..= note.noteActor
, "content" A..= note.noteContent
, "name" A..= note.noteName
, "replies" A..= note.noteReplies
, "id" A..= note.id
, "published" A..= note.published
, "attributedTo" A..= note.actor
, "content" A..= note.content
, "name" A..= note.name
, "replies" A..= note.replies
]
<> [ "name" A..= name | Just name <- [note.noteName] ]
<> [ "url" A..= url | Just url <- [note.noteUrl] ]
<> [ "name" A..= name | Just name <- [note.name] ]
<> [ "url" A..= url | Just url <- [note.url] ]
instance A.ToJSON Object where
toJSON = \case
@ -71,7 +72,7 @@ instance A.ToJSON Activity where
[ "https://www.w3.org/ns/activitystreams" :: String
]
, "type" A..= ("Create" :: String)
, "id" A..= create.createId
, "id" A..= create.id
, "actor" A..= create.actor
, "object" A..= create.object
]
@ -83,9 +84,9 @@ instance A.ToJSON a => A.ToJSON (Collection Ordered a) where
[ "https://www.w3.org/ns/activitystreams" :: String
]
, "type" A..= ("OrderedCollection" :: String)
, "summary" A..= collection.collectionSummary
, "totalItems" A..= length collection.collectionItems
, "orderedItems" A..= collection.collectionItems
, "summary" A..= collection.summary
, "totalItems" A..= length collection.items
, "orderedItems" A..= collection.items
]
instance A.ToJSON a => A.ToJSON (Collection Unordered a) where
@ -95,24 +96,7 @@ instance A.ToJSON a => A.ToJSON (Collection Unordered a) where
[ "https://www.w3.org/ns/activitystreams" :: String
]
, "type" A..= ("Collection" :: String)
, "summary" A..= collection.collectionSummary
, "totalItems" A..= length collection.collectionItems
, "items" A..= collection.collectionItems
, "summary" A..= collection.summary
, "totalItems" A..= length collection.items
, "items" A..= collection.items
]
{-
"@context": "https://www.w3.org/ns/activitystreams",
"summary": "Sally's notes",
"type": "OrderedCollection",
"totalItems": 2,
"orderedItems": [
{
"type": "Note",
"name": "A Simple Note"
},
{
"type": "Note",
"name": "Another Simple Note"
}
]
-}

View file

@ -5,12 +5,12 @@ import Fedi.Types
data Actor
= Actor
{ actorId :: Url
, actorName :: String
, actorPreferredUsername :: String
, actorSummary :: String
, actorIcon :: Url
, actorPublicKey :: PublicKey
{ id :: Url
, name :: String
, preferredUsername :: String
, summary :: String
, icon :: Url
, publicKey :: PublicKey
}
deriving Show
@ -22,9 +22,9 @@ data ActorType
data PublicKey
= PublicKey
{ pkId :: Url
, pkOwner :: Url
, pkPublicKeyPem :: Pem
{ id :: Url
, owner :: Url
, publicKeyPem :: Pem
}
deriving Show
@ -34,16 +34,16 @@ makeActor details =
url = "https://" <> details.domain
actorUrl = url <> "/" <> details.username
in Actor
{ actorId = actorUrl
, actorName = details.name
, actorPreferredUsername = details.username
, actorSummary = details.summary
, actorIcon = details.icon
, actorPublicKey =
{ id = actorUrl
, name = details.name
, preferredUsername = details.username
, summary = details.summary
, icon = details.icon
, publicKey =
PublicKey
{ pkId = actorUrl <> "#main-key"
, pkOwner = actorUrl
, pkPublicKeyPem = details.publicPem
{ id = actorUrl <> "#main-key"
, owner = actorUrl
, publicKeyPem = details.publicPem
}
}
@ -54,19 +54,19 @@ instance A.ToJSON Actor where
[ "https://www.w3.org/ns/activitystreams" :: String
, "https://w3id.org/security/v1"
]
, "id" A..= actor.actorId
, "id" A..= actor.id
, "type" A..= Person
, "name" A..= actor.actorName
, "preferredUsername" A..= actor.actorPreferredUsername
, "summary" A..= actor.actorSummary
, "name" A..= actor.name
, "preferredUsername" A..= actor.preferredUsername
, "summary" A..= actor.summary
, "icon" A..= A.object
[ "type" A..= ("Image" :: String)
, "mediaType" A..= ("image/png" :: String)
, "url" A..= actor.actorIcon
, "url" A..= actor.icon
]
, "inbox" A..= (actor.actorId <> "/inbox")
, "outbox" A..= (actor.actorId <> "/outbox")
, "publicKey" A..= actor.actorPublicKey
, "inbox" A..= (actor.id <> "/inbox")
, "outbox" A..= (actor.id <> "/outbox")
, "publicKey" A..= actor.publicKey
]
instance A.ToJSON ActorType where
@ -75,7 +75,7 @@ instance A.ToJSON ActorType where
instance A.ToJSON PublicKey where
toJSON pk =
A.object
[ "id" A..= pk.pkId
, "owner" A..= pk.pkOwner
, "publicKeyPem" A..= pk.pkPublicKeyPem
[ "id" A..= pk.id
, "owner" A..= pk.owner
, "publicKeyPem" A..= pk.publicKeyPem
]

View file

@ -49,7 +49,7 @@ handleWebfinger :: UserDetails -> Twain.ResponderM b
handleWebfinger details = do
resource <- Twain.param "resource"
let webfinger = makeWebfinger details
if resource == ppSubject webfinger.wfSubject
if resource == ppSubject webfinger.subject
then do
Twain.send $ jsonLD (A.encode webfinger)
else do
@ -63,5 +63,5 @@ matchOutbox details =
handleOutbox :: UserDetails -> Twain.ResponderM b
handleOutbox details = do
let content = Collection { collectionSummary = details.username <> "'s notes", collectionItems = [] } :: Outbox
let content = Collection { summary = details.username <> "'s notes", items = [] } :: Outbox
Twain.send $ jsonLD (A.encode content)

View file

@ -6,27 +6,27 @@ import Fedi.Types
data Webfinger
= Webfinger
{ wfSubject :: Subject
, wfLinks :: [Link]
{ subject :: Subject
, links :: [Link]
}
deriving Show
data Subject
= Subject
{ subjectUsername :: Username
, subjectDomain :: Domain
{ username :: Username
, domain :: Domain
}
deriving Show
ppSubject :: Subject -> String
ppSubject subject =
"acct:" <> subject.subjectUsername <> "@" <> subject.subjectDomain
"acct:" <> subject.username <> "@" <> subject.domain
data Link
= Link
{ linkRel :: Rel
, linkType :: LinkType
, linkHref :: Url
{ rel :: Rel
, type_ :: LinkType
, href :: Url
}
deriving Show
@ -36,15 +36,15 @@ makeWebfinger details =
url = "https://" <> details.domain
in
Webfinger
{ wfSubject = Subject
{ subjectUsername = details.username
, subjectDomain = details.domain
{ subject = Subject
{ username = details.username
, domain = details.domain
}
, wfLinks =
, links =
[ Link
{ linkRel = Self
, linkType = ActivityJson
, linkHref = url <> "/" <> details.username
{ rel = Self
, type_ = ActivityJson
, href = url <> "/" <> details.username
}
]
}
@ -55,8 +55,8 @@ makeWebfinger details =
instance A.ToJSON Webfinger where
toJSON webfinger =
A.object
[ "subject" A..= webfinger.wfSubject
, "links" A..= webfinger.wfLinks
[ "subject" A..= webfinger.subject
, "links" A..= webfinger.links
]
instance A.ToJSON Subject where
@ -66,7 +66,7 @@ instance A.ToJSON Subject where
instance A.ToJSON Link where
toJSON link =
A.object
[ "rel" A..= link.linkRel
, "type" A..= link.linkType
, "href" A..= link.linkHref
[ "rel" A..= link.rel
, "type" A..= link.type_
, "href" A..= link.href
]