use duplicate record fields
This commit is contained in:
parent
3034f194c7
commit
a36f3a2bed
5 changed files with 78 additions and 93 deletions
|
@ -52,6 +52,7 @@ library
|
|||
GeneralizedNewtypeDeriving
|
||||
DeriveAnyClass
|
||||
DerivingStrategies
|
||||
DuplicateRecordFields
|
||||
|
||||
executable fedi
|
||||
import: warnings
|
||||
|
|
|
@ -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"
|
||||
}
|
||||
]
|
||||
-}
|
||||
|
|
|
@ -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
|
||||
]
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
]
|
||||
|
|
Loading…
Add table
Reference in a new issue