72 lines
1.4 KiB
Haskell
72 lines
1.4 KiB
Haskell
module Fedi.Webfinger where
|
|
|
|
import Data.String (fromString)
|
|
import Data.Aeson qualified as A
|
|
import Fedi.Types
|
|
|
|
data Webfinger
|
|
= Webfinger
|
|
{ wfSubject :: Subject
|
|
, wfLinks :: [Link]
|
|
}
|
|
deriving Show
|
|
|
|
data Subject
|
|
= Subject
|
|
{ subjectUsername :: Username
|
|
, subjectDomain :: Domain
|
|
}
|
|
deriving Show
|
|
|
|
ppSubject :: Subject -> String
|
|
ppSubject subject =
|
|
"acct:" <> subject.subjectUsername <> "@" <> subject.subjectDomain
|
|
|
|
data Link
|
|
= Link
|
|
{ linkRel :: Rel
|
|
, linkType :: LinkType
|
|
, linkHref :: Url
|
|
}
|
|
deriving Show
|
|
|
|
makeWebfinger :: UserDetails -> Webfinger
|
|
makeWebfinger details =
|
|
let
|
|
url = "https://" <> details.domain
|
|
in
|
|
Webfinger
|
|
{ wfSubject = Subject
|
|
{ subjectUsername = details.username
|
|
, subjectDomain = details.domain
|
|
}
|
|
, wfLinks =
|
|
[ Link
|
|
{ linkRel = Self
|
|
, linkType = ActivityJson
|
|
, linkHref = url <> "/" <> details.username
|
|
}
|
|
]
|
|
}
|
|
|
|
-- * -------------------------
|
|
---
|
|
|
|
instance A.ToJSON Webfinger where
|
|
toJSON webfinger =
|
|
A.object
|
|
[ "subject" A..= webfinger.wfSubject
|
|
, "links" A..= webfinger.wfLinks
|
|
]
|
|
|
|
instance A.ToJSON Subject where
|
|
toJSON subject =
|
|
fromString $ ppSubject subject
|
|
|
|
instance A.ToJSON Link where
|
|
toJSON link =
|
|
A.object
|
|
[ "rel" A..= link.linkRel
|
|
, "type" A..= link.linkType
|
|
, "href" A..= link.linkHref
|
|
]
|